diff options
Diffstat (limited to 'lib/syntax/tree.ml')
| -rw-r--r-- | lib/syntax/tree.ml | 96 | 
1 files changed, 46 insertions, 50 deletions
| diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml index 85e130d..cf02bf6 100644 --- a/lib/syntax/tree.ml +++ b/lib/syntax/tree.ml @@ -36,58 +36,50 @@ 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 v : t -> t' * Report.t list = fun t -> (t, []) +  let integer : S.pos -> string -> t = fun pos i -> Ast.Integer (pos, i) +  let literal : S.pos -> string -> t = fun pos l -> Ast.Literal (pos, l) -  let integer : S.pos -> string -> t S.repr = -   fun pos i r -> (Ast.Integer (pos, i), r) +  let function_ : S.pos -> T.function_ -> t list -> t = +   fun pos name args -> Ast.Function (pos, name, args) -  let literal : S.pos -> string -> t S.repr = -   fun pos l r -> (Ast.Literal (pos, l), r) +  let uoperator : S.pos -> T.uoperator -> t -> t = +   fun pos op expression -> Ast.Op (pos, op, expression) -  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 boperator : S.pos -> T.boperator -> t -> t -> t = +   fun pos op op1 op2 -> +    let op1 = op1 and op2 = op2 in +    Ast.BinaryOp (pos, op, op1, op2) -  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 : 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 : (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) +  let ident : (S.pos, t) S.variable -> t = +   fun { pos; name; index } -> +    let index = Option.map (fun i -> i) index in +    Ast.Ident { pos; name; index }  end  module Instruction :    S.Instruction -    with type expression = Expression.t' S.repr +    with type expression = Expression.t' * Report.t list       and type t' = S.pos Ast.statement = struct    type t = S.pos Ast.statement    type t' = t -  let v = Fun.id +  let v : t -> t' * Report.t list = fun t -> (t, []) -  type expression = Expression.t' S.repr +  type expression = Expression.t' * Report.t list    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) +   fun pos name args _ -> +    let args = List.map ~f:fst args in +    Ast.Call (pos, name, args)    let location : S.pos -> string -> t S.repr = -   fun loc label report -> (Ast.Location (loc, label), report) +   fun loc label _ -> Ast.Location (loc, label) -  let comment : S.pos -> t S.repr = fun pos report -> (Ast.Comment pos, report) +  let comment : S.pos -> t S.repr = fun pos _ -> Ast.Comment pos    let expression : expression -> t S.repr = -   fun expr report -> (Ast.Expression (fst (expr [])), report) +   fun expr _ -> Ast.Expression (fst expr)    let if_ :        S.pos -> @@ -95,26 +87,26 @@ module Instruction :        elifs:(expression, t) S.clause list ->        else_:(S.pos * t S.repr list) option ->        t S.repr = -   fun pos predicate ~elifs ~else_ report -> +   fun pos predicate ~elifs ~else_ _ ->      let clause (pos, expr, repr) = -      let repr = List.map ~f:(fun instr -> fst @@ instr []) repr in -      (pos, fst @@ expr [], repr) +      let repr = List.map ~f:(fun instr -> instr []) repr in +      (pos, fst @@ expr, repr)      in      let elifs = List.map ~f:clause elifs      and else_ =        match else_ with        | None -> []        | Some (_, instructions) -> -          List.map ~f:(fun instr -> fst @@ instr []) instructions +          List.map ~f:(fun instr -> instr []) instructions      in -    (Ast.If { loc = pos; then_ = clause predicate; elifs; else_ }, report) +    Ast.If { loc = pos; then_ = clause predicate; elifs; else_ }    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) +   fun pos ~label statements _ -> +    let label = fst label +    and statements = List.map ~f:(fun instr -> instr []) statements in +    Ast.Act { loc = pos; label; statements }    let assign :        S.pos -> @@ -122,19 +114,23 @@ module Instruction :        T.assignation_operator ->        expression ->        t S.repr = -   fun pos_loc { pos; name; index } op expr report -> +   fun pos_loc { pos; name; index } op expr _ ->      (*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) +    let index = Option.map fst index in +    let expr = fst expr in +    Ast.Declaration (pos_loc, { pos; name; index }, op, expr)  end  module Location = struct -  type instruction = S.pos Ast.statement +  type instruction = (Instruction.t' * Report.t list) S.repr    type t = S.pos * S.pos Ast.statement list -  let location : S.pos -> instruction S.repr list -> t S.repr = -   fun pos block _report -> -    let block = List.map block ~f:(fun b -> fst @@ b []) in -    ((pos, block), []) +  let location : S.pos -> instruction list -> (t * Report.t list) S.repr = +   fun pos block report -> +    let report, block = +      List.fold_left_map ~init:report block ~f:(fun report b -> +          let v, report = b report in +          (report, v)) +    in +    ((pos, block), report)  end | 
