balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

various refactorings to prepare tests; tests for ligodity don't pass

Browse Source
This commit is contained in:
Galfour 2019-05-31 19:56:51 +00:00
parent 009b0331e9
commit 320d0c1a72
15 changed files with 484 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/main/contract.ml
View File

@ -98,7 +98,7 @@ let parsify_expression_ligodity = fun source ->
let parsify = fun syntax source -> let parsify = fun syntax source ->
let%bind parsify = match syntax with let%bind parsify = match syntax with
| "pascaligo" -> ok parsify_pascaligo | "pascaligo" -> ok parsify_pascaligo
| "cameligo" | "cameligo" -> ok parsify_ligodity
| _ -> simple_fail "unrecognized parser" | _ -> simple_fail "unrecognized parser"
in in
parsify source parsify source
@ -106,7 +106,7 @@ let parsify = fun syntax source ->
let parsify_expression = fun syntax source -> let parsify_expression = fun syntax source ->
let%bind parsify = match syntax with let%bind parsify = match syntax with
| "pascaligo" -> ok parsify_expression_pascaligo | "pascaligo" -> ok parsify_expression_pascaligo
| "cameligo" | "cameligo" -> ok parsify_expression_ligodity
| _ -> simple_fail "unrecognized parser" | _ -> simple_fail "unrecognized parser"
in in
parsify source parsify source

271
src/main/main.ml
View File

@ -1,6 +1,6 @@
module Run_mini_c = Run_mini_c module Run_mini_c = Run_mini_c
open Trace (* open Trace *)
module Parser = Parser module Parser = Parser
module AST_Raw = Parser.Pascaligo.AST module AST_Raw = Parser.Pascaligo.AST
module AST_Simplified = Ast_simplified module AST_Simplified = Ast_simplified
@ -8,159 +8,128 @@ module AST_Typed = Ast_typed
module Mini_c = Mini_c module Mini_c = Mini_c
module Typer = Typer module Typer = Typer
module Transpiler = Transpiler module Transpiler = Transpiler
module Run = struct
include Run_source
include Run_simplified
include Run_typed
include Run_mini_c
end
(* module Parser_multifix = Multifix (* module Parser_multifix = Multifix
* module Simplify_multifix = Simplify_multifix *) * module Simplify_multifix = Simplify_multifix *)
let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p (* let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p
let simplify_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e * let simplify_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e
let unparse_simplified_expr (e:AST_Simplified.expression) : string result = * let unparse_simplified_expr (e:AST_Simplified.expression) : string result =
ok @@ Format.asprintf "%a" AST_Simplified.PP.expression e * ok @@ Format.asprintf "%a" AST_Simplified.PP.expression e
*
let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p * let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p
let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty) * let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
(e:AST_Simplified.expression) : AST_Typed.annotated_expression result = * (e:AST_Simplified.expression) : AST_Typed.annotated_expression result =
Typer.type_expression env e * Typer.type_expression env e
let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.expression result = Typer.untype_expression e * let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.expression result = Typer.untype_expression e
*
let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p * let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p
let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name * let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
let transpile_expression (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression e * let transpile_expression (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression e
let transpile_value *
(e:AST_Typed.annotated_expression) : Mini_c.value result = * let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
let%bind f = * Transpiler.untranspile v e
let open Transpiler in *
let (f , _) = functionalize e in * let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
let%bind main = translate_main f in *
ok main * let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result =
in * let%bind result =
* let%bind mini_c_main =
let input = Mini_c.Combinators.d_unit in * transpile_entry program entry in
let%bind r = Run_mini_c.run_entry f input in * Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
ok r * let%bind typed_result =
* let%bind typed_main = Ast_typed.get_entry program entry in
let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result = * untranspile_value result typed_main.type_annotation in
Transpiler.untranspile v e * ok typed_result
*
let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program *
* let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
let type_file ?(debug_simplify = false) ?(debug_typed = false) *
(path:string) : AST_Typed.program result = *
let%bind raw = Parser.Pascaligo.parse_file path in * let easy_run_typed
let%bind simpl = * ?(debug_mini_c = false) ?options (entry:string)
trace (simple_error "simplifying") @@ * (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
simplify raw in * let%bind () =
(if debug_simplify then * let open Ast_typed in
Format.(printf "Simplified : %a\n%!" AST_Simplified.PP.program simpl) * let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
) ; * let%bind (arg_ty , _) =
let%bind typed = * trace_strong (simple_error "entry-point doesn't have a function type") @@
trace (simple_error "typing") @@ * get_t_function @@ get_type_annotation d.annotated_expression in
type_ simpl in * Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
(if debug_typed then ( * in
Format.(printf "Typed : %a\n%!" AST_Typed.PP.program typed) *
)) ; * let%bind mini_c_main =
ok typed * trace (simple_error "transpile mini_c entry") @@
* transpile_entry program entry in
* (if debug_mini_c then
* Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
* ) ;
*
* let%bind mini_c_value = transpile_value input in
*
* let%bind mini_c_result =
* let error =
* let title () = "run Mini_c" in
* let content () =
* Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
* in
* error title content in
* trace error @@
* Run_mini_c.run_entry ?options mini_c_main mini_c_value in
* let%bind typed_result =
* let%bind main_result_type =
* let%bind typed_main = Ast_typed.get_functional_entry program entry in
* match (snd typed_main).type_value' with
* | T_function (_, result) -> ok result
* | _ -> simple_fail "main doesn't have fun type" in
* untranspile_value mini_c_result main_result_type in
* ok typed_result
*
* let easy_run_typed_simplified
* ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
* (program:AST_Typed.program) (input:Ast_simplified.expression) : Ast_simplified.expression result =
* let%bind mini_c_main =
* trace (simple_error "transpile mini_c entry") @@
* transpile_entry program entry in
* (if debug_mini_c then
* Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
* ) ;
*
* let%bind typed_value =
* let env =
* let last_declaration = Location.unwrap List.(hd @@ rev program) in
* match last_declaration with
* | Declaration_constant (_ , (_ , post_env)) -> post_env
* in
* type_expression ~env input in
* let%bind mini_c_value = transpile_value typed_value in
*
* let%bind mini_c_result =
* let error =
* let title () = "run Mini_c" in
* let content () =
* Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
* in
* error title content in
* trace error @@
* Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
* let%bind typed_result =
* let%bind main_result_type =
* let%bind typed_main = Ast_typed.get_functional_entry program entry in
* match (snd typed_main).type_value' with
* | T_function (_, result) -> ok result
* | _ -> simple_fail "main doesn't have fun type" in
* untranspile_value mini_c_result main_result_type in
* let%bind annotated_result = untype_expression typed_result in
* ok annotated_result *)
let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result = (* module Contract = Contract *)
let%bind result =
let%bind mini_c_main =
transpile_entry program entry in
Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
let%bind typed_result =
let%bind typed_main = Ast_typed.get_entry program entry in
untranspile_value result typed_main.type_annotation in
ok typed_result
let easy_evaluate_typed_simplified (entry:string) (program:AST_Typed.program) : Ast_simplified.expression result =
let%bind result =
let%bind mini_c_main =
transpile_entry program entry in
Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
let%bind typed_result =
let%bind typed_main = Ast_typed.get_entry program entry in
untranspile_value result typed_main.type_annotation in
let%bind annotated_result = untype_expression typed_result in
ok annotated_result
let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
let easy_run_typed
?(debug_mini_c = false) ?options (entry:string)
(program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
let%bind () =
let open Ast_typed in
let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
let%bind (arg_ty , _) =
trace_strong (simple_error "entry-point doesn't have a function type") @@
get_t_function @@ get_type_annotation d.annotated_expression in
Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
in
let%bind mini_c_main =
trace (simple_error "transpile mini_c entry") @@
transpile_entry program entry in
(if debug_mini_c then
Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
) ;
let%bind mini_c_value = transpile_value input in
let%bind mini_c_result =
let error =
let title () = "run Mini_c" in
let content () =
Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
in
error title content in
trace error @@
Run_mini_c.run_entry ?options mini_c_main mini_c_value in
let%bind typed_result =
let%bind main_result_type =
let%bind typed_main = Ast_typed.get_functional_entry program entry in
match (snd typed_main).type_value' with
| T_function (_, result) -> ok result
| _ -> simple_fail "main doesn't have fun type" in
untranspile_value mini_c_result main_result_type in
ok typed_result
let easy_run_typed_simplified
?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
(program:AST_Typed.program) (input:Ast_simplified.expression) : Ast_simplified.expression result =
let%bind mini_c_main =
trace (simple_error "transpile mini_c entry") @@
transpile_entry program entry in
(if debug_mini_c then
Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
) ;
let%bind typed_value =
let env =
let last_declaration = Location.unwrap List.(hd @@ rev program) in
match last_declaration with
| Declaration_constant (_ , (_ , post_env)) -> post_env
in
type_expression ~env input in
let%bind mini_c_value = transpile_value typed_value in
let%bind mini_c_result =
let error =
let title () = "run Mini_c" in
let content () =
Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
in
error title content in
trace error @@
Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
let%bind typed_result =
let%bind main_result_type =
let%bind typed_main = Ast_typed.get_functional_entry program entry in
match (snd typed_main).type_value' with
| T_function (_, result) -> ok result
| _ -> simple_fail "main doesn't have fun type" in
untranspile_value mini_c_result main_result_type in
let%bind annotated_result = untype_expression typed_result in
ok annotated_result
module Contract = Contract

22
src/main/run_mini_c.ml
View File

@ -22,14 +22,6 @@ let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) :
Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
ok (Ex_typed_value (output_ty, output)) ok (Ex_typed_value (output_ty, output))
let run_node (program:program) (input:Michelson.t) : Michelson.t result =
let%bind compiled = translate_program program "main" in
let%bind (Ex_typed_value (output_ty, output)) = run_aux compiled input in
let%bind output =
Trace.trace_tzresult_lwt (simple_error "error unparsing output") @@
Memory_proto_alpha.unparse_michelson_data output_ty output in
ok output
let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:value) : value result = let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:value) : value result =
let%bind compiled = let%bind compiled =
let error = let error =
@ -45,17 +37,3 @@ let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:v
let%bind ex_ty_value = run_aux ?options compiled input_michelson in let%bind ex_ty_value = run_aux ?options compiled input_michelson in
let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
ok result ok result
let run (program:program) (input:value) : value result =
let%bind input_michelson = translate_value input in
let%bind compiled = translate_program program "main" in
let%bind ex_ty_value = run_aux compiled input_michelson in
let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
ok result
let expression_to_value (e:expression) : value result =
match (Combinators.Expression.get_content e) with
| E_literal v -> ok v
| _ -> fail
@@ error (thunk "not a value")
@@ (fun () -> Format.asprintf "%a" PP.expression e)

24
src/main/run_simplified.ml Normal file
View File

@ -0,0 +1,24 @@
open Trace
let run_simplityped
?options
?(debug_mini_c = false) ?(debug_michelson = false)
(program : Ast_typed.program) (entry : string)
(input : Ast_simplified.expression) : Ast_simplified.expression result =
let%bind typed_input =
let env =
let last_declaration = Location.unwrap List.(hd @@ rev program) in
match last_declaration with
| Declaration_constant (_ , (_ , post_env)) -> post_env
in
Typer.type_expression env input in
let%bind typed_result =
Run_typed.run_typed ?options ~debug_mini_c ~debug_michelson entry program typed_input in
let%bind annotated_result = Typer.untype_expression typed_result in
ok annotated_result
let evaluate_simplityped (program : Ast_typed.program) (entry : string)
: Ast_simplified.expression result =
let%bind typed_result = Run_typed.evaluate_typed entry program in
let%bind annotated_result = Typer.untype_expression typed_result in
ok annotated_result

218
src/main/run_source.ml Normal file
View File

@ -0,0 +1,218 @@
open Trace
include struct
open Ast_simplified
let assert_entry_point_defined : program -> string -> unit result =
fun program entry_point ->
let aux : declaration -> bool = fun declaration ->
match declaration with
| Declaration_type _ -> false
| Declaration_constant (name , _ , _) -> name = entry_point
in
trace_strong (simple_error "no entry-point with given name") @@
Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program
end
include struct
open Ast_typed
open Combinators
let get_entry_point_type : type_value -> (type_value * type_value) result = fun t ->
let%bind (arg , result) =
trace_strong (simple_error "entry-point doesn't have a function type") @@
get_t_function t in
let%bind (arg' , storage_param) =
trace_strong (simple_error "entry-point doesn't have 2 parameters") @@
get_t_pair arg in
let%bind (ops , storage_result) =
trace_strong (simple_error "entry-point doesn't have 2 results") @@
get_t_pair result in
let%bind () =
trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@
assert_t_list_operation ops in
let%bind () =
trace_strong (simple_error "entry-point doesn't identitcal type (storage) for second parameter and second result") @@
assert_type_value_eq (storage_param , storage_result) in
ok (arg' , storage_param)
let get_entry_point : program -> string -> (type_value * type_value) result = fun p e ->
let%bind declaration = get_declaration_by_name p e in
match declaration with
| Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation
let assert_valid_entry_point = fun p e ->
let%bind _ = get_entry_point p e in
ok ()
end
let transpile_value
(e:Ast_typed.annotated_expression) : Mini_c.value result =
let%bind f =
let open Transpiler in
let (f , _) = functionalize e in
let%bind main = translate_main f in
ok main
in
let input = Mini_c.Combinators.d_unit in
let%bind r = Run_mini_c.run_entry f input in
ok r
let parsify_pascaligo = fun source ->
let%bind raw =
trace (simple_error "parsing") @@
Parser.Pascaligo.parse_file source in
let%bind simplified =
trace (simple_error "simplifying") @@
Simplify.Pascaligo.simpl_program raw in
ok simplified
let parsify_expression_pascaligo = fun source ->
let%bind raw =
trace (simple_error "parsing expression") @@
Parser.Pascaligo.parse_expression source in
let%bind simplified =
trace (simple_error "simplifying expression") @@
Simplify.Pascaligo.simpl_expression raw in
ok simplified
let parsify_ligodity = fun source ->
let%bind raw =
trace (simple_error "parsing") @@
Parser.Ligodity.parse_file source in
let%bind simplified =
trace (simple_error "simplifying") @@
Simplify.Ligodity.simpl_program raw in
ok simplified
let parsify_expression_ligodity = fun source ->
let%bind raw =
trace (simple_error "parsing expression") @@
Parser.Ligodity.parse_expression source in
let%bind simplified =
trace (simple_error "simplifying expression") @@
Simplify.Ligodity.simpl_expression raw in
ok simplified
let parsify = fun syntax source ->
let%bind parsify = match syntax with
| "pascaligo" -> ok parsify_pascaligo
| "cameligo" -> ok parsify_ligodity
| _ -> simple_fail "unrecognized parser"
in
parsify source
let parsify_expression = fun syntax source ->
let%bind parsify = match syntax with
| "pascaligo" -> ok parsify_expression_pascaligo
| "cameligo" -> ok parsify_expression_ligodity
| _ -> simple_fail "unrecognized parser"
in
parsify source
let compile_contract_file : string -> string -> string -> string result = fun source entry_point syntax ->
let%bind simplified = parsify syntax source in
let%bind () =
assert_entry_point_defined simplified entry_point in
let%bind typed =
trace (simple_error "typing") @@
Typer.type_program simplified in
let%bind mini_c =
trace (simple_error "transpiling") @@
Transpiler.translate_entry typed entry_point in
let%bind michelson =
trace (simple_error "compiling") @@
Compiler.translate_contract mini_c in
let str =
Format.asprintf "%a" Michelson.pp_stripped michelson in
ok str
let compile_contract_parameter : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
let%bind (program , parameter_tv) =
let%bind simplified = parsify syntax source in
let%bind () =
assert_entry_point_defined simplified entry_point in
let%bind typed =
trace (simple_error "typing file") @@
Typer.type_program simplified in
let%bind (param_ty , _) =
get_entry_point typed entry_point in
ok (typed , param_ty)
in
let%bind expr =
let%bind typed =
let%bind simplified = parsify_expression syntax expression in
let env =
let last_declaration = Location.unwrap List.(hd @@ rev program) in
match last_declaration with
| Declaration_constant (_ , (_ , post_env)) -> post_env
in
trace (simple_error "typing expression") @@
Typer.type_expression env simplified in
let%bind () =
trace (simple_error "expression type doesn't match type parameter") @@
Ast_typed.assert_type_value_eq (parameter_tv , typed.type_annotation) in
let%bind mini_c =
trace (simple_error "transpiling expression") @@
transpile_value typed in
let%bind michelson =
trace (simple_error "compiling expression") @@
Compiler.translate_value mini_c in
let str =
Format.asprintf "%a" Michelson.pp_stripped michelson in
ok str
in
ok expr
let compile_contract_storage : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
let%bind (program , storage_tv) =
let%bind simplified = parsify syntax source in
let%bind () =
assert_entry_point_defined simplified entry_point in
let%bind typed =
trace (simple_error "typing file") @@
Typer.type_program simplified in
let%bind (_ , storage_ty) =
get_entry_point typed entry_point in
ok (typed , storage_ty)
in
let%bind expr =
let%bind simplified = parsify_expression syntax expression in
let%bind typed =
let env =
let last_declaration = Location.unwrap List.(hd @@ rev program) in
match last_declaration with
| Declaration_constant (_ , (_ , post_env)) -> post_env
in
trace (simple_error "typing expression") @@
Typer.type_expression env simplified in
let%bind () =
trace (simple_error "expression type doesn't match type storage") @@
Ast_typed.assert_type_value_eq (storage_tv , typed.type_annotation) in
let%bind mini_c =
trace (simple_error "transpiling expression") @@
transpile_value typed in
let%bind michelson =
trace (simple_error "compiling expression") @@
Compiler.translate_value mini_c in
let str =
Format.asprintf "%a" Michelson.pp_stripped michelson in
ok str
in
ok expr
let type_file ?(debug_simplify = false) ?(debug_typed = false)
syntax (path:string) : Ast_typed.program result =
let%bind simpl = parsify syntax path in
(if debug_simplify then
Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl)
) ;
let%bind typed =
trace (simple_error "typing") @@
Typer.type_program simpl in
(if debug_typed then (
Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed)
)) ;
ok typed

64
src/main/run_typed.ml Normal file
View File

@ -0,0 +1,64 @@
open Trace
let transpile_value
(e:Ast_typed.annotated_expression) : Mini_c.value result =
let%bind f =
let open Transpiler in
let (f , _) = functionalize e in
let%bind main = translate_main f in
ok main
in
let input = Mini_c.Combinators.d_unit in
let%bind r = Run_mini_c.run_entry f input in
ok r
let evaluate_typed (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 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
ok typed_result
let run_typed
?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
(program:Ast_typed.program) (input:Ast_typed.annotated_expression) : Ast_typed.annotated_expression result =
let%bind () =
let open Ast_typed in
let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
let%bind (arg_ty , _) =
trace_strong (simple_error "entry-point doesn't have a function type") @@
get_t_function @@ get_type_annotation d.annotated_expression in
Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
in
let%bind mini_c_main =
trace (simple_error "transpile mini_c entry") @@
Transpiler.translate_entry program entry in
(if debug_mini_c then
Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
) ;
let%bind mini_c_value = transpile_value input in
let%bind mini_c_result =
let error =
let title () = "run Mini_c" in
let content () =
Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
in
error title content in
trace error @@
Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
let%bind typed_result =
let%bind main_result_type =
let%bind typed_main = Ast_typed.get_functional_entry program entry in
match (snd typed_main).type_value' with
| T_function (_, result) -> ok result
| _ -> simple_fail "main doesn't have fun type" in
Transpiler.untranspile mini_c_result main_result_type in
ok typed_result

1
src/simplify/pascaligo.ml
View File

@ -351,6 +351,7 @@ and simpl_fun_declaration : Raw.fun_decl -> ((name * type_expression option) * e
let arguments_name = "arguments" in let arguments_name = "arguments" in
let%bind params = bind_map_list simpl_param lst in let%bind params = bind_map_list simpl_param lst in
let (binder , input_type) = let (binder , input_type) =
(* let type_expression = T_record (SMap.of_list params) in *)
let type_expression = T_tuple (List.map snd params) in let type_expression = T_tuple (List.map snd params) in
(arguments_name , type_expression) in (arguments_name , type_expression) in
let%bind tpl_declarations = let%bind tpl_declarations =

4
src/test/bin_tests.ml
View File

@ -1,10 +1,10 @@
open Trace open Trace
open Ligo open Ligo.Run
open Test_helpers open Test_helpers
let compile_contract_basic () : unit result = let compile_contract_basic () : unit result =
let%bind _ = let%bind _ =
Contract.compile_contract_file "./contracts/dispatch-counter.ligo" "main" "pascaligo" compile_contract_file "./contracts/dispatch-counter.ligo" "main" "pascaligo"
in in
ok () ok ()

4
src/test/coase_tests.ml
View File

@ -1,9 +1,11 @@
(* Copyright Coase, Inc 2019 *) (* Copyright Coase, Inc 2019 *)
open Trace open Trace
open Ligo open Ligo.Run
open Test_helpers open Test_helpers
let type_file = type_file "pascaligo"
let get_program = let get_program =
let s = ref None in let s = ref None in
fun () -> match !s with fun () -> match !s with

30
src/test/heap_tests.ml
View File

@ -1,7 +1,9 @@
open Trace open Trace
open Ligo open Ligo.Run
open Test_helpers open Test_helpers
let type_file = type_file "pascaligo"
let get_program = let get_program =
let s = ref None in let s = ref None in
fun () -> match !s with fun () -> match !s with
@ -12,8 +14,8 @@ let get_program =
ok program ok program
) )
let a_heap_ez ?value_type (content:(int * AST_Typed.ae) list) = let a_heap_ez ?value_type (content:(int * Ast_typed.ae) list) =
let open AST_Typed.Combinators in let open Ast_typed.Combinators in
let content = let content =
let aux = fun (x, y) -> e_a_empty_nat x, y in let aux = fun (x, y) -> e_a_empty_nat x, y in
List.map aux content in List.map aux content in
@ -24,7 +26,7 @@ let a_heap_ez ?value_type (content:(int * AST_Typed.ae) list) =
e_a_empty_map content (t_nat ()) value_type e_a_empty_map content (t_nat ()) value_type
let ez lst = let ez lst =
let open AST_Typed.Combinators in let open Ast_typed.Combinators in
let value_type = t_pair let value_type = t_pair
(t_int ()) (t_int ())
(t_string ()) (t_string ())
@ -46,11 +48,11 @@ let dummy n =
let is_empty () : unit result = let is_empty () : unit result =
let%bind program = get_program () in let%bind program = get_program () in
let aux n = let aux n =
let open AST_Typed.Combinators in let open Ast_typed.Combinators in
let input = dummy n in let input = dummy n in
let%bind result = easy_run_typed "is_empty" program input in let%bind result = run_typed "is_empty" program input in
let expected = e_a_empty_bool (n = 0) in let expected = e_a_empty_bool (n = 0) in
AST_Typed.assert_value_eq (expected, result) Ast_typed.assert_value_eq (expected, result)
in in
let%bind _ = bind_list let%bind _ = bind_list
@@ List.map aux @@ List.map aux
@ -60,15 +62,15 @@ let is_empty () : unit result =
let get_top () : unit result = let get_top () : unit result =
let%bind program = get_program () in let%bind program = get_program () in
let aux n = let aux n =
let open AST_Typed.Combinators in let open Ast_typed.Combinators in
let input = dummy n in let input = dummy n in
match n, easy_run_typed "get_top" program input with match n, run_typed "get_top" program input with
| 0, Trace.Ok _ -> simple_fail "unexpected success" | 0, Trace.Ok _ -> simple_fail "unexpected success"
| 0, _ -> ok () | 0, _ -> ok ()
| _, result -> | _, result ->
let%bind result' = result in let%bind result' = result in
let expected = e_a_empty_pair (e_a_empty_int 1) (e_a_empty_string "1") in let expected = e_a_empty_pair (e_a_empty_int 1) (e_a_empty_string "1") in
AST_Typed.assert_value_eq (expected, result') Ast_typed.assert_value_eq (expected, result')
in in
let%bind _ = bind_list let%bind _ = bind_list
@@ List.map aux @@ List.map aux
@ -79,7 +81,7 @@ let pop_switch () : unit result =
let%bind program = get_program () in let%bind program = get_program () in
let aux n = let aux n =
let input = dummy n in let input = dummy n in
match n, easy_run_typed "pop_switch" program input with match n, run_typed "pop_switch" program input with
| 0, Trace.Ok _ -> simple_fail "unexpected success" | 0, Trace.Ok _ -> simple_fail "unexpected success"
| 0, _ -> ok () | 0, _ -> ok ()
| _, result -> | _, result ->
@ -89,7 +91,7 @@ let pop_switch () : unit result =
@@ tl @@ tl
@@ range (n + 1) @@ range (n + 1)
) in ) in
AST_Typed.assert_value_eq (expected, result') Ast_typed.assert_value_eq (expected, result')
in in
let%bind _ = bind_list let%bind _ = bind_list
@@ List.map aux @@ List.map aux
@ -100,9 +102,9 @@ let pop () : unit result =
let%bind program = get_program () in let%bind program = get_program () in
let aux n = let aux n =
let input = dummy n in let input = dummy n in
(match easy_run_typed "pop" program input with (match run_typed "pop" program input with
| Trace.Ok (output , _) -> ( | Trace.Ok (output , _) -> (
Format.printf "\nPop output on %d : %a\n" n AST_Typed.PP.annotated_expression output ; Format.printf "\nPop output on %d : %a\n" n Ast_typed.PP.annotated_expression output ;
) )
| Errors errs -> ( | Errors errs -> (
Format.printf "\nPop output on %d : error\n" n) ; Format.printf "\nPop output on %d : error\n" n) ;

20
src/test/integration_tests.ml
View File

@ -1,14 +1,11 @@
open Trace open Trace
open Ligo open Ligo.Run
open Test_helpers open Test_helpers
open Ast_simplified.Combinators open Ast_simplified.Combinators
let mtype_file path : Ast_typed.program result = let mtype_file = type_file "cameligo"
let%bind raw = Parser.Camligo.User.parse_file path in let type_file = type_file "pascaligo"
let%bind simpl = Simplify.Camligo.main raw in
let%bind typed = Ligo.Typer.type_program (Location.unwrap simpl) in
ok typed
let function_ () : unit result = let function_ () : unit result =
let%bind program = type_file "./contracts/function.ligo" in let%bind program = type_file "./contracts/function.ligo" in
@ -148,6 +145,9 @@ let include_ () : unit result =
let record_ez_int names n = let record_ez_int names n =
ez_e_record @@ List.map (fun x -> x, e_int n) names ez_e_record @@ List.map (fun x -> x, e_int n) names
let tuple_ez_int names n =
e_tuple @@ List.map (fun _ -> e_int n) names
let multiple_parameters () : unit result = let multiple_parameters () : unit result =
let%bind program = type_file "./contracts/multiple-parameters.ligo" in let%bind program = type_file "./contracts/multiple-parameters.ligo" in
let aux ((name : string) , make_input , make_output) = let aux ((name : string) , make_input , make_output) =
@ -155,9 +155,9 @@ let multiple_parameters () : unit result =
expect_eq_n program name make_input make_output' expect_eq_n program name make_input make_output'
in in
let%bind _ = bind_list @@ List.map aux [ let%bind _ = bind_list @@ List.map aux [
("ab", record_ez_int ["a";"b"], fun n -> 2 * n) ; ("ab", tuple_ez_int ["a";"b"], fun n -> 2 * n) ;
("abcd", record_ez_int ["a";"b";"c";"d"], fun n -> 4 * n + 2) ; ("abcd", tuple_ez_int ["a";"b";"c";"d"], fun n -> 4 * n + 2) ;
("abcde", record_ez_int ["a";"b";"c";"d";"e"], fun n -> 2 * n + 3) ; ("abcde", tuple_ez_int ["a";"b";"c";"d";"e"], fun n -> 2 * n + 3) ;
] in ] in
ok () ok ()
@ -437,7 +437,7 @@ let dispatch_counter_contract () : unit result =
let basic_mligo () : unit result = let basic_mligo () : unit result =
let%bind typed = mtype_file "./contracts/basic.mligo" in let%bind typed = mtype_file "./contracts/basic.mligo" in
let%bind result = Ligo.easy_evaluate_typed "foo" typed in let%bind result = evaluate_typed "foo" typed in
Ligo.AST_Typed.assert_value_eq (Ligo.AST_Typed.Combinators.e_a_empty_int (42 + 127), result) Ligo.AST_Typed.assert_value_eq (Ligo.AST_Typed.Combinators.e_a_empty_int (42 + 127), result)
let counter_mligo () : unit result = let counter_mligo () : unit result =

6
src/test/test_helpers.ml
View File

@ -3,7 +3,7 @@ open! Trace
let test name f = let test name f =
Alcotest.test_case name `Quick @@ fun () -> Alcotest.test_case name `Quick @@ fun () ->
let result = let result =
trace (fun () -> error (thunk "running test") (fun () -> name) ()) @@ trace (fun () -> error (thunk "running test") (thunk name) ()) @@
f () in f () in
match result with match result with
| Ok ((), annotations) -> ignore annotations; () | Ok ((), annotations) -> ignore annotations; ()
@ -20,7 +20,7 @@ let expect ?options program entry_point input expecter =
let content () = Format.asprintf "Entry_point: %s" entry_point in let content () = Format.asprintf "Entry_point: %s" entry_point in
error title content in error title content in
trace run_error @@ trace run_error @@
Ligo.easy_run_typed_simplified ~debug_michelson:true ?options entry_point program input in Ligo.Run.run_simplityped ~debug_michelson:true ?options program entry_point input in
expecter result expecter result
let expect_eq ?options program entry_point input expected = let expect_eq ?options program entry_point input expected =
@ -41,7 +41,7 @@ let expect_evaluate program entry_point expecter =
let content () = Format.asprintf "Entry_point: %s" entry_point in let content () = Format.asprintf "Entry_point: %s" entry_point in
error title content in error title content in
trace error @@ trace error @@
let%bind result = Ligo.easy_evaluate_typed_simplified entry_point program in let%bind result = Ligo.Run.evaluate_simplityped program entry_point in
expecter result expecter result
let expect_eq_evaluate program entry_point expected = let expect_eq_evaluate program entry_point expected =

12
src/transpiler/transpiler.ml
View File

@ -469,7 +469,7 @@ let translate_main (l:AST.lambda) : anon_function result =
| E_literal (D_function f) -> ok f | E_literal (D_function f) -> ok f
| _ -> simple_fail "main is not a function" | _ -> simple_fail "main is not a function"
(* From a non-functional expression [expr], build the functional expression [fun () -> expr] *) (* From an expression [expr], build the expression [fun () -> expr] *)
let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value = let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value =
let t = e.type_annotation in let t = e.type_annotation in
let open! AST in let open! AST in
@ -511,16 +511,6 @@ let translate_entry (lst:AST.program) (name:string) : anon_function result =
open Combinators open Combinators
let rec exp x n =
if n = 0
then 1
else
let exp' = exp (x * x) (n / 2) in
let m = if n mod 2 = 0 then 1 else x in
m * exp'
let exp2 = exp 2
let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_value) result = let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_value) result =
let open Append_tree in let open Append_tree in
let rec aux tv : (string * value * AST.type_value) result= let rec aux tv : (string * value * AST.type_value) result=

22
vendors/ligo-utils/simple-utils/trace.ml vendored
View File

@ -467,12 +467,26 @@ module Assert = struct
end end
let json_of_error = J.to_string let json_of_error = J.to_string
let error_pp out (e : error) = let error_pp out (e : error) =
let open JSON_string_utils in let open JSON_string_utils in
let message = e |> member "message" |> string || "(no message)" in let message = e |> member "message" |> J.to_string in
let title = e |> member "title" |> string || "(no title)" in let error_code =
let error_code = e |> member "error_code" |> int |> string_of_int || "no error code" in let error_code = e |> member "error_code" in
Format.fprintf out "%s (%s): %s" title error_code message match error_code with
| `Null -> ""
| _ -> " (" ^ (J.to_string error_code) ^ ")" in
let title = e |> member "title" |> J.to_string in
let data =
let data = e |> member "data" in
match data with
| `Null -> ""
| _ -> J.to_string data in
Format.fprintf out "%s (%s): %s. %s" title error_code message data
(* let error_pp out (e : error) =
* Format.fprintf out "%s" @@ json_of_error e *)
let error_pp_short out (e : error) = let error_pp_short out (e : error) =
let open JSON_string_utils in let open JSON_string_utils in

3
vendors/ligo-utils/simple-utils/x_option.ml vendored
View File

@ -27,8 +27,7 @@ let to_list = function
| None -> [] | None -> []
| Some x -> [ x ] | Some x -> [ x ]
let collapse_list = fun l -> let collapse_list = fun l ->
List.concat List.concat @@ List.map to_list l
@@ List.map to_list l
(* Combinators *) (* Combinators *)
let bind_eager_or = fun a b -> match (a , b) with let bind_eager_or = fun a b -> match (a , b) with