Merge pull request #163 from kmizu/line-tuple

Add line to Tuple of Ast
dwango · Jan 28, 2019 · c55c7e8 · c55c7e8
2 parents 2d5d580 + b435223
commit c55c7e8
Show file tree

Hide file tree

Showing 5 changed files with 45 additions and 21 deletions.
diff --git a/lib/ast.ml b/lib/ast.ml
@@ -13,7 +13,7 @@ type line = int
 type t =
     | Constant of line * Constant.t
     | Var of line * string
-    | Tuple of t list
+    | Tuple of line * t list
     | App of t * t list
     | Abs of fun_abst
     | Let of string * t * t
@@ -33,6 +33,20 @@ and pattern' =
     | PatNil
 [@@deriving sexp_of]
 
+let line_number_of_t = function
+| Constant (line, _) -> line
+| Var (line, _) -> line
+| Tuple (line, _) -> line
+| App (_, _) -> -1
+| Abs (_) -> -1
+| Let (_, _, _) -> -1
+| Letrec (_) -> -1
+| Case (_, _) -> -1
+| LocalFun _ -> -1
+| MFA _ -> -1
+| ListCons (_, _) -> -1
+| ListNil -> -1
+
 let string_of_t t =
   [%sexp_of: t] t |> Sexplib.Sexp.to_string_hum ~indent:2
 

diff --git a/lib/derivation.ml b/lib/derivation.ml
@@ -18,7 +18,7 @@ let rec derive context = function
         let line_in_file = line in
         Error Known_error.(FialyzerError (UnboundVariable {filename; line=line_in_file; variable=Var v}))
      end
-  | Tuple exprs ->
+  | Tuple (_line, exprs) ->
      result_map_m ~f:(derive context) exprs
      >>| List.unzip
      >>| fun (tys, cs) -> (Type.of_elem (TyTuple tys), Conj cs)
@@ -118,7 +118,7 @@ let rec derive context = function
     (* translate pattern to expression *)
     let rec pattern_to_expr = function
       | PatVar v -> Var (-1, v)
-      | PatTuple es -> Tuple (es |> List.map ~f:(fun e -> pattern_to_expr e))
+      | PatTuple es -> Tuple (-1 (* TODO: use line number of PatTuple in the future *), es |> List.map ~f:(fun e -> pattern_to_expr e))
       | PatConstant c -> Constant (-1, c)
       | PatCons (p1, p2) -> ListCons (pattern_to_expr p1, pattern_to_expr p2)
       | PatNil -> ListNil

diff --git a/lib/from_erlang.ml b/lib/from_erlang.ml
@@ -254,8 +254,7 @@ and expr_of_erlang_expr' = function
         arity=Constant (line, Number 2)
      } in
      App(func, List.map ~f:expr_of_erlang_expr' [lhs; rhs])
-  | ExprTuple {elements; _} ->
-     Tuple (List.map ~f:expr_of_erlang_expr' elements)
+  | 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
   | ExprCons {head; tail; _} -> ListCons (expr_of_erlang_expr' head, expr_of_erlang_expr' tail)
@@ -281,9 +280,20 @@ and function_of_clauses clauses =
       let tuple_pattern = PatTuple ps in
       (((tuple_pattern, Constant (line, Atom ("true"))), expr_of_erlang_expr' body), arity)
     ) |> List.unzip in
+     let line_number_of_clause = function
+     | ((PatTuple _patterns, _), term) -> Ast.line_number_of_t term
+     | ((PatConstant _, _), term) -> Ast.line_number_of_t term
+     | ((PatCons (_, _), _), term) -> Ast.line_number_of_t term
+     | ((PatVar _, _), term) -> Ast.line_number_of_t term
+     | ((PatNil, _), term) -> Ast.line_number_of_t term
+     in
      let make_fresh_variables length = fill (fun () -> Variable.create()) length |> List.rev in
      let make_case cs fresh_variables =
-       let fresh_tuple = Tuple (fresh_variables |> List.map ~f:(fun v -> Var (-1, v))) in
+       let line = line_number_of_clause (List.hd_exn cs) in
+       let fresh_tuple = Tuple (
+         line,
+         fresh_variables |> List.map ~f:(fun v -> Var (line, v))
+       ) in
        (* letrec $name = fun $name(A1, A2, ...) -> b1; $name(B1, B2, ...)-> b2; ... end in $name *)
        Case (fresh_tuple, cs)
      in
@@ -363,8 +373,8 @@ let module_to_expr m =
   let body =
     funs
     |> List.map ~f:(fun (name, ({args; body}: fun_abst)) ->
-                  Tuple [Constant (-1, Atom name); LocalFun {function_name=name; arity=List.length args}])
-    |> (fun es -> Tuple es)
+                  Tuple (-1, [Constant (-1, Atom name); LocalFun {function_name=name; arity=List.length args}]))
+    |> (fun es -> Tuple (-1, es))
   in
   Letrec(funs, body)
   |> Result.return

diff --git a/test/unit-test/test_derivation.ml b/test/unit-test/test_derivation.ml
@@ -40,7 +40,7 @@ let%expect_test "derivation" =
   print (Context.add (Context.Key.Var "x") (Type.of_elem TyNumber) Context.empty) (Var (1, "x"));
   [%expect {| (Ok ("number()" Empty)) |}];
 
-  print Context.empty (Tuple [Constant (-1, Number 42); Constant (-1, Atom "x")]);
+  print Context.empty (Tuple (-1, [Constant (-1, Number 42); Constant (-1, Atom "x")]));
   [%expect {|
     (Ok ("{42, 'x'}" (Conj (Empty Empty))))
   |}];
@@ -72,7 +72,7 @@ let%expect_test "derivation" =
    *   {X, Y} when true -> {X, Y}
    * end
    *)
-  print Context.empty (Case (Tuple [Constant (-1, Number 41); Constant (-1, Number 42)], [(PatTuple [PatVar "X"; PatVar "Y"], Constant (-1, Atom "true")), Tuple [Var (-1, "X"); Var (-1, "Y")]]));
+  print Context.empty (Case (Tuple (-1, [Constant (-1, Number 41); Constant (-1, Number 42)]), [(PatTuple [PatVar "X"; PatVar "Y"], Constant (-1, Atom "true")), Tuple (-1, [Var (-1, "X"); Var (-1, "Y")])]));
   [%expect {|
      (Ok (
        a (

diff --git a/test/unit-test/test_from_erlang.ml b/test/unit-test/test_from_erlang.ml
@@ -57,7 +57,7 @@ let%expect_test "code_to_module" =
           (args (__A__))
           (body (
             Case
-            (Tuple ((Var -1 __A__)))
+            (Tuple 111 ((Var 111 __A__)))
             ((((PatTuple ((PatConstant (Atom a)))) (Constant 111 (Atom true)))
               (Constant 111 (Number 10)))
              (((PatTuple ((PatConstant (Atom b)))) (Constant 111 (Atom true)))
@@ -82,7 +82,7 @@ let%expect_test "from_erlang" =
   (* {X, Y, Z} *)
   print (ExprTuple {line=1; elements=[ExprVar {line=1; id="X"}; ExprVar {line=1; id="Y"}; ExprVar {line=1; id="Z"}]});
   [%expect {|
-    (Tuple (
+    (Tuple 1 (
       (Var 1 X)
       (Var 1 Y)
       (Var 1 Z)))
@@ -132,24 +132,24 @@ let%expect_test "from_erlang" =
       (args (__A__ __B__))
       (body (
         Case
-        (Tuple (
-          (Var -1 __A__)
-          (Var -1 __B__)))
+        (Tuple 1 (
+          (Var 1 __A__)
+          (Var 1 __B__)))
         ((((PatTuple (
              (PatVar X)
              (PatTuple (
                (PatVar Y)
                (PatVar Z)))))
            (Constant 1 (Atom true)))
-          (Tuple (
+          (Tuple 1 (
             (Var 1 X)
             (Var 1 Y)
             (Var 1 Z))))
          (((PatTuple (
              (PatVar X)
              (PatVar Y)))
            (Constant 1 (Atom true)))
-          (Tuple (
+          (Tuple 1 (
             (Var 1 X)
             (Var 1 Y)))))))))
   |}];
@@ -165,7 +165,7 @@ let%expect_test "from_erlang" =
       (args (__A__))
       (body (
         Case
-        (Tuple ((Var -1 __A__)))
+        (Tuple 1 ((Var 1 __A__)))
         ((
           ((PatTuple ((PatConstant (Atom x)))) (Constant 1 (Atom true)))
           (Constant 1 (Atom y))))))))
@@ -183,7 +183,7 @@ let%expect_test "from_erlang" =
       (args (__A__))
       (body (
         Case
-        (Tuple ((Var -1 __A__)))
+        (Tuple 1 ((Var 1 __A__)))
         ((
           ((PatTuple ((PatConstant (Number 42)))) (Constant 1 (Atom true)))
           (Constant 1 (Number 43))))))))
@@ -204,7 +204,7 @@ let%expect_test "from_erlang" =
       (args (__A__))
       (body (
         Case
-        (Tuple ((Var -1 __A__)))
+        (Tuple -1 ((Var -1 __A__)))
         ((((PatTuple (PatNil)) (Constant 1 (Atom true))) ListNil)
          (((PatTuple ((
              PatCons
@@ -224,7 +224,7 @@ let%expect_test "from_erlang" =
       (args (__A__))
       (body (
         Case
-        (Tuple ((Var -1 __A__)))
+        (Tuple 1 ((Var 1 __A__)))
         ((
           ((PatTuple ((
              PatCons