/usr/lib/ocaml/compiler-libs/primitive.mli is in ocaml-compiler-libs 4.05.0-10ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | (**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Description of primitive functions *)
type boxed_integer = Pnativeint | Pint32 | Pint64
(* Representation of arguments/result for the native code version
of a primitive *)
type native_repr =
| Same_as_ocaml_repr
| Unboxed_float
| Unboxed_integer of boxed_integer
| Untagged_int
type description = private
{ prim_name: string; (* Name of primitive or C function *)
prim_arity: int; (* Number of arguments *)
prim_alloc: bool; (* Does it allocates or raise? *)
prim_native_name: string; (* Name of C function for the nat. code gen. *)
prim_native_repr_args: native_repr list;
prim_native_repr_res: native_repr }
(* Invariant [List.length d.prim_native_repr_args = d.prim_arity] *)
val simple
: name:string
-> arity:int
-> alloc:bool
-> description
val make
: name:string
-> alloc:bool
-> native_name:string
-> native_repr_args: native_repr list
-> native_repr_res: native_repr
-> description
val parse_declaration
: Parsetree.value_description
-> native_repr_args:native_repr list
-> native_repr_res:native_repr
-> description
val print
: description
-> Outcometree.out_val_decl
-> Outcometree.out_val_decl
val native_name: description -> string
val byte_name: description -> string
type error =
| Old_style_float_with_native_repr_attribute
| Old_style_noalloc_with_noalloc_attribute
| No_native_primitive_with_repr_attribute
exception Error of Location.t * error
|