1 files changed, 70 insertions, 54 deletions

diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index 51033a1..02c6b36 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -1,10 +1,6 @@
 open StdLabels
 
-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]
 
@@ -36,31 +32,34 @@ module Ast = struct
 end
 
 (** Default implementation for the expression *)
-module Expression : S.Expression with type t = pos Ast.expression = struct
-  type 'a obs
-  type t = pos Ast.expression
-  type repr = Report.t list -> t * Report.t list
-  type variable = { pos : pos; name : string; index : repr option }
+module Expression : S.Expression with type t' = S.pos Ast.expression = struct
+  type t = S.pos Ast.expression
+  type t' = t
+
+  let v : t * Report.t list -> t' * Report.t list = fun (t, r) -> (t, r)
 
-  let integer : pos -> string -> repr = fun pos i r -> (Ast.Integer (pos, i), r)
-  let literal : pos -> string -> repr = fun pos l r -> (Ast.Literal (pos, l), r)
+  let integer : S.pos -> string -> t S.repr =
+   fun pos i r -> (Ast.Integer (pos, i), r)
 
-  let function_ : pos -> T.function_ -> repr list -> repr =
+  let literal : S.pos -> string -> t S.repr =
+   fun pos l r -> (Ast.Literal (pos, l), r)
+
+  let function_ : S.pos -> T.function_ -> t S.repr list -> t S.repr =
    fun pos name args r ->
     let args = List.map ~f:(fun f -> fst (f r)) args in
     (Ast.Function (pos, name, args), r)
 
-  let uoperator : pos -> T.uoperator -> repr -> repr =
+  let uoperator : S.pos -> T.uoperator -> t S.repr -> t S.repr =
    fun pos op expression r ->
     let expression = fst (expression r) in
     (Ast.Op (pos, op, expression), r)
 
-  let boperator : pos -> T.boperator -> repr -> repr -> repr =
+  let boperator : S.pos -> T.boperator -> t S.repr -> t S.repr -> t S.repr =
    fun pos op op1 op2 r ->
     let op1 = fst (op1 r) and op2 = fst (op2 r) in
     (Ast.BinaryOp (pos, op, op1, op2), r)
 
-  let ident : variable -> repr =
+  let ident : (S.pos, t S.repr) S.variable -> t S.repr =
    fun { pos; name; index } r ->
     let index = Option.map (fun i -> fst (i r)) index in
     (Ast.Ident { pos; name; index }, r)
@@ -68,50 +67,67 @@ 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 ->
-    let args = List.map ~f:(fun f -> fst (f [])) args in
-    Ast.Call (pos, name, args)
-
-  let location : pos -> string -> repr =
-   fun loc label -> Ast.Location (loc, label)
+    with type expression = Expression.t' S.repr
+     and type t' = S.pos Ast.statement = struct
+  type t = S.pos Ast.statement
+  type t' = t
 
-  let comment : pos -> repr = fun pos -> Ast.Comment pos
+  let v = Fun.id
 
-  let expression : expression -> repr =
-   fun expr -> Ast.Expression (fst (expr []))
+  type expression = Expression.t' S.repr
 
-  type clause = pos * expression * repr list
-
-  let if_ : pos -> clause -> elifs:clause list -> else_:repr list -> repr =
-   fun pos predicate ~elifs ~else_ ->
-    let clause (pos, expr, repr) = (pos, fst (expr []), repr) in
-    let elifs = List.map ~f:clause elifs in
-
-    Ast.If { loc = pos; then_ = clause predicate; elifs; else_ }
-
-  let act : pos -> label:expression -> repr list -> repr =
-   fun pos ~label statements ->
-    let label = fst (label []) in
-    Ast.Act { loc = pos; label; statements }
-
-  let assign : pos -> variable -> T.assignation_operator -> expression -> repr =
-   fun pos_loc { pos; name; index } op expr ->
-    let index = Option.map (fun i -> fst (i [])) index
-    and expr = fst (expr []) in
-    Ast.Declaration (pos_loc, { pos; name; index }, op, expr)
+  let call : S.pos -> T.keywords -> expression list -> t S.repr =
+   fun pos name args report ->
+    let args = List.map ~f:(fun f -> fst (f [])) args in
+    (Ast.Call (pos, name, args), report)
+
+  let location : S.pos -> string -> t S.repr =
+   fun loc label report -> (Ast.Location (loc, label), report)
+
+  let comment : S.pos -> t S.repr = fun pos report -> (Ast.Comment pos, report)
+
+  let expression : expression -> t S.repr =
+   fun expr report -> (Ast.Expression (fst (expr [])), report)
+
+  type clause = S.pos * expression * t S.repr list
+
+  let if_ :
+      S.pos -> clause -> elifs:clause list -> else_:t S.repr list -> t S.repr =
+   fun pos predicate ~elifs ~else_ report ->
+    let clause (pos, expr, repr) =
+      let repr = List.map ~f:(fun instr -> fst @@ instr []) repr in
+      (pos, fst @@ expr [], repr)
+    in
+    let elifs = List.map ~f:clause elifs
+    and else_ = List.map ~f:(fun instr -> fst @@ instr []) else_ in
+
+    (Ast.If { loc = pos; then_ = clause predicate; elifs; else_ }, report)
+
+  let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
+   fun pos ~label statements report ->
+    let label = fst (label [])
+    and statements = List.map ~f:(fun instr -> fst @@ instr []) statements in
+    (Ast.Act { loc = pos; label; statements }, report)
+
+  let assign :
+      S.pos ->
+      (S.pos, expression) S.variable ->
+      T.assignation_operator ->
+      expression ->
+      t S.repr =
+   fun pos_loc { pos; name; index } op expr report ->
+    (*let index = Option.map (fun i -> fst @@ Expression.observe (i [])) index*)
+    let index = Option.map (fun f -> fst @@ f []) index in
+    let expr = fst (expr []) in
+    (Ast.Declaration (pos_loc, { pos; name; index }, op, expr), report)
 end
 
 module Location = struct
-  type instruction = pos Ast.statement
-  type repr = pos * instruction list
+  type instruction = S.pos Ast.statement S.repr
+  type repr = S.pos * S.pos Ast.statement list
 
-  let location : pos -> instruction list -> repr = fun pos block -> (pos, block)
+  let location : S.pos -> instruction list -> repr =
+   fun pos block ->
+    let block = List.map block ~f:(fun b -> fst @@ b []) in
+    (pos, block)
 end