Add support for empty constructors.
This commit is contained in:
commit
5f1182468c
@ -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 ->
|
||||
|
@ -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) @@
|
||||
|
9
src/test/contracts/empty_case.ligo
Normal file
9
src/test/contracts/empty_case.ligo
Normal file
@ -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)
|
8
src/test/contracts/empty_case.mligo
Normal file
8
src/test/contracts/empty_case.mligo
Normal file
@ -0,0 +1,8 @@
|
||||
type foo =
|
||||
| Bar of int
|
||||
| Baz
|
||||
|
||||
let main (f: foo): int =
|
||||
match f with
|
||||
| Bar i -> i
|
||||
| Baz -> -1
|
9
src/test/contracts/empty_case.religo
Normal file
9
src/test/contracts/empty_case.religo
Normal file
@ -0,0 +1,9 @@
|
||||
type foo =
|
||||
| Bar(int)
|
||||
| Baz;
|
||||
|
||||
let main = (f: foo): int =>
|
||||
switch (f) {
|
||||
| Bar(i) => i
|
||||
| Baz => (-1)
|
||||
};
|
@ -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 ;
|
||||
]
|
||||
|
Loading…
Reference in New Issue
Block a user