tests pass again
This commit is contained in:
parent
6fe48ff6ad
commit
e3179bd7c7
@ -7,6 +7,7 @@
|
||||
parser
|
||||
simplify
|
||||
ast_simplified
|
||||
self_ast_simplified
|
||||
typer
|
||||
ast_typed
|
||||
transpiler
|
||||
|
@ -62,11 +62,15 @@ let parsify = fun (syntax : v_syntax) source_filename ->
|
||||
| Pascaligo -> ok parsify_pascaligo
|
||||
| Cameligo -> ok parsify_ligodity
|
||||
in
|
||||
parsify source_filename
|
||||
let%bind parsified = parsify source_filename in
|
||||
let%bind applied = Self_ast_simplified.convert_annotation_program parsified in
|
||||
ok applied
|
||||
|
||||
let parsify_expression = fun syntax source ->
|
||||
let%bind parsify = match syntax with
|
||||
| Pascaligo -> ok parsify_expression_pascaligo
|
||||
| Cameligo -> ok parsify_expression_ligodity
|
||||
in
|
||||
parsify source
|
||||
let%bind parsified = parsify source in
|
||||
let%bind applied = Self_ast_simplified.convert_annotation_expression parsified in
|
||||
ok applied
|
||||
|
@ -35,6 +35,12 @@ let run_function ?options expression input ty =
|
||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
||||
|
||||
let run_function_value ?options expression input ty =
|
||||
let%bind code = Compile.Of_mini_c.compile_function expression in
|
||||
let%bind input = Compile.Of_mini_c.compile_value input ty in
|
||||
let%bind ex_ty_value = Of_michelson.run ~is_input_value:true ?options code input in
|
||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
||||
|
||||
let run_function_entry ?options program entry input =
|
||||
let%bind code = Compile.Of_mini_c.compile_function_entry program entry in
|
||||
let%bind input_michelson =
|
||||
|
@ -125,3 +125,14 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
|
||||
let%bind lst' = bind_map_list aux lst in
|
||||
ok @@ Match_variant lst'
|
||||
)
|
||||
|
||||
and map_program : mapper -> program -> program result = fun m p ->
|
||||
let aux = fun (x : declaration) ->
|
||||
match x with
|
||||
| Declaration_constant (t , o , e) -> (
|
||||
let%bind e' = map_expression m e in
|
||||
ok (Declaration_constant (t , o , e'))
|
||||
)
|
||||
| Declaration_type _ -> ok x
|
||||
in
|
||||
bind_map_list (bind_map_location aux) p
|
||||
|
@ -1 +1,2 @@
|
||||
let convert_annotation = Helpers.map_expression Tezos_type_annotation.peephole_expression
|
||||
let convert_annotation_expression = Helpers.map_expression Tezos_type_annotation.peephole_expression
|
||||
let convert_annotation_program = Helpers.map_program Tezos_type_annotation.peephole_expression
|
||||
|
@ -547,9 +547,9 @@ let transpile_declaration env (d:AST.declaration) : toplevel_statement result =
|
||||
|
||||
let transpile_program (lst : AST.program) : program result =
|
||||
let aux (prev:(toplevel_statement list * Environment.t) result) cur =
|
||||
let%bind (tl, env) = prev in
|
||||
let%bind (hds, env) = prev in
|
||||
let%bind ((_, env') as cur') = transpile_declaration env cur in
|
||||
ok (cur' :: tl, env'.post_environment)
|
||||
ok (hds @ [ cur' ], env'.post_environment)
|
||||
in
|
||||
let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) (temp_unwrap_loc_list lst) in
|
||||
ok statements
|
||||
|
@ -69,7 +69,7 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
|
||||
|
||||
and expression' ppf (e:expression') = match e with
|
||||
| E_skip -> fprintf ppf "skip"
|
||||
| E_closure x -> function_ ppf x
|
||||
| E_closure x -> fprintf ppf "C(%a)" function_ x
|
||||
| E_variable v -> fprintf ppf "V(%s)" v
|
||||
| E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b
|
||||
| E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst
|
||||
|
@ -81,6 +81,10 @@ let get_t_function tv = match tv with
|
||||
| T_function ty -> ok ty
|
||||
| _ -> simple_fail "not a function"
|
||||
|
||||
let get_t_closure tv = match tv with
|
||||
| T_deep_closure ty -> ok ty
|
||||
| _ -> simple_fail "not a function"
|
||||
|
||||
let get_t_option (v:type_value) = match v with
|
||||
| T_option t -> ok t
|
||||
| _ -> simple_fail "not an option"
|
||||
|
@ -87,7 +87,22 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
|
||||
let e' = { entry_expression with content = E_literal (D_function l') } in
|
||||
ok e'
|
||||
)
|
||||
| (E_closure l , false) -> (
|
||||
let l' = { l with body = wrapper l.body } in
|
||||
let%bind t' =
|
||||
let%bind (_ , input_ty , output_ty) = get_t_closure entry_expression.type_value in
|
||||
ok (t_function input_ty output_ty)
|
||||
in
|
||||
let e' = {
|
||||
content = E_literal (D_function l') ;
|
||||
type_value = t' ;
|
||||
} in
|
||||
ok e'
|
||||
)
|
||||
| (_ , true) -> (
|
||||
ok @@ functionalize @@ wrapper entry_expression
|
||||
)
|
||||
| _ -> fail @@ Errors.not_functional_main name
|
||||
| _ -> (
|
||||
Format.printf "Not functional: %a\n" PP.expression entry_expression ;
|
||||
fail @@ Errors.not_functional_main name
|
||||
)
|
||||
|
@ -12,7 +12,7 @@ type type_value =
|
||||
| T_pair of (type_value * type_value)
|
||||
| T_or of type_value * type_value
|
||||
| T_function of (type_value * type_value)
|
||||
| T_deep_closure of environment * type_value * type_value
|
||||
| T_deep_closure of (environment * type_value * type_value)
|
||||
| T_base of type_base
|
||||
| T_map of (type_value * type_value)
|
||||
| T_list of type_value
|
||||
|
@ -5,7 +5,7 @@ open Test_helpers
|
||||
|
||||
let run_entry_int e (n:int) : int result =
|
||||
let param : value = D_int n in
|
||||
let%bind result = Run.Of_mini_c.run_function e param t_int in
|
||||
let%bind result = Run.Of_mini_c.run_function_value e param t_int in
|
||||
match result with
|
||||
| D_int n -> ok n
|
||||
| _ -> simple_fail "result is not an int"
|
||||
|
@ -1,5 +1,3 @@
|
||||
const lst : list(int) = list [] ;
|
||||
|
||||
const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ;
|
||||
|
||||
const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;
|
||||
const address : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;
|
||||
|
@ -28,9 +28,6 @@ let annotation () : unit result =
|
||||
let%bind () =
|
||||
expect_eq_evaluate program "address" (e_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")
|
||||
in
|
||||
let%bind () =
|
||||
expect_eq_evaluate program "address_2" (e_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")
|
||||
in
|
||||
ok ()
|
||||
|
||||
let complex_function () : unit result =
|
||||
@ -99,14 +96,21 @@ let higher_order () : unit result =
|
||||
|
||||
let shared_function () : unit result =
|
||||
let%bind program = type_file "./contracts/function-shared.ligo" in
|
||||
Format.printf "inc\n" ;
|
||||
let%bind () =
|
||||
let make_expect = fun n -> (n + 1) in
|
||||
expect_eq_n_int program "inc" make_expect
|
||||
in
|
||||
Format.printf "double inc?\n" ;
|
||||
let%bind () =
|
||||
expect_eq program "double_inc" (e_int 0) (e_int 2)
|
||||
in
|
||||
Format.printf "double incd!\n" ;
|
||||
let%bind () =
|
||||
let make_expect = fun n -> (n + 2) in
|
||||
expect_eq_n_int program "double_inc" make_expect
|
||||
in
|
||||
Format.printf "foo\n" ;
|
||||
let%bind () =
|
||||
let make_expect = fun n -> (2 * n + 3) in
|
||||
expect_eq program "foo" (e_int 0) (e_int @@ make_expect 0)
|
||||
|
Loading…
Reference in New Issue
Block a user