diff --git a/src/passes/6-transpiler/dune b/src/passes/6-transpiler/dune index 3f483bda3..a547714f0 100644 --- a/src/passes/6-transpiler/dune +++ b/src/passes/6-transpiler/dune @@ -6,6 +6,7 @@ tezos-utils ast_typed mini_c + self_mini_c operators ) (preprocess diff --git a/src/passes/7-self_mini_c/dune b/src/passes/7-self_mini_c/dune new file mode 100644 index 000000000..ec9f97639 --- /dev/null +++ b/src/passes/7-self_mini_c/dune @@ -0,0 +1,11 @@ +(library + (name self_mini_c) + (public_name ligo.self_mini_c) + (libraries + mini_c + ) + (preprocess + (pps ppx_let) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml new file mode 100644 index 000000000..f0d11ff80 --- /dev/null +++ b/src/passes/7-self_mini_c/helpers.ml @@ -0,0 +1,73 @@ +open Mini_c +open Trace + +type mapper = expression -> expression result +(* fold ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a *) + +let rec map_expression : mapper -> expression -> expression result = fun f e -> + let self = map_expression f in + let%bind e' = f e in + let return content = ok { e' with content } in + match e'.content with + | E_variable _ | E_skip | E_make_none _ + | E_make_empty_map (_,_) | E_make_empty_list _ | E_make_empty_set _ as em -> return em + | E_literal v -> ( + let%bind v' = match v with + | D_function an -> + let%bind body = self an.body in + ok @@ D_function { an with body } + | _ -> ok v in + return @@ E_literal v' + ) + | E_constant (name, lst) -> ( + let%bind lst' = bind_map_list self lst in + return @@ E_constant (name,lst') + ) + | E_closure af -> ( + let%bind body = self af.body in + return @@ E_closure { af with body } + ) + | E_application farg -> ( + let%bind farg' = bind_map_pair self farg in + return @@ E_application farg' + ) + | E_iterator (s, ((name , tv) , body) , exp) -> ( + let%bind (exp',body') = bind_map_pair self (exp,body) in + return @@ E_iterator (s, ((name , tv) , body') , exp') + ) + | E_fold (((name , tv) , body) , col , init) -> ( + let%bind (body',col',init') = bind_map_triple self (body,col,init) in + return @@ E_fold (((name , tv) , body') , col', init') + ) + | E_while eb -> ( + let%bind eb' = bind_map_pair self eb in + return @@ E_while eb' + ) + | E_if_bool cab -> ( + let%bind cab' = bind_map_triple self cab in + return @@ E_if_bool cab' + ) + | E_if_none (c, n, ((name, tv) , s)) -> ( + let%bind (c',n',s') = bind_map_triple self (c,n,s) in + return @@ E_if_none (c', n', ((name, tv) , s')) + ) + | E_if_cons (c, n, (((hd, hdtv) , (tl, tltv)) , cons)) -> ( + let%bind (c',n',cons') = bind_map_triple self (c,n,cons) in + return @@ E_if_cons (c', n', (((hd, hdtv) , (tl, tltv)) , cons')) + ) + | E_if_left (c, ((name_l, tvl) , l), ((name_r, tvr) , r)) -> ( + let%bind (c',l',r') = bind_map_triple self (c,l,r) in + return @@ E_if_left (c', ((name_l, tvl) , l'), ((name_r, tvr) , r')) + ) + | E_let_in ((v , tv) , expr , body) -> ( + let%bind (expr',body') = bind_map_pair self (expr,body) in + return @@ E_let_in ((v , tv) , expr' , body') + ) + | E_sequence ab -> ( + let%bind ab' = bind_map_pair self ab in + return @@ E_sequence ab' + ) + | E_assignment (s, lrl, exp) -> ( + let%bind exp' = self exp in + return @@ E_assignment (s, lrl, exp') + ) \ No newline at end of file diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index 7b7f1093d..5901b7dc6 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -64,7 +64,7 @@ and expression' = | E_closure of anon_function | E_skip | E_constant of string * expression list - | E_application of expression * expression + | E_application of (expression * expression) | E_variable of var_name | E_make_empty_map of (type_value * type_value) | E_make_empty_list of type_value @@ -72,14 +72,14 @@ and expression' = | E_make_none of type_value | E_iterator of (string * ((var_name * type_value) * expression) * expression) | E_fold of (((var_name * type_value) * expression) * expression * expression) - | E_if_bool of expression * expression * expression + | E_if_bool of (expression * expression * expression) | E_if_none of expression * expression * ((var_name * type_value) * expression) | E_if_cons of (expression * expression * (((var_name * type_value) * (var_name * type_value)) * expression)) | E_if_left of expression * ((var_name * type_value) * expression) * ((var_name * type_value) * expression) | E_let_in of ((var_name * type_value) * expression * expression) | E_sequence of (expression * expression) | E_assignment of (string * [`Left | `Right] list * expression) - | E_while of expression * expression + | E_while of (expression * expression) and expression = { content : expression' ; diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 329203a46..482ed6e86 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -661,10 +661,17 @@ let bind_and (a, b) = a >>? fun a -> b >>? fun b -> ok (a, b) +let bind_and3 (a, b, c) = + a >>? fun a -> + b >>? fun b -> + c >>? fun c -> + ok (a, b, c) let bind_pair = bind_and let bind_map_pair f (a, b) = bind_pair (f a, f b) +let bind_map_triple f (a, b, c) = + bind_and3 (f a, f b, f c) (**