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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
(** Copyright 2025, Tenyaeva Ekaterina *)
(** SPDX-License-Identifier: LGPL-3.0-or-later *)
open Base
type ident = string [@@deriving show { with_path = false }] (* identifier *)
let is_keyword = function
| "let"
| "rec"
| "and"
| "in"
| "if"
| "then"
| "else"
| "match"
| "with"
| "true"
| "false"
| "Some"
| "None"
| "type"
| "_" -> true
| _ -> false
;;
type constant =
| Const_int of int (** integer, e.g. 122 *)
| Const_bool of bool (** boolean, e.g. true *)
| Const_unit (** [()] *)
[@@deriving show { with_path = false }]
type rec_flag =
| Recursive (** recursive *)
| NonRecursive (** non-recursive *)
[@@deriving show { with_path = false }]
type binary_op =
| Add (** [+] *)
| Mult (** [*] *)
| Sub (** [-] *)
| Div (** [/] *)
| Gt (** [>] *)
| Lt (** [<] *)
| Eq (** [=] *)
| Neq (** [<>] *)
| Gte (** [>=] *)
| Lte (** [<=] *)
[@@deriving show { with_path = false }]
type unary_op =
| Negative (** unary minus, e.g. -5 *)
| Positive (** unary plus, e.g. +5 *)
| Not (** [not] *)
[@@deriving show { with_path = false }]
type type_annot =
| Type_int (** integer type - [int] *)
| Type_bool (** boolean type - [bool] *)
| Type_unit (** unit type - [unit] *)
| Type_var of ident (** variable type *)
| Type_arrow of type_annot * type_annot (** arrow type *)
| Type_option of type_annot (** type option *)
[@@deriving show { with_path = false }]
type pattern =
| Pat_any (** matches any value without binding it - [_] *)
| Pat_var of (ident[@gen gen_ident])
(** matches any value and binds it to a variable, e.g. x *)
| Pat_constant of constant (** matches a constant value, e.g. 42, true *)
| Pat_option of pattern option (** matches an optional pattern, e.g. Some x or None *)
| Pat_constraint of type_annot * (pattern[@gen gen_pattern_sized (n / 20)])
(** typed pattern, e.g. a: int *)
[@@deriving show { with_path = false }]
type expression =
| Expr_const of constant (** constant, e.g. 10*)
| Expr_ident of (ident[@gen gen_ident]) (** variable, e.g. x *)
| Expr_option of expression option (** optonal expression, e.g. Some x*)
| Expr_constraint of type_annot * expression (** typed expression, e.g. a: int *)
| Expr_binop of binary_op * expression * expression (** binary operation, e.g. 1 + 5*)
| Expr_unop of unary_op * expression (** unary operation, e.g. -7 *)
| Expr_fun of pattern * expression (** function, e.g. fun (x, y) -> x + y *)
| Expr_apply of expression * expression
(** application, e.g. (fun (x, y) -> x + y) (1, 2) *)
| Expr_if of expression * expression * expression option
(** conditional expression, e.g. if a then b else c*)
| Expr_let of rec_flag * value_binding * value_binding list * expression
(** let, e.g. let x = 5 *)
| Expr_function of case * case list (** function, e.g. fun (x, y) -> x + y *)
| Expr_match of expression * case * case list
(** pattern matching, e.g. match x with | 0 -> "zero" | _ -> "nonzero" *)
[@@deriving show { with_path = false }]
and value_binding =
{ vb_pat : pattern (** the pattern being bound, e.g. x, (a, b) *)
; vb_expr : expression (** the expression being assigned, e.g. 42, fun x -> x + 1 *)
}
[@@deriving show { with_path = false }]
and case =
{ case_pat : pattern (** the pattern to match, e.g. x, _ *)
; case_expr : expression (** the expression to evaluate if the pattern matches *)
}
[@@deriving show { with_path = false }]
type structure_item =
| Str_eval of expression (** an expression to be evaluated but not bound, e.g. 1 + 2*)
| Str_value of rec_flag * value_binding * value_binding list
(** a value or function binding, e.g. let x = 1*)
[@@deriving show { with_path = false }]
(** full program *)
type structure = structure_item list [@@deriving show { with_path = false }]