Merge branch 'dev' into feature/cameligo-multi-bind-let-in

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)): |}] ;

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)))

src/passes/1-parser/reasonligo/Parser.mly

@@ -320,6 +320,8 @@ core_pattern:
 | "_"                                                    {   PWild $1 }
 | unit                                                   {   PUnit $1 }
 | "<int>"                                                {    PInt $1 }
+| "<nat>"                                                {    PNat $1 }
+| "<bytes>"                                              {  PBytes $1 }
 | "true"                                                 {   PTrue $1 }
 | "false"                                                {  PFalse $1 }
 | "<string>"                                             { 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:
   "<int>"                             {               EArith (Int $1) }
 | "<mutez>"                           {             EArith (Mutez $1) }
 | "<nat>"                             {               EArith (Nat $1) }
+| "<bytes>"                           {                     EBytes $1 }
 | "<ident>" | module_field            {                       EVar $1 }
 | projection                          {                      EProj $1 }
 | "<string>"                          {           EString (String $1) }

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)))

src/passes/2-simplify/cameligo.ml

@@ -210,7 +210,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

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

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
 

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 =
+let t_operator op lst: type_expression result =
-  match op with 
+  match op,lst with 
-  | TC_set _ -> t_set (List.hd lst)
+  | TC_set _         , [t] -> ok @@ t_set t
-  | TC_list _ -> t_list (List.hd lst)
+  | TC_list _        , [t] -> ok @@ t_list t
-  | TC_option _ -> t_option (List.hd lst)
+  | TC_option _      , [t] -> ok @@ t_option t
-  | TC_map (_,_) -> let tl = List.tl lst in t_map (List.hd lst) (List.hd tl)
+  | TC_map (_,_)     , [kt;vt] -> ok @@ t_map kt vt
-  | TC_big_map (_,_) -> let tl = List.tl lst in t_big_map (List.hd lst) (List.hd tl)
+  | TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt
-  | TC_contract _ -> t_contract (List.hd lst)
+  | TC_contract _    , [t] -> ok @@ t_contract t
+  | _ , _ -> fail @@ bad_type_operator op
 
 let location_wrap ?(loc = Location.generated) expression =
   let location = loc in

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

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)