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
|
type pos = Lexing.position * Lexing.position
module Ast = struct
type nonrec pos = pos
type 'a variable = { pos : 'a; name : string; index : 'a expression option }
[@@deriving eq, show]
and 'a expression =
| Integer of 'a * string
| Literal of 'a * string
| Ident of 'a variable
| BinaryOp of 'a * T.boperator * 'a expression * 'a expression
| Op of 'a * T.uoperator * 'a expression
| Function of 'a * T.function_ * 'a expression list
[@@deriving eq, show]
and 'a condition = 'a * 'a expression * 'a statement list
and 'a statement =
| If of {
loc : 'a;
then_ : 'a condition;
elifs : 'a condition list;
else_ : 'a statement list;
}
| Act of { loc : 'a; label : 'a expression; statements : 'a statement list }
| Declaration of ('a * 'a variable * T.assignation_operator * 'a expression)
| Expression of 'a expression
| Comment of 'a
| Call of 'a * T.keywords * 'a expression list
| Location of 'a * string
[@@deriving eq, show]
end
(** Default implementation for the expression *)
module Expression : S.Expression with type repr = pos Ast.expression = struct
type 'a obs
type repr = pos Ast.expression
type variable = { pos : pos; name : string; index : repr option }
let integer : pos -> string -> repr = fun pos i -> Ast.Integer (pos, i)
let literal : pos -> string -> repr = fun pos l -> Ast.Literal (pos, l)
let function_ : pos -> T.function_ -> repr list -> repr =
fun pos name args -> Ast.Function (pos, name, args)
let uoperator : pos -> T.uoperator -> repr -> repr =
fun pos op expression -> Ast.Op (pos, op, expression)
let boperator : pos -> T.boperator -> repr -> repr -> repr =
fun pos op op1 op2 -> Ast.BinaryOp (pos, op, op1, op2)
let ident : variable -> repr =
fun { pos; name; index } -> Ast.Ident { pos; name; index }
end
module Instruction :
S.Instruction
with type expression = Expression.repr
and type repr = pos Ast.statement
and type variable = Expression.variable = struct
type repr = pos Ast.statement
type expression = Expression.repr
type variable = Expression.variable
let call : pos -> T.keywords -> expression list -> repr =
fun pos name args -> Ast.Call (pos, name, args)
let location : pos -> string -> repr =
fun loc label -> Ast.Location (loc, label)
let comment : pos -> repr = fun pos -> Ast.Comment pos
let expression : expression -> repr = fun expr -> Ast.Expression expr
type clause = pos * expression * repr list
let if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr =
fun pos predicate ~elifs ~else_ ->
Ast.If { loc = pos; then_ = predicate; elifs; else_ }
let act : pos -> label:expression -> repr list -> repr =
fun pos ~label statements -> Ast.Act { loc = pos; label; statements }
let assign : pos -> variable -> T.assignation_operator -> expression -> repr =
fun pos_loc { pos; name; index } op expr ->
Ast.Declaration (pos_loc, { pos; name; index }, op, expr)
end
module Location = struct
type instruction = pos Ast.statement
type repr = pos * instruction list
let location : pos -> instruction list -> repr = fun pos block -> (pos, block)
end
|
