fixed minor bug

This commit is contained in:
galfour 2019-09-25 17:21:44 +02:00
parent d9afee0fad
commit be75fd4830
6 changed files with 67 additions and 4 deletions

View File

@ -12,8 +12,9 @@
ast_typed
transpiler
mini_c
operators
compiler
self_michelson
operators
)
(preprocess
(pps ppx_let)

View File

@ -8,11 +8,13 @@ let compile_value : value -> type_value -> Michelson.t result =
let compile_expression_as_value : expression -> _ result = fun e ->
let%bind value = expression_to_value e in
let%bind result = compile_value value e.type_value in
let%bind result = Self_michelson.all_expression result in
ok result
let compile_expression_as_function : expression -> _ result = fun e ->
let (input , output) = t_unit , e.type_value in
let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in
let%bind body = Self_michelson.all_expression body in
let body = Michelson.(seq [ i_drop ; body ]) in
let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in
let open! Compiler.Program in
@ -22,13 +24,11 @@ let compile_function = fun e ->
let%bind (input , output) = get_t_function e.type_value in
let%bind body = get_function e in
let%bind body = compile_value body (t_function input output) in
let%bind body = Self_michelson.all_expression body in
let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in
let open! Compiler.Program in
ok { input ; output ; body }
(* let compile_function : anon_function -> (type_value * type_value) -> Compiler.Program.compiled_program result = fun f io ->
* Compiler.Program.translate_entry f io *)
let compile_expression_as_function_entry = fun program name ->
let%bind aggregated = aggregate_entry program name true in
compile_function aggregated

View File

@ -0,0 +1,12 @@
(library
(name self_michelson)
(public_name ligo.self_michelson)
(libraries
simple-utils
tezos-utils
)
(preprocess
(pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
)

View File

@ -0,0 +1,19 @@
open Trace
open Tezos_utils
open Michelson
open Tezos_micheline.Micheline
type mapper = michelson -> michelson result
let rec map_expression : mapper -> michelson -> michelson result = fun f e ->
let self = map_expression f in
let%bind e' = f e in
match e' with
| Prim (l , p , lst , a) -> (
let%bind lst' = bind_map_list self lst in
ok @@ Prim (l , p , lst' , a)
)
| Seq (l , lst) -> (
let%bind lst' = bind_map_list self lst in
ok @@ Seq (l , lst')
)
| x -> ok x

View File

View File

@ -0,0 +1,31 @@
open Trace
open Tezos_micheline.Micheline
open Memory_proto_alpha.Protocol.Michelson_v1_primitives
let strip_annots = fun e ->
match e with
| Prim (l , p , lst , _) -> ok @@ Prim (l , p , lst , [])
| x -> ok x
let strip_nops = fun e ->
match e with
| Seq(l, [Prim (_, I_UNIT, _, _) ; Prim(_, I_DROP, _, _)]) -> ok @@ Seq (l, [])
| x -> ok x
let all = [
strip_annots ;
strip_nops ;
]
let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x ->
match fs with
| [] -> ok x
| hd :: tl -> (
let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in
bind aux (ok x)
)
let all_expression =
let all_expr = List.map Helpers.map_expression all in
bind_chain all_expr