updating tests

src/bin/expect_tests/contract_tests.ml

@@ -1084,7 +1084,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
   [%expect {|
-ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return\n                let rhs#723 = #P in\n                let p = rhs#723.0 in\n                let s = rhs#723.1 in\n                ( LIST_EMPTY() : (type_operator: list(operation)) , store ) ,\n                NONE() : (type_operator: option(key_hash)) ,\n                300000000mutez ,\n                \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
+ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return\n                let rhs#727 = #P in\n                let p = rhs#727.0 in\n                let s = rhs#727.1 in\n                ( LIST_EMPTY() : (type_operator: list(operation)) , store ) ,\n                NONE() : (type_operator: option(key_hash)) ,\n                300000000mutez ,\n                \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
 
 
  If you're not sure how to fix this error, you can
@@ -1097,7 +1097,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8,
 
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
   [%expect {|
-ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return\n                let rhs#726 = #P in\n                let p = rhs#726.0 in\n                let s = rhs#726.1 in\n                ( LIST_EMPTY() : (type_operator: list(operation)) , a ) ,\n                NONE() : (type_operator: option(key_hash)) ,\n                300000000mutez ,\n                1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
+ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return\n                let rhs#730 = #P in\n                let p = rhs#730.0 in\n                let s = rhs#730.1 in\n                ( LIST_EMPTY() : (type_operator: list(operation)) , a ) ,\n                NONE() : (type_operator: option(key_hash)) ,\n                300000000mutez ,\n                1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
 
 
  If you're not sure how to fix this error, you can

src/bin/expect_tests/michelson_or_tests.ml

@@ -17,7 +17,7 @@ let%expect_test _ =
   run_ligo_good [ "compile-contract" ; contract "michelson_or_tree.mligo" ; "main" ] ;
   [%expect {|
     { parameter unit ;
-      storage (or int (or int nat)) ;
+      storage (or (int %three) (or %four (int %one) (nat %two))) ;
       code { PUSH int 1 ;
              LEFT nat ;
              RIGHT int ;

src/bin/expect_tests/michelson_pair_test.ml

@@ -0,0 +1,46 @@
+open Cli_expect
+
+let contract basename =
+  "../../test/contracts/" ^ basename
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree.ligo" ; "main" ] ;
+  [%expect {|
+    { parameter unit ;
+      storage (pair (string %three) (pair %four (int %one) (nat %two))) ;
+      code { PUSH nat 2 ;
+             PUSH int 1 ;
+             PAIR ;
+             PUSH string "foo" ;
+             PAIR ;
+             NIL operation ;
+             PAIR ;
+             DIP { DROP } } } |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree.mligo" ; "main" ] ;
+  [%expect {|
+    { parameter unit ;
+      storage (pair (int %three) (pair %four (int %one) (nat %two))) ;
+      code { PUSH nat 2 ;
+             PUSH int 1 ;
+             PAIR ;
+             PUSH int 3 ;
+             PAIR ;
+             NIL operation ;
+             PAIR ;
+             DIP { DROP } } } |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree.religo" ; "main" ] ;
+  [%expect {|
+    { parameter unit ;
+      storage (pair (int %three) (pair %four (int %one) (nat %two))) ;
+      code { PUSH nat 2 ;
+             PUSH int 1 ;
+             PAIR ;
+             PUSH int 3 ;
+             PAIR ;
+             NIL operation ;
+             PAIR ;
+             DIP { DROP } } } |}]

src/bin/expect_tests/syntax_error_tests.ml

@@ -4,7 +4,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_syntax.ligo" ; "main" ] ;
   [%expect {|
     ligo: : Parse error in file "error_syntax.ligo", line 1, characters 16-17 at "-", after "bar":
-          15: <syntax error> {}
+          16: <syntax error> {}
 
 
      If you're not sure how to fix this error, you can

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

@@ -206,6 +206,7 @@ type_args:
 
 core_type:
   type_name      { TVar $1 }
+| "<string>"     { TStringLiteral $1 }
 | par(fun_type)  { TPar $1 }
 | module_name "." type_name {
     let module_name = $1.value in

src/passes/2-concrete_to_imperative/cameligo.ml

@@ -256,6 +256,21 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
             ok @@ t_michelson_or ~loc a' b' c' d'
             )
           | _ -> simple_fail "michelson_or does not have the right number of argument")
+        | "michelson_pair" ->
+          let lst = npseq_to_list tuple.value.inside in
+          (match lst with
+          | [a ; b ; c ; d ] -> (
+            let%bind b' =
+              trace_option (simple_error "second argument of michelson_pair must be a string singleton") @@
+                get_t_string_singleton_opt b in
+            let%bind d' =
+              trace_option (simple_error "fourth argument of michelson_pair must be a string singleton") @@
+                get_t_string_singleton_opt d in
+            let%bind a' = compile_type_expression a in
+            let%bind c' = compile_type_expression c in
+            ok @@ t_michelson_pair ~loc a' b' c' d'
+            )
+          | _ -> simple_fail "michelson_pair does not have the right number of argument")
         | _ ->
           let lst = npseq_to_list tuple.value.inside in
           let%bind lst' = bind_map_list compile_type_expression lst in

src/passes/2-concrete_to_imperative/pascaligo.ml

@@ -196,7 +196,7 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
             let%bind c' = compile_type_expression c in
             ok @@ t_michelson_pair ~loc a' b' c' d'
             )
-          | _ -> simple_fail "michelson_or does not have the right number of argument")
+          | _ -> simple_fail "michelson_pair does not have the right number of argument")
         | _ ->
           let lst = npseq_to_list tuple.value.inside in
           let%bind lst =

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -153,8 +153,8 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result
     | I.T_operator (TC_michelson_pair (l,l_ann,r,r_ann)) ->
       let%bind (l,r) = bind_map_pair compile_type_expression (l,r) in
       let sum : (O.label * O.field_content) list = [
-        (O.Label "M_left" , {field_type = l ; michelson_annotation = Some l_ann}); 
+        (O.Label "0" , {field_type = l ; michelson_annotation = Some l_ann}); 
-        (O.Label "M_right", {field_type = r ; michelson_annotation = Some r_ann}); ]
+        (O.Label "1", {field_type = r ; michelson_annotation = Some r_ann}); ]
       in
       return @@ O.T_record (O.LMap.of_list sum)
     | I.T_operator type_operator ->

src/test/contracts/double_michelson_or.ligo

@@ -1,5 +1,5 @@
-type storage is michelson_or (int, string)
+type storage is michelson_or (int,"foo",string,"bar")
-type foobar is michelson_or (int, int)
+type foobar is michelson_or (int,"baz",int,"fooo")
 
 type return is list (operation) * storage 
 

src/test/contracts/double_michelson_or.mligo

@@ -1,5 +1,5 @@
-type storage = (int,string) michelson_or 
+type storage = (int,"foo",string,"bar") michelson_or 
-type foobar = (int, int ) michelson_or
+type foobar = (int,"baz", int, "fooo" ) michelson_or
 
 type return = operation list * storage
 

src/test/contracts/michelson_pair_tree.mligo

@@ -0,0 +1,8 @@
+type inner_storage = (int,"one",nat,"two") michelson_pair
+type storage = (int,"three",inner_storage,"four") michelson_pair
+
+type return = operation list * storage
+
+let main (action, store : unit * storage) : return =
+  let foo = (3,(1,2n)) in
+  (([] : operation list), (foo: storage))

src/test/contracts/michelson_pair_tree.religo

@@ -0,0 +1,9 @@
+type inner_storage = michelson_pair(int,"one",nat,"two");
+type storage = michelson_pair(int,"three",inner_storage,"four");
+
+type return = (list (operation) , storage);
+
+let main = ((action, store) : (unit , storage)) : return => {
+  let foo = (3,(1,2n)) ;
+  (([] : list(operation)), (foo: storage))
+};

src/test/contracts/negative/bad_michelson_or.mligo

@@ -1,4 +1,4 @@
-type storage = (int,string) michelson_or 
+type storage = (int,"foo",string,"bar") michelson_or 
 
 type return = operation list * storage