Skip to content

Commit

Permalink
Fix #101
Browse files Browse the repository at this point in the history
  • Loading branch information
@youxkei
youxkei committed Aug 27, 2019
1 parent 97ffe83 commit 1168646
Show file tree
Hide file tree
Showing 3 changed files with 103 additions and 19 deletions.
56 changes: 37 additions & 19 deletions lib/abstract_format.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -330,7 +330,7 @@ and form_of_sf sf : (form_t, err_t) Result.t =
Sf.List sf_clauses
]) ->
let%bind clauses =
sf_clauses |> List.map ~f:(cls_of_sf ~in_function:true) |> Result.all |> track ~loc:[%here]
sf_clauses |> List.map ~f:cls_fun_of_sf |> Result.all |> track ~loc:[%here]
in
DeclFun {line; function_name; arity; clauses} |> return

Expand Down Expand Up @@ -663,7 +663,7 @@ and expr_of_sf sf : (expr_t, err_t) Result.t =
(* a case expression *)
| Sf.Tuple (4, [Sf.Atom "case"; Sf.Integer line; sf_expr; Sf.List sf_clauses]) ->
let%bind expr = sf_expr |> expr_of_sf |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_of_sf |> Result.all |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_case_of_sf |> Result.all |> track ~loc:[%here] in
ExprCase {line; expr; clauses} |> return

(* a catch expression *)
Expand Down Expand Up @@ -715,15 +715,15 @@ and expr_of_sf sf : (expr_t, err_t) Result.t =
Sf.Integer line;
Sf.Tuple (2, [Sf.Atom "clauses";
Sf.List sf_clauses])]) ->
let%bind clauses = sf_clauses |> List.map ~f:(cls_of_sf ~in_function:true) |> Result.all |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_fun_of_sf |> Result.all |> track ~loc:[%here] in
ExprFun {line; name = None; clauses} |> return

(* a named function expression *)
| Sf.Tuple (4, [Sf.Atom "named_fun";
Sf.Integer line;
Sf.Atom name;
Sf.List sf_clauses]) ->
let%bind clauses = sf_clauses |> List.map ~f:(cls_of_sf ~in_function:true) |> Result.all |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_fun_of_sf |> Result.all |> track ~loc:[%here] in
ExprFun {line; name = Some name; clauses} |> return

(* a function call (remote) *)
Expand All @@ -746,7 +746,7 @@ and expr_of_sf sf : (expr_t, err_t) Result.t =
| Sf.Tuple (3, [Sf.Atom "if";
Sf.Integer line;
Sf.List sf_clauses]) ->
let%bind clauses = sf_clauses |> List.map ~f:(cls_of_sf ~in_function:false) |> Result.all |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_if_of_sf |> Result.all |> track ~loc:[%here] in
ExprIf {line; clauses} |> return

(* a map creation *)
Expand Down Expand Up @@ -796,7 +796,7 @@ and expr_of_sf sf : (expr_t, err_t) Result.t =
| Sf.Tuple (3, [Sf.Atom "receive";
Sf.Integer line;
Sf.List sf_clauses]) ->
let%bind clauses = sf_clauses |> List.map ~f:cls_of_sf |> Result.all |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_case_of_sf |> Result.all |> track ~loc:[%here] in
ExprReceive {line; clauses} |> return

(* a receive-after expression *)
Expand All @@ -805,7 +805,7 @@ and expr_of_sf sf : (expr_t, err_t) Result.t =
Sf.List sf_clauses;
sf_timeout;
Sf.List sf_body]) ->
let%bind clauses = sf_clauses |> List.map ~f:cls_of_sf |> Result.all |> track ~loc:[%here] in
let%bind clauses = sf_clauses |> List.map ~f:cls_case_of_sf |> Result.all |> track ~loc:[%here] in
let%bind timeout = sf_timeout |> expr_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> List.map ~f:expr_of_sf |> Result.all |> track ~loc:[%here] in
ExprReceiveAfter {line; clauses; timeout; body} |> return
Expand Down Expand Up @@ -859,8 +859,8 @@ and expr_of_sf sf : (expr_t, err_t) Result.t =
Sf.List sf_catch_clauses;
Sf.List sf_after]) ->
let%bind exprs = sf_exprs |> List.map ~f:expr_of_sf |> Result.all |> track ~loc:[%here] in
let%bind case_clauses = sf_case_clauses |> List.map ~f:cls_of_sf |> Result.all |> track ~loc:[%here] in
let%bind catch_clauses = sf_catch_clauses |> List.map ~f:cls_of_sf |> Result.all |> track ~loc:[%here] in
let%bind case_clauses = sf_case_clauses |> List.map ~f:cls_case_of_sf |> Result.all |> track ~loc:[%here] in
let%bind catch_clauses = sf_catch_clauses |> List.map ~f:cls_catch_of_sf |> Result.all |> track ~loc:[%here] in
let%bind after = sf_after |> List.map ~f:expr_of_sf |> Result.all |> track ~loc:[%here] in
ExprTry {line; exprs; case_clauses; catch_clauses; after} |> return

Expand Down Expand Up @@ -953,9 +953,9 @@ and integer_or_var_of_sf sf =
(*
* 8.5 Clauses
*)
and cls_of_sf ?(in_function=false) sf : (clause_t, err_t) Result.t =
and cls_catch_of_sf sf =
let open Result.Let_syntax in
match sf, in_function with
match sf with
(* catch clause P -> B or E:P -> B or E:P:S -> B *)
| Sf.Tuple (5, [
Sf.Atom "clause";
Expand All @@ -967,7 +967,7 @@ and cls_of_sf ?(in_function=false) sf : (clause_t, err_t) Result.t =
Sf.Tuple (3, [Sf.Atom "var"; Sf.Integer line_stacktrace; Sf.Atom stacktrace])]])];
Sf.List [];
sf_body
]), false ->
]) ->
let%bind exception_class = sf_exception_class |> atom_or_var_of_sf |> track ~loc:[%here] in
let%bind pattern = sf_pattern |> pat_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
Expand All @@ -984,21 +984,27 @@ and cls_of_sf ?(in_function=false) sf : (clause_t, err_t) Result.t =
Sf.Tuple (3, [Sf.Atom "var"; Sf.Integer line_stacktrace; Sf.Atom stacktrace])]])];
sf_guard_sequence;
sf_body
]), false ->
]) ->
let%bind exception_class = sf_exception_class |> atom_or_var_of_sf |> track ~loc:[%here] in
let%bind pattern = sf_pattern |> pat_of_sf |> track ~loc:[%here] in
let%bind guard_sequence = sf_guard_sequence |> guard_sequence_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
ClsCatch {line; line_cls; line_stacktrace; exception_class; pattern; stacktrace; guard_sequence=Some guard_sequence; body} |> return

| _ ->
Err.create ~loc:[%here] (Err.Invalid_input ("cls_catch", sf)) |> Result.fail

and cls_case_of_sf sf =
let open Result.Let_syntax in
match sf with
(* case clause P -> B *)
| Sf.Tuple (5, [
Sf.Atom "clause";
Sf.Integer line;
Sf.List [sf_pattern];
Sf.List [];
sf_body
]), false ->
]) ->
let%bind pattern = sf_pattern |> pat_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
ClsCase {line; pattern; guard_sequence = None; body} |> return
Expand All @@ -1010,32 +1016,44 @@ and cls_of_sf ?(in_function=false) sf : (clause_t, err_t) Result.t =
Sf.List [sf_pattern];
sf_guard_sequence;
sf_body
]), false ->
]) ->
let%bind pattern = sf_pattern |> pat_of_sf |> track ~loc:[%here] in
let%bind guard_sequence = sf_guard_sequence |> guard_sequence_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
ClsCase {line; pattern; guard_sequence = Some guard_sequence; body} |> return

| _ ->
Err.create ~loc:[%here] (Err.Invalid_input ("cls_case", sf)) |> Result.fail

and cls_if_of_sf sf =
let open Result.Let_syntax in
match sf with
(* if clause Gs -> B *)
| Sf.Tuple (5, [
Sf.Atom "clause";
Sf.Integer line;
Sf.List [];
sf_guard_sequence;
sf_body
]), false ->
]) ->
let%bind guard_sequence = sf_guard_sequence |> guard_sequence_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
ClsIf {line; guard_sequence; body} |> return

| _ ->
Err.create ~loc:[%here] (Err.Invalid_input ("cls_if", sf)) |> Result.fail

and cls_fun_of_sf sf : (clause_t, err_t) Result.t =
let open Result.Let_syntax in
match sf with
(* function clause ( Ps ) -> B *)
| Sf.Tuple (5, [
Sf.Atom "clause";
Sf.Integer line;
Sf.List sf_patterns;
Sf.List [];
sf_body
]), true ->
]) ->
let%bind patterns = sf_patterns |> List.map ~f:pat_of_sf |> Result.all |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
ClsFun {line; patterns; guard_sequence = None; body} |> return
Expand All @@ -1047,14 +1065,14 @@ and cls_of_sf ?(in_function=false) sf : (clause_t, err_t) Result.t =
Sf.List sf_patterns;
sf_guard_sequence;
sf_body
]), true ->
]) ->
let%bind patterns = sf_patterns |> List.map ~f:pat_of_sf |> Result.all |> track ~loc:[%here] in
let%bind guard_sequence = sf_guard_sequence |> guard_sequence_of_sf |> track ~loc:[%here] in
let%bind body = sf_body |> expr_of_sf |> track ~loc:[%here] in
ClsFun {line; patterns; guard_sequence = Some guard_sequence; body} |> return

| _ ->
Err.create ~loc:[%here] (Err.Invalid_input ("cls", sf)) |> Result.fail
Err.create ~loc:[%here] (Err.Invalid_input ("cls_fun", sf)) |> Result.fail

(*
* 8.6 Guards
Expand Down
6 changes: 6 additions & 0 deletions test/test_fix_101.erl
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
-module(test_fix_101).

main(X) ->
case X of
{abc, Foo, Bar} -> ok
end.
60 changes: 60 additions & 0 deletions test/test_fix_101.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,60 @@
open Test_util

let%expect_test "test_fix_101.beam" =
print_ast "test_fix_101.beam";
[%expect {|
(Ok (
AbstractCode (
ModDecl (
(AttrFile
(line 1)
(file test_fix_101.erl)
(file_line 1))
(AttrMod
(line 1)
(module_name test_fix_101))
(DeclFun
(line 3)
(function_name main)
(arity 1)
(clauses ((
ClsFun
(line 3)
(patterns ((
PatVar
(line 3)
(id X))))
(guard_sequence ())
(body (
ExprBody (
exprs ((
ExprCase
(line 4)
(expr (
ExprVar
(line 4)
(id X)))
(clauses ((
ClsCase
(line 5)
(pattern (
PatTuple
(line 5)
(pats (
(PatLit (
lit (
LitAtom
(line 5)
(atom abc))))
(PatVar (line 5) (id Foo))
(PatVar (line 5) (id Bar))))))
(guard_sequence ())
(body (
ExprBody (
exprs ((
ExprLit (
lit (
LitAtom
(line 5)
(atom ok))))))))))))))))))))
FormEof)))) |}]

0 comments on commit 1168646

Please sign in to comment.