tests pass again

This commit is contained in:
galfour 2019-09-19 12:59:07 +02:00
parent 6fe48ff6ad
commit e3179bd7c7
13 changed files with 59 additions and 15 deletions

View File

@ -7,6 +7,7 @@
parser
simplify
ast_simplified
self_ast_simplified
typer
ast_typed
transpiler

View File

@ -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

View File

@ -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 =

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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
)

View File

@ -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

View File

@ -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"

View File

@ -1,5 +1,3 @@
const lst : list(int) = list [] ;
const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ;
const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;
const address : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;

View File

@ -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)