add map to lists ; fix error with lists
This commit is contained in:
parent
9dd8e63cbf
commit
564a4df145
@ -397,13 +397,13 @@ and translate_expression ?push_var_name (expr:expression) (env:environment) : (m
|
||||
)
|
||||
| "MAP" -> (
|
||||
let%bind restrict =
|
||||
let%bind popped = Compiler_environment.pop body_env in
|
||||
Compiler_environment.select_env popped env in
|
||||
let%bind popped' = Compiler_environment.pop body_env in
|
||||
Compiler_environment.select_env popped' popped in
|
||||
let%bind code = ok (seq [
|
||||
expr' ;
|
||||
i_map (seq [body' ; restrict]) ;
|
||||
i_map (seq [body' ; dip restrict]) ;
|
||||
]) in
|
||||
return code
|
||||
return ~prepend_env:popped code
|
||||
)
|
||||
| s -> (
|
||||
let error = error (thunk "bad iterator") (thunk s) in
|
||||
|
@ -68,15 +68,11 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
|
||||
in
|
||||
ok @@ D_map lst'
|
||||
| (List_t (ty, _)), lst ->
|
||||
let lst' =
|
||||
let aux acc cur = cur :: acc in
|
||||
let lst = List.fold_left aux lst [] in
|
||||
List.rev lst in
|
||||
let%bind lst'' =
|
||||
let%bind lst' =
|
||||
let aux = fun t -> translate_value (Ex_typed_value (ty, t)) in
|
||||
bind_map_list aux lst'
|
||||
bind_map_list aux lst
|
||||
in
|
||||
ok @@ D_list lst''
|
||||
ok @@ D_list lst'
|
||||
| (Set_t (ty, _)), (module S) -> (
|
||||
let lst = S.OPS.elements S.boxed in
|
||||
let lst' =
|
||||
|
@ -27,3 +27,7 @@ function iter_op (const s : list(int)) : int is
|
||||
begin
|
||||
list_iter(s , aggregate) ;
|
||||
end with r
|
||||
|
||||
function map_op (const s : list(int)) : list(int) is
|
||||
function increment (const i : int) : int is block { skip } with i + 1
|
||||
block { skip } with list_map(s , increment)
|
||||
|
@ -41,5 +41,14 @@ let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:v
|
||||
Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ;
|
||||
) ;
|
||||
let%bind ex_ty_value = run_aux ?options compiled input_michelson in
|
||||
if debug_michelson then (
|
||||
let (Ex_typed_value (ty , v)) = ex_ty_value in
|
||||
ignore @@
|
||||
let%bind michelson_value =
|
||||
trace_tzresult_lwt (simple_error "debugging run_mini_c") @@
|
||||
Proto_alpha_utils.Memory_proto_alpha.unparse_michelson_data ty v in
|
||||
Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ;
|
||||
ok ()
|
||||
) ;
|
||||
let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
|
||||
ok result
|
||||
|
@ -17,8 +17,11 @@ let run_simplityped
|
||||
let%bind annotated_result = Typer.untype_expression typed_result in
|
||||
ok annotated_result
|
||||
|
||||
let evaluate_simplityped ?options (program : Ast_typed.program) (entry : string)
|
||||
let evaluate_simplityped
|
||||
?options
|
||||
?(debug_mini_c = false) ?(debug_michelson = false)
|
||||
(program : Ast_typed.program) (entry : string)
|
||||
: Ast_simplified.expression result =
|
||||
let%bind typed_result = Run_typed.evaluate_typed ?options entry program in
|
||||
let%bind typed_result = Run_typed.evaluate_typed ?options ~debug_mini_c ~debug_michelson entry program in
|
||||
let%bind annotated_result = Typer.untype_expression typed_result in
|
||||
ok annotated_result
|
||||
|
@ -13,12 +13,18 @@ let transpile_value
|
||||
let%bind r = Run_mini_c.run_entry f input in
|
||||
ok r
|
||||
|
||||
let evaluate_typed ?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result =
|
||||
let evaluate_typed
|
||||
?(debug_mini_c = false) ?(debug_michelson = false)
|
||||
?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result =
|
||||
trace (simple_error "easy evaluate typed") @@
|
||||
let%bind result =
|
||||
let%bind mini_c_main =
|
||||
Transpiler.translate_entry program entry in
|
||||
Run_mini_c.run_entry ?options mini_c_main (Mini_c.Combinators.d_unit) in
|
||||
(if debug_mini_c then
|
||||
Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
|
||||
) ;
|
||||
Run_mini_c.run_entry ?options ~debug_michelson mini_c_main (Mini_c.Combinators.d_unit)
|
||||
in
|
||||
let%bind typed_result =
|
||||
let%bind typed_main = Ast_typed.get_entry program entry in
|
||||
Transpiler.untranspile result typed_main.type_annotation in
|
||||
|
@ -80,6 +80,9 @@ module Simplify = struct
|
||||
("set_remove" , "SET_REMOVE") ;
|
||||
("set_iter" , "SET_ITER") ;
|
||||
("list_iter" , "LIST_ITER") ;
|
||||
("list_map" , "LIST_MAP") ;
|
||||
("map_iter" , "MAP_ITER") ;
|
||||
("map_map" , "MAP_MAP") ;
|
||||
]
|
||||
|
||||
let type_constants = type_constants
|
||||
@ -501,7 +504,7 @@ module Typer = struct
|
||||
let%bind (arg , res) = get_t_function body in
|
||||
let%bind key = get_t_list lst in
|
||||
if eq_1 key arg
|
||||
then ok res
|
||||
then ok (t_list res ())
|
||||
else simple_fail "bad list iter"
|
||||
|
||||
let not_ = typer_1 "NOT" @@ fun elt ->
|
||||
@ -582,12 +585,14 @@ module Typer = struct
|
||||
map_map ;
|
||||
map_fold ;
|
||||
map_iter ;
|
||||
map_map ;
|
||||
set_empty ;
|
||||
set_mem ;
|
||||
set_add ;
|
||||
set_remove ;
|
||||
set_iter ;
|
||||
list_iter ;
|
||||
list_map ;
|
||||
int ;
|
||||
size ;
|
||||
failwith_ ;
|
||||
|
@ -356,15 +356,15 @@ let list () : unit result =
|
||||
let lst' = List.map e_int lst in
|
||||
e_typed_list lst' t_int
|
||||
in
|
||||
let%bind () =
|
||||
let expected = ez [23 ; 42] in
|
||||
expect_eq_evaluate program "fb" expected
|
||||
in
|
||||
let%bind () =
|
||||
let make_input = fun n -> (ez @@ List.range n) in
|
||||
let make_expected = e_nat in
|
||||
expect_eq_n_strict_pos_small program "size_" make_input make_expected
|
||||
in
|
||||
let%bind () =
|
||||
let expected = ez [23 ; 42] in
|
||||
expect_eq_evaluate program "fb" expected
|
||||
in
|
||||
let%bind () =
|
||||
let expected = ez [144 ; 51 ; 42 ; 120 ; 421] in
|
||||
expect_eq_evaluate program "bl" expected
|
||||
@ -372,7 +372,13 @@ let list () : unit result =
|
||||
let%bind () =
|
||||
expect_eq program "iter_op"
|
||||
(e_list [e_int 2 ; e_int 4 ; e_int 7])
|
||||
(e_int 13) in
|
||||
(e_int 13)
|
||||
in
|
||||
let%bind () =
|
||||
expect_eq program "map_op"
|
||||
(e_list [e_int 2 ; e_int 4 ; e_int 7])
|
||||
(e_list [e_int 3 ; e_int 5 ; e_int 8])
|
||||
in
|
||||
ok ()
|
||||
|
||||
let condition () : unit result =
|
||||
|
@ -97,7 +97,7 @@ let expect_evaluate program entry_point expecter =
|
||||
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
||||
error title content in
|
||||
trace error @@
|
||||
let%bind result = Ligo.Run.evaluate_simplityped program entry_point in
|
||||
let%bind result = Ligo.Run.evaluate_simplityped ~debug_mini_c:true ~debug_michelson:true program entry_point in
|
||||
expecter result
|
||||
|
||||
let expect_eq_evaluate program entry_point expected =
|
||||
|
@ -409,7 +409,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re
|
||||
let aux : expression -> expression -> expression result = fun prev cur ->
|
||||
return @@ E_constant ("CONS", [cur ; prev]) in
|
||||
let%bind (init : expression) = return @@ E_make_empty_list t in
|
||||
bind_fold_list aux init lst'
|
||||
bind_fold_right_list aux init lst'
|
||||
)
|
||||
| E_set lst -> (
|
||||
let%bind t =
|
||||
|
Loading…
Reference in New Issue
Block a user