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

Separate aggregation case for contract and expression

Browse Source
This commit is contained in:
Lesenechal Remi 2019-12-11 14:42:43 +01:00
parent 4fcbceef5d
commit ebd073f5e2
1 changed files with 43 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
src/stages/mini_c/misc.ml
View File

@ -162,9 +162,9 @@ type form_t =
| ExpressionForm of ((expression * int) * expression list) | ExpressionForm of ((expression * int) * expression list)
let aggregate_entry (lst : program) (form : form_t) : expression result = let aggregate_entry (lst : program) (form : form_t) : expression result =
let (entry_expression , entry_index, arg_lst) = match form with let (entry_expression , entry_index) = match form with
| ContractForm (exp,i) -> (exp,i,[]) | ContractForm (exp,i) -> (exp,i)
| ExpressionForm ((exp,i),argl) -> (exp,i,argl) in | ExpressionForm ((exp,i),_) -> (exp,i) in
let pre_declarations = List.until entry_index lst in let pre_declarations = List.until entry_index lst in
let wrapper = let wrapper =
let aux prec cur = let aux prec cur =
@ -173,27 +173,45 @@ let aggregate_entry (lst : program) (form : form_t) : expression result =
in in
fun expr -> List.fold_right' aux expr pre_declarations fun expr -> List.fold_right' aux expr pre_declarations
in in
match (entry_expression.content , arg_lst) with match form with
| (E_closure _ , (hd::tl)) -> ( | ContractForm _ -> (
let%bind type_value' = match entry_expression.type_value with match (entry_expression.content) with
| T_function (_,t) -> ok t | (E_closure l) -> (
| _ -> simple_fail "Trying to aggregate closure which does not have function type" in let l' = { l with body = wrapper l.body } in
let entry_expression' = List.fold_left let%bind t' =
(fun acc el -> let%bind (input_ty , output_ty) = get_t_function entry_expression.type_value in
let type_value' = match acc.type_value with ok (t_function input_ty output_ty)
| T_function (_,t) -> t in
| e -> e in let e' = {
content = E_closure l' ;
type_value = t' ;
} in
ok e'
)
| _ -> simple_fail "a contract must be a closure" )
| ExpressionForm (_,arg_lst) -> (
match (entry_expression.content , arg_lst) with
| (E_closure _ , (hd::tl)) -> (
let%bind type_value' = match entry_expression.type_value with
| T_function (_,t) -> ok t
| _ -> simple_fail "Trying to aggregate closure which does not have function type" in
let entry_expression' = List.fold_left
(fun acc el ->
let type_value' = match acc.type_value with
| T_function (_,t) -> t
| e -> e in
{
content = E_application (acc,el) ;
type_value = type_value' ;
}
)
{ {
content = E_application (acc,el) ; content = E_application (entry_expression, hd) ;
type_value = type_value' ; type_value = type_value' ;
} } tl in
) ok @@ wrapper entry_expression'
{ )
content = E_application (entry_expression, hd) ; | (_ , _) -> (
type_value = type_value' ; ok @@ wrapper entry_expression
} tl in )
ok @@ wrapper entry_expression' )
)
| (_ , _) -> (
ok @@ wrapper entry_expression
)