diff --git a/lib/ast.ml b/lib/ast.ml index 08e4c99d..3d9e034f 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -14,10 +14,10 @@ type t = | Constant of line * Constant.t | Var of line * string | Tuple of line * t list - | App of t * t list - | Abs of fun_abst - | Let of string * t * t - | Letrec of (string * fun_abst) list * t + | App of line * t * t list + | Abs of line * fun_abst + | Let of line * string * t * t + | Letrec of line * (string * fun_abst) list * t | Case of t * (pattern * t) list | LocalFun of {function_name : string; arity: int} | MFA of {module_name: t; function_name: t; arity: t} @@ -37,9 +37,9 @@ let line_number_of_t = function | Constant (line, _) -> line | Var (line, _) -> line | Tuple (line, _) -> line -| App (_, _) -> -1 -| Abs (_) -> -1 -| Let (_, _, _) -> -1 +| App (line, _, _) -> line +| Abs (line, _) -> line +| Let (line, _, _, _) -> line | Letrec (_) -> -1 | Case (_, _) -> -1 | LocalFun _ -> -1 diff --git a/lib/derivation.ml b/lib/derivation.ml index df9eca4d..e63f12d8 100644 --- a/lib/derivation.ml +++ b/lib/derivation.ml @@ -22,7 +22,7 @@ let rec derive context = function result_map_m ~f:(derive context) exprs >>| List.unzip >>| fun (tys, cs) -> (Type.of_elem (TyTuple tys), Conj cs) - | App (f, args) -> + | App (_line, f, args) -> derive context f >>= fun (tyf, cf) -> result_map_m ~f:(fun arg -> @@ -47,7 +47,7 @@ let rec derive context = function args_constraints in Ok (beta, Conj constraints) - | Abs {args=vs; body=e} -> + | Abs (_line, {args=vs; body=e}) -> let new_tyvars = List.map ~f:(fun v -> (v, (new_tyvar ()))) vs in let added_context = List.fold_left @@ -57,11 +57,11 @@ let rec derive context = function in derive added_context e >>= fun (ty_e, c) -> Ok (Type.of_elem (TyFun (List.map ~f:snd new_tyvars, ty_e)), c) - | Let (v, e1, e2) -> + | Let (_line, v, e1, e2) -> derive context e1 >>= fun (ty_e1, c1) -> derive (Context.add (Context.Key.Var v) ty_e1 context) e2 >>= fun (ty_e2, c2) -> Ok (ty_e2, Conj [c1; c2]) - | Letrec (lets , e) -> + | Letrec (line, lets , e) -> let new_tyvars = List.map ~f:(fun (v, f) -> (v, f, (new_tyvar ()))) lets in let added_context = List.fold_left @@ -73,7 +73,7 @@ let rec derive context = function in let constraints_result = new_tyvars - |> result_map_m ~f:(fun (_, f, tyvar) -> derive added_context (Abs f) >>| fun(ty, c) -> (ty, c, tyvar)) + |> result_map_m ~f:(fun (_, f, tyvar) -> derive added_context (Abs (line, f)) >>| fun(ty, c) -> (ty, c, tyvar)) >>| List.map ~f:(fun (ty, c, tyvar) -> [Eq (tyvar, ty); c]) >>| List.concat in diff --git a/lib/from_erlang.ml b/lib/from_erlang.ml index 0dabab41..7983a77d 100644 --- a/lib/from_erlang.ml +++ b/lib/from_erlang.ml @@ -190,6 +190,30 @@ let rec pattern_of_erlang_pattern = function | F.PatCons {head; tail; _} -> PatCons (pattern_of_erlang_pattern head, pattern_of_erlang_pattern tail) +let rec line_number_of_erlang_expr = function +| F.ExprBody {exprs} -> line_number_of_erlang_expr (List.hd_exn exprs) +| ExprCase {line; _} -> line +| ExprCons {line; _} -> line +| ExprNil {line} -> line +| ExprListComprehension {line; _} -> line +| ExprLocalFunRef {line; _} -> line +| ExprRemoteFunRef {line; _} -> line +| ExprFun {line; _} -> line +| ExprLocalCall {line; _} -> line +| ExprRemoteCall {line; _} -> line +| ExprMapCreation {line; _} -> line +| ExprMapUpdate {line; _} -> line +| ExprMatch {line; _} -> line +| ExprBinOp {line; _} -> line +| ExprTuple {line; _} -> line +| ExprVar {line; _} -> line +| ExprLit {lit} -> + match lit with + | LitAtom {line; _} -> line + | LitChar {line; _} -> line + | LitInteger {line; _} -> line + | LitBigInt {line; _} -> line + | LitString {line; _} -> line (* converts a secuence of expressions `[e1; e2; ...]` to an expression `let _ = e1 in let _ = e2 in ...` *) (* assume `extract_toplevel` is applied to the argument *) @@ -202,7 +226,7 @@ let rec expr_of_erlang_exprs = function let es' = expr_of_erlang_exprs es in Case (body', [((pattern_of_erlang_pattern pattern, Constant (line, Atom "true")), es')]) | e :: es -> - Let ("_", expr_of_erlang_expr' e, expr_of_erlang_exprs es) + Let (line_number_of_erlang_expr e, "_", expr_of_erlang_expr' e, expr_of_erlang_exprs es) and expr_of_erlang_expr' = function | F.ExprBody {exprs} -> expr_of_erlang_exprs exprs @@ -225,20 +249,20 @@ and expr_of_erlang_expr' = function let fun_abst = function_of_clauses clauses in (* If name is omitted, don't create Letrec *) (match name with - | Some name -> Letrec ([(name, fun_abst)], Var (line, name)) - | None -> Abs fun_abst + | Some name -> Letrec (line, [(name, fun_abst)], Var (line, name)) + | None -> Abs (line, fun_abst) ) - | ExprLocalCall {function_expr=ExprLit {lit=LitAtom {atom=function_name; _}}; args; _} -> + | ExprLocalCall {line; function_expr=ExprLit {lit=LitAtom {atom=function_name; _}}; args} -> let arity = List.length args in - App (LocalFun{function_name; arity}, List.map ~f:expr_of_erlang_expr' args) - | ExprLocalCall {function_expr; args; _} -> - App (expr_of_erlang_expr' function_expr, List.map ~f:expr_of_erlang_expr' args) + App (line, LocalFun{function_name; arity}, List.map ~f:expr_of_erlang_expr' args) + | ExprLocalCall {line; function_expr; args} -> + App (line, expr_of_erlang_expr' function_expr, List.map ~f:expr_of_erlang_expr' args) | ExprRemoteCall {line; module_expr; function_expr; args; _} -> let mfa = MFA { module_name=expr_of_erlang_expr' module_expr; function_name=expr_of_erlang_expr' function_expr; arity=Constant (line, Number (List.length args))} in - App (mfa, List.map ~f:expr_of_erlang_expr' args) + App (line, mfa, List.map ~f:expr_of_erlang_expr' args) | ExprMatch {line; pattern; body} -> (* There is no match expression in `e` by `extract_match_expr`. * Futhermore, this match expression is single or the last of expr sequence because @@ -253,7 +277,7 @@ and expr_of_erlang_expr' = function function_name = Constant (line, Atom op); arity=Constant (line, Number 2) } in - App(func, List.map ~f:expr_of_erlang_expr' [lhs; rhs]) + App(line, func, List.map ~f:expr_of_erlang_expr' [lhs; rhs]) | ExprTuple {line; elements} -> Tuple (line, List.map ~f:expr_of_erlang_expr' elements) | ExprVar {line; id} -> Var (line, id) | ExprLit {lit} -> expr_of_literal lit @@ -376,7 +400,7 @@ let module_to_expr m = Tuple (-1, [Constant (-1, Atom name); LocalFun {function_name=name; arity=List.length args}])) |> (fun es -> Tuple (-1, es)) in - Letrec(funs, body) + Letrec(-1, funs, body) |> Result.return let code_to_expr code = diff --git a/test/unit-test/test_derivation.ml b/test/unit-test/test_derivation.ml index 0c68ea96..97bcb014 100644 --- a/test/unit-test/test_derivation.ml +++ b/test/unit-test/test_derivation.ml @@ -192,15 +192,15 @@ let%expect_test "derivation" = Empty)))) |}]; - print Context.empty (Abs {args=["X"]; body=Var (3, "X")}); + print Context.empty (Abs (-1, {args=["X"]; body=Var (3, "X")})); [%expect {| (Ok ("fun((a) -> a)" Empty)) |}]; - print Context.empty (Abs {args=["x"; "y"; "z"]; body=Var (1,"x")}); + print Context.empty (Abs (-1, {args=["x"; "y"; "z"]; body=Var (1,"x")})); [%expect {| (Ok ("fun((a, b, c) -> a)" Empty)) |}]; - print Context.empty (App (Constant (1, Number 57), [Constant (2, Number 42)])); + print Context.empty (App (3, Constant (1, Number 57), [Constant (2, Number 42)])); [%expect {| (Ok ( c ( @@ -211,7 +211,7 @@ let%expect_test "derivation" = (Subtype 42 a) Empty)))) |}]; - print Context.empty (App (Constant (-1, Atom "I am a function!"), [Constant (-1, Number 42); Constant (-1, Number 57)])); + print Context.empty (App (3, Constant (-1, Atom "I am a function!"), [Constant (-1, Number 42); Constant (-1, Number 57)])); [%expect {| (Ok ( d ( @@ -224,7 +224,7 @@ let%expect_test "derivation" = (Subtype 57 b) Empty)))) |}]; - print Context.empty (App (Abs {args=["X"]; body=Var (-1, "X")}, [Constant (-1, Number 42)])); + print Context.empty (App (3, Abs (-1, {args=["X"]; body=Var (-1, "X")}), [Constant (-1, Number 42)])); [%expect {| (Ok ( d ( @@ -236,7 +236,7 @@ let%expect_test "derivation" = Empty)))) |}]; - print Context.empty (App (Abs {args=["X"; "Y"]; body=Var (-1, "X")}, [Constant (-1, Number 42); Constant (-1, Number 57)])); + print Context.empty (App (3, Abs (-1, {args=["X"; "Y"]; body=Var (-1, "X")}), [Constant (-1, Number 42); Constant (-1, Number 57)])); [%expect {| (Ok ( f ( @@ -249,20 +249,20 @@ let%expect_test "derivation" = (Subtype 57 d) Empty)))) |}]; - print Context.empty (Let ("x", Constant (-1, Number 42), Var (-1, "x"))); + print Context.empty (Let (-1, "x", Constant (-1, Number 42), Var (-1, "x"))); [%expect {| (Ok (42 (Conj (Empty Empty)))) |}]; - print Context.empty (Letrec ([("x", {args=[]; body=Constant (-1, Number 42)})], LocalFun {function_name="x"; arity=0})); + print Context.empty (Letrec (-1, [("x", {args=[]; body=Constant (-1, Number 42)})], LocalFun {function_name="x"; arity=0})); [%expect {| (Ok (a (Conj (Empty (Eq a "fun(() -> 42)") Empty)))) |}]; print Context.empty (Letrec - ([ - ("f", {args=["X"]; body=App (LocalFun {function_name="g"; arity=1}, [Var (1, "X")])}); - ("g", {args=["X"]; body=App (LocalFun {function_name="f"; arity=1}, [Var (2, "X")])}) - ], App (LocalFun {function_name="f"; arity=1}, [Constant (3, (Number 42))]))); + (-1, [ + ("f", {args=["X"]; body=App (4, LocalFun {function_name="g"; arity=1}, [Var (1, "X")])}); + ("g", {args=["X"]; body=App (5, LocalFun {function_name="f"; arity=1}, [Var (2, "X")])}) + ], App (6, LocalFun {function_name="f"; arity=1}, [Constant (3, (Number 42))]))); [%expect {| (Ok ( m ( @@ -292,7 +292,7 @@ let%expect_test "derivation" = (Context.add (Context.Key.MFA {module_name="m"; function_name="f"; arity=0}) (Type.of_elem (TyFun ([], Type.of_elem (TySingleton (Atom "ok"))))) Context.empty) - (App (MFA {module_name=Constant (-1, Atom "m"); function_name=Constant (-1, Atom "f"); arity=Constant (-1, Number 0)}, [])); + (App (-1, MFA {module_name=Constant (-1, Atom "m"); function_name=Constant (-1, Atom "f"); arity=Constant (-1, Number 0)}, [])); [%expect {| (Ok ( b ( @@ -305,10 +305,10 @@ let%expect_test "derivation" = (Context.add (Context.Key.MFA {module_name="m"; function_name="f"; arity=0}) (Type.of_elem (TyFun ([], Type.of_elem (TySingleton (Atom "ok"))))) Context.empty) - (Let ("M", Constant (-1, Atom "m"), - Let ("F", Constant (-1, Atom "f"), - Let ("A", Constant (-1, Number 0), - App (MFA {module_name=Var (-1, "M"); function_name=Var (-1, "F"); arity=Var (-1, "A")}, []))))); + (Let (-1, "M", Constant (-1, Atom "m"), + Let (-1, "F", Constant (-1, Atom "f"), + Let (-1, "A", Constant (-1, Number 0), + App (-1, MFA {module_name=Var (-1, "M"); function_name=Var (-1, "F"); arity=Var (-1, "A")}, []))))); [%expect {| (Ok ( c ( diff --git a/test/unit-test/test_from_erlang.ml b/test/unit-test/test_from_erlang.ml index 5cce6292..33bfef66 100644 --- a/test/unit-test/test_from_erlang.ml +++ b/test/unit-test/test_from_erlang.ml @@ -96,7 +96,7 @@ let%expect_test "from_erlang" = ClsFun {line=1; patterns=[PatVar {line=1; id="X"}]; guard_sequence=None; body=ExprVar {line=1; id="X"}} ]}); [%expect {| - (Abs ((args (X)) (body (Var 1 X)))) + (Abs 1 ((args (X)) (body (Var 1 X)))) |}]; (* @@ -109,7 +109,27 @@ let%expect_test "from_erlang" = body=ExprLocalCall {line=1; function_expr=ExprVar {line=1; id="F"}; args=[ExprVar {line=1; id="X"}]}} ]}); [%expect {| - (Letrec ((F ((args (X)) (body (App (Var 1 F) ((Var 1 X))))))) (Var 1 F)) + (Letrec 1 ((F ((args (X)) (body (App 1 (Var 1 F) ((Var 1 X))))))) (Var 1 F)) + |}]; + + (* + * fun (X) -> [100; 200] end + *) + print (ExprFun {line=1; name=None; clauses=[ + ClsFun {line=1; + patterns=[PatVar {line=2; id="X"}]; + guard_sequence=None; + body=ExprCons{line=3; head=ExprLit {lit=LitInteger {line=4; integer=100}}; + tail=ExprCons {line=5; head=ExprLit {lit=LitInteger{line=6; integer=200}}; + tail=ExprNil {line=7}}}} + ]}); + [%expect {| + (Abs 1 ( + (args (X)) + (body ( + ListCons + (Constant 4 (Number 100)) + (ListCons (Constant 6 (Number 200)) ListNil))))) |}]; (* @@ -128,7 +148,7 @@ let%expect_test "from_erlang" = body=ExprTuple {line=1; elements=[ExprVar {line=1; id="X"}; ExprVar {line=1; id="Y"}]}} ]}); [%expect {| - (Abs ( + (Abs 1 ( (args (__A__ __B__)) (body ( Case @@ -161,7 +181,7 @@ let%expect_test "from_erlang" = ClsFun {line=1; patterns=[PatLit {lit=LitAtom {line=1; atom="x"}}]; guard_sequence=None; body=ExprLit {lit=LitAtom {line=1; atom="y"}}} ]}); [%expect {| - (Abs ( + (Abs 1 ( (args (__A__)) (body ( Case @@ -179,7 +199,7 @@ let%expect_test "from_erlang" = ClsFun {line=1; patterns=[PatLit {lit=LitInteger {line=1; integer=42}}]; guard_sequence=None; body=ExprLit {lit=LitInteger {line=1; integer=43}}} ]}); [%expect {| - (Abs ( + (Abs 1 ( (args (__A__)) (body ( Case @@ -200,7 +220,7 @@ let%expect_test "from_erlang" = ClsFun {line=2; patterns=[PatCons {line=2; head=PatVar {line=2; id="H"}; tail=PatVar {line=2; id="T"}}]; guard_sequence=None; body=ExprVar {line=2; id="T"}} ]}); [%expect {| - (Abs ( + (Abs 1 ( (args (__A__)) (body ( Case @@ -220,7 +240,7 @@ let%expect_test "from_erlang" = ClsFun {line=1; patterns=[PatLit {lit=LitString {line=1; str="abc"}}]; guard_sequence=None; body=ExprLit {lit=LitAtom {line=1; atom="ok"}}} ]}); [%expect {| - (Abs ( + (Abs 1 ( (args (__A__)) (body ( Case @@ -285,7 +305,7 @@ let%expect_test "from_erlang" = ExprMatch {line=1; pattern=PatVar {line=1; id="B"}; body=ExprLit {lit=LitInteger {line=1; integer=2}}}; ExprBinOp {line=1; op="+"; lhs=ExprVar {line=1; id="A"}; rhs=ExprVar {line=1; id="B"}}]}}]}); [%expect {| - (Abs ( + (Abs 1 ( (args ()) (body ( Case @@ -296,7 +316,7 @@ let%expect_test "from_erlang" = (Constant 1 (Number 2)) (( ((PatVar B) (Constant 1 (Atom true))) - (App + (App 1 (MFA (module_name (Constant 1 (Atom erlang))) (function_name (Constant 1 (Atom +)))