From 29c96fb0219d63fcf894c7e94605947f0655aef4 Mon Sep 17 00:00:00 2001 From: Sander Spies Date: Tue, 24 Dec 2019 08:08:50 +0100 Subject: [PATCH 1/3] Fix 'dune build ParserMain.exe'. --- src/passes/1-parser/cameligo/dune | 1 + src/passes/1-parser/reasonligo/dune | 6 ++++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune index ed667617a..730290696 100644 --- a/src/passes/1-parser/cameligo/dune +++ b/src/passes/1-parser/cameligo/dune @@ -31,5 +31,6 @@ (libraries parser_cameligo) (modules + ParserAPI ParserMain) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo))) diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune index f26008059..8d65f1363 100644 --- a/src/passes/1-parser/reasonligo/dune +++ b/src/passes/1-parser/reasonligo/dune @@ -30,7 +30,9 @@ (executable (name ParserMain) (libraries - parser_reasonligo) + parser_reasonligo + parser_cameligo) (modules + ParserAPI ParserMain) - (flags (:standard -open Simple_utils -open Parser_shared -open Parser_reasonligo))) + (flags (:standard -open Simple_utils -open Parser_cameligo -open Parser_shared -open Parser_reasonligo))) From bdd1d09c0443ae16e21cbd20d81f780309c3d2af Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 24 Dec 2019 12:20:39 +0100 Subject: [PATCH 2/3] t_operator can not throw exceptions --- src/bin/expect_tests/contract_tests.ml | 4 ++++ src/passes/2-simplify/cameligo.ml | 2 +- src/passes/2-simplify/pascaligo.ml | 2 +- src/stages/ast_simplified/PP.mli | 2 +- src/stages/ast_simplified/combinators.ml | 21 +++++++++++++-------- src/stages/ast_simplified/combinators.mli | 2 +- src/test/contracts/bad_type_operator.ligo | 4 ++++ 7 files changed, 25 insertions(+), 12 deletions(-) create mode 100644 src/test/contracts/bad_type_operator.ligo diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index fc87bc8cb..53db85afc 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -924,3 +924,7 @@ let%expect_test _ = NIL operation ; PAIR ; DIP { DROP 2 } } } |}] + +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; contract "bad_type_operator.ligo" ; "main" ] ; + [%expect {| ligo: bad type operator (TO_Map (unit,unit)): |}] ; \ No newline at end of file diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 530b46042..2725bf952 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -190,7 +190,7 @@ let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te let%bind cst = trace (unknown_predefined_type name) @@ type_operators name.value in - ok @@ t_operator cst lst' + t_operator cst lst' ) | TProd p -> ( let%bind tpl = simpl_list_type_expression @@ npseq_to_list p.value in diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 6aea532e0..e945be8eb 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -250,7 +250,7 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = let%bind cst = trace (unknown_predefined_type name) @@ type_operators name.value in - ok @@ t_operator cst lst + t_operator cst lst | TProd p -> let%bind tpl = simpl_list_type_expression @@ npseq_to_list p.value in diff --git a/src/stages/ast_simplified/PP.mli b/src/stages/ast_simplified/PP.mli index 9769e2396..afa18bb0c 100644 --- a/src/stages/ast_simplified/PP.mli +++ b/src/stages/ast_simplified/PP.mli @@ -8,8 +8,8 @@ val list_sep_d : (formatter -> 'a -> unit) -> formatter -> 'a list -> unit val smap_sep_d : (formatter -> 'a -> unit) -> formatter -> 'a Map.String.t -> unit -val type_expression : formatter -> type_expression -> unit *) +val type_expression : formatter -> type_expression -> unit val literal : formatter -> literal -> unit diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index a13edc14f..eb00a86a6 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -12,6 +12,10 @@ module Errors = struct ("location" , fun () -> Format.asprintf "%a" Location.pp location) ; ] in error ~data title message + let bad_type_operator type_op = + let title () = Format.asprintf "bad type operator %a" (Stage_common.PP.type_operator PP.type_expression) type_op in + let message () = "" in + error title message end open Errors @@ -57,14 +61,15 @@ let t_set key : type_expression = make_t @@ T_operator (TC_set key let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract) (* TODO find a better way than using list*) -let t_operator op lst: type_expression = - match op with - | TC_set _ -> t_set (List.hd lst) - | TC_list _ -> t_list (List.hd lst) - | TC_option _ -> t_option (List.hd lst) - | TC_map (_,_) -> let tl = List.tl lst in t_map (List.hd lst) (List.hd tl) - | TC_big_map (_,_) -> let tl = List.tl lst in t_big_map (List.hd lst) (List.hd tl) - | TC_contract _ -> t_contract (List.hd lst) +let t_operator op lst: type_expression result = + match op,lst with + | TC_set _ , [t] -> ok @@ t_set t + | TC_list _ , [t] -> ok @@ t_list t + | TC_option _ , [t] -> ok @@ t_option t + | TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt + | TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt + | TC_contract _ , [t] -> ok @@ t_contract t + | _ , _ -> fail @@ bad_type_operator op let location_wrap ?(loc = Location.generated) expression = let location = loc in diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli index a060fb865..b3a0751e0 100644 --- a/src/stages/ast_simplified/combinators.mli +++ b/src/stages/ast_simplified/combinators.mli @@ -42,7 +42,7 @@ val ez_t_sum : ( string * type_expression ) list -> type_expression val t_function : type_expression -> type_expression -> type_expression val t_map : type_expression -> type_expression -> type_expression -val t_operator : 'a type_operator -> type_expression list -> type_expression +val t_operator : type_expression type_operator -> type_expression list -> type_expression result val t_set : type_expression -> type_expression val e_var : ?loc:Location.t -> string -> expression diff --git a/src/test/contracts/bad_type_operator.ligo b/src/test/contracts/bad_type_operator.ligo new file mode 100644 index 000000000..eff64ad66 --- /dev/null +++ b/src/test/contracts/bad_type_operator.ligo @@ -0,0 +1,4 @@ +type t is (nat * nat) +type s is map(t) + +function main (const u : unit; const s : s) : (list(operation) * s) is ((nil : list(operation)), s) From dadf1fbe418b33749b68ac373bf2c25575a827e6 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Tue, 24 Dec 2019 17:01:39 +0100 Subject: [PATCH 3/3] Fixed the stratification of "++". --- src/passes/1-parser/reasonligo/Parser.mly | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 23deaf776..223d35c65 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -320,6 +320,8 @@ core_pattern: | "_" { PWild $1 } | unit { PUnit $1 } | "" { PInt $1 } +| "" { PNat $1 } +| "" { PBytes $1 } | "true" { PTrue $1 } | "false" { PFalse $1 } | "" { PString $1 } @@ -424,7 +426,8 @@ fun_expr: {p.value with inside = arg_to_pattern p.value.inside} in PPar {p with value} | EUnit u -> PUnit u - | e -> raise (SyntaxError.Error (WrongFunctionArguments e)) + | e -> let open! SyntaxError + in raise (Error (WrongFunctionArguments e)) in let fun_args_to_pattern = function EAnnot { @@ -453,7 +456,8 @@ fun_expr: in arg_to_pattern (fst fun_args), bindings | EUnit e -> arg_to_pattern (EUnit e), [] - | e -> raise (SyntaxError.Error (WrongFunctionArguments e)) + | e -> let open! SyntaxError + in raise (Error (WrongFunctionArguments e)) in let binders = fun_args_to_pattern $1 in let f = {kwd_fun; @@ -601,7 +605,7 @@ comp_expr_level: | cat_expr_level { $1 } cat_expr_level: - bin_op(add_expr_level, "++", add_expr_level) { EString (Cat $1) } + bin_op(add_expr_level, "++", cat_expr_level) { EString (Cat $1) } | add_expr_level { $1 } add_expr_level: @@ -682,6 +686,7 @@ common_expr: "" { EArith (Int $1) } | "" { EArith (Mutez $1) } | "" { EArith (Nat $1) } +| "" { EBytes $1 } | "" | module_field { EVar $1 } | projection { EProj $1 } | "" { EString (String $1) }