/
helpers.ml
50 lines (41 loc) · 1.46 KB
/
helpers.ml
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
open Typedtree
let noneloc = Location.none
let mk_pat ?(loc = noneloc) ?(extra = []) ~typ ~env desc =
{ pat_desc = desc;
pat_type = typ;
pat_extra = extra;
pat_loc = loc;
pat_env = env; }
let mk_expr ?(loc = noneloc) ?(extra = []) ~typ ~env desc =
{ exp_desc = desc;
exp_type = typ;
exp_extra = extra;
exp_loc = loc;
exp_env = env; }
open Predef
open Env
let core_env = initial
let typ_unit = type_unit
let typ_int = type_int
let val_unit = find_value ( Path.Pident ( List.assoc "()" builtin_idents) ) core_env
let cstr_unit =
let open Types in
{
cstr_name = "()";
cstr_res = typ_unit; (* Type of the result *)
cstr_existentials = []; (* list of existentials *)
cstr_args = []; (* Type of the arguments *)
cstr_arity = 0; (* Number of arguments *)
cstr_tag = Cstr_constant 0; (* Tag for heap blocks *)
cstr_consts = 1; (* Number of constant constructors *)
cstr_nonconsts = 0; (* Number of non-const constructors *)
cstr_normal = 0; (* Number of non generalized constrs *)
cstr_generalized = true; (* Constrained return type? *)
cstr_private = Asttypes.Public } (* Read-only constructor? *)
let typ_arrow ?(label="") ?(commutable=Types.Cunknown) t1 t2 =
let open Types in
{
desc = Tarrow ( label, t1, t2, commutable);
level = 0; (* UNSAFE ! *)
id = 0;
}