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

tmp

Browse Source
This commit is contained in:
Galfour 2019-04-15 11:38:05 +00:00
parent c2dd795287
commit 5b577c1fa4
3 changed files with 15 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/lib_utils/x_list.ml
View File

@ -7,6 +7,8 @@ let map ?(acc = []) f lst =
in
aux acc f (List.rev lst)
let fold_right' f init lst = List.fold_left f init (List.rev lst)
let filter_map f =
let rec aux acc lst = match lst with
| [] -> List.rev acc

18
src/ligo/mini_c/compiler.ml
View File

@ -327,29 +327,17 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
let%bind expr = translate_expression expr in
let%bind a' = translate_regular_block a in
let%bind b' = translate_regular_block b in
let%bind restrict_a =
let env_a = (snd a).pre_environment in
Environment.to_michelson_restrict env_a in
let%bind restrict_b =
let env_b = (snd b).pre_environment in
Environment.to_michelson_restrict env_b in
ok @@ (seq [
i_push_unit ;
expr ;
prim I_CAR ;
dip @@ Environment.to_michelson_extend w_env.pre_environment ;
prim ~children:[seq [a' ; restrict_a];seq [b' ; restrict_b]] I_IF ;
prim ~children:[seq [a'];seq [b']] I_IF ;
])
| S_if_none (expr, none, (_, some)) ->
let%bind expr = translate_expression expr in
let%bind none' = translate_regular_block none in
let%bind some' = translate_regular_block some in
let%bind restrict_none =
let env_none = (snd none).pre_environment in
Environment.to_michelson_restrict env_none in
let%bind restrict_some =
let env_some = (snd some).pre_environment in
Environment.to_michelson_restrict env_some in
let%bind add =
let env = Environment.extend w_env.pre_environment in
Environment.to_michelson_anonymous_add env in
@ -357,8 +345,8 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
i_push_unit ; expr ; i_car ;
dip @@ Environment.to_michelson_extend w_env.pre_environment ;
prim ~children:[
seq [none' ; restrict_none] ;
seq [add ; some' ; restrict_some] ;
seq [none'] ;
seq [add ; some'] ;
] I_IF_NONE
])
| S_while ((_, _, _) as expr, block) ->

35
src/ligo/transpiler.ml
View File

@ -147,11 +147,19 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
| I_matching (expr, m) -> (
let%bind expr' = translate_annotated_expression env expr in
let env' = Environment.extend env in
let aux : block -> block = fun (lst, wrap) -> (* Takes a block and add a "restrict" statement at its end *)
let b_wrap = { wrap with post_environment = env } in
let s_wrap = {
pre_environment = wrap.post_environment ;
post_environment = env ;
} in
(lst @ [S_environment_restrict, s_wrap], b_wrap)
in
match m with
| Match_bool {match_true ; match_false} -> (
let%bind true_branch = translate_block env' match_true in
let%bind false_branch = translate_block env' match_false in
return (S_cond (expr', true_branch, false_branch))
return (S_cond (expr', aux true_branch, aux false_branch))
)
| Match_option {match_none ; match_some = ((name, t), sm)} -> (
let%bind none_branch = translate_block env' match_none in
@ -159,7 +167,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
let%bind t' = translate_type t in
let env' = Environment.add (name, t') env' in
translate_block env' sm in
return (S_if_none (expr', none_branch, (name, some_branch)))
return (S_if_none (expr', aux none_branch, (name, aux some_branch)))
)
| _ -> simple_fail "todo : match"
)
@ -238,29 +246,6 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
let%bind tpl' = translate_annotated_expression env tpl in
let expr = List.fold_left aux tpl' path in
ok expr
(* let%bind tpl' = translate_annotated_expression env tpl in
* let%bind tpl_tv = get_t_tuple tpl.type_annotation in
* let node_tv = Append_tree.of_list @@ List.mapi (fun i a -> (i, a)) tpl_tv in
* let leaf (i, _) : expression result =
* if i = ind then (
* ok tpl'
* ) else (
* simple_fail "bad leaf"
* ) in
* let node a b : expression result =
* match%bind bind_lr (a, b) with
* | `Left ((_, t, env) as ex) -> (
* let%bind (a, _) = get_t_pair t in
* ok (E_constant ("CAR", [ex]), a, env)
* )
* | `Right ((_, t, env) as ex) -> (
* let%bind (_, b) = get_t_pair t in
* ok (E_constant ("CDR", [ex]), b, env)
* ) in
* let%bind expr =
* trace_strong (simple_error "bad index in tuple (shouldn't happen here)") @@
* Append_tree.fold_ne leaf node node_tv in
* ok expr *)
| E_record m ->
let node = Append_tree.of_list @@ list_of_map m in
let aux a b : expression result =