diff options
Diffstat (limited to 'lib/syntax/tree.ml')
-rw-r--r-- | lib/syntax/tree.ml | 95 |
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 |