balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'bug_fix/old_cases_in_transpiler' into 'dev'

Browse Source 
bug-fix : remove old code in transpiler& fix env recomputing

See merge request ligolang/ligo!636
This commit is contained in:
Rémi Lesenechal 2020-05-26 13:51:10 +00:00
commit bc2d95d6f6
6 changed files with 210 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
src/bin/expect_tests/michelson_converter.ml
View File

@ -202,4 +202,121 @@ let%expect_test _ =
IF_LEFT
{ DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } }
{ DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } } ;
DIP { DROP 2 } } } |}]
let%expect_test _ =
run_ligo_good [ "compile-contract" ; (contract "double_fold_converter.religo") ; "main" ] ;
[%expect {|
{ parameter
(list (pair (address %from_)
(list %txs (pair (address %to_) (pair (nat %token_id) (nat %amount)))))) ;
storage (big_map nat address) ;
code { DUP ;
CDR ;
DIG 1 ;
DUP ;
DUG 2 ;
CAR ;
ITER { SWAP ;
PAIR ;
DUP ;
CDR ;
DUP ;
CAR ;
SENDER ;
DIG 1 ;
DUP ;
DUG 2 ;
COMPARE ;
NEQ ;
IF { PUSH string "NOT_OWNER" ; FAILWITH } { PUSH unit Unit } ;
DIG 1 ;
DUP ;
DUG 2 ;
DIG 4 ;
DUP ;
DUG 5 ;
CAR ;
PAIR ;
DIG 3 ;
DUP ;
DUG 4 ;
CDR ;
ITER { SWAP ;
PAIR ;
DUP ;
CAR ;
DIG 1 ;
DUP ;
DUG 2 ;
CDR ;
DIG 1 ;
DUP ;
DUG 2 ;
CAR ;
DIG 2 ;
DUP ;
DUG 3 ;
CDR ;
DIG 2 ;
DUP ;
DUG 3 ;
CDR ;
CAR ;
DIG 3 ;
DUP ;
DUG 4 ;
CAR ;
DIG 4 ;
DUP ;
DUG 5 ;
CDR ;
CDR ;
PAIR ;
PAIR ;
DIG 2 ;
DUP ;
DUG 3 ;
DIG 1 ;
DUP ;
DUG 2 ;
CDR ;
GET ;
IF_NONE
{ PUSH string "TOKEN_UNDEFINED" ; FAILWITH }
{ DIG 2 ;
DUP ;
DUG 3 ;
DIG 1 ;
DUP ;
DUG 2 ;
COMPARE ;
EQ ;
IF { DUP } { PUSH string "INSUFFICIENT_BALANCE" ; FAILWITH } ;
DIP { DROP } } ;
DIG 2 ;
DUP ;
DUG 3 ;
DIG 4 ;
DUP ;
DUG 5 ;
DIG 3 ;
DUP ;
DUG 4 ;
CAR ;
CDR ;
SOME ;
DIG 4 ;
DUP ;
DUG 5 ;
CDR ;
UPDATE ;
PAIR ;
DIP { DROP 7 } } ;
DUP ;
CAR ;
DIP { DROP 5 } } ;
DUP ;
NIL operation ;
PAIR ;
DIP { DROP 2 } } } |}]

36
src/passes/10-transpiler/transpiler.ml
View File

@ -42,14 +42,6 @@ them. please report this to the developers." in
] in
error ~data title content
let unsupported_iterator location =
let title () = "unsupported iterator" in
let content () = "only lambda are supported as iterators" in
let data = [
row_loc location ;
] in
error ~data title content
let not_functional_main location =
let title () = "not functional main" in
let content () = "main should be a function" in
@ -511,28 +503,14 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
return @@ E_record_update (record, path, update)
| E_constant {cons_name=name; arguments=lst} -> (
let iterator_generator iterator_name =
let lambda_to_iterator_body (f : AST.expression) (l : AST.lambda) =
let%bind body' = transpile_annotated_expression l.result in
let%bind (input , _) = AST.get_t_function f.type_expression in
let%bind input' = transpile_type input in
ok ((l.binder , input') , body')
in
let expression_to_iterator_body (f : AST.expression) =
match f.expression_content with
| E_lambda l -> lambda_to_iterator_body f l
| E_variable v -> (
let%bind elt =
trace_option (corner_case ~loc:__LOC__ "missing var") @@
AST.Environment.get_opt v f.environment in
match elt.definition with
| ED_declaration { expr = f ; free_variables = _ } -> (
match f.expression_content with
| E_lambda l -> lambda_to_iterator_body f l
| _ -> fail @@ unsupported_iterator f.location
)
| _ -> fail @@ unsupported_iterator f.location
)
| _ -> fail @@ unsupported_iterator f.location
let%bind (input , output) = AST.get_t_function f.type_expression in
let%bind f' = transpile_annotated_expression f in
let%bind input' = transpile_type input in
let%bind output' = transpile_type output in
let binder = Var.fresh ~name:"iterated" () in
let application = Mini_c.Combinators.e_application f' output' (Mini_c.Combinators.e_var binder input') in
ok ((binder , input'), application)
in
fun (lst : AST.expression list) -> match (lst , iterator_name) with
| [f ; i] , C_ITER | [f ; i] , C_MAP -> (

6
src/passes/9-self_ast_typed/recompute_environment.ml
View File

@ -34,9 +34,9 @@ let rec expression : environment -> expression -> expression = fun env expr ->
return @@ E_lambda { c with result }
)
| E_let_in c -> (
let env' = Environment.add_ez_declaration c.let_binder c.rhs env in
let let_result = self ~env' c.let_result in
let rhs = self c.rhs in
let env' = Environment.add_ez_declaration c.let_binder rhs env in
let let_result = self ~env' c.let_result in
return @@ E_let_in { c with rhs ; let_result }
)
(* rec fun_name binder -> result *)
@ -152,7 +152,7 @@ let program : environment -> program -> program = fun init_env prog ->
let aux (pre_env , rev_decls) decl_wrapped =
let (Declaration_constant c) = Location.unwrap decl_wrapped in
let expr = expression pre_env c.expr in
let post_env = Environment.add_ez_declaration c.binder c.expr pre_env in
let post_env = Environment.add_ez_declaration c.binder expr pre_env in
let post_env' = merge c.post_env post_env in
let wrap_content = Declaration_constant { c with expr ; post_env = post_env' } in
let decl_wrapped' = { decl_wrapped with wrap_content } in

9
src/stages/5-mini_c/combinators.ml
View File

@ -183,6 +183,15 @@ let e_let_in ?loc v tv inline expr body : expression = Expression.(make_tpl ?loc
E_let_in ((v , tv) , inline, expr , body) ,
get_type body
))
let e_application ?loc f t arg: expression = Expression.(make_tpl ?loc(
E_application (f,arg) ,
t
))
let e_var ?loc vname t: expression = Expression.(make_tpl ?loc(
E_variable vname ,
t
))
let ez_e_sequence ?loc a b : expression = Expression.(make_tpl (E_sequence (make_tpl ?loc (a , t_unit ()) , b) , get_type b))

2
src/stages/5-mini_c/combinators.mli
View File

@ -78,3 +78,5 @@ val d_unit : value
val environment_wrap : environment -> environment -> environment_wrap
val id_environment_wrap : environment -> environment_wrap
val e_var : ?loc:Location.t -> var_name -> type_expression -> expression
val e_application : ?loc:Location.t -> expression -> type_expression -> expression -> expression

72
src/test/contracts/double_fold_converter.religo Normal file
View File

@ -0,0 +1,72 @@
type tokenId = nat;
type tokenOwner = address;
type tokenAmount = nat;
type transferContents = {
to_: tokenOwner,
token_id: tokenId,
amount: tokenAmount
};
type transfer = {
from_: tokenOwner,
txs: list(transferContents)
};
type transferContentsMichelson = michelson_pair_right_comb(transferContents);
type transferAuxiliary = {
from_: tokenOwner,
txs: list(transferContentsMichelson)
};
type transferMichelson = michelson_pair_right_comb(transferAuxiliary);
type transferParameter = list(transferMichelson);
type parameter =
| Transfer(transferParameter)
type storage = big_map(tokenId, tokenOwner);
type entrypointParameter = (parameter, storage);
type entrypointReturn = (list(operation), storage);
let errorTokenUndefined = "TOKEN_UNDEFINED";
let errorNotOwner = "NOT_OWNER";
let errorInsufficientBalance = "INSUFFICIENT_BALANCE";
type transferContentsIteratorAccumulator = (storage, tokenOwner);
let transferContentsIterator = ((accumulator, transferContentsMichelson): (transferContentsIteratorAccumulator, transferContentsMichelson)): transferContentsIteratorAccumulator => {
let (storage, from_) = accumulator;
let transferContents: transferContents = Layout.convert_from_right_comb(transferContentsMichelson);
let tokenOwner: option(tokenOwner) = Map.find_opt(transferContents.token_id, storage);
let tokenOwner = switch (tokenOwner) {
| None => (failwith(errorTokenUndefined): tokenOwner)
| Some(tokenOwner) => if (tokenOwner == from_) {
tokenOwner
} else {
(failwith(errorInsufficientBalance): tokenOwner);
}
};
let storage = Map.update(
transferContents.token_id,
Some(transferContents.to_),
storage
);
(storage, from_)
};
let allowOnlyOwnTransfer = (from: tokenOwner): unit => {
if (from != Tezos.sender) {
failwith(errorNotOwner)
} else { (); }
}
let transferIterator = ((storage, transferMichelson): (storage, transferMichelson)): storage => {
let transferAuxiliary2: transferAuxiliary = Layout.convert_from_right_comb(transferMichelson);
let from_: tokenOwner = transferAuxiliary2.from_;
allowOnlyOwnTransfer(from_);
let (storage, _) = List.fold(
transferContentsIterator,
transferAuxiliary2.txs,
(storage, from_)
);
storage
};
let transfer = ((transferParameter, storage): (transferParameter, storage)): entrypointReturn => {
let storage = List.fold(transferIterator, transferParameter, storage);
(([]: list(operation)), storage);
};
let main = ((parameter, storage): entrypointParameter): entrypointReturn => {
switch (parameter) {
| Transfer(transferParameter) => transfer((transferParameter, storage))
}
}