Merge pull request #165 from kmizu/line-app-abs

Add line to App, Abs, Let, and Letrec
dwango · Jan 30, 2019 · 06763a4 · 06763a4
2 parents c55c7e8 + f6a4306
commit 06763a4
Show file tree

Hide file tree

Showing 5 changed files with 92 additions and 48 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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   +)))