Merge branch '181-cannot-declare-michelson_or-michelson_pair-element-w-o-annotation' into 'dev'

Resolve "Cannot declare michelson_or/michelson_pair element w/o annotation"

Closes #181

See merge request ligolang/ligo!583
This commit is contained in:
Gabriel Alfour 2020-04-20 21:15:08 +00:00
commit c302a1a9d5
6 changed files with 52 additions and 3 deletions

View File

@ -38,4 +38,17 @@ let%expect_test _ =
* Visit our documentation: https://ligolang.org/docs/intro/introduction
* Ask a question on our Discord: https://discord.gg/9rhYaEt
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
* Check the changelog by running 'ligo changelog' |}]
* Check the changelog by running 'ligo changelog' |}]
let%expect_test _ =
run_ligo_good [ "compile-contract" ; contract "michelson_or_tree_intermediary.ligo" ; "main" ] ;
[%expect {|
{ parameter unit ;
storage (or (int %three) (or (int %one) (nat %two))) ;
code { PUSH int 1 ;
LEFT nat ;
RIGHT int ;
DUP ;
NIL operation ;
PAIR ;
DIP { DROP 2 } } } |}]

View File

@ -43,4 +43,18 @@ let%expect_test _ =
PAIR ;
NIL operation ;
PAIR ;
DIP { DROP } } } |}]
let%expect_test _ =
run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree_intermediary.ligo" ; "main" ] ;
[%expect {|
{ parameter unit ;
storage (pair (string %three) (pair (int %one) (nat %two))) ;
code { PUSH nat 2 ;
PUSH int 1 ;
PAIR ;
PUSH string "foo" ;
PAIR ;
NIL operation ;
PAIR ;
DIP { DROP } } } |}]

View File

@ -282,7 +282,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
let%bind m' = Append_tree.fold_ne
(fun (_, ({ctor_type ; michelson_annotation}: AST.ctor_content)) ->
let%bind a = transpile_type ctor_type in
ok (michelson_annotation, a) )
ok (Ast_typed.Helpers.remove_empty_annotation michelson_annotation, a) )
aux node in
ok @@ snd m'
| T_sum m ->
@ -308,7 +308,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
let%bind m' = Append_tree.fold_ne
(fun (_, ({field_type ; michelson_annotation} : AST.field_content)) ->
let%bind a = transpile_type field_type in
ok (michelson_annotation, a) )
ok (Ast_typed.Helpers.remove_empty_annotation michelson_annotation, a) )
aux node in
ok @@ snd m'
| T_record m ->

View File

@ -166,12 +166,18 @@ let kv_list_of_record_or_tuple (m: _ LMap.t) =
List.rev @@ LMap.to_kv_list m
let remove_empty_annotation (ann : string option) : string option =
match ann with
| Some "" -> None
| _ -> ann
let is_michelson_or (t: _ constructor_map) =
CMap.cardinal t = 2 &&
(CMap.mem (Constructor "M_left") t) &&
(CMap.mem (Constructor "M_right") t)
let is_michelson_pair (t: _ label_map) =
LMap.cardinal t = 2 &&
let l = LMap.to_list t in
List.fold_left
(fun prev {field_type=_;michelson_annotation} -> match michelson_annotation with

View File

@ -0,0 +1,8 @@
type inner_storage is michelson_or(int,"one",nat,"two")
type storage is michelson_or (int,"three",inner_storage,"")
type return is list(operation) * storage
function main (const action : unit; const store : storage) : return is block {
const foo : storage = (M_right ((M_left(1) : inner_storage)) : storage) ;
} with ((nil : list(operation)), (foo: storage))

View File

@ -0,0 +1,8 @@
type inner_storage is michelson_pair(int,"one",nat,"two")
type storage is michelson_pair (string,"three",inner_storage,"")
type return is list(operation) * storage
function main (const action : unit; const store : storage) : return is block {
const foo : storage = ("foo",(1,2n)) ;
} with ((nil : list(operation)), (foo: storage))