From ce6ccab728b33b56eadcd29d73c442bea1b5eac2 Mon Sep 17 00:00:00 2001 From: Sander Date: Fri, 3 Jan 2020 13:01:13 +0000 Subject: [PATCH] Add support for empty constructors. --- src/passes/2-simplify/cameligo.ml | 10 +++++-- src/passes/2-simplify/pascaligo.ml | 5 ++++ src/test/contracts/empty_case.ligo | 9 ++++++ src/test/contracts/empty_case.mligo | 8 +++++ src/test/contracts/empty_case.religo | 9 ++++++ src/test/integration_tests.ml | 45 ++++++++++++++++++++++++++++ 6 files changed, 83 insertions(+), 3 deletions(-) create mode 100644 src/test/contracts/empty_case.ligo create mode 100644 src/test/contracts/empty_case.mligo create mode 100644 src/test/contracts/empty_case.religo diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 762215450..b2bef414c 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -89,7 +89,7 @@ module Errors = struct fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ] in error ~data title message - + let unsupported_non_var_pattern p = let title () = "pattern is not a variable" in let message () = @@ -238,7 +238,7 @@ let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result = match lst with - | [] -> assert false + | [] -> ok @@ t_unit | [hd] -> simpl_type_expression hd | lst -> let%bind lst = bind_map_list simpl_type_expression lst in @@ -779,7 +779,11 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result = | PConstr v -> let const, pat_opt = match v with - PConstrApp {value; _} -> value + PConstrApp {value; _} -> + (match value with + | constr, None -> + constr, Some (PVar {value = "unit"; region = Region.ghost}) + | _ -> value) | PSomeApp {value=region,pat; _} -> {value="Some"; region}, Some pat | PNone region -> diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index e945be8eb..0707ee85a 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -952,6 +952,11 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result = let get_constr (t: Raw.pattern) = match t with | PConstr (PConstrApp v) -> ( + let value = v.value in + match value with + | constr, None -> + ok (constr.value, "unit") + | _ -> let const, pat_opt = v.value in let%bind pat = trace_option (unsupported_cst_constr t) @@ diff --git a/src/test/contracts/empty_case.ligo b/src/test/contracts/empty_case.ligo new file mode 100644 index 000000000..30771c774 --- /dev/null +++ b/src/test/contracts/empty_case.ligo @@ -0,0 +1,9 @@ +type foo is + | Bar of int + | Baz + +function main (const f: foo) : int is + (case f of + | Bar (n) -> n + | Baz -> -1 + end) diff --git a/src/test/contracts/empty_case.mligo b/src/test/contracts/empty_case.mligo new file mode 100644 index 000000000..844897f01 --- /dev/null +++ b/src/test/contracts/empty_case.mligo @@ -0,0 +1,8 @@ +type foo = + | Bar of int + | Baz + +let main (f: foo): int = + match f with + | Bar i -> i + | Baz -> -1 \ No newline at end of file diff --git a/src/test/contracts/empty_case.religo b/src/test/contracts/empty_case.religo new file mode 100644 index 000000000..c5d6bdc5a --- /dev/null +++ b/src/test/contracts/empty_case.religo @@ -0,0 +1,9 @@ +type foo = + | Bar(int) + | Baz; + +let main = (f: foo): int => + switch (f) { + | Bar(i) => i + | Baz => (-1) + }; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index c4610dc89..caa4c7c01 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1830,6 +1830,48 @@ let bytes_unpack () : unit result = let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in ok () +let empty_case () : unit result = + let%bind program = type_file "./contracts/empty_case.ligo" in + let%bind () = + let input _ = e_constructor "Bar" (e_int 1) in + let expected _ = e_int 1 in + expect_eq_n program "main" input expected + in + let%bind () = + let input _ = e_constructor "Baz" (e_unit ()) in + let expected _ = e_int (-1) in + expect_eq_n program "main" input expected + in + ok () + +let empty_case_mligo () : unit result = + let%bind program = mtype_file "./contracts/empty_case.mligo" in + let%bind () = + let input _ = e_constructor "Bar" (e_int 1) in + let expected _ = e_int 1 in + expect_eq_n program "main" input expected + in + let%bind () = + let input _ = e_constructor "Baz" (e_unit ()) in + let expected _ = e_int (-1) in + expect_eq_n program "main" input expected + in + ok () + +let empty_case_religo () : unit result = + let%bind program = retype_file "./contracts/empty_case.religo" in + let%bind () = + let input _ = e_constructor "Bar" (e_int 1) in + let expected _ = e_int 1 in + expect_eq_n program "main" input expected + in + let%bind () = + let input _ = e_constructor "Baz" (e_unit ()) in + let expected _ = e_int (-1) in + expect_eq_n program "main" input expected + in + ok () + let main = test_suite "Integration (End to End)" [ test "bytes unpack" bytes_unpack ; test "key hash" key_hash ; @@ -1973,4 +2015,7 @@ let main = test_suite "Integration (End to End)" [ test "type tuple destruct (mligo)" type_tuple_destruct ; test "let in multi-bind (mligo)" let_in_multi_bind ; test "tuple param destruct (mligo)" tuple_param_destruct ; + test "empty case" empty_case ; + test "empty case (mligo)" empty_case_mligo ; + test "empty case (religo)" empty_case_religo ; ]