aboutsummaryrefslogtreecommitdiff
path: root/lib/syntax/tree.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/syntax/tree.ml')
-rw-r--r--lib/syntax/tree.ml95
1 files changed, 95 insertions, 0 deletions
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
new file mode 100644
index 0000000..bb31253
--- /dev/null
+++ b/lib/syntax/tree.ml
@@ -0,0 +1,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 * string * '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 -> string -> 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