diff --git a/src/main/compile/dune b/src/main/compile/dune index f850f7fe1..998f52859 100644 --- a/src/main/compile/dune +++ b/src/main/compile/dune @@ -6,13 +6,13 @@ simple-utils tezos-utils parser - concrete_to_imperative + tree_abstraction ast_imperative self_ast_imperative - imperative_to_sugar + purification ast_sugar self_ast_sugar - sugar_to_core + desugaring ast_core self_ast_core typer_new @@ -20,10 +20,10 @@ ast_typed self_ast_typed interpreter - transpiler + spilling mini_c self_mini_c - compiler + stacking self_michelson ) (preprocess diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index e4de4887c..1e88176da 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -22,42 +22,42 @@ let parsify_pascaligo source = let%bind raw = trace parser_tracer @@ Parser.Pascaligo.parse_file source in let%bind imperative = trace cit_pascaligo_tracer @@ - Concrete_to_imperative.Pascaligo.compile_program raw + Tree_abstraction.Pascaligo.compile_program raw in ok imperative let parsify_expression_pascaligo source = let%bind raw = trace parser_tracer @@ Parser.Pascaligo.parse_expression source in let%bind imperative = trace cit_pascaligo_tracer @@ - Concrete_to_imperative.Pascaligo.compile_expression raw + Tree_abstraction.Pascaligo.compile_expression raw in ok imperative let parsify_cameligo source = let%bind raw = trace parser_tracer @@ Parser.Cameligo.parse_file source in let%bind imperative = trace cit_cameligo_tracer @@ - Concrete_to_imperative.Cameligo.compile_program raw + Tree_abstraction.Cameligo.compile_program raw in ok imperative let parsify_expression_cameligo source = let%bind raw = trace parser_tracer @@ Parser.Cameligo.parse_expression source in let%bind imperative = trace cit_cameligo_tracer @@ - Concrete_to_imperative.Cameligo.compile_expression raw + Tree_abstraction.Cameligo.compile_expression raw in ok imperative let parsify_reasonligo source = let%bind raw = trace parser_tracer @@ Parser.Reasonligo.parse_file source in let%bind imperative = trace cit_cameligo_tracer @@ - Concrete_to_imperative.Cameligo.compile_program raw + Tree_abstraction.Cameligo.compile_program raw in ok imperative let parsify_expression_reasonligo source = let%bind raw = trace parser_tracer @@ Parser.Reasonligo.parse_expression source in let%bind imperative = trace cit_cameligo_tracer @@ - Concrete_to_imperative.Cameligo.compile_expression raw + Tree_abstraction.Cameligo.compile_expression raw in ok imperative let parsify syntax source : (Ast_imperative.program, _) Trace.result = @@ -85,21 +85,21 @@ let parsify_string_reasonligo source = let%bind raw = trace parser_tracer @@ Parser.Reasonligo.parse_string source in let%bind imperative = trace cit_cameligo_tracer @@ - Concrete_to_imperative.Cameligo.compile_program raw + Tree_abstraction.Cameligo.compile_program raw in ok imperative let parsify_string_pascaligo source = let%bind raw = trace parser_tracer @@ Parser.Pascaligo.parse_string source in let%bind imperative = trace cit_pascaligo_tracer @@ - Concrete_to_imperative.Pascaligo.compile_program raw + Tree_abstraction.Pascaligo.compile_program raw in ok imperative let parsify_string_cameligo source = let%bind raw = trace parser_tracer @@ Parser.Cameligo.parse_string source in let%bind imperative = trace cit_cameligo_tracer @@ - Concrete_to_imperative.Cameligo.compile_program raw + Tree_abstraction.Cameligo.compile_program raw in ok imperative let parsify_string syntax source = @@ -117,33 +117,33 @@ let pretty_print_pascaligo_cst source = let%bind ast = trace parser_tracer @@ Parser.Pascaligo.parse_file source in let buffer = Buffer.create 59 in let state = - Parser_pascaligo.ParserLog.mk_state + Cst_pascaligo.ParserLog.mk_state ~offsets:true ~mode:`Byte ~buffer in - Parser_pascaligo.ParserLog.pp_cst state ast; + Cst_pascaligo.ParserLog.pp_cst state ast; ok buffer let pretty_print_cameligo_cst source = let%bind ast = trace parser_tracer @@ Parser.Cameligo.parse_file source in let buffer = Buffer.create 59 in let state = (* TODO: Should flow from the CLI *) - Parser_cameligo.ParserLog.mk_state + Cst_cameligo.ParserLog.mk_state ~offsets:true ~mode:`Point ~buffer in - Parser_cameligo.ParserLog.pp_cst state ast; + Cst_cameligo.ParserLog.pp_cst state ast; ok buffer let pretty_print_reasonligo_cst source = let%bind ast = trace parser_tracer @@ Parser.Reasonligo.parse_file source in let buffer = Buffer.create 59 in let state = (* TODO: Should flow from the CLI *) - Parser_cameligo.ParserLog.mk_state + Cst_cameligo.ParserLog.mk_state ~offsets:true ~mode:`Point ~buffer in - Parser_cameligo.ParserLog.pp_cst state ast; + Cst_cameligo.ParserLog.pp_cst state ast; ok buffer let pretty_print_cst syntax source = diff --git a/src/main/compile/of_imperative.ml b/src/main/compile/of_imperative.ml index 50f5bf40a..269b994ad 100644 --- a/src/main/compile/of_imperative.ml +++ b/src/main/compile/of_imperative.ml @@ -1,17 +1,17 @@ open Main_errors open Trace open Ast_imperative -open Imperative_to_sugar +open Purification type form = | Contract of string | Env let compile (program : program) : (Ast_sugar.program, _) result = - trace imperative_to_sugar_tracer @@ compile_program program + trace purification_tracer @@ compile_program program let compile_expression (e : expression) : (Ast_sugar.expression , _) result = - trace imperative_to_sugar_tracer @@ compile_expression e + trace purification_tracer @@ compile_expression e let pretty_print formatter (program : program) = PP.program formatter program diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 1c517a804..fd31db150 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -3,7 +3,7 @@ open Tezos_utils open Proto_alpha_utils open Trace -let build_contract : ?disable_typecheck:bool -> Compiler.compiled_expression -> (Michelson.michelson , _) result = +let build_contract : ?disable_typecheck:bool -> Stacking.compiled_expression -> (Michelson.michelson , _) result = fun ?(disable_typecheck= false) compiled -> let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = trace_option (entrypoint_not_a_function) @@ Self_michelson.fetch_contract_inputs compiled.expr_ty in @@ -28,7 +28,7 @@ let build_contract : ?disable_typecheck:bool -> Compiler.compiled_expression -> | Err_gas -> fail @@ gas_exhaustion | Err_unknown -> fail @@ unknown -let assert_equal_contract_type : Simple_utils.Runned_result.check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> (unit , _) result = +let assert_equal_contract_type : Simple_utils.Runned_result.check_type -> Stacking.compiled_expression -> Stacking.compiled_expression -> (unit , _) result = fun c compiled_prg compiled_param -> let%bind (Ex_ty expected_ty) = let%bind (c_param_ty,c_storage_ty) = trace_option (entrypoint_not_a_function) @@ diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 024493c2f..172d24ca4 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -2,31 +2,32 @@ open Main_errors open Mini_c open Proto_alpha_utils open Trace +open Stacking -let compile_contract : expression -> (Compiler.compiled_expression , _) result = fun e -> +let compile_contract : expression -> (Stacking.compiled_expression , _) result = fun e -> let%bind e = trace self_mini_c_tracer @@ Self_mini_c.contract_check e in let%bind (input_ty , _) = trace self_mini_c_tracer @@ Self_mini_c.get_t_function e.type_expression in let%bind body = trace self_mini_c_tracer @@ Self_mini_c. get_function e in - let%bind body = trace compiler_tracer @@ Compiler.Program.translate_function_body body [] input_ty in + let%bind body = trace stacking_tracer @@ Stacking.Program.translate_function_body body [] input_ty in let expr = Self_michelson.optimize body in - let%bind expr_ty = trace compiler_tracer @@ Compiler.Type.Ty.type_ e.type_expression in - ok ({ expr_ty ; expr } : Compiler.Program.compiled_expression) + let%bind expr_ty = trace stacking_tracer @@ Stacking.Type.Ty.type_ e.type_expression in + ok ({ expr_ty ; expr } : Stacking.Program.compiled_expression) -let compile_expression : expression -> (Compiler.compiled_expression, _) result = fun e -> - trace compiler_tracer @@ - let%bind expr = Compiler.Program.translate_expression e Compiler.Environment.empty in +let compile_expression : expression -> (compiled_expression, _) result = fun e -> + trace stacking_tracer @@ + let%bind expr = Stacking.Program.translate_expression e Stacking.Environment.empty in let expr = Self_michelson.optimize expr in - let%bind expr_ty = Compiler.Type.Ty.type_ e.type_expression in - ok ({ expr_ty ; expr } : Compiler.Program.compiled_expression) + let%bind expr_ty = Type.Ty.type_ e.type_expression in + ok ({ expr_ty ; expr } : Program.compiled_expression) -let aggregate_and_compile : program -> form_t -> (Compiler.compiled_expression, _) result = fun program form -> +let aggregate_and_compile : program -> form_t -> (Stacking.compiled_expression, _) result = fun program form -> let%bind aggregated = trace self_mini_c_tracer @@ Self_mini_c.aggregate_entry program form in let aggregated' = Self_mini_c.all_expression aggregated in match form with | ContractForm _ -> compile_contract aggregated' | ExpressionForm _ -> compile_expression aggregated' -let aggregate_and_compile_contract : program -> string -> (Compiler.compiled_expression, _) result = fun program name -> +let aggregate_and_compile_contract : program -> string -> (Stacking.compiled_expression, _) result = fun program name -> let%bind (exp, idx) = trace_option entrypoint_not_found @@ Mini_c.get_entry program name in let program' = List.take idx program in aggregate_and_compile program' (ContractForm exp) diff --git a/src/main/compile/of_sugar.ml b/src/main/compile/of_sugar.ml index 85988b558..1a3da165d 100644 --- a/src/main/compile/of_sugar.ml +++ b/src/main/compile/of_sugar.ml @@ -1,6 +1,6 @@ open Trace open Ast_sugar -open Sugar_to_core +open Desugaring open Main_errors type form = @@ -8,10 +8,10 @@ type form = | Env let compile (program : program) : (Ast_core.program , _) result = - trace sugar_to_core_tracer @@ compile_program program + trace desugaring_tracer @@ compile_program program let compile_expression (e : expression) : (Ast_core.expression , _) result = - trace sugar_to_core_tracer @@ compile_expression e + trace desugaring_tracer @@ compile_expression e let list_declarations (program : program) : string list = List.fold_left diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index 761badb3f..707128c95 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -1,12 +1,13 @@ -open Main_errors open Trace open Ast_typed +open Spilling +open Main_errors let compile : Ast_typed.program -> (Mini_c.program, _) result = fun p -> - trace transpiler_tracer @@ Transpiler.transpile_program p + trace spilling_tracer @@ compile_program p let compile_expression : expression -> (Mini_c.expression, _) result = fun e -> - trace transpiler_tracer @@ Transpiler.transpile_annotated_expression e + trace spilling_tracer @@ compile_expression e let assert_equal_contract_type : Simple_utils.Runned_result.check_type -> string -> Ast_typed.program -> Ast_typed.expression -> (unit , _) result = fun c entry contract param -> diff --git a/src/main/main_errors/dune b/src/main/main_errors/dune index c5dad72af..0eb5a31ec 100644 --- a/src/main/main_errors/dune +++ b/src/main/main_errors/dune @@ -4,19 +4,19 @@ (libraries simple-utils parser - concrete_to_imperative + tree_abstraction self_ast_imperative - interpreter - imperative_to_sugar + purification ast_sugar self_ast_sugar - sugar_to_core + desugaring self_ast_core typer self_ast_typed - transpiler + interpreter + spilling self_mini_c - compiler + stacking self_michelson ) (preprocess diff --git a/src/main/main_errors/formatter.ml b/src/main/main_errors/formatter.ml index f74db24e1..0d325c6d2 100644 --- a/src/main/main_errors/formatter.ml +++ b/src/main/main_errors/formatter.ml @@ -122,19 +122,19 @@ let rec error_ppformat' : display_format:string display_format -> | `Main_parser e -> Parser.Errors.error_ppformat ~display_format f e | `Main_self_ast_imperative e -> Self_ast_imperative.Errors.error_ppformat ~display_format f e - | `Main_imperative_to_sugar e -> Imperative_to_sugar.Errors.error_ppformat ~display_format f e - | `Main_sugar_to_core _e -> () (*no error in this pass*) - | `Main_cit_pascaligo e -> Concrete_to_imperative.Errors_pascaligo.error_ppformat ~display_format f e - | `Main_cit_cameligo e -> Concrete_to_imperative.Errors_cameligo.error_ppformat ~display_format f e + | `Main_purification e -> Purification.Errors.error_ppformat ~display_format f e + | `Main_desugaring _e -> () (*no error in this pass*) + | `Main_cit_pascaligo e -> Tree_abstraction.Pascaligo.Errors.error_ppformat ~display_format f e + | `Main_cit_cameligo e -> Tree_abstraction.Cameligo.Errors.error_ppformat ~display_format f e | `Main_typer e -> Typer.Errors.error_ppformat ~display_format f e | `Main_interpreter _ -> () (*no error*) | `Main_self_ast_typed e -> Self_ast_typed.Errors.error_ppformat ~display_format f e | `Main_self_mini_c e -> Self_mini_c.Errors.error_ppformat ~display_format f e - | `Main_transpiler e -> Transpiler.Errors.error_ppformat ~display_format f e - | `Main_compiler e -> Compiler.Errors.error_ppformat ~display_format f e + | `Main_spilling e -> Spilling.Errors.error_ppformat ~display_format f e + | `Main_stacking e -> Stacking.Errors.error_ppformat ~display_format f e - | `Main_uncompile_michelson e -> Compiler.Errors.error_ppformat ~display_format f e - | `Main_uncompile_mini_c e -> Transpiler.Errors.error_ppformat ~display_format f e + | `Main_uncompile_michelson e -> Stacking.Errors.error_ppformat ~display_format f e + | `Main_uncompile_mini_c e -> Spilling.Errors.error_ppformat ~display_format f e | `Main_uncompile_typed e -> Typer.Errors.error_ppformat ~display_format f e ) @@ -273,22 +273,22 @@ let rec error_jsonformat : Types.all -> J.t = fun a -> | `Main_parser e -> Parser.Errors.error_jsonformat e | `Main_self_ast_imperative e -> Self_ast_imperative.Errors.error_jsonformat e - | `Main_imperative_to_sugar e -> Imperative_to_sugar.Errors.error_jsonformat e - | `Main_sugar_to_core _ -> `Null (*no error in this pass*) - | `Main_cit_pascaligo e -> Concrete_to_imperative.Errors_pascaligo.error_jsonformat e - | `Main_cit_cameligo e -> Concrete_to_imperative.Errors_cameligo.error_jsonformat e + | `Main_purification e -> Purification.Errors.error_jsonformat e + | `Main_desugaring _ -> `Null (*no error in this pass*) + | `Main_cit_pascaligo e -> Tree_abstraction.Pascaligo.Errors.error_jsonformat e + | `Main_cit_cameligo e -> Tree_abstraction.Cameligo.Errors.error_jsonformat e | `Main_typer e -> Typer.Errors.error_jsonformat e | `Main_interpreter _ -> `Null (*no error*) | `Main_self_ast_typed e -> Self_ast_typed.Errors.error_jsonformat e - | `Main_transpiler e -> Transpiler.Errors.error_jsonformat e + | `Main_spilling e -> Spilling.Errors.error_jsonformat e | `Main_self_mini_c e -> Self_mini_c.Errors.error_jsonformat e - | `Main_compiler e -> Compiler.Errors.error_jsonformat e + | `Main_stacking e -> Stacking.Errors.error_jsonformat e - | `Main_uncompile_michelson e -> Compiler.Errors.error_jsonformat e - | `Main_uncompile_mini_c e -> Transpiler.Errors.error_jsonformat e + | `Main_uncompile_michelson e -> Stacking.Errors.error_jsonformat e + | `Main_uncompile_mini_c e -> Spilling.Errors.error_jsonformat e | `Main_uncompile_typed e -> Typer.Errors.error_jsonformat e let error_format : _ Display.format = { pp = error_ppformat; to_json = error_jsonformat; -} \ No newline at end of file +} diff --git a/src/main/main_errors/main_errors.ml b/src/main/main_errors/main_errors.ml index 9c029c105..d701f64b2 100644 --- a/src/main/main_errors/main_errors.ml +++ b/src/main/main_errors/main_errors.ml @@ -5,21 +5,21 @@ type all = Types.all (* passes tracers *) let parser_tracer (e:Parser.Errors.parser_error) : all = `Main_parser e -let cit_cameligo_tracer (e:Concrete_to_imperative.Errors_cameligo.abs_error) : all = `Main_cit_cameligo e -let cit_pascaligo_tracer (e:Concrete_to_imperative.Errors_pascaligo.abs_error) : all = `Main_cit_pascaligo e +let cit_cameligo_tracer (e:Tree_abstraction.Cameligo.Errors.abs_error) : all = `Main_cit_cameligo e +let cit_pascaligo_tracer (e:Tree_abstraction.Pascaligo.Errors.abs_error) : all = `Main_cit_pascaligo e let self_ast_imperative_tracer (e:Self_ast_imperative.Errors.self_ast_imperative_error) : all = `Main_self_ast_imperative e -let imperative_to_sugar_tracer (e:Imperative_to_sugar.Errors.imperative_to_sugar_error) : all = `Main_imperative_to_sugar e -let sugar_to_core_tracer (e:Sugar_to_core.Errors.sugar_to_core_error) : all = `Main_sugar_to_core e +let purification_tracer (e:Purification.Errors.purification_error) : all = `Main_purification e +let desugaring_tracer (e:Desugaring.Errors.desugaring_error) : all = `Main_desugaring e let typer_tracer (e:Typer.Errors.typer_error) : all = `Main_typer e let self_ast_typed_tracer (e:Self_ast_typed.Errors.self_ast_typed_error) : all = `Main_self_ast_typed e let self_mini_c_tracer (e:Self_mini_c.Errors.self_mini_c_error) : all = `Main_self_mini_c e -let transpiler_tracer (e:Transpiler.Errors.transpiler_error) : all = `Main_transpiler e -let compiler_tracer (e:Compiler.Errors.compiler_error) : all = `Main_compiler e +let spilling_tracer (e:Spilling.Errors.spilling_error) : all = `Main_spilling e +let stacking_tracer (e:Stacking.Errors.stacking_error) : all = `Main_stacking e let interpret_tracer (e:Interpreter.interpreter_error) : all = `Main_interpreter e -let uncompile_mini_c : Transpiler.Errors.transpiler_error -> all = fun e -> `Main_uncompile_mini_c e +let uncompile_mini_c : Spilling.Errors.spilling_error -> all = fun e -> `Main_uncompile_mini_c e let uncompile_typed : Typer.Errors.typer_error -> all = fun e -> `Main_uncompile_typed e -let uncompile_michelson : Compiler.Errors.compiler_error -> all = fun e -> `Main_uncompile_michelson e +let uncompile_michelson : Stacking.Errors.stacking_error -> all = fun e -> `Main_uncompile_michelson e (* top-level glue (in between passes) *) @@ -68,4 +68,4 @@ let test_internal loc : all = `Test_internal loc let test_md_file_tracer md_file s group prg err : all = `Test_md_file_tracer (md_file,s,group,prg,err) let test_code_block_arg arg : all = `Test_bad_code_block arg let test_expected_to_fail : all = `Test_expected_to_fail -let test_not_expected_to_fail : all = `Test_not_expected_to_fail \ No newline at end of file +let test_not_expected_to_fail : all = `Test_not_expected_to_fail diff --git a/src/main/main_errors/types.ml b/src/main/main_errors/types.ml index 651f5fbfc..b0f5c3a4a 100644 --- a/src/main/main_errors/types.ml +++ b/src/main/main_errors/types.ml @@ -22,19 +22,19 @@ type all = | `Main_parser of Parser.Errors.parser_error | `Main_self_ast_imperative of Self_ast_imperative.Errors.self_ast_imperative_error - | `Main_imperative_to_sugar of Imperative_to_sugar.Errors.imperative_to_sugar_error - | `Main_sugar_to_core of Sugar_to_core.Errors.sugar_to_core_error - | `Main_cit_pascaligo of Concrete_to_imperative.Errors_pascaligo.abs_error - | `Main_cit_cameligo of Concrete_to_imperative.Errors_cameligo.abs_error + | `Main_purification of Purification.Errors.purification_error + | `Main_desugaring of Desugaring.Errors.desugaring_error + | `Main_cit_pascaligo of Tree_abstraction.Pascaligo.Errors.abs_error + | `Main_cit_cameligo of Tree_abstraction.Cameligo.Errors.abs_error | `Main_typer of Typer.Errors.typer_error | `Main_interpreter of Interpreter.interpreter_error | `Main_self_ast_typed of Self_ast_typed.Errors.self_ast_typed_error | `Main_self_mini_c of Self_mini_c.Errors.self_mini_c_error - | `Main_transpiler of Transpiler.Errors.transpiler_error - | `Main_compiler of Compiler.Errors.compiler_error + | `Main_spilling of Spilling.Errors.spilling_error + | `Main_stacking of Stacking.Errors.stacking_error - | `Main_uncompile_michelson of Compiler.Errors.compiler_error - | `Main_uncompile_mini_c of Transpiler.Errors.transpiler_error + | `Main_uncompile_michelson of Stacking.Errors.stacking_error + | `Main_uncompile_mini_c of Spilling.Errors.spilling_error | `Main_uncompile_typed of Typer.Errors.typer_error | `Main_entrypoint_not_a_function | `Main_entrypoint_not_found @@ -53,4 +53,4 @@ type all = | `Test_bad_code_block of string | `Test_expected_to_fail | `Test_not_expected_to_fail -] \ No newline at end of file +] diff --git a/src/main/run/dune b/src/main/run/dune index c5179a3e6..d3bb7db38 100644 --- a/src/main/run/dune +++ b/src/main/run/dune @@ -5,17 +5,17 @@ simple-utils tezos-utils parser - concrete_to_imperative + tree_abstraction self_ast_imperative - sugar_to_core + desugaring ast_core typer_new typer ast_typed - transpiler + spilling mini_c - operators - compiler + predefined + stacking compile ) (preprocess diff --git a/src/main/uncompile/dune b/src/main/uncompile/dune index d1b2d72eb..d453c4495 100644 --- a/src/main/uncompile/dune +++ b/src/main/uncompile/dune @@ -3,14 +3,14 @@ (public_name ligo.uncompile) (libraries simple-utils - compiler - imperative_to_sugar - sugar_to_core + purification + desugaring typer_new typer ast_typed + spilling mini_c - transpiler + stacking main_errors ) (preprocess diff --git a/src/main/uncompile/uncompile.ml b/src/main/uncompile/uncompile.ml index 2a9546e5c..8d2dccfd1 100644 --- a/src/main/uncompile/uncompile.ml +++ b/src/main/uncompile/uncompile.ml @@ -14,8 +14,8 @@ let uncompile_value func_or_expr program entry ex_ty_value = | Function -> let%bind (_,output_type) = trace_option entrypoint_not_a_function @@ Ast_typed.get_t_function entry_expression.type_expression in ok output_type in - let%bind mini_c = trace uncompile_michelson @@ Compiler.Uncompiler.translate_value ex_ty_value in - let%bind typed = trace uncompile_mini_c @@ Transpiler.untranspile mini_c output_type in + let%bind mini_c = trace uncompile_michelson @@ Stacking.Decompiler.decompile_value ex_ty_value in + let%bind typed = trace uncompile_mini_c @@ Spilling.decompile mini_c output_type in let%bind core = trace uncompile_typed @@ Typer.untype_expression typed in ok @@ core @@ -37,8 +37,7 @@ let uncompile_expression type_value runned_result = match runned_result with | Fail s -> ok (Fail s) | Success ex_ty_value -> - let%bind mini_c = trace uncompile_michelson @@ Compiler.Uncompiler.translate_value ex_ty_value in - let%bind typed = trace uncompile_mini_c @@ Transpiler.untranspile mini_c type_value in + let%bind mini_c = trace uncompile_michelson @@ Stacking.Decompiler.decompile_value ex_ty_value in + let%bind typed = trace uncompile_mini_c @@ Spilling.decompile mini_c type_value in let%bind uncompiled_value = trace uncompile_typed @@ Typer.untype_expression typed in ok (Success uncompiled_value) - diff --git a/src/passes/01-parser/cameligo/Scoping.mli b/src/passes/01-parser/cameligo/Scoping.mli deleted file mode 100644 index dd886f9a8..000000000 --- a/src/passes/01-parser/cameligo/Scoping.mli +++ /dev/null @@ -1,18 +0,0 @@ -(* This module exports checks on scoping, called from the parser. *) - -module Region = Simple_utils.Region - -type t = - Reserved_name of AST.variable -| Duplicate_variant of AST.variable -| Non_linear_pattern of AST.variable -| Duplicate_field of AST.variable - -type error = t - -exception Error of t - -val check_reserved_name : AST.variable -> unit -val check_pattern : AST.pattern -> unit -val check_variants : AST.variant Region.reg list -> unit -val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/01-parser/cameligo/Tests/pp.mligo b/src/passes/01-parser/cameligo/Tests/pp.mligo deleted file mode 100644 index e68de8216..000000000 --- a/src/passes/01-parser/cameligo/Tests/pp.mligo +++ /dev/null @@ -1,54 +0,0 @@ -let patch_ (m : foobar) : foobar = Map.literal [(0, 5); (1, 6); (2, 7)] - -let (greet_num : int), (greeting : string), one_more_component = - different_types of_many_things + ffffff 124312 - -type storage = int * int - -let main (n : int * storage) - : operation list * storage = - let x : int * int = - let x : int = 7 - in x + n.0.asdasdasd.4, n.1.0 + n.1.1.1111111.aaaa.ddddddd.eeeeeee - in ([] : operation list), x - -let y : t = - if true then ffffffffff (-30000 * 10000 - 100000 + f x x y y y y - ((x / 4000) * -5), 103+5) else (10000 + 100000) / 10000000000 -type return = operation list * (storage * fsdgsdgf * sdfsdfsdf * ssdf) -let xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = - ttttttttttttt <= (aaaaaaaaaaaaaaaaaaaaaaaa - bbbbbbbbbbbbbbbbbbbb) -let x = tttt * ((fffffffff /55555555) - 3455 * 5135664) - 134 * (-4) -type x = AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA | B -let or_true (b : bool) : bool = bbbbbbbbbbbbb || true && cccccccccccccccccc -type x = A | B of t * int | CCC of int -> (string -> int) -> (string, address, timestamp, int) map -let c = CCCCCCCCCCCC (aaaaa, BBBBBBBBB aaaaaaaaaaaa) -let e = Some (a, B b) -type w = timestamp * nat -> (string, address) map -> t -type v = int * (a_long_type_name * (another_long_one * address * and_so_on) * more_of_a_very_long_type) - -type r = int list -type t = int -type s = (int,address,a_long_type_name, more_of_a_very_long_type * foo_bar_baz) t -type q = {a: int; b: {c: string}; c: timestamp * (address, string) big_map -> longer_type_name} -type u = {a: int; b: t * char; c: int * (a_long_type_name * (another_long_one * address * and_so_on) * more_of_a_very_long_type)} -let f xxxxxxxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ttttt : type_annotation_which_is_very_verbose = this_too_short_a_variable -let g : type_annotation_which_is_very_verbose = fun x y z t -> this_too_short_a_variable [@@inline] -let yyyyyyyyyyy : a_very_long_and_specific_type_of_string = "foo and bar" -let rec x (_, (yyyyyyyyyyyyyyyy: tttttttttttttttttttttttt), very_long_variable_to_trigger_a_break) = 4 -let y {xxxxxxxxx=(_,yyyyyyyy,more_components,another_one); zzzzzzz=34444444; ttttttt=3n} = xxxxxx -let z : (t) = y -let f (xxxxxxxxxxx: tttttttttttttt) y = (xxxxxxxxxxxx : tttttttttttttttttt) -let n : nat = 0n -let a = A -let b = B a -let d = None -let z = let v = "hello" ^ "world" ^ "!" in v -let r = { field = 0; another = 11111111111111111; and_another_one = "dddddd"} -let r = { r with field = 42; another = 11111111111111111; and_another_one = "dddddddddddddddddddddd"} -let w = Map.literal [(11111111111111,"11111111111111"); (22222222222,"22222222222222222"); (1234567890,"1234567890")] -let z = z.1.a.0.4.c.6.7.8.9.cccccccccccc.ccccccccccccccccc.ddddddddddddddddd.0.1.2 -let y : t = (if true then -30000000000000 + f x x y y y y else 10000000000000000000) - 1 -let w = - match f 3 with - None -> [] - | Some (1::[2;3;4;5;6]) -> [4;5]::[] diff --git a/src/passes/01-parser/pascaligo/ParserLog.mli b/src/passes/01-parser/pascaligo/ParserLog.mli deleted file mode 100644 index 558c51bff..000000000 --- a/src/passes/01-parser/pascaligo/ParserLog.mli +++ /dev/null @@ -1,39 +0,0 @@ -(** Printing the AST *) - -(** The type [state] captures the state that is threaded in the - printing iterators in this module. -*) -type state - -val mk_state : - offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state - -(** {1 Printing tokens from the AST in a buffer} - - Printing the tokens reconstructed from the AST. This is very useful - for debugging, as the output of [print_token ast] can be textually - compared to that of [Lexer.trace] (see module [LexerMain]). *) - -val print_tokens : state -> AST.t -> unit -val print_path : state -> AST.path -> unit -val print_pattern : state -> AST.pattern -> unit -val print_instruction : state -> AST.instruction -> unit -val print_expr : state -> AST.expr -> unit - -(** {1 Printing tokens from the AST in a string} *) - -val tokens_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.t -> string -val path_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.path -> string -val pattern_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.pattern -> string -val instruction_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.instruction -> string -val type_expr_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.type_expr -> string - -(** {1 Pretty-printing of AST nodes} *) - -val pp_cst : state -> AST.t -> unit -val pp_expr : state -> AST.expr -> unit diff --git a/src/passes/01-parser/pascaligo/Scoping.mli b/src/passes/01-parser/pascaligo/Scoping.mli deleted file mode 100644 index bc4372979..000000000 --- a/src/passes/01-parser/pascaligo/Scoping.mli +++ /dev/null @@ -1,20 +0,0 @@ -(* This module exports checks on scoping, called from the parser. *) - -module Region = Simple_utils.Region - -type t = - Reserved_name of AST.variable -| Duplicate_parameter of AST.variable -| Duplicate_variant of AST.variable -| Non_linear_pattern of AST.variable -| Duplicate_field of AST.variable - -type error = t - -exception Error of t - -val check_reserved_name : AST.variable -> unit -val check_pattern : AST.pattern -> unit -val check_variants : AST.variant Region.reg list -> unit -val check_parameters : AST.param_decl list -> unit -val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/01-parser/pascaligo/Tests/a.ligo b/src/passes/01-parser/pascaligo/Tests/a.ligo deleted file mode 100644 index 129a68d1f..000000000 --- a/src/passes/01-parser/pascaligo/Tests/a.ligo +++ /dev/null @@ -1,45 +0,0 @@ -type t is int * string -type u is t - -type v is record - foo: key; - bar: mutez; - baz: address - end - -type w is K of (U of int) // v * u - -type i is int; - -const x : v = - record - foo = 4; - bar = 5; - baz = 0x3244 - end - -(* Block comment *) - -entrypoint g (storage s : u; const l : list (int)) - : operation (list) is - var m : map (int, string) := empty_map; - var y : v := copy x with record bar = 7 end; - - function f (const x : int) : int is - var y : int := 5 - x - const z : int = 6 - begin - y := x + y - end with y * 2 - - begin - y.[4] := "hello"; - match l with - [] -> null - | h#t -> q (h+2) - end; - begin - g (Unit); - fail "in extremis" - end - end with (s, ([]: (u * operation (list)))) diff --git a/src/passes/01-parser/pascaligo/Tests/crowdfunding.ligo b/src/passes/01-parser/pascaligo/Tests/crowdfunding.ligo deleted file mode 100644 index 97fe7f15c..000000000 --- a/src/passes/01-parser/pascaligo/Tests/crowdfunding.ligo +++ /dev/null @@ -1,55 +0,0 @@ -type store is - record [ - goal : mutez; - deadline : timestamp; - backers : map (address, nat); - funded : bool; - ] - -function back (var store : store) : list (operation) * store is - var operations : list (operation) := list [] - begin - if now > store.deadline then - failwith ("Deadline passed"); - else - case store.backers[sender] of [ - None -> store.backers[sender] := amount - // or: None -> patch store.backers with map sender -> amount end - | _ -> skip - ] - end with (operations, store) - -function claim (var store : store) : list (operation) * store is - var operations : list (operation) := nil - begin - if now <= store.deadline then - failwith ("Too soon.") - else - case store.backers[sender] of - None -> - failwith ("Not a backer.") - | Some (amount) -> - if balance >= store.goal or store.funded then - failwith ("Goal reached: no refund.") - else - begin - operations := list [transaction (unit, sender, amount)]; - remove sender from map store.backers - end - end - end with (operations, store) - -function withdraw (var store : store) : list (operation) * store is - var operations : list (operation) := list end - begin - if sender = owner then - if now >= store.deadline then - if balance >= store.goal then { - store.funded := True; - // or: patch store with record funded = True end; - operations := list [Transfer (owner, balance)]; - }; - else failwith ("Below target.") - else failwith ("Too soon."); - else skip - end with (operations, store) diff --git a/src/passes/01-parser/pascaligo/Tests/pp.ligo b/src/passes/01-parser/pascaligo/Tests/pp.ligo deleted file mode 100644 index 2dd2563df..000000000 --- a/src/passes/01-parser/pascaligo/Tests/pp.ligo +++ /dev/null @@ -1,102 +0,0 @@ -function incr_map (const l : list (int)) : list (int) is - List.map (function (const i : int) : int is i + 1, l) - -type t is timestamp * nat -> map (string, address) -type u is A | B of t * int | C of int -> (string -> int) -type v is record aaaaaa : ttttttt; bbbbbb : record ccccccccc : string end end - -function back (var store : store) : list (operation) * store is - begin - var operations : list (operation) := list []; - const operations : list (operation) = list []; - const a : nat = 0n; - x0 := record foo = "1"; bar = 4n end; - x1 := nil; - x2 := list end; - x3 := 3#4# list [5; 6]; - case foo of - 10n -> skip - end; -if saaa.0.1.2.a.b.b.x contains xxxxxxxxxxxxxxx[123] then skip else skip; - s := set [3_000mutez; -2; 1n]; - a := A; - b := B (a); - c := C (a, B (a)); - d := None; - e := Some (a, B (b)); - z := z.1.2; -x := if true then map [1 -> "1"; 2 -> "2"; 3 -> "3"; 4 -> "4"; 5 -> "5555555555555555"] else Unit; - y := a.b.c[3]; - a := "hello " ^ "world" ^ "!"; - r := record aaaaaaaaaaaa = 100000000; bbbbbbb = ffffff (2, aa, x, y) + 1 end; - r := r with record aaaaaaaaaaa = 444442; bbbbbbbbb = 43 + f (z) / 234 end; - patch store.backers.8.aa.33333.5 with set [(1); f(2*3); 123124234/2345]; - remove (1,2,3) from set foo.bar; - remove 3 from map foo.bar; - patch store.backers with map [sender -> amount]; - if now > store.deadline and (not True) then - begin - f (x,1); - for k -> d in map m block { skip }; - for x in set s block { skip }; - while i < 10n - begin - acc := 2 - (if toggle then f(x) else Unit); - end; - for i := 1n to 10n step 2n - begin - acc := acc + i; - end; - failwith ("Deadline passed"); - end - else - case store.backers[sender] of [ - None -> store.0.backers[sender] := amount - | Some (_) -> skip - | B (x, C (y,z)) -> skip - | False#True#Unit#0xAA#"hi"#4#nil -> skip - ] - end with (operations, store, (more_stuff, and_here_too)) - - function claim (var store : store; const bar : t; const baz : u; var z : operations * store * (more_stuff * and_here_too)) : list (operation) * store * timestamp * nat -> map (string, address) is - begin - const operations : list (operation * map (address, map (longname, domain))) = nilllllllllll; -var operations : list (operation * map (address, map (longname, domain))) := nilllllllllll; - attributes ["foo"; "inline"]; - if now <= store.deadline then - failwith ("Too soon.") - else - case store.backers[sender] of - None -> - failwith ("Not a backer.") - | Some (0) -> skip - | Some (quantity) -> - if balance >= store.goal or store.funded then - failwith ("Goal reached: no refund.") - else - begin - operations.0.foo := list [transaction (unit, sender, quantity); transaction (foo, bar, bazzzzzzzzzzzzzzz)]; - remove sender.0099999.fffff [fiar (abaxxasfdf)] from map store.backers.foooooo.barrrrr.01.bazzzzzzz - end - end - end with long_function_name (operations, store, (more_stuff, (and_here_too, well_in_here_too), hello)) - -attributes ["inline"; "foo"] - -function withdraw (var store : store) : list (operation) * store is - begin - var operations : list (operation) := list end; - if sender = owner then - if now >= store.deadline then - if balance >= store.goal then { -// store.funded := True; - patch store with record funded = True; a = b end; - operations := list [Transfer (owner, balance)]; - }; - else failwith ("Below target.") - else failwith ("Too soon."); - else skip - end with case (foo: bar) of - nil -> (operations, (store : store)) - | _ -> (operations, store) - end diff --git a/src/passes/01-parser/reasonligo/SyntaxError.ml b/src/passes/01-parser/reasonligo/SyntaxError.ml deleted file mode 100644 index e6d23dbed..000000000 --- a/src/passes/01-parser/reasonligo/SyntaxError.ml +++ /dev/null @@ -1,5 +0,0 @@ -type error = - | WrongFunctionArguments of AST.expr - | InvalidWild of AST.expr - -exception Error of error \ No newline at end of file diff --git a/src/passes/01-parser/reasonligo/SyntaxError.mli b/src/passes/01-parser/reasonligo/SyntaxError.mli deleted file mode 100644 index 5288ceb41..000000000 --- a/src/passes/01-parser/reasonligo/SyntaxError.mli +++ /dev/null @@ -1,5 +0,0 @@ -type error = - | WrongFunctionArguments of AST.expr - | InvalidWild of AST.expr - -exception Error of error diff --git a/src/passes/01-parser/cameligo.ml b/src/passes/01-parsing/cameligo.ml similarity index 95% rename from src/passes/01-parser/cameligo.ml rename to src/passes/01-parsing/cameligo.ml index cba4d223b..69af2bd6e 100644 --- a/src/passes/01-parser/cameligo.ml +++ b/src/passes/01-parsing/cameligo.ml @@ -1,4 +1,4 @@ -module AST = Parser_cameligo.AST +module CST = Cst.Cameligo module LexToken = Parser_cameligo.LexToken module Lexer = Lexer.Make(LexToken) module Scoping = Parser_cameligo.Scoping @@ -54,20 +54,20 @@ module SubIO = module Parser = struct - type ast = AST.t - type expr = AST.expr + type ast = CST.t + type expr = CST.expr include Parser_cameligo.Parser end module ParserLog = struct - type ast = AST.t - type expr = AST.expr - include Parser_cameligo.ParserLog + type ast = CST.t + type expr = CST.expr + include Cst_cameligo.ParserLog end module Unit = - ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) + ParserUnit.Make (Lexer)(CST)(Parser)(ParErr)(ParserLog)(SubIO) let apply parser = let local_fail error = diff --git a/src/passes/01-parser/cameligo.mli b/src/passes/01-parsing/cameligo.mli similarity index 75% rename from src/passes/01-parser/cameligo.mli rename to src/passes/01-parsing/cameligo.mli index d994acab6..01151dca8 100644 --- a/src/passes/01-parser/cameligo.mli +++ b/src/passes/01-parsing/cameligo.mli @@ -1,22 +1,22 @@ (** This file provides an interface to the CameLIGO parser. *) open Trace -module AST = Parser_cameligo.AST +module CST = Cst.Cameligo (** Open a CameLIGO filename given by string and convert into an abstract syntax tree. *) -val parse_file : string -> (AST.t , Errors.parser_error) result +val parse_file : string -> (CST.t , Errors.parser_error) result (** Convert a given string into a CameLIGO abstract syntax tree *) -val parse_string : string -> (AST.t , Errors.parser_error) result +val parse_string : string -> (CST.t , Errors.parser_error) result (** Parse a given string as a CameLIGO expression and return an - expression AST. + expression CST. This is intended to be used for interactive interpreters, or other scenarios where you would want to parse a CameLIGO expression outside of a contract. *) -val parse_expression : string -> (AST.expr , Errors.parser_error) result +val parse_expression : string -> (CST.expr , Errors.parser_error) result (** Preprocess a given CameLIGO file and preprocess it. *) val preprocess : string -> (Buffer.t , Errors.parser_error) result diff --git a/src/passes/01-parser/cameligo/.AST.ml.tag b/src/passes/01-parsing/cameligo/.AST.ml.tag similarity index 100% rename from src/passes/01-parser/cameligo/.AST.ml.tag rename to src/passes/01-parsing/cameligo/.AST.ml.tag diff --git a/src/passes/01-parser/cameligo/.LexerMain.tag b/src/passes/01-parsing/cameligo/.LexerMain.tag similarity index 100% rename from src/passes/01-parser/cameligo/.LexerMain.tag rename to src/passes/01-parsing/cameligo/.LexerMain.tag diff --git a/src/passes/01-parser/cameligo/.Parser.mly.tag b/src/passes/01-parsing/cameligo/.Parser.mly.tag similarity index 100% rename from src/passes/01-parser/cameligo/.Parser.mly.tag rename to src/passes/01-parsing/cameligo/.Parser.mly.tag diff --git a/src/passes/01-parser/cameligo/.ParserMain.tag b/src/passes/01-parsing/cameligo/.ParserMain.tag similarity index 100% rename from src/passes/01-parser/cameligo/.ParserMain.tag rename to src/passes/01-parsing/cameligo/.ParserMain.tag diff --git a/src/passes/01-parser/cameligo/.Unlexer.tag b/src/passes/01-parsing/cameligo/.Unlexer.tag similarity index 100% rename from src/passes/01-parser/cameligo/.Unlexer.tag rename to src/passes/01-parsing/cameligo/.Unlexer.tag diff --git a/src/passes/01-parser/cameligo/.gitignore b/src/passes/01-parsing/cameligo/.gitignore similarity index 100% rename from src/passes/01-parser/cameligo/.gitignore rename to src/passes/01-parsing/cameligo/.gitignore diff --git a/src/passes/01-parser/cameligo/.links b/src/passes/01-parsing/cameligo/.links similarity index 100% rename from src/passes/01-parser/cameligo/.links rename to src/passes/01-parsing/cameligo/.links diff --git a/src/passes/01-parser/cameligo/LexToken.mli b/src/passes/01-parsing/cameligo/LexToken.mli similarity index 100% rename from src/passes/01-parser/cameligo/LexToken.mli rename to src/passes/01-parsing/cameligo/LexToken.mli diff --git a/src/passes/01-parser/cameligo/LexToken.mll b/src/passes/01-parsing/cameligo/LexToken.mll similarity index 100% rename from src/passes/01-parser/cameligo/LexToken.mll rename to src/passes/01-parsing/cameligo/LexToken.mll diff --git a/src/passes/01-parser/cameligo/LexerMain.ml b/src/passes/01-parsing/cameligo/LexerMain.ml similarity index 100% rename from src/passes/01-parser/cameligo/LexerMain.ml rename to src/passes/01-parsing/cameligo/LexerMain.ml diff --git a/src/passes/01-parser/cameligo/Makefile.cfg b/src/passes/01-parsing/cameligo/Makefile.cfg similarity index 100% rename from src/passes/01-parser/cameligo/Makefile.cfg rename to src/passes/01-parsing/cameligo/Makefile.cfg diff --git a/src/passes/01-parser/cameligo/ParToken.mly b/src/passes/01-parsing/cameligo/ParToken.mly similarity index 100% rename from src/passes/01-parser/cameligo/ParToken.mly rename to src/passes/01-parsing/cameligo/ParToken.mly diff --git a/src/passes/01-parser/cameligo/Parser.mly b/src/passes/01-parsing/cameligo/Parser.mly similarity index 99% rename from src/passes/01-parser/cameligo/Parser.mly rename to src/passes/01-parsing/cameligo/Parser.mly index 85ad87f3c..de0251a89 100644 --- a/src/passes/01-parser/cameligo/Parser.mly +++ b/src/passes/01-parsing/cameligo/Parser.mly @@ -4,7 +4,8 @@ [@@@warning "-42"] open Simple_utils.Region -open AST +module CST = Cst.Cameligo +open CST (* END HEADER *) %} @@ -14,8 +15,8 @@ open AST (* Entry points *) %start contract interactive_expr -%type contract -%type interactive_expr +%type contract +%type interactive_expr %% @@ -108,7 +109,7 @@ contract: declarations EOF { {decl=$1; eof=$2} } declarations: - declaration { $1,[] : AST.declaration Utils.nseq } + declaration { $1,[] : CST.declaration Utils.nseq } | declaration declarations { Utils.nseq_cons $1 $2 } declaration: diff --git a/src/passes/01-parser/cameligo/ParserMain.ml b/src/passes/01-parsing/cameligo/ParserMain.ml similarity index 100% rename from src/passes/01-parser/cameligo/ParserMain.ml rename to src/passes/01-parsing/cameligo/ParserMain.ml diff --git a/src/passes/01-parser/cameligo/Pretty.ml b/src/passes/01-parsing/cameligo/Pretty.ml similarity index 96% rename from src/passes/01-parser/cameligo/Pretty.ml rename to src/passes/01-parsing/cameligo/Pretty.ml index 7ab17d516..1eec2dc69 100644 --- a/src/passes/01-parser/cameligo/Pretty.ml +++ b/src/passes/01-parsing/cameligo/Pretty.ml @@ -1,6 +1,7 @@ [@@@warning "-42"] -open AST +module CST=Cst.Cameligo +open CST module Region = Simple_utils.Region open! Region open! PPrint diff --git a/src/passes/01-parser/cameligo/Scoping.ml b/src/passes/01-parsing/cameligo/Scoping.ml similarity index 94% rename from src/passes/01-parser/cameligo/Scoping.ml rename to src/passes/01-parsing/cameligo/Scoping.ml index e1332b96d..5b9820132 100644 --- a/src/passes/01-parser/cameligo/Scoping.ml +++ b/src/passes/01-parsing/cameligo/Scoping.ml @@ -1,12 +1,13 @@ [@@@warning "-42"] module Region = Simple_utils.Region +module CST = Cst.Cameligo type t = - Reserved_name of AST.variable -| Duplicate_variant of AST.variable -| Non_linear_pattern of AST.variable -| Duplicate_field of AST.variable + Reserved_name of CST.variable +| Duplicate_variant of CST.variable +| Non_linear_pattern of CST.variable +| Duplicate_field of CST.variable type error = t @@ -20,7 +21,7 @@ module SSet = Utils.String.Set module Ord = struct - type t = AST.variable + type t = CST.variable let compare v1 v2 = String.compare v1.value v2.value end @@ -71,7 +72,7 @@ let check_reserved_name var = (* Checking the linearity of patterns *) -open! AST +open! CST let rec vars_of_pattern env = function PConstr p -> vars_of_pconstr env p diff --git a/src/passes/01-parsing/cameligo/Scoping.mli b/src/passes/01-parsing/cameligo/Scoping.mli new file mode 100644 index 000000000..c53a1cecd --- /dev/null +++ b/src/passes/01-parsing/cameligo/Scoping.mli @@ -0,0 +1,19 @@ +(* This module exports checks on scoping, called from the parser. *) + +module Region = Simple_utils.Region +module CST = Cst.Cameligo + +type t = + Reserved_name of CST.variable +| Duplicate_variant of CST.variable +| Non_linear_pattern of CST.variable +| Duplicate_field of CST.variable + +type error = t + +exception Error of t + +val check_reserved_name : CST.variable -> unit +val check_pattern : CST.pattern -> unit +val check_variants : CST.variant Region.reg list -> unit +val check_fields : CST.field_decl Region.reg list -> unit diff --git a/src/passes/01-parser/cameligo/Unlexer.ml b/src/passes/01-parsing/cameligo/Unlexer.ml similarity index 100% rename from src/passes/01-parser/cameligo/Unlexer.ml rename to src/passes/01-parsing/cameligo/Unlexer.ml diff --git a/src/passes/01-parser/cameligo/cameligo.ml b/src/passes/01-parsing/cameligo/cameligo.ml similarity index 60% rename from src/passes/01-parser/cameligo/cameligo.ml rename to src/passes/01-parsing/cameligo/cameligo.ml index 8a76623e3..d85ec4700 100644 --- a/src/passes/01-parser/cameligo/cameligo.ml +++ b/src/passes/01-parsing/cameligo/cameligo.ml @@ -1,5 +1,3 @@ module Parser = Parser -module AST = AST module Lexer = Lexer module LexToken = LexToken -module ParserLog = ParserLog diff --git a/src/passes/01-parser/cameligo/dune b/src/passes/01-parsing/cameligo/dune similarity index 97% rename from src/passes/01-parser/cameligo/dune rename to src/passes/01-parsing/cameligo/dune index 6c5257688..197c92f69 100644 --- a/src/passes/01-parser/cameligo/dune +++ b/src/passes/01-parsing/cameligo/dune @@ -15,7 +15,7 @@ (name parser_cameligo) (public_name ligo.parser.cameligo) (modules - Scoping AST cameligo Parser ParserLog LexToken ParErr Pretty) + Scoping cameligo Parser LexToken ParErr Pretty) (libraries pprint terminal_size @@ -23,7 +23,9 @@ parser_shared str simple-utils - tezos-utils) + tezos-utils + cst + ) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Parser_shared -open Simple_utils))) diff --git a/src/passes/01-parser/cameligo/error.messages.checked-in b/src/passes/01-parsing/cameligo/error.messages.checked-in similarity index 100% rename from src/passes/01-parser/cameligo/error.messages.checked-in rename to src/passes/01-parsing/cameligo/error.messages.checked-in diff --git a/src/passes/01-parser/dune b/src/passes/01-parsing/dune similarity index 100% rename from src/passes/01-parser/dune rename to src/passes/01-parsing/dune diff --git a/src/passes/01-parser/errors.ml b/src/passes/01-parsing/errors.ml similarity index 84% rename from src/passes/01-parser/errors.ml rename to src/passes/01-parsing/errors.ml index 04e315c56..ce2533f15 100644 --- a/src/passes/01-parser/errors.ml +++ b/src/passes/01-parsing/errors.ml @@ -1,10 +1,12 @@ open Trace open Simple_utils.Display +module CST = Cst.Cameligo + type parser_error = [ | `Parser_generic of string Region.reg - | `Parser_wrong_function_arguments of Parser_cameligo.AST.expr - | `Parser_invalid_wild of Parser_cameligo.AST.expr + | `Parser_wrong_function_arguments of CST.expr + | `Parser_invalid_wild of CST.expr ] let stage = "parser" @@ -36,13 +38,13 @@ let error_ppformat : display_format:string display_format -> | `Parser_wrong_function_arguments expr -> let loc = Format.asprintf "%a" - Location.pp_lift @@ Parser_cameligo.AST.expr_to_region expr in + Location.pp_lift @@ CST.expr_to_region expr in let s = Format.asprintf "%s\n%s" loc wrong_function_msg in Format.pp_print_string f s ; | `Parser_invalid_wild expr -> let loc = Format.asprintf "%a" - Location.pp_lift @@ Parser_cameligo.AST.expr_to_region expr in + Location.pp_lift @@ CST.expr_to_region expr in let s = Format.asprintf "%s\n%s" loc wild_pattern_msg in Format.pp_print_string f s ; ) @@ -62,7 +64,7 @@ let error_jsonformat : parser_error -> J.t = fun a -> json_error ~stage ~content | `Parser_wrong_function_arguments expr -> let loc = Format.asprintf "%a" Location.pp_lift @@ - Parser_cameligo.AST.expr_to_region expr in + CST.expr_to_region expr in let content = `Assoc [ ("message", `String wrong_function_msg); ("location", `String loc); ] @@ -70,9 +72,9 @@ let error_jsonformat : parser_error -> J.t = fun a -> json_error ~stage ~content | `Parser_invalid_wild expr -> let loc = Format.asprintf "%a" Location.pp_lift @@ - Parser_cameligo.AST.expr_to_region expr in + CST.expr_to_region expr in let content = `Assoc [ ("message", `String wild_pattern_msg); ("location", `String loc); ] in - json_error ~stage ~content \ No newline at end of file + json_error ~stage ~content diff --git a/src/passes/01-parser/formatter.ml b/src/passes/01-parsing/formatter.ml similarity index 100% rename from src/passes/01-parser/formatter.ml rename to src/passes/01-parsing/formatter.ml diff --git a/src/passes/01-parser/parser.ml b/src/passes/01-parsing/parser.ml similarity index 100% rename from src/passes/01-parser/parser.ml rename to src/passes/01-parsing/parser.ml diff --git a/src/passes/01-parser/pascaligo.ml b/src/passes/01-parsing/pascaligo.ml similarity index 95% rename from src/passes/01-parser/pascaligo.ml rename to src/passes/01-parsing/pascaligo.ml index 265efe149..2f79b07e2 100644 --- a/src/passes/01-parser/pascaligo.ml +++ b/src/passes/01-parsing/pascaligo.ml @@ -1,4 +1,4 @@ -module AST = Parser_pascaligo.AST +module CST = Cst.Pascaligo module LexToken = Parser_pascaligo.LexToken module Lexer = Lexer.Make(LexToken) module Scoping = Parser_pascaligo.Scoping @@ -53,20 +53,20 @@ module SubIO = module Parser = struct - type ast = AST.t - type expr = AST.expr + type ast = CST.t + type expr = CST.expr include Parser_pascaligo.Parser end module ParserLog = struct - type ast = AST.t - type expr = AST.expr - include Parser_pascaligo.ParserLog + type ast = CST.t + type expr = CST.expr + include Cst_pascaligo.ParserLog end module Unit = - ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) + ParserUnit.Make (Lexer)(CST)(Parser)(ParErr)(ParserLog)(SubIO) let apply parser = let local_fail error = diff --git a/src/passes/01-parser/pascaligo.mli b/src/passes/01-parsing/pascaligo.mli similarity index 72% rename from src/passes/01-parser/pascaligo.mli rename to src/passes/01-parsing/pascaligo.mli index 1e5b296a0..1711f7974 100644 --- a/src/passes/01-parser/pascaligo.mli +++ b/src/passes/01-parsing/pascaligo.mli @@ -2,22 +2,22 @@ open Errors open Trace -module AST = Parser_pascaligo.AST +module CST = Cst.Pascaligo (** Open a PascaLIGO filename given by string and convert into an abstract syntax tree. *) -val parse_file : string -> (AST.t, parser_error) result +val parse_file : string -> (CST.t, parser_error) result (** Convert a given string into a PascaLIGO abstract syntax tree *) -val parse_string : string -> (AST.t, parser_error) result +val parse_string : string -> (CST.t, parser_error) result (** Parse a given string as a PascaLIGO expression and return an - expression AST. + expression CST. This is intended to be used for interactive interpreters, or other scenarios where you would want to parse a PascaLIGO expression outside of a contract. *) -val parse_expression : string -> (AST.expr, parser_error) result +val parse_expression : string -> (CST.expr, parser_error) result (** Preprocess a given PascaLIGO file and preprocess it. *) val preprocess : string -> (Buffer.t, parser_error) result diff --git a/src/passes/01-parser/pascaligo/.LexerMain.tag b/src/passes/01-parsing/pascaligo/.LexerMain.tag similarity index 100% rename from src/passes/01-parser/pascaligo/.LexerMain.tag rename to src/passes/01-parsing/pascaligo/.LexerMain.tag diff --git a/src/passes/01-parser/pascaligo/.Parser.mly.tag b/src/passes/01-parsing/pascaligo/.Parser.mly.tag similarity index 100% rename from src/passes/01-parser/pascaligo/.Parser.mly.tag rename to src/passes/01-parsing/pascaligo/.Parser.mly.tag diff --git a/src/passes/01-parser/pascaligo/.ParserMain.tag b/src/passes/01-parsing/pascaligo/.ParserMain.tag similarity index 100% rename from src/passes/01-parser/pascaligo/.ParserMain.tag rename to src/passes/01-parsing/pascaligo/.ParserMain.tag diff --git a/src/passes/01-parser/pascaligo/.Unlexer.tag b/src/passes/01-parsing/pascaligo/.Unlexer.tag similarity index 100% rename from src/passes/01-parser/pascaligo/.Unlexer.tag rename to src/passes/01-parsing/pascaligo/.Unlexer.tag diff --git a/src/passes/01-parser/pascaligo/.gitignore b/src/passes/01-parsing/pascaligo/.gitignore similarity index 100% rename from src/passes/01-parser/pascaligo/.gitignore rename to src/passes/01-parsing/pascaligo/.gitignore diff --git a/src/passes/01-parser/pascaligo/.links b/src/passes/01-parsing/pascaligo/.links similarity index 100% rename from src/passes/01-parser/pascaligo/.links rename to src/passes/01-parsing/pascaligo/.links diff --git a/src/passes/01-parser/pascaligo/Doc/misc.txt b/src/passes/01-parsing/pascaligo/Doc/misc.txt similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/misc.txt rename to src/passes/01-parsing/pascaligo/Doc/misc.txt diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo.md b/src/passes/01-parsing/pascaligo/Doc/pascaligo.md similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo.md rename to src/passes/01-parsing/pascaligo/Doc/pascaligo.md diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo.txt b/src/passes/01-parsing/pascaligo/Doc/pascaligo.txt similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo.txt rename to src/passes/01-parsing/pascaligo/Doc/pascaligo.txt diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_01.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_01.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_01.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_01.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_02.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_02.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_02.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_02.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_03.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_03.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_03.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_03.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_04.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_04.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_04.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_04.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_05.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_05.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_05.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_05.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_06.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_06.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_06.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_06.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_07.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_07.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_07.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_07.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_08.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_08.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_08.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_08.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_09.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_09.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_09.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_09.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_10.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_10.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_10.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_10.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_11.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_11.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_11.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_11.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_12.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_12.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_12.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_12.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_13.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_13.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_13.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_13.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_14.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_14.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_14.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_14.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_15.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_15.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_15.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_15.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_16.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_16.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_16.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_16.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_17.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_17.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_17.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_17.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_18.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_18.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_18.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_18.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_19.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_19.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_19.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_19.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_20.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_20.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_20.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_20.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_21.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_21.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_21.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_21.bnf diff --git a/src/passes/01-parser/pascaligo/Doc/pascaligo_22.bnf b/src/passes/01-parsing/pascaligo/Doc/pascaligo_22.bnf similarity index 100% rename from src/passes/01-parser/pascaligo/Doc/pascaligo_22.bnf rename to src/passes/01-parsing/pascaligo/Doc/pascaligo_22.bnf diff --git a/src/passes/01-parser/pascaligo/LexToken.mli b/src/passes/01-parsing/pascaligo/LexToken.mli similarity index 100% rename from src/passes/01-parser/pascaligo/LexToken.mli rename to src/passes/01-parsing/pascaligo/LexToken.mli diff --git a/src/passes/01-parser/pascaligo/LexToken.mll b/src/passes/01-parsing/pascaligo/LexToken.mll similarity index 100% rename from src/passes/01-parser/pascaligo/LexToken.mll rename to src/passes/01-parsing/pascaligo/LexToken.mll diff --git a/src/passes/01-parser/pascaligo/LexerMain.ml b/src/passes/01-parsing/pascaligo/LexerMain.ml similarity index 100% rename from src/passes/01-parser/pascaligo/LexerMain.ml rename to src/passes/01-parsing/pascaligo/LexerMain.ml diff --git a/src/passes/01-parser/pascaligo/Makefile.cfg b/src/passes/01-parsing/pascaligo/Makefile.cfg similarity index 100% rename from src/passes/01-parser/pascaligo/Makefile.cfg rename to src/passes/01-parsing/pascaligo/Makefile.cfg diff --git a/src/passes/01-parser/pascaligo/Misc/.SParser.ml.tag b/src/passes/01-parsing/pascaligo/Misc/.SParser.ml.tag similarity index 100% rename from src/passes/01-parser/pascaligo/Misc/.SParser.ml.tag rename to src/passes/01-parsing/pascaligo/Misc/.SParser.ml.tag diff --git a/src/passes/01-parser/pascaligo/Misc/SParser.ml b/src/passes/01-parsing/pascaligo/Misc/SParser.ml similarity index 100% rename from src/passes/01-parser/pascaligo/Misc/SParser.ml rename to src/passes/01-parsing/pascaligo/Misc/SParser.ml diff --git a/src/passes/01-parser/pascaligo/Misc/SParserMain.ml b/src/passes/01-parsing/pascaligo/Misc/SParserMain.ml similarity index 100% rename from src/passes/01-parser/pascaligo/Misc/SParserMain.ml rename to src/passes/01-parsing/pascaligo/Misc/SParserMain.ml diff --git a/src/passes/01-parser/pascaligo/ParToken.mly b/src/passes/01-parsing/pascaligo/ParToken.mly similarity index 100% rename from src/passes/01-parser/pascaligo/ParToken.mly rename to src/passes/01-parsing/pascaligo/ParToken.mly diff --git a/src/passes/01-parser/pascaligo/Parser.mly b/src/passes/01-parsing/pascaligo/Parser.mly similarity index 99% rename from src/passes/01-parser/pascaligo/Parser.mly rename to src/passes/01-parsing/pascaligo/Parser.mly index a6043a26c..33eaf3149 100644 --- a/src/passes/01-parser/pascaligo/Parser.mly +++ b/src/passes/01-parsing/pascaligo/Parser.mly @@ -4,7 +4,8 @@ [@@@warning "-42"] open Simple_utils.Region -open AST +module CST = Cst.Pascaligo +open CST (* END HEADER *) %} @@ -14,8 +15,8 @@ open AST (* Entry points *) %start contract interactive_expr -%type contract -%type interactive_expr +%type contract +%type interactive_expr %% @@ -521,7 +522,7 @@ proc_call: conditional: "if" expr "then" if_clause ";"? "else" if_clause { let region = cover $1 (if_clause_to_region $7) in - let value : AST.conditional = { + let value : CST.conditional = { kwd_if = $1; test = $2; kwd_then = $3; @@ -668,7 +669,7 @@ expr: cond_expr: "if" expr "then" expr ";"? "else" expr { let region = cover $1 (expr_to_region $7) in - let value : AST.cond_expr = { + let value : CST.cond_expr = { kwd_if = $1; test = $2; kwd_then = $3; @@ -941,7 +942,7 @@ record_expr: "record" sep_or_term_list(field_assignment,";") "end" { let ne_elements, terminator = $2 in let region = cover $1 $3 - and value : field_assignment AST.reg ne_injection = { + and value : field_assignment CST.reg ne_injection = { kind = NEInjRecord $1; enclosing = End $3; ne_elements; @@ -951,7 +952,7 @@ record_expr: | "record" "[" sep_or_term_list(field_assignment,";") "]" { let ne_elements, terminator = $3 in let region = cover $1 $4 - and value : field_assignment AST.reg ne_injection = { + and value : field_assignment CST.reg ne_injection = { kind = NEInjRecord $1; enclosing = Brackets ($2,$4); ne_elements; diff --git a/src/passes/01-parser/pascaligo/ParserMain.ml b/src/passes/01-parsing/pascaligo/ParserMain.ml similarity index 100% rename from src/passes/01-parser/pascaligo/ParserMain.ml rename to src/passes/01-parsing/pascaligo/ParserMain.ml diff --git a/src/passes/01-parser/pascaligo/Pretty.ml b/src/passes/01-parsing/pascaligo/Pretty.ml similarity index 99% rename from src/passes/01-parser/pascaligo/Pretty.ml rename to src/passes/01-parsing/pascaligo/Pretty.ml index 52e1b1b7a..d7de34d37 100644 --- a/src/passes/01-parser/pascaligo/Pretty.ml +++ b/src/passes/01-parsing/pascaligo/Pretty.ml @@ -2,7 +2,8 @@ [@@@warning "-27"] [@@@warning "-26"] -open AST +module CST = Cst.Pascaligo +open CST module Region = Simple_utils.Region open! Region open! PPrint diff --git a/src/passes/01-parser/pascaligo/Scoping.ml b/src/passes/01-parsing/pascaligo/Scoping.ml similarity index 94% rename from src/passes/01-parser/pascaligo/Scoping.ml rename to src/passes/01-parsing/pascaligo/Scoping.ml index 3fc439efb..300abbfc7 100644 --- a/src/passes/01-parser/pascaligo/Scoping.ml +++ b/src/passes/01-parsing/pascaligo/Scoping.ml @@ -1,13 +1,14 @@ [@@@warning "-42"] module Region = Simple_utils.Region +module CST = Cst.Pascaligo type t = - Reserved_name of AST.variable -| Duplicate_parameter of AST.variable -| Duplicate_variant of AST.variable -| Non_linear_pattern of AST.variable -| Duplicate_field of AST.variable + Reserved_name of CST.variable +| Duplicate_parameter of CST.variable +| Duplicate_variant of CST.variable +| Non_linear_pattern of CST.variable +| Duplicate_field of CST.variable type error = t @@ -21,7 +22,7 @@ module SSet = Utils.String.Set module Ord = struct - type t = AST.variable + type t = CST.variable let compare v1 v2 = String.compare v1.value v2.value end @@ -99,7 +100,7 @@ let check_reserved_name var = (* Checking the linearity of patterns *) -open! AST +open! CST let rec vars_of_pattern env = function PConstr p -> vars_of_pconstr env p diff --git a/src/passes/01-parsing/pascaligo/Scoping.mli b/src/passes/01-parsing/pascaligo/Scoping.mli new file mode 100644 index 000000000..7cf0f176e --- /dev/null +++ b/src/passes/01-parsing/pascaligo/Scoping.mli @@ -0,0 +1,21 @@ +(* This module exports checks on scoping, called from the parser. *) + +module Region = Simple_utils.Region +module CST = Cst.Pascaligo + +type t = + Reserved_name of CST.variable +| Duplicate_parameter of CST.variable +| Duplicate_variant of CST.variable +| Non_linear_pattern of CST.variable +| Duplicate_field of CST.variable + +type error = t + +exception Error of t + +val check_reserved_name : CST.variable -> unit +val check_pattern : CST.pattern -> unit +val check_variants : CST.variant Region.reg list -> unit +val check_parameters : CST.param_decl list -> unit +val check_fields : CST.field_decl Region.reg list -> unit diff --git a/src/passes/01-parser/pascaligo/Unlexer.ml b/src/passes/01-parsing/pascaligo/Unlexer.ml similarity index 100% rename from src/passes/01-parser/pascaligo/Unlexer.ml rename to src/passes/01-parsing/pascaligo/Unlexer.ml diff --git a/src/passes/01-parser/pascaligo/dune b/src/passes/01-parsing/pascaligo/dune similarity index 97% rename from src/passes/01-parser/pascaligo/dune rename to src/passes/01-parsing/pascaligo/dune index 855fb0da9..4851e927c 100644 --- a/src/passes/01-parser/pascaligo/dune +++ b/src/passes/01-parsing/pascaligo/dune @@ -15,7 +15,7 @@ (name parser_pascaligo) (public_name ligo.parser.pascaligo) (modules - Scoping AST pascaligo Parser ParserLog LexToken ParErr Pretty) + Scoping pascaligo Parser LexToken ParErr Pretty) (libraries pprint terminal_size @@ -23,7 +23,8 @@ parser_shared hex Preprocessor - simple-utils) + simple-utils + cst) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Parser_shared -open Simple_utils))) diff --git a/src/passes/01-parser/pascaligo/error.messages.checked-in b/src/passes/01-parsing/pascaligo/error.messages.checked-in similarity index 100% rename from src/passes/01-parser/pascaligo/error.messages.checked-in rename to src/passes/01-parsing/pascaligo/error.messages.checked-in diff --git a/src/passes/01-parser/pascaligo/pascaligo.ml b/src/passes/01-parsing/pascaligo/pascaligo.ml similarity index 60% rename from src/passes/01-parser/pascaligo/pascaligo.ml rename to src/passes/01-parsing/pascaligo/pascaligo.ml index 21b604e3e..2421f543f 100644 --- a/src/passes/01-parser/pascaligo/pascaligo.ml +++ b/src/passes/01-parsing/pascaligo/pascaligo.ml @@ -1,5 +1,3 @@ module Lexer = Lexer module LexToken = LexToken -module AST = AST module Parser = Parser -module ParserLog = ParserLog diff --git a/src/passes/01-parser/reasonligo.ml b/src/passes/01-parsing/reasonligo.ml similarity index 95% rename from src/passes/01-parser/reasonligo.ml rename to src/passes/01-parsing/reasonligo.ml index f5ccdeb98..5bbed6c0c 100644 --- a/src/passes/01-parser/reasonligo.ml +++ b/src/passes/01-parsing/reasonligo.ml @@ -1,4 +1,4 @@ -module AST = Parser_cameligo.AST +module CST = Cst.Cameligo module LexToken = Parser_reasonligo.LexToken module Lexer = Lexer.Make (LexToken) module Scoping = Parser_cameligo.Scoping @@ -55,20 +55,20 @@ module SubIO = module Parser = struct - type ast = AST.t - type expr = AST.expr + type ast = CST.t + type expr = CST.expr include Parser_reasonligo.Parser end module ParserLog = struct - type ast = AST.t - type expr = AST.expr - include Parser_cameligo.ParserLog + type ast = CST.t + type expr = CST.expr + include Cst_cameligo.ParserLog end module Unit = - ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) + ParserUnit.Make (Lexer)(CST)(Parser)(ParErr)(ParserLog)(SubIO) let apply parser = let local_fail error = diff --git a/src/passes/01-parser/reasonligo.mli b/src/passes/01-parsing/reasonligo.mli similarity index 75% rename from src/passes/01-parser/reasonligo.mli rename to src/passes/01-parsing/reasonligo.mli index 5f96fd4f0..4a032807a 100644 --- a/src/passes/01-parser/reasonligo.mli +++ b/src/passes/01-parsing/reasonligo.mli @@ -1,22 +1,22 @@ (** This file provides an interface to the ReasonLIGO parser. *) open Trace -module AST = Parser_cameligo.AST +module CST = Cst.Cameligo (** Open a ReasonLIGO filename given by string and convert into an abstract syntax tree. *) -val parse_file : string -> (AST.t , Errors.parser_error) result +val parse_file : string -> (CST.t , Errors.parser_error) result (** Convert a given string into a ReasonLIGO abstract syntax tree *) -val parse_string : string -> (AST.t , Errors.parser_error) result +val parse_string : string -> (CST.t , Errors.parser_error) result (** Parse a given string as a ReasonLIGO expression and return an - expression AST. + expression CST. This is intended to be used for interactive interpreters, or other scenarios where you would want to parse a ReasonLIGO expression outside of a contract. *) -val parse_expression : string -> (AST.expr , Errors.parser_error) result +val parse_expression : string -> (CST.expr , Errors.parser_error) result (** Preprocess a given ReasonLIGO file and preprocess it. *) val preprocess : string -> (Buffer.t , Errors.parser_error) result diff --git a/src/passes/01-parser/reasonligo/.LexerMain.tag b/src/passes/01-parsing/reasonligo/.LexerMain.tag similarity index 100% rename from src/passes/01-parser/reasonligo/.LexerMain.tag rename to src/passes/01-parsing/reasonligo/.LexerMain.tag diff --git a/src/passes/01-parser/reasonligo/.Parser.mly.tag b/src/passes/01-parsing/reasonligo/.Parser.mly.tag similarity index 100% rename from src/passes/01-parser/reasonligo/.Parser.mly.tag rename to src/passes/01-parsing/reasonligo/.Parser.mly.tag diff --git a/src/passes/01-parser/reasonligo/.ParserMain.tag b/src/passes/01-parsing/reasonligo/.ParserMain.tag similarity index 100% rename from src/passes/01-parser/reasonligo/.ParserMain.tag rename to src/passes/01-parsing/reasonligo/.ParserMain.tag diff --git a/src/passes/01-parser/reasonligo/.Unlexer.tag b/src/passes/01-parsing/reasonligo/.Unlexer.tag similarity index 100% rename from src/passes/01-parser/reasonligo/.Unlexer.tag rename to src/passes/01-parsing/reasonligo/.Unlexer.tag diff --git a/src/passes/01-parser/reasonligo/.gitignore b/src/passes/01-parsing/reasonligo/.gitignore similarity index 100% rename from src/passes/01-parser/reasonligo/.gitignore rename to src/passes/01-parsing/reasonligo/.gitignore diff --git a/src/passes/01-parser/reasonligo/.links b/src/passes/01-parsing/reasonligo/.links similarity index 100% rename from src/passes/01-parser/reasonligo/.links rename to src/passes/01-parsing/reasonligo/.links diff --git a/src/passes/01-parser/reasonligo/LexToken.mli b/src/passes/01-parsing/reasonligo/LexToken.mli similarity index 100% rename from src/passes/01-parser/reasonligo/LexToken.mli rename to src/passes/01-parsing/reasonligo/LexToken.mli diff --git a/src/passes/01-parser/reasonligo/LexToken.mll b/src/passes/01-parsing/reasonligo/LexToken.mll similarity index 100% rename from src/passes/01-parser/reasonligo/LexToken.mll rename to src/passes/01-parsing/reasonligo/LexToken.mll diff --git a/src/passes/01-parser/reasonligo/LexerMain.ml b/src/passes/01-parsing/reasonligo/LexerMain.ml similarity index 100% rename from src/passes/01-parser/reasonligo/LexerMain.ml rename to src/passes/01-parsing/reasonligo/LexerMain.ml diff --git a/src/passes/01-parser/reasonligo/Makefile.cfg b/src/passes/01-parsing/reasonligo/Makefile.cfg similarity index 100% rename from src/passes/01-parser/reasonligo/Makefile.cfg rename to src/passes/01-parsing/reasonligo/Makefile.cfg diff --git a/src/passes/01-parser/reasonligo/Misc/Misc.ml b/src/passes/01-parsing/reasonligo/Misc/Misc.ml similarity index 100% rename from src/passes/01-parser/reasonligo/Misc/Misc.ml rename to src/passes/01-parsing/reasonligo/Misc/Misc.ml diff --git a/src/passes/01-parser/reasonligo/ParToken.mly b/src/passes/01-parsing/reasonligo/ParToken.mly similarity index 100% rename from src/passes/01-parser/reasonligo/ParToken.mly rename to src/passes/01-parsing/reasonligo/ParToken.mly diff --git a/src/passes/01-parser/reasonligo/Parser.mly b/src/passes/01-parsing/reasonligo/Parser.mly similarity index 99% rename from src/passes/01-parser/reasonligo/Parser.mly rename to src/passes/01-parsing/reasonligo/Parser.mly index 003128f61..3e931a5e9 100644 --- a/src/passes/01-parser/reasonligo/Parser.mly +++ b/src/passes/01-parsing/reasonligo/Parser.mly @@ -5,8 +5,8 @@ module Region = Simple_utils.Region open Region -module AST = Parser_cameligo.AST -open! AST +module CST = Cst.Cameligo +open! CST let (<@) f g x = f (g x) @@ -41,8 +41,8 @@ let wild_error e = (* Entry points *) %start contract interactive_expr -%type contract -%type interactive_expr +%type contract +%type interactive_expr (* Solves a shift/reduce problem that happens with records and sequences. To elaborate: [sequence_or_record_in] @@ -147,7 +147,7 @@ contract: declarations EOF { {decl=$1; eof=$2} } declarations: - declaration { $1,[] : AST.declaration Utils.nseq } + declaration { $1,[] : CST.declaration Utils.nseq } | declaration declarations { Utils.nseq_cons $1 $2 } declaration: diff --git a/src/passes/01-parser/reasonligo/ParserMain.ml b/src/passes/01-parsing/reasonligo/ParserMain.ml similarity index 100% rename from src/passes/01-parser/reasonligo/ParserMain.ml rename to src/passes/01-parsing/reasonligo/ParserMain.ml diff --git a/src/passes/01-parser/reasonligo/Pretty.ml b/src/passes/01-parsing/reasonligo/Pretty.ml similarity index 99% rename from src/passes/01-parser/reasonligo/Pretty.ml rename to src/passes/01-parsing/reasonligo/Pretty.ml index a9e566c47..4c507a5d2 100644 --- a/src/passes/01-parser/reasonligo/Pretty.ml +++ b/src/passes/01-parsing/reasonligo/Pretty.ml @@ -1,6 +1,7 @@ [@@@warning "-42"] -open AST +module CST = Cst.Cameligo +open CST module Region = Simple_utils.Region open! Region open! PPrint diff --git a/src/passes/01-parser/reasonligo/Stubs/Parser_cameligo.ml b/src/passes/01-parsing/reasonligo/Stubs/Parser_cameligo.ml similarity index 100% rename from src/passes/01-parser/reasonligo/Stubs/Parser_cameligo.ml rename to src/passes/01-parsing/reasonligo/Stubs/Parser_cameligo.ml diff --git a/src/passes/01-parsing/reasonligo/SyntaxError.ml b/src/passes/01-parsing/reasonligo/SyntaxError.ml new file mode 100644 index 000000000..cab81f352 --- /dev/null +++ b/src/passes/01-parsing/reasonligo/SyntaxError.ml @@ -0,0 +1,7 @@ +module CST = Cst.Cameligo + +type error = + | WrongFunctionArguments of CST.expr + | InvalidWild of CST.expr + +exception Error of error diff --git a/src/passes/01-parsing/reasonligo/SyntaxError.mli b/src/passes/01-parsing/reasonligo/SyntaxError.mli new file mode 100644 index 000000000..434625931 --- /dev/null +++ b/src/passes/01-parsing/reasonligo/SyntaxError.mli @@ -0,0 +1,7 @@ +module CST = Cst.Cameligo + +type error = + | WrongFunctionArguments of CST.expr + | InvalidWild of CST.expr + +exception Error of error diff --git a/src/passes/01-parser/reasonligo/Unlexer.ml b/src/passes/01-parsing/reasonligo/Unlexer.ml similarity index 100% rename from src/passes/01-parser/reasonligo/Unlexer.ml rename to src/passes/01-parsing/reasonligo/Unlexer.ml diff --git a/src/passes/01-parser/reasonligo/dune b/src/passes/01-parsing/reasonligo/dune similarity index 100% rename from src/passes/01-parser/reasonligo/dune rename to src/passes/01-parsing/reasonligo/dune diff --git a/src/passes/01-parser/reasonligo/error.messages.checked-in b/src/passes/01-parsing/reasonligo/error.messages.checked-in similarity index 100% rename from src/passes/01-parser/reasonligo/error.messages.checked-in rename to src/passes/01-parsing/reasonligo/error.messages.checked-in diff --git a/src/passes/01-parser/reasonligo/reasonligo.ml b/src/passes/01-parsing/reasonligo/reasonligo.ml similarity index 57% rename from src/passes/01-parser/reasonligo/reasonligo.ml rename to src/passes/01-parsing/reasonligo/reasonligo.ml index 48dd4401b..8ac1f47fa 100644 --- a/src/passes/01-parser/reasonligo/reasonligo.ml +++ b/src/passes/01-parsing/reasonligo/reasonligo.ml @@ -1,6 +1,4 @@ module Parser = Parser -module AST = Parser_cameligo.AST module Lexer = Lexer module LexToken = LexToken -module ParserLog = Parser_cameligo.ParserLog module SyntaxError = SyntaxError diff --git a/src/passes/01-parser/shared/Doc/shared.txt b/src/passes/01-parsing/shared/Doc/shared.txt similarity index 100% rename from src/passes/01-parser/shared/Doc/shared.txt rename to src/passes/01-parsing/shared/Doc/shared.txt diff --git a/src/passes/01-parser/shared/EvalOpt.ml b/src/passes/01-parsing/shared/EvalOpt.ml similarity index 100% rename from src/passes/01-parser/shared/EvalOpt.ml rename to src/passes/01-parsing/shared/EvalOpt.ml diff --git a/src/passes/01-parser/shared/EvalOpt.mli b/src/passes/01-parsing/shared/EvalOpt.mli similarity index 100% rename from src/passes/01-parser/shared/EvalOpt.mli rename to src/passes/01-parsing/shared/EvalOpt.mli diff --git a/src/passes/01-parser/shared/FQueue.ml b/src/passes/01-parsing/shared/FQueue.ml similarity index 100% rename from src/passes/01-parser/shared/FQueue.ml rename to src/passes/01-parsing/shared/FQueue.ml diff --git a/src/passes/01-parser/shared/FQueue.mli b/src/passes/01-parsing/shared/FQueue.mli similarity index 100% rename from src/passes/01-parser/shared/FQueue.mli rename to src/passes/01-parsing/shared/FQueue.mli diff --git a/src/passes/01-parser/shared/Lexer.mli b/src/passes/01-parsing/shared/Lexer.mli similarity index 100% rename from src/passes/01-parser/shared/Lexer.mli rename to src/passes/01-parsing/shared/Lexer.mli diff --git a/src/passes/01-parser/shared/Lexer.mll b/src/passes/01-parsing/shared/Lexer.mll similarity index 100% rename from src/passes/01-parser/shared/Lexer.mll rename to src/passes/01-parsing/shared/Lexer.mll diff --git a/src/passes/01-parser/shared/LexerLib.ml b/src/passes/01-parsing/shared/LexerLib.ml similarity index 100% rename from src/passes/01-parser/shared/LexerLib.ml rename to src/passes/01-parsing/shared/LexerLib.ml diff --git a/src/passes/01-parser/shared/LexerLib.mli b/src/passes/01-parsing/shared/LexerLib.mli similarity index 100% rename from src/passes/01-parser/shared/LexerLib.mli rename to src/passes/01-parsing/shared/LexerLib.mli diff --git a/src/passes/01-parser/shared/LexerLog.ml b/src/passes/01-parsing/shared/LexerLog.ml similarity index 100% rename from src/passes/01-parser/shared/LexerLog.ml rename to src/passes/01-parsing/shared/LexerLog.ml diff --git a/src/passes/01-parser/shared/LexerLog.mli b/src/passes/01-parsing/shared/LexerLog.mli similarity index 100% rename from src/passes/01-parser/shared/LexerLog.mli rename to src/passes/01-parsing/shared/LexerLog.mli diff --git a/src/passes/01-parser/shared/LexerUnit.ml b/src/passes/01-parsing/shared/LexerUnit.ml similarity index 100% rename from src/passes/01-parser/shared/LexerUnit.ml rename to src/passes/01-parsing/shared/LexerUnit.ml diff --git a/src/passes/01-parser/shared/LexerUnit.mli b/src/passes/01-parsing/shared/LexerUnit.mli similarity index 100% rename from src/passes/01-parser/shared/LexerUnit.mli rename to src/passes/01-parsing/shared/LexerUnit.mli diff --git a/src/passes/01-parser/shared/Markup.ml b/src/passes/01-parsing/shared/Markup.ml similarity index 100% rename from src/passes/01-parser/shared/Markup.ml rename to src/passes/01-parsing/shared/Markup.ml diff --git a/src/passes/01-parser/shared/Markup.mli b/src/passes/01-parsing/shared/Markup.mli similarity index 100% rename from src/passes/01-parser/shared/Markup.mli rename to src/passes/01-parsing/shared/Markup.mli diff --git a/src/passes/01-parser/shared/Memo.ml b/src/passes/01-parsing/shared/Memo.ml similarity index 100% rename from src/passes/01-parser/shared/Memo.ml rename to src/passes/01-parsing/shared/Memo.ml diff --git a/src/passes/01-parser/shared/Memo.mli b/src/passes/01-parsing/shared/Memo.mli similarity index 100% rename from src/passes/01-parser/shared/Memo.mli rename to src/passes/01-parsing/shared/Memo.mli diff --git a/src/passes/01-parser/shared/ParserAPI.ml b/src/passes/01-parsing/shared/ParserAPI.ml similarity index 100% rename from src/passes/01-parser/shared/ParserAPI.ml rename to src/passes/01-parsing/shared/ParserAPI.ml diff --git a/src/passes/01-parser/shared/ParserAPI.mli b/src/passes/01-parsing/shared/ParserAPI.mli similarity index 100% rename from src/passes/01-parser/shared/ParserAPI.mli rename to src/passes/01-parsing/shared/ParserAPI.mli diff --git a/src/passes/01-parser/shared/ParserUnit.ml b/src/passes/01-parsing/shared/ParserUnit.ml similarity index 100% rename from src/passes/01-parser/shared/ParserUnit.ml rename to src/passes/01-parsing/shared/ParserUnit.ml diff --git a/src/passes/01-parser/shared/ParserUnit.mli b/src/passes/01-parsing/shared/ParserUnit.mli similarity index 100% rename from src/passes/01-parser/shared/ParserUnit.mli rename to src/passes/01-parsing/shared/ParserUnit.mli diff --git a/src/passes/01-parser/shared/Utils.ml b/src/passes/01-parsing/shared/Utils.ml similarity index 100% rename from src/passes/01-parser/shared/Utils.ml rename to src/passes/01-parsing/shared/Utils.ml diff --git a/src/passes/01-parser/shared/Utils.mli b/src/passes/01-parsing/shared/Utils.mli similarity index 100% rename from src/passes/01-parser/shared/Utils.mli rename to src/passes/01-parsing/shared/Utils.mli diff --git a/src/passes/01-parser/shared/dune b/src/passes/01-parsing/shared/dune similarity index 100% rename from src/passes/01-parser/shared/dune rename to src/passes/01-parsing/shared/dune diff --git a/src/passes/02-concrete_to_imperative/cameligo.mli b/src/passes/02-concrete_to_imperative/cameligo.mli deleted file mode 100644 index 2a16d6f6a..000000000 --- a/src/passes/02-concrete_to_imperative/cameligo.mli +++ /dev/null @@ -1,14 +0,0 @@ -[@@@warning "-45"] - -open Trace -open Ast_imperative - -module Raw = Parser.Cameligo.AST -module SMap = Map.String -module Option = Simple_utils.Option - -val npseq_to_nelist : 'a * ( 'b * 'c ) list -> 'a * 'c list - -val compile_expression : Raw.expr -> (expr, Errors_cameligo.abs_error) result - -val compile_program : Raw.ast -> (program, Errors_cameligo.abs_error) result \ No newline at end of file diff --git a/src/passes/02-concrete_to_imperative/concrete_to_imperative.ml b/src/passes/02-concrete_to_imperative/concrete_to_imperative.ml deleted file mode 100644 index 09f459ef4..000000000 --- a/src/passes/02-concrete_to_imperative/concrete_to_imperative.ml +++ /dev/null @@ -1,4 +0,0 @@ -module Errors_cameligo = Errors_cameligo -module Errors_pascaligo = Errors_pascaligo -module Pascaligo = Pascaligo -module Cameligo = Cameligo diff --git a/src/passes/03-tree_abstraction/cameligo/cameligo.ml b/src/passes/03-tree_abstraction/cameligo/cameligo.ml new file mode 100644 index 000000000..3a1c68ef1 --- /dev/null +++ b/src/passes/03-tree_abstraction/cameligo/cameligo.ml @@ -0,0 +1,8 @@ +module CST = Cst.Cameligo +module AST = Ast_imperative + +module Compiler = Compiler +module Errors = Errors + +let compile_program = Compiler.compile_program +let compile_expression = Compiler.compile_expression diff --git a/src/passes/03-tree_abstraction/cameligo/cameligo.mli b/src/passes/03-tree_abstraction/cameligo/cameligo.mli new file mode 100644 index 000000000..5f22a30ee --- /dev/null +++ b/src/passes/03-tree_abstraction/cameligo/cameligo.mli @@ -0,0 +1,12 @@ +[@@@warning "-45"] + +open Trace + +module CST = Cst.Cameligo +module AST = Ast_imperative +module Errors = Errors + + +val compile_expression : CST.expr -> (AST.expr, Errors.abs_error) result + +val compile_program : CST.ast -> (AST.program, Errors.abs_error) result diff --git a/src/passes/02-concrete_to_imperative/camligo.ml.old b/src/passes/03-tree_abstraction/cameligo/camligo.ml.old similarity index 100% rename from src/passes/02-concrete_to_imperative/camligo.ml.old rename to src/passes/03-tree_abstraction/cameligo/camligo.ml.old diff --git a/src/passes/02-concrete_to_imperative/cameligo.ml b/src/passes/03-tree_abstraction/cameligo/compiler.ml similarity index 99% rename from src/passes/02-concrete_to_imperative/cameligo.ml rename to src/passes/03-tree_abstraction/cameligo/compiler.ml index 2747a2fb4..5dd691fae 100644 --- a/src/passes/02-concrete_to_imperative/cameligo.ml +++ b/src/passes/03-tree_abstraction/cameligo/compiler.ml @@ -1,10 +1,10 @@ [@@@warning "-45"] -open Errors_cameligo +open Errors open Trace open Ast_imperative -module Raw = Parser.Cameligo.AST +module Raw = Cst.Cameligo module SMap = Map.String module Option = Simple_utils.Option (* TODO: move 1-parser/shared/Utils.ml{i} to Simple_utils/ *) @@ -19,7 +19,7 @@ let pseq_to_list = function | Some lst -> npseq_to_list lst let get_value : 'a Raw.reg -> 'a = fun x -> x.value -open Operators.Concrete_to_imperative.Cameligo +open Predefined.Tree_abstraction.Cameligo let r_split = Location.r_split diff --git a/src/passes/02-concrete_to_imperative/dune b/src/passes/03-tree_abstraction/cameligo/dune similarity index 53% rename from src/passes/02-concrete_to_imperative/dune rename to src/passes/03-tree_abstraction/cameligo/dune index 9c9247162..af72191ce 100644 --- a/src/passes/02-concrete_to_imperative/dune +++ b/src/passes/03-tree_abstraction/cameligo/dune @@ -1,13 +1,12 @@ (library - (name concrete_to_imperative) - (public_name ligo.concrete_to_imperative) + (name cameligo) + (public_name ligo.cameligo) (libraries simple-utils tezos-utils - parser + cst ast_imperative - operators) - (modules errors_cameligo errors_pascaligo cameligo pascaligo concrete_to_imperative) + predefined) (preprocess (pps ppx_let diff --git a/src/passes/02-concrete_to_imperative/errors_cameligo.ml b/src/passes/03-tree_abstraction/cameligo/errors.ml similarity index 92% rename from src/passes/02-concrete_to_imperative/errors_cameligo.ml rename to src/passes/03-tree_abstraction/cameligo/errors.ml index f34090187..05b407590 100644 --- a/src/passes/02-concrete_to_imperative/errors_cameligo.ml +++ b/src/passes/03-tree_abstraction/cameligo/errors.ml @@ -1,7 +1,7 @@ open Trace open Simple_utils.Display -module Raw = Parser_cameligo.AST +module Raw = Cst.Cameligo let stage = "abstracter" @@ -59,7 +59,7 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@Wrong pattern: expected %s got %s@]" Location.pp_lift (Raw.pattern_to_region actual) - (Parser_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point actual) + (Cst_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point actual) expected_name | `Concrete_cameligo_unsupported_let_in expr -> Format.fprintf f @@ -82,7 +82,7 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@The following tuple pattern is not supported yet:@\"%s\"@]" Location.pp_lift (Raw.pattern_to_region p) - (Parser_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p) + (Cst_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p) | `Concrete_cameligo_unsupported_constant_constr p -> Format.fprintf f "@[%a@Constant constructors are not supported yet@]" @@ -103,19 +103,19 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@Abstracting expression:@\"%s\"@%a@]" Location.pp_lift (Raw.expr_to_region expr) - (Parser_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr) + (Cst_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr) (error_ppformat ~display_format) err | `Concrete_cameligo_abstraction_type_tracer (te,err) -> Format.fprintf f "@[%a@Abstracting type expression:@\"%s\"@%a@]" Location.pp_lift (Raw.type_expr_to_region te) - (Parser_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point te) + (Cst_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point te) (error_ppformat ~display_format) err | `Concrete_cameligo_bad_deconstruction expr -> Format.fprintf f "@[%a@Bad tuple deconstruction \"%s\"@]" Location.pp_lift (Raw.expr_to_region expr) - (Parser_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr) + (Cst_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr) | `Concrete_cameligo_only_constructors p -> Format.fprintf f "@[%a@Currently, only constructors are supported in patterns@]" @@ -132,7 +132,7 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@Argument %s of %s must be a string singleton@]" Location.pp_lift (Raw.type_expr_to_region texpr) - (Parser_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) + (Cst_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) name | `Concrete_cameligo_michelson_type_wrong_arity (loc,name) -> Format.fprintf f @@ -158,7 +158,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_cameligo_wrong_pattern (expected_name,actual) -> let message = `String "wrong pattern" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.pattern_to_region actual) in - let actual = (Parser_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point actual) in + let actual = (Cst_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point actual) in let content = `Assoc [ ("message", message); ("location", `String loc); @@ -199,7 +199,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_cameligo_unsupported_tuple_pattern p -> let message = `String "The following tuple pattern is not supported yet" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.pattern_to_region p) in - let pattern = Parser_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p in + let pattern = Cst_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p in let content = `Assoc [ ("message", message ); ("location", `String loc); @@ -237,7 +237,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_cameligo_abstraction_tracer (expr,err) -> let message = `String "Abstracting expression" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.expr_to_region expr) in - let expr = Parser_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr in + let expr = Cst_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr in let children = error_jsonformat err in let content = `Assoc [ ("message", message ); @@ -248,7 +248,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_cameligo_abstraction_type_tracer (te,err) -> let message = `String "Abstracting type expression" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.type_expr_to_region te) in - let expr = Parser_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point te in + let expr = Cst_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point te in let children = error_jsonformat err in let content = `Assoc [ ("message", message ); @@ -259,7 +259,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_cameligo_bad_deconstruction expr -> let message = `String "Bad tuple deconstruction" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.expr_to_region expr) in - let expr = Parser_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr in + let expr = Cst_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point expr in let content = `Assoc [ ("message", message ); ("location", `String loc); @@ -291,7 +291,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> json_error ~stage ~content | `Concrete_cameligo_michelson_type_wrong (texpr,name) -> let message = Format.asprintf "Argument %s of %s must be a string singleton" - (Parser_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) name in + (Cst_cameligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) name in let loc = Format.asprintf "%a" Location.pp_lift (Raw.type_expr_to_region texpr) in let content = `Assoc [ ("message", `String message ); @@ -313,4 +313,4 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> ("message", message ); ("location", `String loc); ("children", children) ] in - json_error ~stage ~content \ No newline at end of file + json_error ~stage ~content diff --git a/src/passes/03-tree_abstraction/dune b/src/passes/03-tree_abstraction/dune new file mode 100644 index 000000000..76cc80595 --- /dev/null +++ b/src/passes/03-tree_abstraction/dune @@ -0,0 +1,11 @@ +(library + (name tree_abstraction) + (public_name ligo.tree_abstraction) + (libraries + cameligo + pascaligo) + (preprocess + (pps + ppx_let + bisect_ppx --conditional)) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils))) diff --git a/src/passes/02-concrete_to_imperative/pascaligo.ml b/src/passes/03-tree_abstraction/pascaligo/compiler.ml similarity index 99% rename from src/passes/02-concrete_to_imperative/pascaligo.ml rename to src/passes/03-tree_abstraction/pascaligo/compiler.ml index 9bce219b9..d3805389d 100644 --- a/src/passes/02-concrete_to_imperative/pascaligo.ml +++ b/src/passes/03-tree_abstraction/pascaligo/compiler.ml @@ -1,7 +1,7 @@ -open Errors_pascaligo +open Errors open Trace -module CST = Parser.Pascaligo.AST +module CST = Cst.Pascaligo module AST = Ast_imperative open AST @@ -12,7 +12,7 @@ let npseq_to_ne_list (hd, tl) = (hd, List.map snd tl) let (<@) f g x = f (g x) -open Operators.Concrete_to_imperative.Pascaligo +open Predefined.Tree_abstraction.Pascaligo let r_split = Location.r_split @@ -119,7 +119,8 @@ let compile_selection (selection : CST.selection) = let ((_,index), loc) = r_split comp in (Access_tuple index, loc) -let rec compile_expression : CST.expr -> (AST.expr , Errors_pascaligo.abs_error) result = fun e -> +let rec compile_expression : CST.expr -> (AST.expr , abs_error) result = fun e -> + let return e = ok @@ e in let compile_tuple_expression (tuple_expr : CST.tuple_expr) = let (lst, loc) = r_split tuple_expr in let%bind lst = bind_map_list compile_expression @@ npseq_to_list lst.inside in diff --git a/src/passes/03-tree_abstraction/pascaligo/dune b/src/passes/03-tree_abstraction/pascaligo/dune new file mode 100644 index 000000000..18101257f --- /dev/null +++ b/src/passes/03-tree_abstraction/pascaligo/dune @@ -0,0 +1,14 @@ +(library + (name pascaligo) + (public_name ligo.pascaligo) + (libraries + simple-utils + tezos-utils + cst + ast_imperative + predefined) + (preprocess + (pps + ppx_let + bisect_ppx --conditional)) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils))) diff --git a/src/passes/02-concrete_to_imperative/errors_pascaligo.ml b/src/passes/03-tree_abstraction/pascaligo/errors.ml similarity index 95% rename from src/passes/02-concrete_to_imperative/errors_pascaligo.ml rename to src/passes/03-tree_abstraction/pascaligo/errors.ml index 32b789496..7760ea91a 100644 --- a/src/passes/02-concrete_to_imperative/errors_pascaligo.ml +++ b/src/passes/03-tree_abstraction/pascaligo/errors.ml @@ -1,7 +1,7 @@ open Trace open Simple_utils.Display -module Raw = Parser_pascaligo.AST +module Raw = Cst.Pascaligo let stage = "abstracter" @@ -62,7 +62,7 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@The following tuple pattern is not supported yet:@\"%s\"@]" Location.pp_lift (Raw.pattern_to_region p) - (Parser_pascaligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p) + (Cst_pascaligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p) | `Concrete_pascaligo_unsupported_constant_constr p -> Format.fprintf f "@[%a@Constant constructors are not supported yet@]" @@ -97,7 +97,7 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@Argument %s of %s must be a string singleton@]" Location.pp_lift (Raw.type_expr_to_region texpr) - (Parser_pascaligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) + (Cst_pascaligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) name | `Concrete_pascaligo_michelson_type_wrong_arity (loc,name) -> Format.fprintf f @@ -108,7 +108,7 @@ let rec error_ppformat : display_format:string display_format -> Format.fprintf f "@[%a@Abstracting instruction:@\"%s\"@%a@]" Location.pp_lift (Raw.instr_to_region inst) - (Parser_pascaligo.ParserLog.instruction_to_string ~offsets:true ~mode:`Point inst) + (Cst_pascaligo.ParserLog.instruction_to_string ~offsets:true ~mode:`Point inst) (error_ppformat ~display_format) err | `Concrete_pascaligo_program_tracer (decl,err) -> Format.fprintf f @@ -161,7 +161,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_pascaligo_unsupported_tuple_pattern p -> let message = `String "The following tuple pattern is not supported yet" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.pattern_to_region p) in - let pattern = Parser_pascaligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p in + let pattern = Cst_pascaligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point p in let content = `Assoc [ ("message", message ); ("location", `String loc); @@ -223,7 +223,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> json_error ~stage ~content | `Concrete_pascaligo_michelson_type_wrong (texpr,name) -> let message = Format.asprintf "Argument %s of %s must be a string singleton" - (Parser_pascaligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) name in + (Cst_pascaligo.ParserLog.type_expr_to_string ~offsets:true ~mode:`Point texpr) name in let loc = Format.asprintf "%a" Location.pp_lift (Raw.type_expr_to_region texpr) in let content = `Assoc [ ("message", `String message ); @@ -239,7 +239,7 @@ let rec error_jsonformat : abs_error -> J.t = fun a -> | `Concrete_pascaligo_instruction_tracer (inst,err) -> let message = `String "Abstracting instruction" in let loc = Format.asprintf "%a" Location.pp_lift (Raw.instr_to_region inst) in - let expr = Parser_pascaligo.ParserLog.instruction_to_string ~offsets:true ~mode:`Point inst in + let expr = Cst_pascaligo.ParserLog.instruction_to_string ~offsets:true ~mode:`Point inst in let children = error_jsonformat err in let content = `Assoc [ ("message", message ); diff --git a/src/passes/03-tree_abstraction/pascaligo/pascaligo.ml b/src/passes/03-tree_abstraction/pascaligo/pascaligo.ml new file mode 100644 index 000000000..6c7382ac1 --- /dev/null +++ b/src/passes/03-tree_abstraction/pascaligo/pascaligo.ml @@ -0,0 +1,8 @@ +module CST = Cst.Pascaligo +module AST = Ast_imperative + +module Compiler = Compiler +module Errors = Errors + +let compile_program = Compiler.compile_program +let compile_expression = Compiler.compile_expression diff --git a/src/passes/02-concrete_to_imperative/pascaligo.mli b/src/passes/03-tree_abstraction/pascaligo/pascaligo.mli similarity index 62% rename from src/passes/02-concrete_to_imperative/pascaligo.mli rename to src/passes/03-tree_abstraction/pascaligo/pascaligo.mli index 9fecca4dc..3a296dcb0 100644 --- a/src/passes/02-concrete_to_imperative/pascaligo.mli +++ b/src/passes/03-tree_abstraction/pascaligo/pascaligo.mli @@ -1,14 +1,15 @@ (** Converts PascaLIGO programs to the Simplified Abstract Syntax Tree. *) +module CST = Cst.Pascaligo +module AST = Ast_imperative +module Errors = Errors + open Trace -module AST = Ast_imperative -module CST = Parser.Pascaligo.AST - (** Convert a concrete PascaLIGO expression AST to the imperative expression AST used by the compiler. *) -val compile_expression : CST.expr -> (AST.expr , Errors_pascaligo.abs_error) result +val compile_expression : CST.expr -> (AST.expr , Errors.abs_error) result (** Convert a concrete PascaLIGO program AST to the miperative program AST used by the compiler. *) -val compile_program : CST.ast -> (AST.program, Errors_pascaligo.abs_error) result +val compile_program : CST.ast -> (AST.program, Errors.abs_error) result diff --git a/src/passes/03-tree_abstraction/tree_abstraction.ml b/src/passes/03-tree_abstraction/tree_abstraction.ml new file mode 100644 index 000000000..846da5ab3 --- /dev/null +++ b/src/passes/03-tree_abstraction/tree_abstraction.ml @@ -0,0 +1,2 @@ +module Pascaligo = Pascaligo +module Cameligo = Cameligo diff --git a/src/passes/03-self_ast_imperative/dune b/src/passes/04-self_ast_imperative/dune similarity index 100% rename from src/passes/03-self_ast_imperative/dune rename to src/passes/04-self_ast_imperative/dune diff --git a/src/passes/03-self_ast_imperative/entrypoints_length_limit.ml b/src/passes/04-self_ast_imperative/entrypoints_length_limit.ml similarity index 100% rename from src/passes/03-self_ast_imperative/entrypoints_length_limit.ml rename to src/passes/04-self_ast_imperative/entrypoints_length_limit.ml diff --git a/src/passes/03-self_ast_imperative/errors.ml b/src/passes/04-self_ast_imperative/errors.ml similarity index 100% rename from src/passes/03-self_ast_imperative/errors.ml rename to src/passes/04-self_ast_imperative/errors.ml diff --git a/src/passes/03-self_ast_imperative/helpers.ml b/src/passes/04-self_ast_imperative/helpers.ml similarity index 100% rename from src/passes/03-self_ast_imperative/helpers.ml rename to src/passes/04-self_ast_imperative/helpers.ml diff --git a/src/passes/03-self_ast_imperative/literals.ml b/src/passes/04-self_ast_imperative/literals.ml similarity index 100% rename from src/passes/03-self_ast_imperative/literals.ml rename to src/passes/04-self_ast_imperative/literals.ml diff --git a/src/passes/03-self_ast_imperative/none_variant.ml b/src/passes/04-self_ast_imperative/none_variant.ml similarity index 100% rename from src/passes/03-self_ast_imperative/none_variant.ml rename to src/passes/04-self_ast_imperative/none_variant.ml diff --git a/src/passes/03-self_ast_imperative/self_ast_imperative.ml b/src/passes/04-self_ast_imperative/self_ast_imperative.ml similarity index 100% rename from src/passes/03-self_ast_imperative/self_ast_imperative.ml rename to src/passes/04-self_ast_imperative/self_ast_imperative.ml diff --git a/src/passes/03-self_ast_imperative/tezos_type_annotation.ml b/src/passes/04-self_ast_imperative/tezos_type_annotation.ml similarity index 100% rename from src/passes/03-self_ast_imperative/tezos_type_annotation.ml rename to src/passes/04-self_ast_imperative/tezos_type_annotation.ml diff --git a/src/passes/04-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/05-purification/compiler.ml similarity index 75% rename from src/passes/04-imperative_to_sugar/imperative_to_sugar.ml rename to src/passes/05-purification/compiler.ml index 47ce0cd9e..b0f87ef1e 100644 --- a/src/passes/04-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/05-purification/compiler.ml @@ -108,7 +108,7 @@ and restore_mutable_variable (expr : O.expression->O.expression) (free_vars : O. | Some e -> expr (ef e) -let rec compile_type_expression : I.type_expression -> (O.type_expression,Errors.imperative_to_sugar_error) result = +let rec compile_type_expression : I.type_expression -> (O.type_expression,Errors.purification_error) result = fun te -> let return tc = ok @@ O.make_t ~loc:te.location tc in match te.type_content with @@ -169,7 +169,7 @@ let rec compile_expression : I.expression -> (O.expression , _) result = let%bind e = compile_expression' e in ok @@ e None -and compile_expression' : I.expression -> (O.expression option -> O.expression, Errors.imperative_to_sugar_error) result = +and compile_expression' : I.expression -> (O.expression option -> O.expression, Errors.purification_error) result = fun e -> let return expr = ok @@ function | None -> expr @@ -298,7 +298,7 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression, let%bind w = compile_while w in ok @@ w -and compile_path : I.access list -> (O.access list, Errors.imperative_to_sugar_error) result = +and compile_path : I.access list -> (O.access list, Errors.purification_error) result = fun path -> let aux a = match a with | I.Access_record s -> ok @@ O.Access_record s @@ -316,7 +316,7 @@ and compile_lambda : I.lambda -> (O.lambda, _) result = let%bind result = compile_expression result in ok @@ O.{binder;input_type;output_type;result} -and compile_matching : I.matching -> Location.t -> (O.expression option -> O.expression, Errors.imperative_to_sugar_error) result = +and compile_matching : I.matching -> Location.t -> (O.expression option -> O.expression, Errors.purification_error) result = fun {matchee;cases} loc -> let return expr = ok @@ function | None -> expr @@ -528,185 +528,6 @@ let compile_declaration : I.declaration Location.wrap -> _ = let%bind te = compile_type_expression te in return @@ O.Declaration_type (n,te) -let compile_program : I.program -> (O.program , Errors.imperative_to_sugar_error) result = +let compile_program : I.program -> (O.program , Errors.purification_error) result = fun p -> bind_map_list compile_declaration p - -(* uncompiling *) -let rec uncompile_type_expression : O.type_expression -> (I.type_expression , Errors.imperative_to_sugar_error) result = - fun te -> - let return te = ok @@ I.make_t te in - match te.type_content with - | O.T_sum sum -> - (* This type sum could be a michelson_or as well, we could use is_michelson_or *) - let sum = I.CMap.to_kv_list sum in - let%bind sum = - bind_map_list (fun (k,v) -> - let {ctor_type;ctor_decl_pos;_} : O.ctor_content = v in - let%bind v = uncompile_type_expression ctor_type in - ok @@ (k,({ctor_type=v; ctor_decl_pos}: I.ctor_content)) - ) sum - in - return @@ I.T_sum (O.CMap.of_list sum) - | O.T_record record -> - let record = I.LMap.to_kv_list record in - let%bind record = - bind_map_list (fun (k,v) -> - let {field_type;field_decl_pos} : O.field_content = v in - let%bind v = uncompile_type_expression field_type in - ok @@ (k,({field_type=v;field_decl_pos}:I.field_content)) - ) record - in - return @@ I.T_record (O.LMap.of_list record) - | O.T_tuple tuple -> - let%bind tuple = bind_map_list uncompile_type_expression tuple in - return @@ I.T_tuple tuple - | O.T_arrow {type1;type2} -> - let%bind type1 = uncompile_type_expression type1 in - let%bind type2 = uncompile_type_expression type2 in - return @@ T_arrow {type1;type2} - | O.T_variable type_variable -> return @@ T_variable type_variable - | O.T_constant type_constant -> return @@ T_constant type_constant - | O.T_operator (type_operator, lst) -> - let%bind lst = bind_map_list uncompile_type_expression lst in - return @@ T_operator (type_operator, lst) - -let rec uncompile_expression : O.expression -> (I.expression , Errors.imperative_to_sugar_error) result = - fun e -> - let return expr = ok @@ I.make_e ~loc:e.location expr in - match e.expression_content with - O.E_literal lit -> return @@ I.E_literal lit - | O.E_constant {cons_name;arguments} -> - let%bind arguments = bind_map_list uncompile_expression arguments in - return @@ I.E_constant {cons_name;arguments} - | O.E_variable name -> return @@ I.E_variable name - | O.E_application {lamb; args} -> - let%bind lamb = uncompile_expression lamb in - let%bind args = uncompile_expression args in - return @@ I.E_application {lamb; args} - | O.E_lambda lambda -> - let%bind lambda = uncompile_lambda lambda in - return @@ I.E_lambda lambda - | O.E_recursive {fun_name;fun_type;lambda} -> - let%bind fun_type = uncompile_type_expression fun_type in - let%bind lambda = uncompile_lambda lambda in - return @@ I.E_recursive {fun_name;fun_type;lambda} - | O.E_let_in {let_binder;inline;rhs;let_result} -> - let (binder,ty_opt) = let_binder in - let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in - let%bind rhs = uncompile_expression rhs in - let%bind let_result = uncompile_expression let_result in - return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} - | O.E_raw_code {language;code} -> - let%bind code = uncompile_expression code in - return @@ I.E_raw_code {language;code} - | O.E_constructor {constructor;element} -> - let%bind element = uncompile_expression element in - return @@ I.E_constructor {constructor;element} - | O.E_matching {matchee; cases} -> - let%bind matchee = uncompile_expression matchee in - let%bind cases = uncompile_matching cases in - return @@ I.E_matching {matchee;cases} - | O.E_record record -> - let record = I.LMap.to_kv_list record in - let%bind record = - bind_map_list (fun (k,v) -> - let%bind v = uncompile_expression v in - ok @@ (k,v) - ) record - in - return @@ I.E_record (O.LMap.of_list record) - | O.E_accessor {record;path} -> - let%bind record = uncompile_expression record in - let%bind path = uncompile_path path in - return @@ I.E_accessor {record;path} - | O.E_update {record;path;update} -> - let%bind record = uncompile_expression record in - let%bind path = uncompile_path path in - let%bind update = uncompile_expression update in - return @@ I.E_update {record;path;update} - | O.E_tuple tuple -> - let%bind tuple = bind_map_list uncompile_expression tuple in - return @@ I.E_tuple tuple - | O.E_map map -> - let%bind map = bind_map_list ( - bind_map_pair uncompile_expression - ) map - in - return @@ I.E_map map - | O.E_big_map big_map -> - let%bind big_map = bind_map_list ( - bind_map_pair uncompile_expression - ) big_map - in - return @@ I.E_big_map big_map - | O.E_list lst -> - let%bind lst = bind_map_list uncompile_expression lst in - return @@ I.E_list lst - | O.E_set set -> - let%bind set = bind_map_list uncompile_expression set in - return @@ I.E_set set - | O.E_ascription {anno_expr; type_annotation} -> - let%bind anno_expr = uncompile_expression anno_expr in - let%bind type_annotation = uncompile_type_expression type_annotation in - return @@ I.E_ascription {anno_expr; type_annotation} - | O.E_cond {condition;then_clause;else_clause} -> - let%bind condition = uncompile_expression condition in - let%bind then_clause = uncompile_expression then_clause in - let%bind else_clause = uncompile_expression else_clause in - return @@ I.E_cond {condition; then_clause; else_clause} - | O.E_sequence {expr1; expr2} -> - let%bind expr1 = uncompile_expression expr1 in - let%bind expr2 = uncompile_expression expr2 in - return @@ I.E_sequence {expr1; expr2} - | O.E_skip -> return @@ I.E_skip - -and uncompile_path : O.access list -> (I.access list, Errors.imperative_to_sugar_error) result = - fun path -> let aux a = match a with - | O.Access_record s -> ok @@ I.Access_record s - | O.Access_tuple i -> ok @@ I.Access_tuple i - | O.Access_map e -> - let%bind e = uncompile_expression e in - ok @@ I.Access_map e - in - bind_map_list aux path - -and uncompile_lambda : O.lambda -> (I.lambda , Errors.imperative_to_sugar_error) result = - fun {binder;input_type;output_type;result}-> - let%bind input_type = bind_map_option uncompile_type_expression input_type in - let%bind output_type = bind_map_option uncompile_type_expression output_type in - let%bind result = uncompile_expression result in - ok @@ I.{binder;input_type;output_type;result} -and uncompile_matching : O.matching_expr -> (I.matching_expr , Errors.imperative_to_sugar_error) result = - fun m -> - match m with - | O.Match_list {match_nil;match_cons} -> - let%bind match_nil = uncompile_expression match_nil in - let (hd,tl,expr) = match_cons in - let%bind expr = uncompile_expression expr in - ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)} - | O.Match_option {match_none;match_some} -> - let%bind match_none = uncompile_expression match_none in - let (n,expr) = match_some in - let%bind expr = uncompile_expression expr in - ok @@ I.Match_option {match_none; match_some=(n,expr)} - | O.Match_variant lst -> - let%bind lst = bind_map_list ( - fun ((c,n),expr) -> - let%bind expr = uncompile_expression expr in - ok @@ ((c,n),expr) - ) lst - in - ok @@ I.Match_variant lst - | O.Match_record (lst,ty_opt,expr) -> - let%bind expr = uncompile_expression expr in - let%bind ty_opt = bind_map_option (bind_map_list uncompile_type_expression) ty_opt in - ok @@ I.Match_record (lst,ty_opt,expr) - | O.Match_tuple (lst,ty_opt,expr) -> - let%bind expr = uncompile_expression expr in - let%bind ty_opt = bind_map_option (bind_map_list uncompile_type_expression) ty_opt in - ok @@ I.Match_tuple (lst,ty_opt,expr) - | O.Match_variable (lst,ty_opt,expr) -> - let%bind expr = uncompile_expression expr in - let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in - ok @@ I.Match_variable (lst,ty_opt,expr) diff --git a/src/passes/05-purification/decompiler.ml b/src/passes/05-purification/decompiler.ml new file mode 100644 index 000000000..9ba70453b --- /dev/null +++ b/src/passes/05-purification/decompiler.ml @@ -0,0 +1,197 @@ + +module Errors = Errors +module I = Ast_imperative +module O = Ast_sugar +open Trace + +let rec decompile_type_expression : O.type_expression -> (I.type_expression, Errors.purification_error) result = + fun te -> + let return te = ok @@ I.make_t te in + match te.type_content with + | O.T_sum sum -> + (* This type sum could be a michelson_or as well, we could use is_michelson_or *) + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let {ctor_type;ctor_decl_pos;_} : O.ctor_content = v in + let%bind v = decompile_type_expression ctor_type in + ok @@ (k,({ctor_type=v; ctor_decl_pos}: I.ctor_content)) + ) sum + in + return @@ I.T_sum (O.CMap.of_list sum) + | O.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let {field_type;field_decl_pos} : O.field_content = v in + let%bind v = decompile_type_expression field_type in + ok @@ (k,({field_type=v;field_decl_pos}:I.field_content)) + ) record + in + return @@ I.T_record (O.LMap.of_list record) + | O.T_tuple tuple -> + let%bind tuple = bind_map_list decompile_type_expression tuple in + return @@ I.T_tuple tuple + | O.T_arrow {type1;type2} -> + let%bind type1 = decompile_type_expression type1 in + let%bind type2 = decompile_type_expression type2 in + return @@ T_arrow {type1;type2} + | O.T_variable type_variable -> return @@ T_variable type_variable + | O.T_constant type_constant -> return @@ T_constant type_constant + | O.T_operator (type_operator, lst) -> + let%bind lst = bind_map_list decompile_type_expression lst in + return @@ T_operator (type_operator, lst) + +let rec decompile_expression : O.expression -> (I.expression, Errors.purification_error) result = + fun e -> + let return expr = ok @@ I.make_e ~loc:e.location expr in + match e.expression_content with + O.E_literal lit -> return @@ I.E_literal lit + | O.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list decompile_expression arguments in + return @@ I.E_constant {cons_name;arguments} + | O.E_variable name -> return @@ I.E_variable name + | O.E_application {lamb; args} -> + let%bind lamb = decompile_expression lamb in + let%bind args = decompile_expression args in + return @@ I.E_application {lamb; args} + | O.E_lambda lambda -> + let%bind lambda = decompile_lambda lambda in + return @@ I.E_lambda lambda + | O.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = decompile_type_expression fun_type in + let%bind lambda = decompile_lambda lambda in + return @@ I.E_recursive {fun_name;fun_type;lambda} + | O.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option decompile_type_expression ty_opt in + let%bind rhs = decompile_expression rhs in + let%bind let_result = decompile_expression let_result in + return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} + | O.E_raw_code {language;code} -> + let%bind code = decompile_expression code in + return @@ I.E_raw_code {language;code} + | O.E_constructor {constructor;element} -> + let%bind element = decompile_expression element in + return @@ I.E_constructor {constructor;element} + | O.E_matching {matchee; cases} -> + let%bind matchee = decompile_expression matchee in + let%bind cases = decompile_matching cases in + return @@ I.E_matching {matchee;cases} + | O.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = decompile_expression v in + ok @@ (k,v) + ) record + in + return @@ I.E_record (O.LMap.of_list record) + | O.E_accessor {record;path} -> + let%bind record = decompile_expression record in + let%bind path = decompile_path path in + return @@ I.E_accessor {record;path} + | O.E_update {record;path;update} -> + let%bind record = decompile_expression record in + let%bind path = decompile_path path in + let%bind update = decompile_expression update in + return @@ I.E_update {record;path;update} + | O.E_tuple tuple -> + let%bind tuple = bind_map_list decompile_expression tuple in + return @@ I.E_tuple tuple + | O.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair decompile_expression + ) map + in + return @@ I.E_map map + | O.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair decompile_expression + ) big_map + in + return @@ I.E_big_map big_map + | O.E_list lst -> + let%bind lst = bind_map_list decompile_expression lst in + return @@ I.E_list lst + | O.E_set set -> + let%bind set = bind_map_list decompile_expression set in + return @@ I.E_set set + | O.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = decompile_expression anno_expr in + let%bind type_annotation = decompile_type_expression type_annotation in + return @@ I.E_ascription {anno_expr; type_annotation} + | O.E_cond {condition;then_clause;else_clause} -> + let%bind condition = decompile_expression condition in + let%bind then_clause = decompile_expression then_clause in + let%bind else_clause = decompile_expression else_clause in + return @@ I.E_cond {condition; then_clause; else_clause} + | O.E_sequence {expr1; expr2} -> + let%bind expr1 = decompile_expression expr1 in + let%bind expr2 = decompile_expression expr2 in + return @@ I.E_sequence {expr1; expr2} + | O.E_skip -> return @@ I.E_skip + +and decompile_path : O.access list -> (I.access list, Errors.purification_error) result = + fun path -> let aux a = match a with + | O.Access_record s -> ok @@ I.Access_record s + | O.Access_tuple i -> ok @@ I.Access_tuple i + | O.Access_map e -> + let%bind e = decompile_expression e in + ok @@ I.Access_map e + in + bind_map_list aux path + +and decompile_lambda : O.lambda -> (I.lambda, Errors.purification_error) result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option decompile_type_expression input_type in + let%bind output_type = bind_map_option decompile_type_expression output_type in + let%bind result = decompile_expression result in + ok @@ I.{binder;input_type;output_type;result} +and decompile_matching : O.matching_expr -> (I.matching_expr, Errors.purification_error) result = + fun m -> + match m with + | O.Match_list {match_nil;match_cons} -> + let%bind match_nil = decompile_expression match_nil in + let (hd,tl,expr) = match_cons in + let%bind expr = decompile_expression expr in + ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)} + | O.Match_option {match_none;match_some} -> + let%bind match_none = decompile_expression match_none in + let (n,expr) = match_some in + let%bind expr = decompile_expression expr in + ok @@ I.Match_option {match_none; match_some=(n,expr)} + | O.Match_variant lst -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = decompile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ I.Match_variant lst + | O.Match_record (lst,ty_opt,expr) -> + let%bind expr = decompile_expression expr in + let%bind ty_opt = bind_map_option (bind_map_list decompile_type_expression) ty_opt in + ok @@ I.Match_record (lst,ty_opt,expr) + | O.Match_tuple (lst,ty_opt,expr) -> + let%bind expr = decompile_expression expr in + let%bind ty_opt = bind_map_option (bind_map_list decompile_type_expression) ty_opt in + ok @@ I.Match_tuple (lst,ty_opt,expr) + | O.Match_variable (lst,ty_opt,expr) -> + let%bind expr = decompile_expression expr in + let%bind ty_opt = bind_map_option decompile_type_expression ty_opt in + ok @@ I.Match_variable (lst,ty_opt,expr) + +let decompile_declaration : O.declaration Location.wrap -> _ result = fun {wrap_content=declaration;location} -> + let return decl = ok @@ Location.wrap ~loc:location decl in + match declaration with + | O.Declaration_constant (n, te_opt, inline, expr) -> + let%bind expr = decompile_expression expr in + let%bind te_opt = bind_map_option decompile_type_expression te_opt in + return @@ I.Declaration_constant (n, te_opt, inline, expr) + | O.Declaration_type (n, te) -> + let%bind te = decompile_type_expression te in + return @@ I.Declaration_type (n,te) + +let decompile_program : O.program -> (I.program, Errors.purification_error) result = fun prg -> + bind_map_list decompile_declaration prg diff --git a/src/passes/04-imperative_to_sugar/dune b/src/passes/05-purification/dune similarity index 78% rename from src/passes/04-imperative_to_sugar/dune rename to src/passes/05-purification/dune index 66f996558..870e2dbf8 100644 --- a/src/passes/04-imperative_to_sugar/dune +++ b/src/passes/05-purification/dune @@ -1,6 +1,6 @@ (library - (name imperative_to_sugar) - (public_name ligo.imperative_to_sugar) + (name purification) + (public_name ligo.purification) (libraries simple-utils ast_imperative diff --git a/src/passes/04-imperative_to_sugar/errors.ml b/src/passes/05-purification/errors.ml similarity index 58% rename from src/passes/04-imperative_to_sugar/errors.ml rename to src/passes/05-purification/errors.ml index 983fea9ef..d24057d6a 100644 --- a/src/passes/04-imperative_to_sugar/errors.ml +++ b/src/passes/05-purification/errors.ml @@ -1,27 +1,27 @@ open Trace open Simple_utils.Display -let stage = "imperative_to_sugar" +let stage = "purification" -type imperative_to_sugar_error = [ - | `Imperative_to_sugar_corner_case of string +type purification_error = [ + | `purification_corner_case of string ] -let corner_case s = `Imperative_to_sugar_corner_case s +let corner_case s = `purification_corner_case s let error_ppformat : display_format:string display_format -> - Format.formatter -> imperative_to_sugar_error -> unit = + Format.formatter -> purification_error -> unit = fun ~display_format f a -> match display_format with | Human_readable | Dev -> ( match a with - | `Imperative_to_sugar_corner_case s -> + | `purification_corner_case s -> Format.fprintf f "@[Corner case: %s@]" s ) -let error_jsonformat : imperative_to_sugar_error -> J.t = fun a -> +let error_jsonformat : purification_error -> J.t = fun a -> let json_error ~stage ~content = `Assoc [ ("status", `String "error") ; @@ -29,10 +29,10 @@ let error_jsonformat : imperative_to_sugar_error -> J.t = fun a -> ("content", content )] in match a with - | `Imperative_to_sugar_corner_case s -> + | `purification_corner_case s -> let message = `String "corner case" in let content = `Assoc [ ("message", message); ("value", `String s) ] in - json_error ~stage ~content \ No newline at end of file + json_error ~stage ~content diff --git a/src/passes/05-purification/purification.ml b/src/passes/05-purification/purification.ml new file mode 100644 index 000000000..0d2dc55a5 --- /dev/null +++ b/src/passes/05-purification/purification.ml @@ -0,0 +1,10 @@ +module Errors = Errors +module Compiler = Compiler +module Decompiler = Decompiler + +let compile_program = Compiler.compile_program +let compile_expression = Compiler.compile_expression + + +let decompile_program = Decompiler.decompile_program +let decompile_expression = Decompiler.decompile_expression diff --git a/src/passes/05-self_ast_sugar/dune b/src/passes/06-self_ast_sugar/dune similarity index 100% rename from src/passes/05-self_ast_sugar/dune rename to src/passes/06-self_ast_sugar/dune diff --git a/src/passes/05-self_ast_sugar/helpers.ml b/src/passes/06-self_ast_sugar/helpers.ml similarity index 100% rename from src/passes/05-self_ast_sugar/helpers.ml rename to src/passes/06-self_ast_sugar/helpers.ml diff --git a/src/passes/05-self_ast_sugar/self_ast_sugar.ml b/src/passes/06-self_ast_sugar/self_ast_sugar.ml similarity index 100% rename from src/passes/05-self_ast_sugar/self_ast_sugar.ml rename to src/passes/06-self_ast_sugar/self_ast_sugar.ml diff --git a/src/passes/06-sugar_to_core/sugar_to_core.ml b/src/passes/07-desugaring/compiler.ml similarity index 65% rename from src/passes/06-sugar_to_core/sugar_to_core.ml rename to src/passes/07-desugaring/compiler.ml index de1e9f3b7..58fbd38de 100644 --- a/src/passes/06-sugar_to_core/sugar_to_core.ml +++ b/src/passes/07-desugaring/compiler.ml @@ -2,12 +2,9 @@ module I = Ast_sugar module O = Ast_core open Trace -module Errors = struct - type sugar_to_core_error = [] -end open Errors -let rec compile_type_expression : I.type_expression -> (O.type_expression , sugar_to_core_error) result = +let rec compile_type_expression : I.type_expression -> (O.type_expression , desugaring_error) result = fun te -> let return tc = ok @@ O.make_t ~loc:te.location tc in match te.type_content with @@ -50,7 +47,7 @@ let rec compile_type_expression : I.type_expression -> (O.type_expression , suga let%bind lst = bind_map_list compile_type_expression lst in return @@ T_operator (type_operator, lst) -let rec compile_expression : I.expression -> (O.expression , sugar_to_core_error) result = +let rec compile_expression : I.expression -> (O.expression , desugaring_error) result = fun e -> let return expr = ok @@ O.make_e ~loc:e.location expr in match e.expression_content with @@ -188,13 +185,13 @@ let rec compile_expression : I.expression -> (O.expression , sugar_to_core_error let m = O.LMap.of_list lst in return @@ O.E_record m -and compile_lambda : I.lambda -> (O.lambda , sugar_to_core_error) result = +and compile_lambda : I.lambda -> (O.lambda , desugaring_error) result = fun {binder;input_type;output_type;result}-> let%bind input_type = bind_map_option compile_type_expression input_type in let%bind output_type = bind_map_option compile_type_expression output_type in let%bind result = compile_expression result in ok @@ O.{binder;input_type;output_type;result} -and compile_matching : Location.t -> O.expression -> I.matching_expr -> (O.expression, sugar_to_core_error) result = +and compile_matching : Location.t -> O.expression -> I.matching_expr -> (O.expression, desugaring_error) result = fun loc e m -> match m with | I.Match_list {match_nil;match_cons} -> @@ -265,134 +262,6 @@ let compile_declaration : I.declaration Location.wrap -> _ = let%bind te = compile_type_expression te in return @@ O.Declaration_type (n,te) -let compile_program : I.program -> (O.program , sugar_to_core_error) result = +let compile_program : I.program -> (O.program , desugaring_error) result = fun p -> bind_map_list compile_declaration p - -(* uncompiling *) -let rec uncompile_type_expression : O.type_expression -> (I.type_expression , sugar_to_core_error) result = - fun te -> - let return te = ok @@ I.make_t te in - match te.type_content with - | O.T_sum sum -> - let sum = I.CMap.to_kv_list sum in - let%bind sum = - bind_map_list (fun (k,v) -> - let {ctor_type;michelson_annotation;ctor_decl_pos} : O.ctor_content = v in - let%bind ctor_type = uncompile_type_expression ctor_type in - let v' : I.ctor_content = {ctor_type;michelson_annotation;ctor_decl_pos} in - ok @@ (k,v') - ) sum - in - return @@ I.T_sum (O.CMap.of_list sum) - | O.T_record record -> - let record = I.LMap.to_kv_list record in - let%bind record = - bind_map_list (fun (k,v) -> - let {field_type;field_annotation;field_decl_pos} : O.field_content = v in - let%bind field_type = uncompile_type_expression field_type in - let v' : I.field_content = {field_type ; michelson_annotation=field_annotation ; field_decl_pos} in - ok @@ (k,v') - ) record - in - return @@ I.T_record (O.LMap.of_list record) - | O.T_arrow {type1;type2} -> - let%bind type1 = uncompile_type_expression type1 in - let%bind type2 = uncompile_type_expression type2 in - return @@ T_arrow {type1;type2} - | O.T_variable type_variable -> return @@ T_variable type_variable - | O.T_constant type_constant -> return @@ T_constant type_constant - | O.T_operator (type_operator, lst) -> - let%bind lst = bind_map_list uncompile_type_expression lst in - return @@ T_operator (type_operator, lst) - -let rec uncompile_expression : O.expression -> (I.expression , sugar_to_core_error) result = - fun e -> - let return expr = ok @@ I.make_e ~loc:e.location expr in - match e.expression_content with - O.E_literal lit -> return @@ I.E_literal lit - | O.E_constant {cons_name;arguments} -> - let%bind arguments = bind_map_list uncompile_expression arguments in - return @@ I.E_constant {cons_name;arguments} - | O.E_variable name -> return @@ I.E_variable name - | O.E_application {lamb; args} -> - let%bind lamb = uncompile_expression lamb in - let%bind args = uncompile_expression args in - return @@ I.E_application {lamb; args} - | O.E_lambda lambda -> - let%bind lambda = uncompile_lambda lambda in - return @@ I.E_lambda lambda - | O.E_recursive {fun_name;fun_type;lambda} -> - let%bind fun_type = uncompile_type_expression fun_type in - let%bind lambda = uncompile_lambda lambda in - return @@ I.E_recursive {fun_name;fun_type;lambda} - | O.E_let_in {let_binder;inline=false;rhs=expr1;let_result=expr2} when let_binder = (Var.of_name "_", Some (O.t_unit ())) -> - let%bind expr1 = uncompile_expression expr1 in - let%bind expr2 = uncompile_expression expr2 in - return @@ I.E_sequence {expr1;expr2} - | O.E_let_in {let_binder;inline;rhs;let_result} -> - let (binder,ty_opt) = let_binder in - let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in - let%bind rhs = uncompile_expression rhs in - let%bind let_result = uncompile_expression let_result in - return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result} - | O.E_raw_code {language;code} -> - let%bind code = uncompile_expression code in - return @@ I.E_raw_code {language;code} - | O.E_constructor {constructor;element} -> - let%bind element = uncompile_expression element in - return @@ I.E_constructor {constructor;element} - | O.E_matching {matchee; cases} -> - let%bind matchee = uncompile_expression matchee in - let%bind cases = uncompile_matching cases in - return @@ I.E_matching {matchee;cases} - | O.E_record record -> - let record = I.LMap.to_kv_list record in - let%bind record = - bind_map_list (fun (k,v) -> - let%bind v = uncompile_expression v in - ok @@ (k,v) - ) record - in - return @@ I.E_record (O.LMap.of_list record) - | O.E_record_accessor {record;path} -> - let%bind record = uncompile_expression record in - let Label path = path in - return @@ I.E_accessor {record;path=[I.Access_record path]} - | O.E_record_update {record;path;update} -> - let%bind record = uncompile_expression record in - let%bind update = uncompile_expression update in - let Label path = path in - return @@ I.E_update {record;path=[I.Access_record path];update} - | O.E_ascription {anno_expr; type_annotation} -> - let%bind anno_expr = uncompile_expression anno_expr in - let%bind type_annotation = uncompile_type_expression type_annotation in - return @@ I.E_ascription {anno_expr; type_annotation} - -and uncompile_lambda : O.lambda -> (I.lambda , sugar_to_core_error) result = - fun {binder;input_type;output_type;result}-> - let%bind input_type = bind_map_option uncompile_type_expression input_type in - let%bind output_type = bind_map_option uncompile_type_expression output_type in - let%bind result = uncompile_expression result in - ok @@ I.{binder;input_type;output_type;result} -and uncompile_matching : O.matching_expr -> (I.matching_expr , sugar_to_core_error) result = - fun m -> - match m with - | O.Match_list {match_nil;match_cons} -> - let%bind match_nil = uncompile_expression match_nil in - let (hd,tl,expr) = match_cons in - let%bind expr = uncompile_expression expr in - ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)} - | O.Match_option {match_none;match_some} -> - let%bind match_none = uncompile_expression match_none in - let (n,expr) = match_some in - let%bind expr = uncompile_expression expr in - ok @@ I.Match_option {match_none; match_some=(n,expr)} - | O.Match_variant lst -> - let%bind lst = bind_map_list ( - fun ((c,n),expr) -> - let%bind expr = uncompile_expression expr in - ok @@ ((c,n),expr) - ) lst - in - ok @@ I.Match_variant lst diff --git a/src/passes/07-desugaring/decompiler.ml b/src/passes/07-desugaring/decompiler.ml new file mode 100644 index 000000000..7dfcdb514 --- /dev/null +++ b/src/passes/07-desugaring/decompiler.ml @@ -0,0 +1,146 @@ +module I = Ast_sugar +module O = Ast_core + +open Trace +open Errors + +let rec decompile_type_expression : O.type_expression -> (I.type_expression, desugaring_error) result = + fun te -> + let return te = ok @@ I.make_t te in + match te.type_content with + | O.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let {ctor_type;michelson_annotation;ctor_decl_pos} : O.ctor_content = v in + let%bind ctor_type = decompile_type_expression ctor_type in + let v' : I.ctor_content = {ctor_type;michelson_annotation;ctor_decl_pos} in + ok @@ (k,v') + ) sum + in + return @@ I.T_sum (O.CMap.of_list sum) + | O.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let {field_type;field_annotation;field_decl_pos} : O.field_content = v in + let%bind field_type = decompile_type_expression field_type in + let v' : I.field_content = {field_type ; michelson_annotation=field_annotation ; field_decl_pos} in + ok @@ (k,v') + ) record + in + return @@ I.T_record (O.LMap.of_list record) + | O.T_arrow {type1;type2} -> + let%bind type1 = decompile_type_expression type1 in + let%bind type2 = decompile_type_expression type2 in + return @@ T_arrow {type1;type2} + | O.T_variable type_variable -> return @@ T_variable type_variable + | O.T_constant type_constant -> return @@ T_constant type_constant + | O.T_operator (type_operator, lst) -> + let%bind lst = bind_map_list decompile_type_expression lst in + return @@ T_operator (type_operator, lst) + +let rec decompile_expression : O.expression -> (I.expression, desugaring_error) result = + fun e -> + let return expr = ok @@ I.make_e ~loc:e.location expr in + match e.expression_content with + O.E_literal lit -> return @@ I.E_literal lit + | O.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list decompile_expression arguments in + return @@ I.E_constant {cons_name;arguments} + | O.E_variable name -> return @@ I.E_variable name + | O.E_application {lamb; args} -> + let%bind lamb = decompile_expression lamb in + let%bind args = decompile_expression args in + return @@ I.E_application {lamb; args} + | O.E_lambda lambda -> + let%bind lambda = decompile_lambda lambda in + return @@ I.E_lambda lambda + | O.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = decompile_type_expression fun_type in + let%bind lambda = decompile_lambda lambda in + return @@ I.E_recursive {fun_name;fun_type;lambda} + | O.E_let_in {let_binder;inline=false;rhs=expr1;let_result=expr2} when let_binder = (Var.of_name "_", Some (O.t_unit ())) -> + let%bind expr1 = decompile_expression expr1 in + let%bind expr2 = decompile_expression expr2 in + return @@ I.E_sequence {expr1;expr2} + | O.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option decompile_type_expression ty_opt in + let%bind rhs = decompile_expression rhs in + let%bind let_result = decompile_expression let_result in + return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result} + | O.E_raw_code {language;code} -> + let%bind code = decompile_expression code in + return @@ I.E_raw_code {language;code} + | O.E_constructor {constructor;element} -> + let%bind element = decompile_expression element in + return @@ I.E_constructor {constructor;element} + | O.E_matching {matchee; cases} -> + let%bind matchee = decompile_expression matchee in + let%bind cases = decompile_matching cases in + return @@ I.E_matching {matchee;cases} + | O.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = decompile_expression v in + ok @@ (k,v) + ) record + in + return @@ I.E_record (O.LMap.of_list record) + | O.E_record_accessor {record;path} -> + let%bind record = decompile_expression record in + let Label path = path in + return @@ I.E_accessor {record;path=[I.Access_record path]} + | O.E_record_update {record;path;update} -> + let%bind record = decompile_expression record in + let%bind update = decompile_expression update in + let Label path = path in + return @@ I.E_update {record;path=[I.Access_record path];update} + | O.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = decompile_expression anno_expr in + let%bind type_annotation = decompile_type_expression type_annotation in + return @@ I.E_ascription {anno_expr; type_annotation} + +and decompile_lambda : O.lambda -> (I.lambda, desugaring_error) result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option decompile_type_expression input_type in + let%bind output_type = bind_map_option decompile_type_expression output_type in + let%bind result = decompile_expression result in + ok @@ I.{binder;input_type;output_type;result} +and decompile_matching : O.matching_expr -> (I.matching_expr, desugaring_error) result = + fun m -> + match m with + | O.Match_list {match_nil;match_cons} -> + let%bind match_nil = decompile_expression match_nil in + let (hd,tl,expr) = match_cons in + let%bind expr = decompile_expression expr in + ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)} + | O.Match_option {match_none;match_some} -> + let%bind match_none = decompile_expression match_none in + let (n,expr) = match_some in + let%bind expr = decompile_expression expr in + ok @@ I.Match_option {match_none; match_some=(n,expr)} + | O.Match_variant lst -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = decompile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ I.Match_variant lst + +let decompile_declaration : O.declaration Location.wrap -> _ result = fun {wrap_content=declaration;location} -> + let return decl = ok @@ Location.wrap ~loc:location decl in + match declaration with + | O.Declaration_constant (n, te_opt, inline, expr) -> + let%bind expr = decompile_expression expr in + let%bind te_opt = bind_map_option decompile_type_expression te_opt in + return @@ I.Declaration_constant (n, te_opt, inline, expr) + | O.Declaration_type (n, te) -> + let%bind te = decompile_type_expression te in + return @@ I.Declaration_type (n,te) + +let decompile_program : O.program -> (I.program, desugaring_error) result = fun prg -> + bind_map_list decompile_declaration prg diff --git a/src/passes/07-desugaring/desugaring.ml b/src/passes/07-desugaring/desugaring.ml new file mode 100644 index 000000000..d590323b8 --- /dev/null +++ b/src/passes/07-desugaring/desugaring.ml @@ -0,0 +1,10 @@ +module Compiler = Compiler +module Decompiler = Decompiler +module Errors = Errors + +let compile_program = Compiler.compile_program +let compile_expression = Compiler.compile_expression + + +let decompile_program = Decompiler.decompile_program +let decompile_expression = Decompiler.decompile_expression diff --git a/src/passes/06-sugar_to_core/dune b/src/passes/07-desugaring/dune similarity index 80% rename from src/passes/06-sugar_to_core/dune rename to src/passes/07-desugaring/dune index 4f4bb92e9..3d02bff23 100644 --- a/src/passes/06-sugar_to_core/dune +++ b/src/passes/07-desugaring/dune @@ -1,6 +1,6 @@ (library - (name sugar_to_core) - (public_name ligo.sugar_to_core) + (name desugaring) + (public_name ligo.desugaring) (libraries simple-utils ast_sugar diff --git a/src/passes/07-desugaring/errors.ml b/src/passes/07-desugaring/errors.ml new file mode 100644 index 000000000..0c44e9e31 --- /dev/null +++ b/src/passes/07-desugaring/errors.ml @@ -0,0 +1 @@ +type desugaring_error = [] diff --git a/src/passes/07-self_ast_core/dune b/src/passes/08-self_ast_core/dune similarity index 100% rename from src/passes/07-self_ast_core/dune rename to src/passes/08-self_ast_core/dune diff --git a/src/passes/07-self_ast_core/helpers.ml b/src/passes/08-self_ast_core/helpers.ml similarity index 100% rename from src/passes/07-self_ast_core/helpers.ml rename to src/passes/08-self_ast_core/helpers.ml diff --git a/src/passes/07-self_ast_core/self_ast_core.ml b/src/passes/08-self_ast_core/self_ast_core.ml similarity index 100% rename from src/passes/07-self_ast_core/self_ast_core.ml rename to src/passes/08-self_ast_core/self_ast_core.ml diff --git a/src/passes/08-typer-common/constant_typers.ml b/src/passes/09-typing/08-typer-common/constant_typers.ml similarity index 100% rename from src/passes/08-typer-common/constant_typers.ml rename to src/passes/09-typing/08-typer-common/constant_typers.ml diff --git a/src/passes/08-typer-common/constant_typers_new.ml b/src/passes/09-typing/08-typer-common/constant_typers_new.ml similarity index 100% rename from src/passes/08-typer-common/constant_typers_new.ml rename to src/passes/09-typing/08-typer-common/constant_typers_new.ml diff --git a/src/passes/08-typer-common/dune b/src/passes/09-typing/08-typer-common/dune similarity index 100% rename from src/passes/08-typer-common/dune rename to src/passes/09-typing/08-typer-common/dune diff --git a/src/passes/08-typer-common/errors.ml b/src/passes/09-typing/08-typer-common/errors.ml similarity index 100% rename from src/passes/08-typer-common/errors.ml rename to src/passes/09-typing/08-typer-common/errors.ml diff --git a/src/passes/08-typer-common/helpers.ml b/src/passes/09-typing/08-typer-common/helpers.ml similarity index 100% rename from src/passes/08-typer-common/helpers.ml rename to src/passes/09-typing/08-typer-common/helpers.ml diff --git a/src/passes/08-typer-common/michelson_type_converter.ml b/src/passes/09-typing/08-typer-common/michelson_type_converter.ml similarity index 100% rename from src/passes/08-typer-common/michelson_type_converter.ml rename to src/passes/09-typing/08-typer-common/michelson_type_converter.ml diff --git a/src/passes/08-typer-common/typer_common.ml b/src/passes/09-typing/08-typer-common/typer_common.ml similarity index 100% rename from src/passes/08-typer-common/typer_common.ml rename to src/passes/09-typing/08-typer-common/typer_common.ml diff --git a/src/passes/08-typer-new/PP.ml b/src/passes/09-typing/08-typer-new/PP.ml similarity index 100% rename from src/passes/08-typer-new/PP.ml rename to src/passes/09-typing/08-typer-new/PP.ml diff --git a/src/passes/08-typer-new/README b/src/passes/09-typing/08-typer-new/README similarity index 100% rename from src/passes/08-typer-new/README rename to src/passes/09-typing/08-typer-new/README diff --git a/src/passes/08-typer-new/constraint_databases.ml b/src/passes/09-typing/08-typer-new/constraint_databases.ml similarity index 100% rename from src/passes/08-typer-new/constraint_databases.ml rename to src/passes/09-typing/08-typer-new/constraint_databases.ml diff --git a/src/passes/08-typer-new/dune b/src/passes/09-typing/08-typer-new/dune similarity index 95% rename from src/passes/08-typer-new/dune rename to src/passes/09-typing/08-typer-new/dune index af5327e8f..4b2e80840 100644 --- a/src/passes/08-typer-new/dune +++ b/src/passes/09-typing/08-typer-new/dune @@ -6,7 +6,7 @@ tezos-utils ast_core ast_typed - operators + predefined UnionFind environment typer_common diff --git a/src/passes/08-typer-new/heuristic_break_ctor.ml b/src/passes/09-typing/08-typer-new/heuristic_break_ctor.ml similarity index 100% rename from src/passes/08-typer-new/heuristic_break_ctor.ml rename to src/passes/09-typing/08-typer-new/heuristic_break_ctor.ml diff --git a/src/passes/08-typer-new/heuristic_specialize1.ml b/src/passes/09-typing/08-typer-new/heuristic_specialize1.ml similarity index 100% rename from src/passes/08-typer-new/heuristic_specialize1.ml rename to src/passes/09-typing/08-typer-new/heuristic_specialize1.ml diff --git a/src/passes/08-typer-new/normalizer.ml b/src/passes/09-typing/08-typer-new/normalizer.ml similarity index 100% rename from src/passes/08-typer-new/normalizer.ml rename to src/passes/09-typing/08-typer-new/normalizer.ml diff --git a/src/passes/08-typer-new/solver.ml b/src/passes/09-typing/08-typer-new/solver.ml similarity index 100% rename from src/passes/08-typer-new/solver.ml rename to src/passes/09-typing/08-typer-new/solver.ml diff --git a/src/passes/08-typer-new/solver_should_be_generated.ml b/src/passes/09-typing/08-typer-new/solver_should_be_generated.ml similarity index 100% rename from src/passes/08-typer-new/solver_should_be_generated.ml rename to src/passes/09-typing/08-typer-new/solver_should_be_generated.ml diff --git a/src/passes/08-typer-new/solver_types.ml b/src/passes/09-typing/08-typer-new/solver_types.ml similarity index 100% rename from src/passes/08-typer-new/solver_types.ml rename to src/passes/09-typing/08-typer-new/solver_types.ml diff --git a/src/passes/08-typer-new/todo_use_fold_generator.ml b/src/passes/09-typing/08-typer-new/todo_use_fold_generator.ml similarity index 100% rename from src/passes/08-typer-new/todo_use_fold_generator.ml rename to src/passes/09-typing/08-typer-new/todo_use_fold_generator.ml diff --git a/src/passes/08-typer-new/typelang.ml b/src/passes/09-typing/08-typer-new/typelang.ml similarity index 100% rename from src/passes/08-typer-new/typelang.ml rename to src/passes/09-typing/08-typer-new/typelang.ml diff --git a/src/passes/08-typer-new/typer.ml b/src/passes/09-typing/08-typer-new/typer.ml similarity index 100% rename from src/passes/08-typer-new/typer.ml rename to src/passes/09-typing/08-typer-new/typer.ml diff --git a/src/passes/08-typer-new/typer.ml.old b/src/passes/09-typing/08-typer-new/typer.ml.old similarity index 100% rename from src/passes/08-typer-new/typer.ml.old rename to src/passes/09-typing/08-typer-new/typer.ml.old diff --git a/src/passes/08-typer-new/typer.mli b/src/passes/09-typing/08-typer-new/typer.mli similarity index 100% rename from src/passes/08-typer-new/typer.mli rename to src/passes/09-typing/08-typer-new/typer.mli diff --git a/src/passes/08-typer-new/typer_new.ml b/src/passes/09-typing/08-typer-new/typer_new.ml similarity index 100% rename from src/passes/08-typer-new/typer_new.ml rename to src/passes/09-typing/08-typer-new/typer_new.ml diff --git a/src/passes/08-typer-new/untyper.ml b/src/passes/09-typing/08-typer-new/untyper.ml similarity index 100% rename from src/passes/08-typer-new/untyper.ml rename to src/passes/09-typing/08-typer-new/untyper.ml diff --git a/src/passes/08-typer-new/wrap.ml b/src/passes/09-typing/08-typer-new/wrap.ml similarity index 100% rename from src/passes/08-typer-new/wrap.ml rename to src/passes/09-typing/08-typer-new/wrap.ml diff --git a/src/passes/08-typer-old/dune b/src/passes/09-typing/08-typer-old/dune similarity index 95% rename from src/passes/08-typer-old/dune rename to src/passes/09-typing/08-typer-old/dune index fc8cfbd18..10601f713 100644 --- a/src/passes/08-typer-old/dune +++ b/src/passes/09-typing/08-typer-old/dune @@ -8,7 +8,7 @@ ast_core ast_typed typer_new - operators + predefined environment ) (preprocess diff --git a/src/passes/08-typer-old/typer.ml b/src/passes/09-typing/08-typer-old/typer.ml similarity index 100% rename from src/passes/08-typer-old/typer.ml rename to src/passes/09-typing/08-typer-old/typer.ml diff --git a/src/passes/08-typer-old/typer.mli b/src/passes/09-typing/08-typer-old/typer.mli similarity index 100% rename from src/passes/08-typer-old/typer.mli rename to src/passes/09-typing/08-typer-old/typer.mli diff --git a/src/passes/08-typer-old/typer_old.ml b/src/passes/09-typing/08-typer-old/typer_old.ml similarity index 100% rename from src/passes/08-typer-old/typer_old.ml rename to src/passes/09-typing/08-typer-old/typer_old.ml diff --git a/src/passes/08-typer/dune b/src/passes/09-typing/dune similarity index 95% rename from src/passes/08-typer/dune rename to src/passes/09-typing/dune index f6072da39..2b31ab3c8 100644 --- a/src/passes/08-typer/dune +++ b/src/passes/09-typing/dune @@ -8,7 +8,7 @@ ast_typed typer_old typer_new - operators + predefined ) (preprocess (pps ppx_let bisect_ppx --conditional) diff --git a/src/passes/08-typer/typer.ml b/src/passes/09-typing/typer.ml similarity index 100% rename from src/passes/08-typer/typer.ml rename to src/passes/09-typing/typer.ml diff --git a/src/passes/08-typer/typer.mli b/src/passes/09-typing/typer.mli similarity index 100% rename from src/passes/08-typer/typer.mli rename to src/passes/09-typing/typer.mli diff --git a/src/passes/09-self_ast_typed/contract_passes.ml b/src/passes/10-self_ast_typed/contract_passes.ml similarity index 100% rename from src/passes/09-self_ast_typed/contract_passes.ml rename to src/passes/10-self_ast_typed/contract_passes.ml diff --git a/src/passes/09-self_ast_typed/dune b/src/passes/10-self_ast_typed/dune similarity index 100% rename from src/passes/09-self_ast_typed/dune rename to src/passes/10-self_ast_typed/dune diff --git a/src/passes/09-self_ast_typed/errors.ml b/src/passes/10-self_ast_typed/errors.ml similarity index 100% rename from src/passes/09-self_ast_typed/errors.ml rename to src/passes/10-self_ast_typed/errors.ml diff --git a/src/passes/09-self_ast_typed/helpers.ml b/src/passes/10-self_ast_typed/helpers.ml similarity index 100% rename from src/passes/09-self_ast_typed/helpers.ml rename to src/passes/10-self_ast_typed/helpers.ml diff --git a/src/passes/09-self_ast_typed/michelson_layout.ml b/src/passes/10-self_ast_typed/michelson_layout.ml similarity index 100% rename from src/passes/09-self_ast_typed/michelson_layout.ml rename to src/passes/10-self_ast_typed/michelson_layout.ml diff --git a/src/passes/09-self_ast_typed/no_nested_big_map.ml b/src/passes/10-self_ast_typed/no_nested_big_map.ml similarity index 100% rename from src/passes/09-self_ast_typed/no_nested_big_map.ml rename to src/passes/10-self_ast_typed/no_nested_big_map.ml diff --git a/src/passes/09-self_ast_typed/self_ast_typed.ml b/src/passes/10-self_ast_typed/self_ast_typed.ml similarity index 100% rename from src/passes/09-self_ast_typed/self_ast_typed.ml rename to src/passes/10-self_ast_typed/self_ast_typed.ml diff --git a/src/passes/09-self_ast_typed/tail_recursion.ml b/src/passes/10-self_ast_typed/tail_recursion.ml similarity index 100% rename from src/passes/09-self_ast_typed/tail_recursion.ml rename to src/passes/10-self_ast_typed/tail_recursion.ml diff --git a/src/passes/10-transpiler/transpiler.mli b/src/passes/10-transpiler/transpiler.mli deleted file mode 100644 index 8ec051962..000000000 --- a/src/passes/10-transpiler/transpiler.mli +++ /dev/null @@ -1,19 +0,0 @@ -open Trace -open Errors - -module AST = Ast_typed -module Append_tree = Tree.Append -module Errors = Errors -open Mini_c - -val temp_unwrap_loc : 'a Location.wrap -> 'a - -val transpile_annotated_expression : AST.expression -> (expression, transpiler_error) result - -val transpile_program : AST.program -> (program, transpiler_error) result - -val extract_constructor : value -> ( string * AST.type_expression ) Append_tree.t' -> ((string * value * AST.type_expression) , transpiler_error) result -val extract_tuple : value -> AST.type_expression Append_tree.t' -> ((value * AST.type_expression) list , transpiler_error) result -val extract_record : value -> ( string * AST.type_expression ) Append_tree.t' -> (( string * ( value * AST.type_expression)) list , transpiler_error) result - -val untranspile : value -> AST.type_expression -> (AST.expression , transpiler_error) result \ No newline at end of file diff --git a/src/passes/10-interpreter/dune b/src/passes/11-interpreter/dune similarity index 100% rename from src/passes/10-interpreter/dune rename to src/passes/11-interpreter/dune diff --git a/src/passes/10-interpreter/interpreter.ml b/src/passes/11-interpreter/interpreter.ml similarity index 100% rename from src/passes/10-interpreter/interpreter.ml rename to src/passes/11-interpreter/interpreter.ml diff --git a/src/passes/10-interpreter/interpreter.mli b/src/passes/11-interpreter/interpreter.mli similarity index 100% rename from src/passes/10-interpreter/interpreter.mli rename to src/passes/11-interpreter/interpreter.mli diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/11-spilling/compiler.ml similarity index 81% rename from src/passes/10-transpiler/transpiler.ml rename to src/passes/11-spilling/compiler.ml index 550eead4a..8dca424af 100644 --- a/src/passes/10-transpiler/transpiler.ml +++ b/src/passes/11-spilling/compiler.ml @@ -1,4 +1,4 @@ -(* The Transpiler is a function that takes as input the Typed AST, and outputs expressions in a language that is basically a Michelson with named variables and first-class-environments. +(* The compiler is a function that takes as input the Typed AST, and outputs expressions in a language that is basically a Michelson with named variables and first-class-environments. For more info, see back-end.md: https://gitlab.com/ligolang/ligo/blob/dev/gitlab-pages/docs/contributors/big-picture/back-end.md *) @@ -12,12 +12,11 @@ module Append_tree = Tree.Append open AST.Combinators open Mini_c -let untranspile = Untranspiler.untranspile let temp_unwrap_loc = Location.unwrap let temp_unwrap_loc_list = List.map Location.unwrap -let transpile_constant' : AST.constant' -> constant' = function +let compile_constant' : AST.constant' -> constant' = function | C_INT -> C_INT | C_UNIT -> C_UNIT | C_NIL -> C_NIL @@ -136,7 +135,7 @@ let transpile_constant' : AST.constant' -> constant' = function | C_CONVERT_FROM_LEFT_COMB -> C_CONVERT_FROM_LEFT_COMB | C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_RIGHT_COMB -let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_error) result = +let rec compile_type (t:AST.type_expression) : (type_expression, spilling_error) result = let return tc = ok @@ Expression.make_t ~loc:t.location @@ tc in match t.type_content with | T_variable (name) when Var.equal name Stage_common.Constant.t_bool -> return (T_base TB_bool) @@ -157,28 +156,28 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er | T_constant (TC_chain_id) -> return (T_base TB_chain_id) | T_constant (TC_void) -> return (T_base TB_void) | T_operator (TC_contract x) -> - let%bind x' = transpile_type x in + let%bind x' = compile_type x in return (T_contract x') | T_operator (TC_map {k;v}) -> - let%bind kv' = bind_map_pair transpile_type (k, v) in + let%bind kv' = bind_map_pair compile_type (k, v) in return (T_map kv') | T_operator (TC_big_map {k;v}) -> - let%bind kv' = bind_map_pair transpile_type (k, v) in + let%bind kv' = bind_map_pair compile_type (k, v) in return (T_big_map kv') | T_operator (TC_map_or_big_map _) -> - fail @@ corner_case ~loc:"transpiler" "TC_map_or_big_map should have been resolved before transpilation" + fail @@ corner_case ~loc:"compiler" "TC_map_or_big_map should have been resolved before transpilation" | T_operator (TC_list t) -> - let%bind t' = transpile_type t in + let%bind t' = compile_type t in return (T_list t') | T_operator (TC_set t) -> - let%bind t' = transpile_type t in + let%bind t' = compile_type t in return (T_set t') | T_operator (TC_option o) -> - let%bind o' = transpile_type o in + let%bind o' = compile_type o in return (T_option o') | T_sum m when Ast_typed.Helpers.is_michelson_or m -> let node = Append_tree.of_list @@ kv_list_of_cmap m in - let aux a b : (type_expression annotated , transpiler_error) result = + let aux a b : (type_expression annotated , spilling_error) result = let%bind a = a in let%bind b = b in let%bind t = return @@ T_or (a,b) in @@ -186,13 +185,13 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er in let%bind m' = Append_tree.fold_ne (fun (_, ({ctor_type ; michelson_annotation}: AST.ctor_content)) -> - let%bind a = transpile_type ctor_type in + let%bind a = compile_type ctor_type in ok (Ast_typed.Helpers.remove_empty_annotation michelson_annotation, a) ) aux node in ok @@ snd m' | T_sum m -> let node = Append_tree.of_list @@ kv_list_of_cmap m in - let aux a b : (type_expression annotated , transpiler_error) result = + let aux a b : (type_expression annotated , spilling_error) result = let%bind a = a in let%bind b = b in let%bind t = return @@ T_or (a,b) in @@ -200,13 +199,13 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er in let%bind m' = Append_tree.fold_ne (fun (Ast_typed.Types.Constructor ann, ({ctor_type ; _}: AST.ctor_content)) -> - let%bind a = transpile_type ctor_type in + let%bind a = compile_type ctor_type in ok (Some (String.uncapitalize_ascii ann), a)) aux node in ok @@ snd m' | T_record m when Ast_typed.Helpers.is_michelson_pair m -> let node = Append_tree.of_list @@ Ast_typed.Helpers.tuple_of_record m in - let aux a b : (type_expression annotated , transpiler_error) result = + let aux a b : (type_expression annotated , spilling_error) result = let%bind a = a in let%bind b = b in let%bind t = return @@ T_pair (a, b) in @@ -214,7 +213,7 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er in let%bind m' = Append_tree.fold_ne (fun (_, ({field_type ; michelson_annotation} : AST.field_content)) -> - let%bind a = transpile_type field_type in + let%bind a = compile_type field_type in ok (Ast_typed.Helpers.remove_empty_annotation michelson_annotation, a) ) aux node in ok @@ snd m' @@ -227,7 +226,7 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er List.rev @@ Ast_typed.Types.LMap.to_kv_list m ) in - let aux a b : (type_expression annotated, transpiler_error) result = + let aux a b : (type_expression annotated, spilling_error) result = let%bind a = a in let%bind b = b in let%bind t = return @@ T_pair (a, b) in @@ -235,7 +234,7 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er in let%bind m' = Append_tree.fold_ne (fun (Ast_typed.Types.Label ann, ({field_type;_}: AST.field_content)) -> - let%bind a = transpile_type field_type in + let%bind a = compile_type field_type in ok ((if is_tuple_lmap then None else @@ -245,12 +244,12 @@ let rec transpile_type (t:AST.type_expression) : (type_expression, transpiler_er aux node in ok @@ snd m' | T_arrow {type1;type2} -> ( - let%bind param' = transpile_type type1 in - let%bind result' = transpile_type type2 in + let%bind param' = compile_type type1 in + let%bind result' = compile_type type2 in return @@ (T_function (param',result')) ) -let record_access_to_lr : type_expression -> type_expression AST.label_map -> AST.label -> ((type_expression * [`Left | `Right]) list , transpiler_error) result = fun ty tym ind -> +let record_access_to_lr : type_expression -> type_expression AST.label_map -> AST.label -> ((type_expression * [`Left | `Right]) list , spilling_error) result = fun ty tym ind -> let tys = Ast_typed.Helpers.kv_list_of_record_or_tuple tym in let node_tv = Append_tree.of_list tys in let%bind path = @@ -269,7 +268,7 @@ let record_access_to_lr : type_expression -> type_expression AST.label_map -> AS bind_fold_list aux (ty , []) lr_path in ok lst -let rec transpile_literal : AST.literal -> value = fun l -> match l with +let rec compile_literal : AST.literal -> value = fun l -> match l with | Literal_int n -> D_int n | Literal_nat n -> D_nat n | Literal_timestamp n -> D_timestamp n @@ -285,49 +284,49 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with | Literal_unit -> D_unit | Literal_void -> D_none -and tree_of_sum : AST.type_expression -> ((AST.constructor' * AST.type_expression) Append_tree.t, transpiler_error) result = fun t -> +and tree_of_sum : AST.type_expression -> ((AST.constructor' * AST.type_expression) Append_tree.t, spilling_error) result = fun t -> let%bind map_tv = trace_option (corner_case ~loc:__LOC__ "getting lr tree") @@ get_t_sum t in let kt_list = List.map (fun (k,({ctor_type;_}:AST.ctor_content)) -> (k,ctor_type)) (kv_list_of_cmap map_tv) in ok @@ Append_tree.of_list kt_list -and transpile_annotated_expression (ae:AST.expression) : (expression , transpiler_error) result = - let%bind tv = transpile_type ae.type_expression in +and compile_expression (ae:AST.expression) : (expression , spilling_error) result = + let%bind tv = compile_type ae.type_expression in let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl ~loc:ae.location (expr, tv) in trace (translation_tracer ae.location) @@ match ae.expression_content with | E_let_in {let_binder; rhs; let_result; inline} -> - let%bind rhs' = transpile_annotated_expression rhs in - let%bind result' = transpile_annotated_expression let_result in + let%bind rhs' = compile_expression rhs in + let%bind result' = compile_expression let_result in return (E_let_in ((let_binder, rhs'.type_expression), inline, rhs', result')) - | E_literal l -> return @@ E_literal (transpile_literal l) + | E_literal l -> return @@ E_literal (compile_literal l) | E_variable name -> ( return @@ E_variable (name) ) | E_application {lamb; args} -> - let%bind a = transpile_annotated_expression lamb in - let%bind b = transpile_annotated_expression args in + let%bind a = compile_expression lamb in + let%bind b = compile_expression args in return @@ E_application (a, b) | E_constructor {constructor=Constructor name;element} when (String.equal name "true"|| String.equal name "false") && element.expression_content = AST.e_unit () -> return @@ E_literal (D_bool (bool_of_string name)) | E_constructor {constructor;element} -> ( - let%bind param' = transpile_annotated_expression element in + let%bind param' = compile_expression element in let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in let%bind node_tv = trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@ tree_of_sum ae.type_expression in - let leaf (k, tv) : (expression_content option * type_expression , transpiler_error) result = + let leaf (k, tv) : (expression_content option * type_expression , spilling_error) result = if k = constructor then ( let%bind _ = trace_option (corner_case ~loc:__LOC__ "wrong type for constructor parameter") @@ AST.assert_type_expression_eq (tv, element.type_expression) in ok (Some (param'_expr), param'_tv) ) else ( - let%bind tv = transpile_type tv in + let%bind tv = compile_type tv in ok (None, tv) ) in - let node a b : (expression_content option * type_expression , transpiler_error) result = + let node a b : (expression_content option * type_expression , spilling_error) result = let%bind a = a in let%bind b = b in match (a, b) with @@ -344,7 +343,7 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile ) | E_record m -> ( let node = Append_tree.of_list @@ Ast_typed.Helpers.list_of_record_or_tuple m in - let aux a b : (expression , transpiler_error) result = + let aux a b : (expression , spilling_error) result = let%bind a = a in let%bind b = b in let a_ty = Combinators.Expression.get_type a in @@ -353,14 +352,14 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile return ~tv @@ E_constant {cons_name=C_PAIR;arguments=[a; b]} in trace_strong (corner_case ~loc:__LOC__ "record build") @@ - Append_tree.fold_ne (transpile_annotated_expression) aux node + Append_tree.fold_ne (compile_expression) aux node ) | E_record_accessor {record; path} -> - let%bind ty' = transpile_type (get_type_expression record) in + let%bind ty' = compile_type (get_type_expression record) in let%bind ty_lmap = trace_option (corner_case ~loc:__LOC__ "not a record") @@ get_t_record (get_type_expression record) in - let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in + let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t compile_type ty_lmap in let%bind path = record_access_to_lr ty' ty'_lmap path in let aux = fun pred (ty, lr) -> let c = match lr with @@ -369,7 +368,7 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile in return ~tv:ty @@ E_constant {cons_name=c;arguments=[pred]} in - let%bind record' = transpile_annotated_expression record in + let%bind record' = compile_expression record in let%bind expr = bind_fold_list aux record' path in ok expr | E_record_update {record; path; update} -> @@ -378,8 +377,8 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile let%bind ty_lmap = trace_option (corner_case ~loc:__LOC__ "not a record") @@ get_t_record (ty) in - let%bind ty' = transpile_type (ty) in - let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in + let%bind ty' = compile_type (ty) in + let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t compile_type ty_lmap in let%bind p' = trace_strong (corner_case ~loc:__LOC__ "record access") @@ record_access_to_lr ty' ty'_lmap p in @@ -397,16 +396,16 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile in let%bind (update, path) = aux [] (record, path, update) in let path = List.map snd path in - let%bind update = transpile_annotated_expression update in - let%bind record = transpile_annotated_expression record in + let%bind update = compile_expression update in + let%bind record = compile_expression record in return @@ E_record_update (record, path, update) | E_constant {cons_name=name; arguments=lst} -> ( let iterator_generator iterator_name = let expression_to_iterator_body (f : AST.expression) = let%bind (input , output) = trace_option (corner_case ~loc:__LOC__ "expected function type") @@ AST.get_t_function f.type_expression in - let%bind f' = transpile_annotated_expression f in - let%bind input' = transpile_type input in - let%bind output' = transpile_type output in + let%bind f' = compile_expression f in + let%bind input' = compile_type input in + let%bind output' = compile_type output in let binder = Var.fresh ~name:"iterated" () in let application = Mini_c.Combinators.e_application f' output' (Mini_c.Combinators.e_var binder input') in ok ((binder , input'), application) @@ -414,13 +413,13 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile fun (lst : AST.expression list) -> match (lst , iterator_name) with | [f ; i] , C_ITER | [f ; i] , C_MAP -> ( let%bind f' = expression_to_iterator_body f in - let%bind i' = transpile_annotated_expression i in + let%bind i' = compile_expression i in return @@ E_iterator (iterator_name , f' , i') ) | [ f ; collection ; initial ] , C_FOLD -> ( let%bind f' = expression_to_iterator_body f in - let%bind initial' = transpile_annotated_expression initial in - let%bind collection' = transpile_annotated_expression collection in + let%bind initial' = compile_expression initial in + let%bind collection' = compile_expression collection in return @@ E_fold (f' , collection' , initial') ) | _ -> fail @@ corner_case ~loc:__LOC__ (Format.asprintf "bad iterator arity: %a" Stage_common.PP.constant iterator_name) @@ -436,24 +435,24 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile | (C_SET_FOLD , lst) -> fold lst | (C_MAP_FOLD , lst) -> fold lst | _ -> ( - let%bind lst' = bind_map_list (transpile_annotated_expression) lst in - return @@ E_constant {cons_name=transpile_constant' name;arguments=lst'} + let%bind lst' = bind_map_list (compile_expression) lst in + return @@ E_constant {cons_name=compile_constant' name;arguments=lst'} ) ) | E_lambda l -> let%bind io = trace_option (corner_case ~loc:__LOC__ "expected function type") @@ AST.get_t_function ae.type_expression in - transpile_lambda l io + compile_lambda l io | E_recursive r -> - transpile_recursive r + compile_recursive r | E_matching {matchee=expr; cases=m} -> ( - let%bind expr' = transpile_annotated_expression expr in + let%bind expr' = compile_expression expr in match m with | Match_option { match_none; match_some = {opt; body; tv} } -> - let%bind n = transpile_annotated_expression match_none in + let%bind n = compile_expression match_none in let%bind (tv' , s') = - let%bind tv' = transpile_type tv in - let%bind s' = transpile_annotated_expression body in + let%bind tv' = compile_type tv in + let%bind s' = compile_expression body in ok (tv' , s') in return @@ E_if_none (expr' , n , ((opt , tv') , s')) @@ -461,17 +460,17 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile match_nil ; match_cons = {hd; tl; body; tv} ; } -> ( - let%bind nil = transpile_annotated_expression match_nil in + let%bind nil = compile_expression match_nil in let%bind cons = - let%bind ty' = transpile_type tv in - let%bind match_cons' = transpile_annotated_expression body in + let%bind ty' = compile_type tv in + let%bind match_cons' = compile_expression body in ok (((hd , ty') , (tl , ty')) , match_cons') in return @@ E_if_cons (expr' , nil , cons) ) | Match_variant {cases=[{constructor=Constructor t;body=match_true};{constructor=Constructor f;body=match_false}];_} when String.equal t "true" && String.equal f "false" -> - let%bind (t , f) = bind_map_pair (transpile_annotated_expression) (match_true, match_false) in + let%bind (t , f) = bind_map_pair (compile_expression) (match_true, match_false) in return @@ E_if_bool (expr', t, f) | Match_variant {cases ; tv} -> ( let%bind tree = @@ -484,7 +483,7 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile let rec aux t = match (t : _ Append_tree.t') with | Leaf (name , tv) -> - let%bind tv' = transpile_type tv in + let%bind tv' = compile_type tv in ok (`Leaf name , tv') | Node {a ; b} -> let%bind a' = aux a in @@ -502,7 +501,7 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile let aux ({constructor = Constructor c ; pattern=_ ; body=_} : AST.matching_content_case) = (c = constructor_name) in List.find_opt aux cases in - let%bind body' = transpile_annotated_expression body in + let%bind body' = compile_expression body in return @@ E_let_in ((pattern , tv) , false , top , body') ) | ((`Node (a , b)) , tv) -> @@ -532,22 +531,22 @@ and transpile_annotated_expression (ae:AST.expression) : (expression , transpile (String.equal language backend) in let type_anno = get_type_expression code in - let%bind type_anno' = transpile_type type_anno in + let%bind type_anno' = compile_type type_anno in let%bind code = trace_option (corner_case ~loc:__LOC__ "could not get a string") @@ get_a_string code in return ~tv:type_anno' @@ E_raw_michelson code -and transpile_lambda l (input_type , output_type) = +and compile_lambda l (input_type , output_type) = let { binder ; result } : AST.lambda = l in - let%bind result' = transpile_annotated_expression result in - let%bind input = transpile_type input_type in - let%bind output = transpile_type output_type in + let%bind result' = compile_expression result in + let%bind input = compile_type input_type in + let%bind output = compile_type output_type in let tv = Combinators.t_function input output in let binder = binder in let closure = E_closure { binder; body = result'} in ok @@ Combinators.Expression.make_tpl ~loc:result.location (closure , tv) -and transpile_recursive {fun_name; fun_type; lambda} = - let rec map_lambda : AST.expression_variable -> type_expression -> AST.expression -> (expression * expression_variable list , transpiler_error) result = fun fun_name loop_type e -> +and compile_recursive {fun_name; fun_type; lambda} = + let rec map_lambda : AST.expression_variable -> type_expression -> AST.expression -> (expression * expression_variable list , spilling_error) result = fun fun_name loop_type e -> match e.expression_content with E_lambda {binder;result} -> let%bind (body,l) = map_lambda fun_name loop_type result in @@ -556,38 +555,38 @@ and transpile_recursive {fun_name; fun_type; lambda} = let%bind res = replace_callback fun_name loop_type false e in ok @@ (res, []) - and replace_callback : AST.expression_variable -> type_expression -> bool -> AST.expression -> (expression , transpiler_error) result = fun fun_name loop_type shadowed e -> + and replace_callback : AST.expression_variable -> type_expression -> bool -> AST.expression -> (expression , spilling_error) result = fun fun_name loop_type shadowed e -> match e.expression_content with E_let_in li -> let shadowed = shadowed || Var.equal li.let_binder fun_name in let%bind let_result = replace_callback fun_name loop_type shadowed li.let_result in - let%bind rhs = transpile_annotated_expression li.rhs in - let%bind ty = transpile_type e.type_expression in + let%bind rhs = compile_expression li.rhs in + let%bind ty = compile_type e.type_expression in ok @@ e_let_in li.let_binder ty li.inline rhs let_result | E_matching m -> - let%bind ty = transpile_type e.type_expression in + let%bind ty = compile_type e.type_expression in matching fun_name loop_type shadowed m ty | E_application {lamb;args} -> ( match lamb.expression_content,shadowed with E_variable name, false when Var.equal fun_name name -> - let%bind expr = transpile_annotated_expression args in + let%bind expr = compile_expression args in ok @@ Expression.make (E_constant {cons_name=C_LOOP_CONTINUE;arguments=[expr]}) loop_type | _ -> - let%bind expr = transpile_annotated_expression e in + let%bind expr = compile_expression e in ok @@ Expression.make (E_constant {cons_name=C_LOOP_STOP;arguments=[expr]}) loop_type ) | _ -> - let%bind expr = transpile_annotated_expression e in + let%bind expr = compile_expression e in ok @@ Expression.make (E_constant {cons_name=C_LOOP_STOP;arguments=[expr]}) loop_type - and matching : AST.expression_variable -> type_expression -> bool -> AST.matching -> type_expression -> (expression , transpiler_error) result = fun fun_name loop_type shadowed m ty -> + and matching : AST.expression_variable -> type_expression -> bool -> AST.matching -> type_expression -> (expression , spilling_error) result = fun fun_name loop_type shadowed m ty -> let return ret = ok @@ Expression.make ret @@ ty in - let%bind expr = transpile_annotated_expression m.matchee in + let%bind expr = compile_expression m.matchee in match m.cases with | Match_option { match_none; match_some = {opt; body; tv} } -> let%bind n = replace_callback fun_name loop_type shadowed match_none in let%bind (tv' , s') = - let%bind tv' = transpile_type tv in + let%bind tv' = compile_type tv in let%bind s' = replace_callback fun_name loop_type shadowed body in ok (tv' , s') in @@ -598,7 +597,7 @@ and transpile_recursive {fun_name; fun_type; lambda} = } -> ( let%bind nil = replace_callback fun_name loop_type shadowed match_nil in let%bind cons = - let%bind ty' = transpile_type tv in + let%bind ty' = compile_type tv in let%bind match_cons' = replace_callback fun_name loop_type shadowed body in ok (((hd , ty') , (tl , ty')) , match_cons') in @@ -619,7 +618,7 @@ and transpile_recursive {fun_name; fun_type; lambda} = let rec aux t = match (t : _ Append_tree.t') with | Leaf (name , tv) -> - let%bind tv' = transpile_type tv in + let%bind tv' = compile_type tv in ok (`Leaf name , tv') | Node {a ; b} -> let%bind a' = aux a in @@ -658,7 +657,7 @@ and transpile_recursive {fun_name; fun_type; lambda} = aux expr tree'' ) in - let%bind fun_type = transpile_type fun_type in + let%bind fun_type = compile_type fun_type in let%bind (input_type,output_type) = trace_option (corner_case ~loc:__LOC__ "wrongtype") @@ get_t_function fun_type in let loop_type = t_union (None, input_type) (None, output_type) in let%bind (body,binder) = map_lambda fun_name loop_type lambda.result in @@ -668,28 +667,28 @@ and transpile_recursive {fun_name; fun_type; lambda} = let body = Expression.make (E_iterator (C_LOOP_LEFT, ((lambda.binder, loop_type),body), expr)) output_type in ok @@ Expression.make (E_closure {binder;body}) fun_type -let transpile_declaration env (d:AST.declaration) : (toplevel_statement option , transpiler_error) result = +let compile_declaration env (d:AST.declaration) : (toplevel_statement option , spilling_error) result = match d with | Declaration_constant { binder ; expr ; inline } -> - let%bind expression = transpile_annotated_expression expr in + let%bind expression = compile_expression expr in let tv = Combinators.Expression.get_type expression in let env' = Environment.add (binder, tv) env in ok @@ Some ((binder, inline, expression), environment_wrap env env') | _ -> ok None -let transpile_program (lst : AST.program) : (program , transpiler_error) result = - let aux (prev:(toplevel_statement list * Environment.t , transpiler_error) result) cur = +let compile_program (lst : AST.program) : (program , spilling_error) result = + let aux (prev:(toplevel_statement list * Environment.t , spilling_error) result) cur = let%bind (hds, env) = prev in - match%bind transpile_declaration env cur with + match%bind compile_declaration env cur with | Some ((_ , env') as cur') -> ok (hds @ [ cur' ] , env'.post_environment) | None -> ok (hds , env) in let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) (temp_unwrap_loc_list lst) in ok statements -let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_expression , transpiler_error) result = +let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_expression , spilling_error) result = let open Append_tree in - let rec aux tv : (string * value * AST.type_expression , transpiler_error) result= + let rec aux tv : (string * value * AST.type_expression , spilling_error) result= match tv with | Leaf (k, t), v -> ok (k, v, t) | Node {a}, D_left v -> aux (a, v) @@ -699,9 +698,9 @@ let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value let%bind (s, v, t) = aux (tree, v) in ok (s, v, t) -let extract_tuple (v : value) (tree : AST.type_expression Append_tree.t') : ((value * AST.type_expression) list , transpiler_error) result = +let extract_tuple (v : value) (tree : AST.type_expression Append_tree.t') : ((value * AST.type_expression) list , spilling_error) result = let open Append_tree in - let rec aux tv : ((value * AST.type_expression) list , transpiler_error) result = + let rec aux tv : ((value * AST.type_expression) list , spilling_error) result = match tv with | Leaf t, v -> ok @@ [v, t] | Node {a;b}, D_pair (va, vb) -> @@ -712,9 +711,9 @@ let extract_tuple (v : value) (tree : AST.type_expression Append_tree.t') : ((va in aux (tree, v) -let extract_record (v : value) (tree : _ Append_tree.t') : (_ list , transpiler_error) result = +let extract_record (v : value) (tree : _ Append_tree.t') : (_ list , spilling_error) result = let open Append_tree in - let rec aux tv : ((string * (value * AST.type_expression)) list , transpiler_error) result = + let rec aux tv : ((string * (value * AST.type_expression)) list , spilling_error) result = match tv with | Leaf (s, t), v -> ok @@ [s, (v, t)] | Node {a;b}, D_pair (va, vb) -> diff --git a/src/passes/10-transpiler/untranspiler.ml b/src/passes/11-spilling/decompiler.ml similarity index 89% rename from src/passes/10-transpiler/untranspiler.ml rename to src/passes/11-spilling/decompiler.ml index 9780dd929..e13522312 100644 --- a/src/passes/10-transpiler/untranspiler.ml +++ b/src/passes/11-spilling/decompiler.ml @@ -7,7 +7,7 @@ open Errors open Mini_c open Trace -let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , transpiler_error) result = +let rec decompile (v : value) (t : AST.type_expression) : (AST.expression , spilling_error) result = let open! AST in let return e = ok (make_e e t) in match t.type_content with @@ -121,7 +121,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr match opt with | None -> ok (e_a_none o) | Some s -> - let%bind s' = untranspile s o in + let%bind s' = decompile s o in ok (e_a_some s') ) | TC_map {k=k_ty;v=v_ty}-> ( @@ -130,8 +130,8 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr get_map v in let%bind map' = let aux = fun (k, v) -> - let%bind k = untranspile k k_ty in - let%bind v = untranspile v v_ty in + let%bind k = decompile k k_ty in + let%bind v = decompile v v_ty in ok ({k; v} : AST.map_kv) in bind_map_list aux map in let map' = List.sort_uniq compare map' in @@ -147,8 +147,8 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr get_big_map v in let%bind big_map' = let aux = fun (k, v) -> - let%bind k = untranspile k k_ty in - let%bind v = untranspile v v_ty in + let%bind k = decompile k k_ty in + let%bind v = decompile v v_ty in ok ({k; v} : AST.map_kv) in bind_map_list aux big_map in let big_map' = List.sort_uniq compare big_map' in @@ -158,13 +158,13 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in bind_fold_right_list aux init big_map' ) - | TC_map_or_big_map _ -> fail @@ corner_case ~loc:"untranspiler" "TC_map_or_big_map t should not be present in mini-c" + | TC_map_or_big_map _ -> fail @@ corner_case ~loc:"decompiler" "TC_map_or_big_map t should not be present in mini-c" | TC_list ty -> ( let%bind lst = trace_option (wrong_mini_c_value t v) @@ get_list v in let%bind lst' = - let aux = fun e -> untranspile e ty in + let aux = fun e -> decompile e ty in bind_map_list aux lst in let aux = fun prev cur -> return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in @@ -176,7 +176,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr trace_option (wrong_mini_c_value t v) @@ get_set v in let%bind lst' = - let aux = fun e -> untranspile e ty in + let aux = fun e -> decompile e ty in bind_map_list aux lst in let lst' = List.sort_uniq compare lst' in let aux = fun prev cur -> @@ -185,7 +185,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr bind_fold_list aux init lst' ) | TC_contract _ -> - fail @@ bad_untranspile v + fail @@ bad_decompile v ) | T_sum m -> let lst = List.map (fun (k,{ctor_type;_}) -> (k,ctor_type)) @@ kv_list_of_cmap m in @@ -196,7 +196,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr let%bind (name, v, tv) = trace_strong (corner_case ~loc:__LOC__ "sum extract constructor") @@ extract_constructor v node in - let%bind sub = untranspile v tv in + let%bind sub = decompile v tv in return (E_constructor {constructor=Constructor name;element=sub}) | T_record m -> let lst = List.map (fun (k,{field_type;_}) -> (k,field_type)) @@ Ast_typed.Helpers.kv_list_of_record_or_tuple m in @@ -207,7 +207,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr trace_strong (corner_case ~loc:__LOC__ "record extract") @@ extract_record v node in let%bind lst = bind_list - @@ List.map (fun (x, (y, z)) -> let%bind yz = untranspile y z in ok (x, yz)) lst in + @@ List.map (fun (x, (y, z)) -> let%bind yz = decompile y z in ok (x, yz)) lst in let m' = AST.LMap.of_list lst in return (E_record m') | T_arrow _ -> @@ -217,4 +217,4 @@ let rec untranspile (v : value) (t : AST.type_expression) : (AST.expression , tr let n = Ligo_string.Standard n in return (E_literal (Literal_string n)) | T_variable _ -> - fail @@ corner_case ~loc:__LOC__ "trying to untranspile at variable type" + fail @@ corner_case ~loc:__LOC__ "trying to decompile at variable type" diff --git a/src/passes/10-transpiler/dune b/src/passes/11-spilling/dune similarity index 78% rename from src/passes/10-transpiler/dune rename to src/passes/11-spilling/dune index 6c3139e5e..74cf7320c 100644 --- a/src/passes/10-transpiler/dune +++ b/src/passes/11-spilling/dune @@ -1,13 +1,13 @@ (library - (name transpiler) - (public_name ligo.transpiler) + (name spilling) + (public_name ligo.spilling) (libraries simple-utils tezos-utils ast_typed mini_c self_mini_c - operators + predefined ) (preprocess (pps ppx_let bisect_ppx --conditional) diff --git a/src/passes/10-transpiler/errors.ml b/src/passes/11-spilling/errors.ml similarity index 67% rename from src/passes/10-transpiler/errors.ml rename to src/passes/11-spilling/errors.ml index 0dc324b58..93545afd3 100644 --- a/src/passes/10-transpiler/errors.ml +++ b/src/passes/11-spilling/errors.ml @@ -1,83 +1,83 @@ open Trace open Simple_utils.Display -type transpiler_error = [ - | `Transpiler_corner_case of string * string - | `Transpiler_no_type_variable of Stage_common.Types.type_variable - | `Transpiler_unsupported_pattern_matching of Location.t - | `Transpiler_unsupported_iterator of Location.t - | `Transpiler_unsupported_recursive_function of Ast_typed.expression_variable - | `Transpiler_tracer of Location.t * transpiler_error - | `Transpiler_wrong_mini_c_value of Ast_typed.type_expression * Mini_c.value - | `Transpiler_bad_untranspile of Mini_c.value +type spilling_error = [ + | `Spilling_corner_case of string * string + | `Spilling_no_type_variable of Stage_common.Types.type_variable + | `Spilling_unsupported_pattern_matching of Location.t + | `Spilling_unsupported_iterator of Location.t + | `Spilling_unsupported_recursive_function of Ast_typed.expression_variable + | `Spilling_tracer of Location.t * spilling_error + | `Spilling_wrong_mini_c_value of Ast_typed.type_expression * Mini_c.value + | `Spilling_bad_decompile of Mini_c.value ] -let stage = "transpiler" +let stage = "spilling" -let translation_tracer loc err = `Transpiler_tracer (loc , err) +let translation_tracer loc err = `Spilling_tracer (loc , err) -let corner_case ~loc desc = `Transpiler_corner_case (loc, desc) +let corner_case ~loc desc = `Spilling_corner_case (loc, desc) let corner_case_message () = "we don't have a good error message for this case. we are striving find ways to better report them and find the use-cases that generate them. please report this to the developers." -let no_type_variable name = `Transpiler_no_type_variable name +let no_type_variable name = `Spilling_no_type_variable name let unsupported_tuple_pattern_matching location = - `Transpiler_unsupported_pattern_matching location + `Spilling_unsupported_pattern_matching location let unsupported_iterator location = - `Transpiler_unsupported_iterator location + `Spilling_unsupported_iterator location let unsupported_recursive_function expression_variable = - `Transpiler_unsupported_recursive_function expression_variable + `Spilling_unsupported_recursive_function expression_variable let wrong_mini_c_value expected actual = - `Transpiler_wrong_mini_c_value (expected , actual) + `Spilling_wrong_mini_c_value (expected , actual) -let bad_untranspile bad_type = - `Transpiler_bad_untranspile bad_type +let bad_decompile bad_type = + `Spilling_bad_decompile bad_type let rec error_ppformat : display_format:string display_format -> - Format.formatter -> transpiler_error -> unit = + Format.formatter -> spilling_error -> unit = fun ~display_format f a -> match display_format with | Human_readable | Dev -> ( match a with - | `Transpiler_tracer (loc,err) -> + | `Spilling_tracer (loc,err) -> Format.fprintf f "@[%a@Translating expression@%a@]" Location.pp loc (error_ppformat ~display_format) err - | `Transpiler_corner_case (loc,desc) -> + | `Spilling_corner_case (loc,desc) -> let s = Format.asprintf "%s\n corner case: %s\n%s" loc desc (corner_case_message ()) in Format.pp_print_string f s - | `Transpiler_no_type_variable tv -> + | `Spilling_no_type_variable tv -> let s = Format.asprintf "type variables can't be transpiled : %a" Var.pp tv in Format.pp_print_string f s - | `Transpiler_unsupported_pattern_matching loc -> + | `Spilling_unsupported_pattern_matching loc -> let s = Format.asprintf "%a\n unsupported pattern-matching: tuple patterns aren't supported yet" Location.pp loc in Format.pp_print_string f s - | `Transpiler_unsupported_iterator loc -> + | `Spilling_unsupported_iterator loc -> let s = Format.asprintf "%a\n unsupported iterator: only lambda are supported as iterators" Location.pp loc in Format.pp_print_string f s - | `Transpiler_unsupported_recursive_function var -> + | `Spilling_unsupported_recursive_function var -> let s = Format.asprintf "Recursive functions with only one variable are supported : %a" Ast_typed.PP.expression_variable var in Format.pp_print_string f s - | `Transpiler_wrong_mini_c_value (expected , actual) -> + | `Spilling_wrong_mini_c_value (expected , actual) -> let s = Format.asprintf "illed typed intermediary value: expected %a got %a" Ast_typed.PP.type_expression expected Mini_c.PP.value actual in Format.pp_print_string f s - | `Transpiler_bad_untranspile bad -> + | `Spilling_bad_decompile bad -> let s = Format.asprintf "can not untranspile %a" Mini_c.PP.value bad in Format.pp_print_string f s ) -let rec error_jsonformat : transpiler_error -> J.t = fun a -> +let rec error_jsonformat : spilling_error -> J.t = fun a -> let json_error ~stage ~content = `Assoc [ ("status", `String "error") ; @@ -85,7 +85,7 @@ let rec error_jsonformat : transpiler_error -> J.t = fun a -> ("content", content )] in match a with - | `Transpiler_tracer (loc, err) -> + | `Spilling_tracer (loc, err) -> let loc' = Format.asprintf "%a" Location.pp loc in let children = error_jsonformat err in let content = `Assoc [ @@ -93,42 +93,42 @@ let rec error_jsonformat : transpiler_error -> J.t = fun a -> ("children", children) ] in json_error ~stage ~content - | `Transpiler_corner_case (loc, desc) -> + | `Spilling_corner_case (loc, desc) -> let content = `Assoc [ ("location", `String loc); ("description", `String desc); ("message", `String (corner_case_message ()) ); ] in json_error ~stage ~content - | `Transpiler_no_type_variable tv -> + | `Spilling_no_type_variable tv -> let tv' = Format.asprintf "%a" Var.pp tv in let content = `Assoc [ ("description", `String "type variables can't be transpiled"); ("type_variable", `String tv'); ] in json_error ~stage ~content - | `Transpiler_unsupported_pattern_matching loc -> + | `Spilling_unsupported_pattern_matching loc -> let loc' = Format.asprintf "%a" Location.pp loc in let content = `Assoc [ ("location", `String loc'); ("message", `String "unsupported tuple in pattern-matching"); ] in json_error ~stage ~content - | `Transpiler_unsupported_iterator loc -> + | `Spilling_unsupported_iterator loc -> let loc' = Format.asprintf "%a" Location.pp loc in let content = `Assoc [ ("location", `String loc'); ("message", `String "unsupported iterator"); ] in json_error ~stage ~content - | `Transpiler_unsupported_recursive_function var -> + | `Spilling_unsupported_recursive_function var -> let var' = Format.asprintf "%a" Ast_typed.PP.expression_variable var in let content = `Assoc [ ("message", `String "Recursive functions with only one variable are supported"); ("value", `String var'); ] in json_error ~stage ~content - | `Transpiler_wrong_mini_c_value (expected , actual) -> + | `Spilling_wrong_mini_c_value (expected , actual) -> let expected' = Format.asprintf "%a" Ast_typed.PP.type_expression expected in let actual' = Format.asprintf "%a" Mini_c.PP.value actual in let content = `Assoc [ @@ -137,10 +137,10 @@ let rec error_jsonformat : transpiler_error -> J.t = fun a -> ("actual", `String actual'); ] in json_error ~stage ~content - | `Transpiler_bad_untranspile bad -> + | `Spilling_bad_decompile bad -> let var' = Format.asprintf "%a" Mini_c.PP.value bad in let content = `Assoc [ ("message", `String "untranspiling bad value"); ("value", `String var'); ] in - json_error ~stage ~content \ No newline at end of file + json_error ~stage ~content diff --git a/src/passes/10-transpiler/helpers.ml b/src/passes/11-spilling/helpers.ml similarity index 85% rename from src/passes/10-transpiler/helpers.ml rename to src/passes/11-spilling/helpers.ml index ffc228897..95bccf5f6 100644 --- a/src/passes/10-transpiler/helpers.ml +++ b/src/passes/11-spilling/helpers.ml @@ -24,9 +24,9 @@ let map_of_kv_list lst = let open Map.String in List.fold_left (fun prev (k, v) -> add k v prev) empty lst -let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_expression , transpiler_error) result = +let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_expression , spilling_error) result = let open Append_tree in - let rec aux tv : (string * value * AST.type_expression , transpiler_error) result= + let rec aux tv : (string * value * AST.type_expression , spilling_error) result= match tv with | Leaf (Ast_typed.Constructor k, t), v -> ok (k, v, t) | Node {a}, D_left v -> aux (a, v) @@ -36,9 +36,9 @@ let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value let%bind (s, v, t) = aux (tree, v) in ok (s, v, t) -let extract_tuple (v : value) (tree : AST.type_expression Append_tree.t') : ((value * AST.type_expression) list , transpiler_error) result = +let extract_tuple (v : value) (tree : AST.type_expression Append_tree.t') : ((value * AST.type_expression) list , spilling_error) result = let open Append_tree in - let rec aux tv : ((value * AST.type_expression) list , transpiler_error) result = + let rec aux tv : ((value * AST.type_expression) list , spilling_error) result = match tv with | Leaf t, v -> ok @@ [v, t] | Node {a;b}, D_pair (va, vb) -> @@ -49,9 +49,9 @@ let extract_tuple (v : value) (tree : AST.type_expression Append_tree.t') : ((va in aux (tree, v) -let extract_record (v : value) (tree : _ Append_tree.t') : (_ list , transpiler_error) result = +let extract_record (v : value) (tree : _ Append_tree.t') : (_ list , spilling_error) result = let open Append_tree in - let rec aux tv : ((AST.label * (value * AST.type_expression)) list , transpiler_error) result = + let rec aux tv : ((AST.label * (value * AST.type_expression)) list , spilling_error) result = match tv with | Leaf (s, t), v -> ok @@ [s, (v, t)] | Node {a;b}, D_pair (va, vb) -> diff --git a/src/passes/11-spilling/spilling.ml b/src/passes/11-spilling/spilling.ml new file mode 100644 index 000000000..726982dff --- /dev/null +++ b/src/passes/11-spilling/spilling.ml @@ -0,0 +1,11 @@ +module AST = Ast_typed +module Append_tree = Tree.Append + +module Compiler = Compiler +module Decompiler = Decompiler +module Errors = Errors + +let compile_program = Compiler.compile_program +let compile_expression = Compiler.compile_expression + +let decompile = Decompiler.decompile diff --git a/src/passes/11-spilling/spilling.mli b/src/passes/11-spilling/spilling.mli new file mode 100644 index 000000000..b583ca564 --- /dev/null +++ b/src/passes/11-spilling/spilling.mli @@ -0,0 +1,12 @@ +open Trace +open Errors + +module AST = Ast_typed +module Append_tree = Tree.Append +module Errors = Errors +open Mini_c + +val compile_expression : AST.expression -> (expression, spilling_error) result +val compile_program : AST.program -> (program, spilling_error) result + +val decompile : value -> AST.type_expression -> (AST.expression , spilling_error) result diff --git a/src/passes/11-self_mini_c/dune b/src/passes/12-self_mini_c/dune similarity index 100% rename from src/passes/11-self_mini_c/dune rename to src/passes/12-self_mini_c/dune diff --git a/src/passes/11-self_mini_c/errors.ml b/src/passes/12-self_mini_c/errors.ml similarity index 100% rename from src/passes/11-self_mini_c/errors.ml rename to src/passes/12-self_mini_c/errors.ml diff --git a/src/passes/11-self_mini_c/helpers.ml b/src/passes/12-self_mini_c/helpers.ml similarity index 100% rename from src/passes/11-self_mini_c/helpers.ml rename to src/passes/12-self_mini_c/helpers.ml diff --git a/src/passes/11-self_mini_c/michelson_restrictions.ml b/src/passes/12-self_mini_c/michelson_restrictions.ml similarity index 100% rename from src/passes/11-self_mini_c/michelson_restrictions.ml rename to src/passes/12-self_mini_c/michelson_restrictions.ml diff --git a/src/passes/11-self_mini_c/self_mini_c.ml b/src/passes/12-self_mini_c/self_mini_c.ml similarity index 100% rename from src/passes/11-self_mini_c/self_mini_c.ml rename to src/passes/12-self_mini_c/self_mini_c.ml diff --git a/src/passes/11-self_mini_c/subst.ml b/src/passes/12-self_mini_c/subst.ml similarity index 100% rename from src/passes/11-self_mini_c/subst.ml rename to src/passes/12-self_mini_c/subst.ml diff --git a/src/passes/12-compiler/compiler_environment.ml b/src/passes/13-stacking/compiler_environment.ml similarity index 87% rename from src/passes/12-compiler/compiler_environment.ml rename to src/passes/13-stacking/compiler_environment.ml index 77ff075ba..c561223fe 100644 --- a/src/passes/12-compiler/compiler_environment.ml +++ b/src/passes/13-stacking/compiler_environment.ml @@ -6,7 +6,7 @@ open Michelson let empty : environment = [] -let get : environment -> expression_variable -> (michelson, compiler_error) result = fun e s -> +let get : environment -> expression_variable -> (michelson, stacking_error) result = fun e s -> let%bind (_ , position) = generic_try (get_env s e) @@ (fun () -> Environment.get_i s e) in @@ -23,7 +23,7 @@ let get : environment -> expression_variable -> (michelson, compiler_error) resu ok code -let pack_closure : environment -> selector -> (michelson, compiler_error) result = fun e lst -> +let pack_closure : environment -> selector -> (michelson, stacking_error) result = fun e lst -> let%bind () = Assert.assert_true (corner_case ~loc:__LOC__ "pack closure") (e <> []) in (* Tag environment with selected elements. Only the first occurence @@ -53,7 +53,7 @@ let pack_closure : environment -> selector -> (michelson, compiler_error) result ok code -let unpack_closure : environment -> (michelson , compiler_error) result = fun e -> +let unpack_closure : environment -> (michelson , stacking_error) result = fun e -> match e with | [] -> ok @@ seq [] | _ :: tl -> ( diff --git a/src/passes/12-compiler/compiler_environment.mli b/src/passes/13-stacking/compiler_environment.mli similarity index 80% rename from src/passes/12-compiler/compiler_environment.mli rename to src/passes/13-stacking/compiler_environment.mli index fc68931a7..0b0bb444e 100644 --- a/src/passes/12-compiler/compiler_environment.mli +++ b/src/passes/13-stacking/compiler_environment.mli @@ -9,10 +9,10 @@ module Stack = Meta_michelson.Stack *) val empty: environment val get : environment -> expression_variable -> - (michelson , compiler_error) result + (michelson , stacking_error) result -val pack_closure : environment -> selector -> (michelson , compiler_error) result -val unpack_closure : environment -> (michelson , compiler_error) result +val pack_closure : environment -> selector -> (michelson , stacking_error) result +val unpack_closure : environment -> (michelson , stacking_error) result (* val add : environment -> (string * type_value) -> michelson result diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/13-stacking/compiler_program.ml similarity index 98% rename from src/passes/12-compiler/compiler_program.ml rename to src/passes/13-stacking/compiler_program.ml index 003458a88..670fdd4bd 100644 --- a/src/passes/12-compiler/compiler_program.ml +++ b/src/passes/13-stacking/compiler_program.ml @@ -3,11 +3,11 @@ open Errors open Mini_c open Michelson open Memory_proto_alpha.Protocol.Script_ir_translator -open Operators.Compiler +open Predefined.Stacking (* This does not makes sense to me *) -let rec get_operator : constant' -> type_expression -> expression list -> (predicate , compiler_error) result = fun s ty lst -> - match Operators.Compiler.get_operators s with +let rec get_operator : constant' -> type_expression -> expression list -> (predicate , stacking_error) result = fun s ty lst -> + match Predefined.Stacking.get_operators s with | Some x -> ok x | None -> ( match s with @@ -146,7 +146,7 @@ let rec get_operator : constant' -> type_expression -> expression list -> (predi | x -> fail @@ corner_case ~loc:__LOC__ (Format.asprintf "predicate \"%a\" doesn't exist" PP.constant x) ) -and translate_value (v:value) ty : (michelson , compiler_error) result = match v with +and translate_value (v:value) ty : (michelson , stacking_error) result = match v with | D_bool b -> ok @@ prim (if b then D_True else D_False) | D_int n -> ok @@ int n | D_nat n -> ok @@ int n @@ -207,7 +207,7 @@ and translate_value (v:value) ty : (michelson , compiler_error) result = match v | D_operation _ -> fail @@ corner_case ~loc:__LOC__ "can't compile an operation" -and translate_expression (expr:expression) (env:environment) : (michelson , compiler_error) result = +and translate_expression (expr:expression) (env:environment) : (michelson , stacking_error) result = let (expr' , ty) = Combinators.Expression.(get_content expr , get_type expr) in let return code = ok code in @@ -461,7 +461,7 @@ and translate_expression (expr:expression) (env:environment) : (michelson , comp let%bind ty = Compiler_type.type_ ty in return @@ i_push ty code -and translate_function_body ({body ; binder} : anon_function) lst input : (michelson , compiler_error) result = +and translate_function_body ({body ; binder} : anon_function) lst input : (michelson , stacking_error) result = let pre_env = Environment.of_list lst in let env = Environment.(add (binder , input) pre_env) in let%bind expr_code = translate_expression body env in @@ -478,7 +478,7 @@ and translate_function_body ({body ; binder} : anon_function) lst input : (miche ok code -and translate_function anon env input_ty output_ty : (michelson , compiler_error) result = +and translate_function anon env input_ty output_ty : (michelson , stacking_error) result = let fvs = Mini_c.Free_variables.lambda [] anon in let small_env = Mini_c.Environment.select fvs env in let%bind (_lambda_ty , input_ty' , output_ty') = diff --git a/src/passes/12-compiler/compiler_program.mli b/src/passes/13-stacking/compiler_program.mli similarity index 65% rename from src/passes/12-compiler/compiler_program.mli rename to src/passes/13-stacking/compiler_program.mli index 0b7d2a02b..eed0d1090 100644 --- a/src/passes/12-compiler/compiler_program.mli +++ b/src/passes/13-stacking/compiler_program.mli @@ -4,7 +4,7 @@ open Mini_c open Michelson open Memory_proto_alpha.Protocol.Script_ir_translator -open Operators.Compiler +open Predefined.Stacking (* module Contract_types = Meta_michelson.Types @@ -16,10 +16,10 @@ type compiled_expression = { } -val get_operator : constant' -> type_expression -> expression list -> (predicate, compiler_error) result +val get_operator : constant' -> type_expression -> expression list -> (predicate, stacking_error) result -val translate_expression : expression -> environment -> (michelson, compiler_error) result +val translate_expression : expression -> environment -> (michelson, stacking_error) result -val translate_function_body : anon_function -> environment_element list -> type_expression -> (michelson, compiler_error) result +val translate_function_body : anon_function -> environment_element list -> type_expression -> (michelson, stacking_error) result -val translate_value : value -> type_expression -> (michelson, compiler_error) result +val translate_value : value -> type_expression -> (michelson, stacking_error) result diff --git a/src/passes/12-compiler/compiler_type.ml b/src/passes/13-stacking/compiler_type.ml similarity index 93% rename from src/passes/12-compiler/compiler_type.ml rename to src/passes/13-stacking/compiler_type.ml index 08a2cd625..b0cbae3b0 100644 --- a/src/passes/12-compiler/compiler_type.ml +++ b/src/passes/13-stacking/compiler_type.ml @@ -57,7 +57,7 @@ module Ty = struct let pair_ann (anna, a) (annb, b) = Pair_t ((a, field_annot anna, None), (b, field_annot annb, None), None , has_big_map a || has_big_map b) - let comparable_type_base : type_base -> (ex_comparable_ty , compiler_error) result = fun tb -> + let comparable_type_base : type_base -> (ex_comparable_ty , stacking_error) result = fun tb -> let return x = ok @@ Ex_comparable_ty x in match tb with | TB_unit -> fail (Errors.not_comparable_base tb) @@ -76,7 +76,7 @@ module Ty = struct | TB_key_hash -> return key_hash_k | TB_chain_id -> fail (Errors.not_comparable_base tb) - let comparable_leaf : type a. (a, _) comparable_struct -> ((a , leaf) comparable_struct , compiler_error) result = + let comparable_leaf : type a. (a, _) comparable_struct -> ((a , leaf) comparable_struct , stacking_error) result = fun a -> match a with | Pair_key _ -> fail Errors.not_comparable_pair_struct @@ -90,7 +90,7 @@ module Ty = struct | Timestamp_key annot -> ok (Timestamp_key annot) | Address_key annot -> ok (Address_key annot) - let rec comparable_type : type_expression -> (ex_comparable_ty , compiler_error) result = fun tv -> + let rec comparable_type : type_expression -> (ex_comparable_ty , stacking_error) result = fun tv -> match tv.type_content with | T_base b -> comparable_type_base b | T_function _ -> fail (Errors.not_comparable tv) @@ -107,7 +107,7 @@ module Ty = struct | T_option _ -> fail (Errors.not_comparable tv) | T_contract _ -> fail (Errors.not_comparable tv) - let base_type : type_base -> (ex_ty , compiler_error) result = fun b -> + let base_type : type_base -> (ex_ty , stacking_error) result = fun b -> let return x = ok @@ Ex_ty x in match b with | TB_unit -> return unit @@ -126,7 +126,7 @@ module Ty = struct | TB_key_hash -> return key_hash | TB_chain_id -> return chain_id - let rec type_ : type_expression -> (ex_ty , compiler_error) result = + let rec type_ : type_expression -> (ex_ty , stacking_error) result = fun te -> match te.type_content with | T_base b -> base_type b | T_pair (t, t') -> ( @@ -165,7 +165,7 @@ module Ty = struct let%bind (Ex_ty t') = type_ t in ok @@ Ex_ty (contract t') - and annotated : type_expression annotated -> (ex_ty annotated , compiler_error) result = + and annotated : type_expression annotated -> (ex_ty annotated , stacking_error) result = fun (ann, a) -> let%bind a = type_ a in ok @@ (ann, a) @@ -181,7 +181,7 @@ module Ty = struct bind_fold_right_list aux tl_ty hds ) - and environment : environment -> (ex_stack_ty , compiler_error) result = fun env -> + and environment : environment -> (ex_stack_ty , stacking_error) result = fun env -> let%bind lst = bind_map_list type_ @@ List.map snd env in @@ -192,7 +192,7 @@ module Ty = struct end -let base_type : type_base -> (O.michelson , compiler_error) result = +let base_type : type_base -> (O.michelson , stacking_error) result = function | TB_unit -> ok @@ O.prim T_unit | TB_void -> fail (Errors.void_type_not_compilable) @@ -210,7 +210,7 @@ let base_type : type_base -> (O.michelson , compiler_error) result = | TB_key_hash -> ok @@ O.prim T_key_hash | TB_chain_id -> ok @@ O.prim T_chain_id -let rec type_ : type_expression -> (O.michelson , compiler_error) result = +let rec type_ : type_expression -> (O.michelson , stacking_error) result = fun te -> match te.type_content with | T_base b -> base_type b | T_pair (t, t') -> ( @@ -246,7 +246,7 @@ let rec type_ : type_expression -> (O.michelson , compiler_error) result = let%bind ret = type_ ret in ok @@ O.prim ~children:[arg;ret] T_lambda -and annotated : type_expression annotated -> (O.michelson , compiler_error) result = +and annotated : type_expression annotated -> (O.michelson , stacking_error) result = function | (Some ann, o) -> let%bind o' = type_ o in diff --git a/src/passes/12-compiler/compiler_type.mli b/src/passes/13-stacking/compiler_type.mli similarity index 80% rename from src/passes/12-compiler/compiler_type.mli rename to src/passes/13-stacking/compiler_type.mli index 2771561eb..901d67cb4 100644 --- a/src/passes/12-compiler/compiler_type.mli +++ b/src/passes/13-stacking/compiler_type.mli @@ -64,11 +64,11 @@ module Ty : sig val comparable_type : type_value -> ex_comparable_ty result val base_type : type_base -> ex_ty result *) - val type_ : type_expression -> (ex_ty, compiler_error) result + val type_ : type_expression -> (ex_ty, stacking_error) result - val environment_representation : environment -> (ex_ty, compiler_error) result + val environment_representation : environment -> (ex_ty, stacking_error) result - val environment : environment -> (ex_stack_ty, compiler_error) result + val environment : environment -> (ex_stack_ty, stacking_error) result (* val not_comparable : string -> unit -> error val not_compilable_type : string -> unit -> error @@ -82,14 +82,14 @@ module Ty : sig *) end -val type_ : type_expression -> (O.t, compiler_error) result +val type_ : type_expression -> (O.t, stacking_error) result -val environment_element : string * type_expression -> ((int, O.prim) Tezos_micheline.Micheline.node, compiler_error) result +val environment_element : string * type_expression -> ((int, O.prim) Tezos_micheline.Micheline.node, stacking_error) result -val environment : ( 'a * type_expression ) list -> (O.t list , compiler_error) result +val environment : ( 'a * type_expression ) list -> (O.t list , stacking_error) result val lambda_closure_with_ty : environment * type_expression * type_expression -> - (O.michelson * O.michelson * O.michelson, compiler_error) result + (O.michelson * O.michelson * O.michelson, stacking_error) result -val lambda_closure : environment * type_expression * type_expression -> ((int, O.prim) Tezos_micheline.Micheline.node, compiler_error) result +val lambda_closure : environment * type_expression * type_expression -> ((int, O.prim) Tezos_micheline.Micheline.node, stacking_error) result -val environment_closure : environment -> ((int , O.prim ) Tezos_micheline.Micheline.node, compiler_error) result +val environment_closure : environment -> ((int , O.prim ) Tezos_micheline.Micheline.node, stacking_error) result diff --git a/src/passes/12-compiler/uncompiler.ml b/src/passes/13-stacking/decompiler.ml similarity index 83% rename from src/passes/12-compiler/uncompiler.ml rename to src/passes/13-stacking/decompiler.ml index a6f2ca529..280a12067 100644 --- a/src/passes/12-compiler/uncompiler.ml +++ b/src/passes/13-stacking/decompiler.ml @@ -7,19 +7,19 @@ open Protocol open Script_typed_ir open Script_ir_translator -let rec translate_value (Ex_typed_value (ty, value)) : (value , compiler_error) result = +let rec decompile_value (Ex_typed_value (ty, value)) : (value , stacking_error) result = match (ty, value) with | Pair_t ((a_ty, _, _), (b_ty, _, _), _ , _), (a, b) -> ( - let%bind a = translate_value @@ Ex_typed_value(a_ty, a) in - let%bind b = translate_value @@ Ex_typed_value(b_ty, b) in + let%bind a = decompile_value @@ Ex_typed_value(a_ty, a) in + let%bind b = decompile_value @@ Ex_typed_value(b_ty, b) in ok @@ D_pair(a, b) ) | Union_t ((a_ty, _), _, _ , _), L a -> ( - let%bind a = translate_value @@ Ex_typed_value(a_ty, a) in + let%bind a = decompile_value @@ Ex_typed_value(a_ty, a) in ok @@ D_left a ) | Union_t (_, (b_ty, _), _ , _), R b -> ( - let%bind b = translate_value @@ Ex_typed_value(b_ty, b) in + let%bind b = decompile_value @@ Ex_typed_value(b_ty, b) in ok @@ D_right b ) | (Int_t _), n -> @@ -60,7 +60,7 @@ let rec translate_value (Ex_typed_value (ty, value)) : (value , compiler_error) | (Option_t _), None -> ok @@ D_none | (Option_t (o_ty, _, _)), Some s -> - let%bind s' = translate_value @@ Ex_typed_value (o_ty, s) in + let%bind s' = decompile_value @@ Ex_typed_value (o_ty, s) in ok @@ D_some s' | (Map_t (k_cty, v_ty, _ , _)), m -> let k_ty = Script_ir_translator.ty_of_comparable_ty k_cty in @@ -70,8 +70,8 @@ let rec translate_value (Ex_typed_value (ty, value)) : (value , compiler_error) List.rev lst in let%bind lst' = let aux (k, v) = - let%bind k' = translate_value (Ex_typed_value (k_ty, k)) in - let%bind v' = translate_value (Ex_typed_value (v_ty, v)) in + let%bind k' = decompile_value (Ex_typed_value (k_ty, k)) in + let%bind v' = decompile_value (Ex_typed_value (v_ty, v)) in ok (k', v') in bind_map_list aux lst @@ -85,11 +85,11 @@ let rec translate_value (Ex_typed_value (ty, value)) : (value , compiler_error) List.rev lst in let%bind lst' = let aux orig (k, v) = - let%bind k' = translate_value (Ex_typed_value (k_ty, k)) in + let%bind k' = decompile_value (Ex_typed_value (k_ty, k)) in let orig_rem = List.remove_assoc k' orig in match v with | Some vadd -> - let%bind v' = translate_value (Ex_typed_value (v_ty, vadd)) in + let%bind v' = decompile_value (Ex_typed_value (v_ty, vadd)) in if (List.mem_assoc k' orig) then ok @@ (k', v')::orig_rem else ok @@ (k', v')::orig | None -> ok orig_rem in @@ -97,7 +97,7 @@ let rec translate_value (Ex_typed_value (ty, value)) : (value , compiler_error) ok @@ D_big_map lst' | (List_t (ty, _ , _)), lst -> let%bind lst' = - let aux = fun t -> translate_value (Ex_typed_value (ty, t)) in + let aux = fun t -> decompile_value (Ex_typed_value (ty, t)) in bind_map_list aux lst in ok @@ D_list lst' @@ -108,7 +108,7 @@ let rec translate_value (Ex_typed_value (ty, value)) : (value , compiler_error) let lst = List.fold_left aux lst [] in List.rev lst in let%bind lst'' = - let aux = fun t -> translate_value (Ex_typed_value (ty_of_comparable_ty ty, t)) in + let aux = fun t -> decompile_value (Ex_typed_value (ty_of_comparable_ty ty, t)) in bind_map_list aux lst' in ok @@ D_set lst'' diff --git a/src/passes/12-compiler/uncompiler.mli b/src/passes/13-stacking/decompiler.mli similarity index 64% rename from src/passes/12-compiler/uncompiler.mli rename to src/passes/13-stacking/decompiler.mli index a2f7aedac..ce4634a4e 100644 --- a/src/passes/12-compiler/uncompiler.mli +++ b/src/passes/13-stacking/decompiler.mli @@ -4,4 +4,4 @@ open Proto_alpha_utils.Memory_proto_alpha open X open Proto_alpha_utils.Trace -val translate_value : ex_typed_value -> (value , compiler_error) result +val decompile_value : ex_typed_value -> (value , stacking_error) result diff --git a/src/passes/12-compiler/dune b/src/passes/13-stacking/dune similarity index 79% rename from src/passes/12-compiler/dune rename to src/passes/13-stacking/dune index 89878e2fd..2b8e14786 100644 --- a/src/passes/12-compiler/dune +++ b/src/passes/13-stacking/dune @@ -1,12 +1,12 @@ (library - (name compiler) - (public_name ligo.compiler) + (name stacking) + (public_name ligo.stacking) (libraries simple-utils proto-alpha-utils tezos-utils mini_c - operators + predefined ) (preprocess (pps ppx_let bisect_ppx --conditional) diff --git a/src/passes/12-compiler/errors.ml b/src/passes/13-stacking/errors.ml similarity index 63% rename from src/passes/12-compiler/errors.ml rename to src/passes/13-stacking/errors.ml index 244edf8e6..0c7a297f7 100644 --- a/src/passes/12-compiler/errors.ml +++ b/src/passes/13-stacking/errors.ml @@ -2,97 +2,97 @@ open Trace open Simple_utils.Display open Stage_common.Types -type compiler_error = [ - | `Compiler_get_environment of expression_variable * Mini_c.environment - | `Compiler_corner_case of string * string - | `Compiler_contract_entrypoint of string - | `Compiler_expression_tracer of Mini_c.expression * Mini_c.type_expression * compiler_error - | `Compiler_bad_iterator of Mini_c.constant' - | `Compiler_not_comparable_base of Mini_c.type_base - | `Compiler_not_comparable of Mini_c.type_expression - | `Compiler_not_comparable_pair_struct - | `Compiler_void_type_not_compilable - | `Compiler_unparsing_unrecognized_data of +type stacking_error = [ + | `Stacking_get_environment of expression_variable * Mini_c.environment + | `Stacking_corner_case of string * string + | `Stacking_contract_entrypoint of string + | `Stacking_expression_tracer of Mini_c.expression * Mini_c.type_expression * stacking_error + | `Stacking_bad_iterator of Mini_c.constant' + | `Stacking_not_comparable_base of Mini_c.type_base + | `Stacking_not_comparable of Mini_c.type_expression + | `Stacking_not_comparable_pair_struct + | `Stacking_void_type_not_compilable + | `Stacking_unparsing_unrecognized_data of (Proto_alpha_utils.Trace.tezos_alpha_error list) - | `Compiler_untranspilable of Michelson.michelson * Michelson.michelson - | `Compiler_bad_constant_arity of Mini_c.constant' + | `Stacking_untranspilable of Michelson.michelson * Michelson.michelson + | `Stacking_bad_constant_arity of Mini_c.constant' ] -let stage = "compiler" -let uncompiler_stage = "uncompiler_stage" +let stage = "stacking" +let unstacking_stage = "unstacking_stage" let corner_case_msg () = "we don't have a good error message for this case. we are striving find ways to better report them and find the use-cases that generate them. please report this to the developers." -let get_env var env = `Compiler_get_environment (var , env) -let corner_case ~loc message = `Compiler_corner_case (loc,message) -let contract_entrypoint_must_be_literal ~loc = `Compiler_contract_entrypoint loc -let compile_expression_tracer e ty err = `Compiler_expression_tracer (e,ty,err) -let bad_iterator cst = `Compiler_bad_iterator cst -let not_comparable_base tb = `Compiler_not_comparable_base tb -let not_comparable t = `Compiler_not_comparable t -let not_comparable_pair_struct = `Compiler_not_comparable_pair_struct -let void_type_not_compilable = `Compiler_void_type_not_compilable -let unrecognized_data errs = `Compiler_unparsing_unrecognized_data errs -let untranspilable m_data m_type = `Compiler_untranspilable (m_data, m_type) -let bad_constant_arity c = `Compiler_bad_constant_arity c +let get_env var env = `Stacking_get_environment (var , env) +let corner_case ~loc message = `Stacking_corner_case (loc,message) +let contract_entrypoint_must_be_literal ~loc = `Stacking_contract_entrypoint loc +let compile_expression_tracer e ty err = `Stacking_expression_tracer (e,ty,err) +let bad_iterator cst = `Stacking_bad_iterator cst +let not_comparable_base tb = `Stacking_not_comparable_base tb +let not_comparable t = `Stacking_not_comparable t +let not_comparable_pair_struct = `Stacking_not_comparable_pair_struct +let void_type_not_compilable = `Stacking_void_type_not_compilable +let unrecognized_data errs = `Stacking_unparsing_unrecognized_data errs +let untranspilable m_data m_type = `Stacking_untranspilable (m_data, m_type) +let bad_constant_arity c = `Stacking_bad_constant_arity c let rec error_ppformat : display_format:string display_format -> - Format.formatter -> compiler_error -> unit = + Format.formatter -> stacking_error -> unit = fun ~display_format f a -> match display_format with | Human_readable | Dev -> ( match a with - | `Compiler_get_environment (var,env) -> + | `Stacking_get_environment (var,env) -> let s = Format.asprintf "failed to get var %a in environment %a" Var.pp var Mini_c.PP.environment env in Format.pp_print_string f s ; - | `Compiler_corner_case (loc,msg) -> - let s = Format.asprintf "compiler corner case at %s : %s\n %s" + | `Stacking_corner_case (loc,msg) -> + let s = Format.asprintf "stacking corner case at %s : %s\n %s" loc msg (corner_case_msg ()) in Format.pp_print_string f s ; - | `Compiler_contract_entrypoint loc -> + | `Stacking_contract_entrypoint loc -> let s = Format.asprintf "contract entrypoint must be given as a literal string: %s" loc in Format.pp_print_string f s ; - | `Compiler_expression_tracer (e,ty,err) -> + | `Stacking_expression_tracer (e,ty,err) -> Format.fprintf f "@[compiling expression@%a of type %a@%a]" Mini_c.PP.expression e Mini_c.PP.type_variable ty (error_ppformat ~display_format) err - | `Compiler_bad_iterator cst -> + | `Stacking_bad_iterator cst -> let s = Format.asprintf "bad iterator: iter %a" Mini_c.PP.constant cst in Format.pp_print_string f s ; - | `Compiler_not_comparable_base tb -> + | `Stacking_not_comparable_base tb -> let s = Format.asprintf "not a comparable type: %a" Mini_c.PP.type_constant tb in Format.pp_print_string f s ; - | `Compiler_not_comparable t -> + | `Stacking_not_comparable t -> let s = Format.asprintf "not a comparable type: %a" Mini_c.PP.type_variable t in Format.pp_print_string f s ; - | `Compiler_not_comparable_pair_struct -> + | `Stacking_not_comparable_pair_struct -> let s = "pair does not have a comparable structure. (hint: use (a,(b,c)) instead of (a,b,c))" in Format.pp_print_string f s; - | `Compiler_void_type_not_compilable -> + | `Stacking_void_type_not_compilable -> let s = "void is not a compilable type" in Format.pp_print_string f s; - | `Compiler_unparsing_unrecognized_data _errlist -> + | `Stacking_unparsing_unrecognized_data _errlist -> let s = "unparsing unrecognized data" in Format.pp_print_string f s; - | `Compiler_untranspilable (mdata,mty) -> + | `Stacking_untranspilable (mdata,mty) -> let s = Format.asprintf "this value can't be transpiled back yet. data : %a type : %a" Michelson.pp mdata Michelson.pp mty in Format.pp_print_string f s; - | `Compiler_bad_constant_arity c -> + | `Stacking_bad_constant_arity c -> Format.fprintf f "Bad arity for %a" Mini_c.PP.constant c ) -let rec error_jsonformat : compiler_error -> J.t = fun a -> +let rec error_jsonformat : stacking_error -> J.t = fun a -> let json_error ~stage ~content = `Assoc [ ("status", `String "error") ; @@ -100,7 +100,7 @@ let rec error_jsonformat : compiler_error -> J.t = fun a -> ("content", content )] in match a with - | `Compiler_get_environment (var,env) -> + | `Stacking_get_environment (var,env) -> let var' = Format.asprintf "%a" Var.pp var in let env' = Format.asprintf "%a" Mini_c.PP.environment env in let content = `Assoc [ @@ -108,17 +108,17 @@ let rec error_jsonformat : compiler_error -> J.t = fun a -> ("var", `String var'); ("environment", `String env'); ] in json_error ~stage ~content - | `Compiler_corner_case (loc,msg) -> + | `Stacking_corner_case (loc,msg) -> let content = `Assoc [ ("location", `String loc); ("message", `String msg); ] in json_error ~stage ~content - | `Compiler_contract_entrypoint loc -> + | `Stacking_contract_entrypoint loc -> let content = `Assoc [ ("location", `String loc); ("message", `String "contract entrypoint must be given as literal string"); ] in json_error ~stage ~content - | `Compiler_expression_tracer (e,ty,err) -> + | `Stacking_expression_tracer (e,ty,err) -> let e' = Format.asprintf "%a" Mini_c.PP.expression e in let ty' = Format.asprintf "%a" Mini_c.PP.type_variable ty in let children = error_jsonformat err in @@ -129,44 +129,44 @@ let rec error_jsonformat : compiler_error -> J.t = fun a -> ("children", children) ] in json_error ~stage ~content - | `Compiler_bad_iterator cst -> + | `Stacking_bad_iterator cst -> let s = Format.asprintf "%a" Mini_c.PP.constant cst in let content = `Assoc [ ("message", `String "bad iterator"); ("iterator", `String s); ] in json_error ~stage ~content - | `Compiler_not_comparable_base tb -> + | `Stacking_not_comparable_base tb -> let s = Format.asprintf "%a" Mini_c.PP.type_constant tb in let content = `Assoc [ ("message", `String "not a comparable type"); ("type", `String s); ] in json_error ~stage ~content - | `Compiler_not_comparable t -> + | `Stacking_not_comparable t -> let s = Format.asprintf "%a" Mini_c.PP.type_variable t in let content = `Assoc [ ("message", `String "not a comparable type"); ("type", `String s); ] in json_error ~stage ~content - | `Compiler_not_comparable_pair_struct -> + | `Stacking_not_comparable_pair_struct -> let content = `Assoc [ ("message", `String "pair does not have a comparable structure"); ("hint", `String "use (a,(b,c)) instead of (a,b,c)"); ] in json_error ~stage ~content - | `Compiler_void_type_not_compilable -> + | `Stacking_void_type_not_compilable -> let content = `Assoc [ ("message", `String "void is not a compilable type"); ] in json_error ~stage ~content - | `Compiler_unparsing_unrecognized_data _errlist -> + | `Stacking_unparsing_unrecognized_data _errlist -> let content = `Assoc [ ("message", `String "unparsing unrecognized data"); ] in - json_error ~stage:uncompiler_stage ~content - | `Compiler_untranspilable (mdata,mty) -> + json_error ~stage:unstacking_stage ~content + | `Stacking_untranspilable (mdata,mty) -> let mdata' = Format.asprintf "%a" Michelson.pp mdata in let mty' = Format.asprintf "%a" Michelson.pp mty in let content = `Assoc [ @@ -175,11 +175,11 @@ let rec error_jsonformat : compiler_error -> J.t = fun a -> ("michelson type", `String mty'); ] in - json_error ~stage:uncompiler_stage ~content - | `Compiler_bad_constant_arity c -> + json_error ~stage:unstacking_stage ~content + | `Stacking_bad_constant_arity c -> let constant = Format.asprintf "%a" Mini_c.PP.constant c in let content = `Assoc [ ("message", `String "Bad constant arity"); ("constant", `String constant)] in - json_error ~stage ~content \ No newline at end of file + json_error ~stage ~content diff --git a/src/passes/12-compiler/compiler.ml b/src/passes/13-stacking/stacking.ml similarity index 64% rename from src/passes/12-compiler/compiler.ml rename to src/passes/13-stacking/stacking.ml index 4389b4f00..c06f5b711 100644 --- a/src/passes/12-compiler/compiler.ml +++ b/src/passes/13-stacking/stacking.ml @@ -1,7 +1,9 @@ -module Uncompiler = Uncompiler +module Decompiler = Decompiler module Program = Compiler_program module Type = Compiler_type module Environment = Compiler_environment module Errors = Errors include Program + +let decompile_value = Decompiler.decompile_value diff --git a/src/passes/13-self_michelson/dune b/src/passes/14-self_michelson/dune similarity index 100% rename from src/passes/13-self_michelson/dune rename to src/passes/14-self_michelson/dune diff --git a/src/passes/13-self_michelson/helpers.ml b/src/passes/14-self_michelson/helpers.ml similarity index 100% rename from src/passes/13-self_michelson/helpers.ml rename to src/passes/14-self_michelson/helpers.ml diff --git a/src/passes/13-self_michelson/main.ml b/src/passes/14-self_michelson/main.ml similarity index 100% rename from src/passes/13-self_michelson/main.ml rename to src/passes/14-self_michelson/main.ml diff --git a/src/passes/13-self_michelson/self_michelson.ml b/src/passes/14-self_michelson/self_michelson.ml similarity index 100% rename from src/passes/13-self_michelson/self_michelson.ml rename to src/passes/14-self_michelson/self_michelson.ml diff --git a/src/passes/operators/dune b/src/passes/predefined/dune similarity index 82% rename from src/passes/operators/dune rename to src/passes/predefined/dune index fa69f6257..30ea10add 100644 --- a/src/passes/operators/dune +++ b/src/passes/predefined/dune @@ -1,6 +1,6 @@ (library - (name operators) - (public_name ligo.operators) + (name predefined) + (public_name ligo.predefined) (libraries simple-utils tezos-utils diff --git a/src/passes/operators/helpers.ml b/src/passes/predefined/helpers.ml similarity index 95% rename from src/passes/operators/helpers.ml rename to src/passes/predefined/helpers.ml index 4fc4eba63..640389c9c 100644 --- a/src/passes/operators/helpers.ml +++ b/src/passes/predefined/helpers.ml @@ -1,4 +1,4 @@ -module Compiler = struct +module Stacking = struct open Tezos_utils.Michelson diff --git a/src/passes/operators/helpers.mli b/src/passes/predefined/helpers.mli similarity index 95% rename from src/passes/operators/helpers.mli rename to src/passes/predefined/helpers.mli index 6182ad1fe..5a26c0428 100644 --- a/src/passes/operators/helpers.mli +++ b/src/passes/predefined/helpers.mli @@ -1,4 +1,4 @@ -module Compiler : sig +module Stacking : sig open Tezos_utils.Michelson type predicate = diff --git a/src/passes/operators/operators.ml b/src/passes/predefined/predefined.ml similarity index 98% rename from src/passes/operators/operators.ml rename to src/passes/predefined/predefined.ml index 30b29f6de..3701b62ab 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/predefined/predefined.ml @@ -3,11 +3,11 @@ that you have to modify when you add a new operator/constant to the language. This file mirrors the LIGO pipeline, starting with Simplify, then Typer and - ending with Compiler. Usually, when adding a new operator, you'll have to add + ending with Stacking. Usually, when adding a new operator, you'll have to add a new constructor at all those places. *) -module Concrete_to_imperative = struct +module Tree_abstraction = struct open Ast_imperative (* @@ -375,13 +375,13 @@ module Concrete_to_imperative = struct end end -module Compiler = struct +module Stacking = struct (* - Most constants pass through the Transpiler unchanged. So they need to be + Most constants pass through the Spilling unchanged. So they need to be compiled down to Michelson. This is the last step. When compiling the constant, we need to provide its arity (through the type - predicate, defined in `Helpers.Compiler`, and its michelson code. + predicate, defined in `Helpers.Stacking`, and its michelson code. In the case of an n-ary constant, we assume that the stack has the form: `x1 :: x2 :: x3 ... :: xn :: _`. @@ -390,7 +390,7 @@ module Compiler = struct be written by hand. *) - include Helpers.Compiler + include Helpers.Stacking open Tezos_utils.Michelson open Mini_c @@ -461,4 +461,4 @@ module Compiler = struct | C_CHAIN_ID -> Some ( simple_constant @@ prim I_CHAIN_ID) | _ -> None -end \ No newline at end of file +end diff --git a/src/passes/operators/operators.mli b/src/passes/predefined/predefined.mli similarity index 92% rename from src/passes/operators/operators.mli rename to src/passes/predefined/predefined.mli index 3ccced4df..15a213ae0 100644 --- a/src/passes/operators/operators.mli +++ b/src/passes/predefined/predefined.mli @@ -1,5 +1,5 @@ -module Concrete_to_imperative : sig +module Tree_abstraction : sig open Ast_imperative module Pascaligo : sig @@ -16,9 +16,9 @@ module Concrete_to_imperative : sig end -module Compiler : sig +module Stacking : sig (* - include Helpers.Compiler + include Helpers.Stacking *) open Tezos_utils.Michelson open Mini_c diff --git a/src/passes/01-parser/cameligo/AST.ml b/src/stages/1-cst/cameligo/CST.ml similarity index 100% rename from src/passes/01-parser/cameligo/AST.ml rename to src/stages/1-cst/cameligo/CST.ml diff --git a/src/passes/01-parser/cameligo/ParserLog.ml b/src/stages/1-cst/cameligo/ParserLog.ml similarity index 99% rename from src/passes/01-parser/cameligo/ParserLog.ml rename to src/stages/1-cst/cameligo/ParserLog.ml index b06ac2ca3..5331e3e65 100644 --- a/src/passes/01-parser/cameligo/ParserLog.ml +++ b/src/stages/1-cst/cameligo/ParserLog.ml @@ -1,7 +1,7 @@ [@@@warning "-42"] [@@@coverage exclude_file] -open AST +open CST module Region = Simple_utils.Region open! Region diff --git a/src/passes/01-parser/cameligo/ParserLog.mli b/src/stages/1-cst/cameligo/ParserLog.mli similarity index 57% rename from src/passes/01-parser/cameligo/ParserLog.mli rename to src/stages/1-cst/cameligo/ParserLog.mli index 14fdc9bcd..6a8abf245 100644 --- a/src/passes/01-parser/cameligo/ParserLog.mli +++ b/src/stages/1-cst/cameligo/ParserLog.mli @@ -14,20 +14,20 @@ val mk_state : for debugging, as the output of [print_token ast] can be textually compared to that of [Lexer.trace] (see module [LexerMain]). *) -val print_tokens : state -> AST.t -> unit -val print_pattern : state -> AST.pattern -> unit -val print_expr : state -> AST.expr -> unit +val print_tokens : state -> CST.t -> unit +val print_pattern : state -> CST.pattern -> unit +val print_expr : state -> CST.expr -> unit val tokens_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.t -> string + offsets:bool -> mode:[`Point|`Byte] -> CST.t -> string val pattern_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.pattern -> string + offsets:bool -> mode:[`Point|`Byte] -> CST.pattern -> string val expr_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.expr -> string + offsets:bool -> mode:[`Point|`Byte] -> CST.expr -> string val type_expr_to_string : - offsets:bool -> mode:[`Point|`Byte] -> AST.type_expr -> string + offsets:bool -> mode:[`Point|`Byte] -> CST.type_expr -> string (** {1 Pretty-printing of AST nodes} *) -val pp_cst : state -> AST.t -> unit -val pp_expr : state -> AST.expr -> unit +val pp_cst : state -> CST.t -> unit +val pp_expr : state -> CST.expr -> unit diff --git a/src/stages/1-cst/cameligo/cameligo.ml b/src/stages/1-cst/cameligo/cameligo.ml new file mode 100644 index 000000000..0429a03db --- /dev/null +++ b/src/stages/1-cst/cameligo/cameligo.ml @@ -0,0 +1 @@ +include CST diff --git a/src/stages/1-cst/cameligo/dune b/src/stages/1-cst/cameligo/dune new file mode 100644 index 000000000..5249351d2 --- /dev/null +++ b/src/stages/1-cst/cameligo/dune @@ -0,0 +1,13 @@ +(library + (name cst_cameligo) + (public_name ligo.cst.cameligo) + (libraries + simple-utils + tezos-utils + parser_shared + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -open Parser_shared -open Simple_utils )) +) diff --git a/src/stages/1-cst/cst.ml b/src/stages/1-cst/cst.ml new file mode 100644 index 000000000..fd4dd7016 --- /dev/null +++ b/src/stages/1-cst/cst.ml @@ -0,0 +1,2 @@ +module Cameligo = Cst_cameligo.CST +module Pascaligo = Cst_pascaligo.CST diff --git a/src/stages/1-cst/dune b/src/stages/1-cst/dune new file mode 100644 index 000000000..10a31affb --- /dev/null +++ b/src/stages/1-cst/dune @@ -0,0 +1,14 @@ +(library + (name cst) + (public_name ligo.cst) + (libraries + simple-utils + tezos-utils + cst_cameligo + cst_pascaligo + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -open Simple_utils )) +) diff --git a/src/passes/01-parser/pascaligo/AST.ml b/src/stages/1-cst/pascaligo/CST.ml similarity index 100% rename from src/passes/01-parser/pascaligo/AST.ml rename to src/stages/1-cst/pascaligo/CST.ml diff --git a/src/passes/01-parser/pascaligo/ParserLog.ml b/src/stages/1-cst/pascaligo/ParserLog.ml similarity index 99% rename from src/passes/01-parser/pascaligo/ParserLog.ml rename to src/stages/1-cst/pascaligo/ParserLog.ml index 511140ea7..e33c9be4c 100644 --- a/src/passes/01-parser/pascaligo/ParserLog.ml +++ b/src/stages/1-cst/pascaligo/ParserLog.ml @@ -1,7 +1,7 @@ [@@@warning "-42"] [@@@coverage exclude_file] -open AST +open CST module Region = Simple_utils.Region open! Region @@ -868,7 +868,7 @@ let instruction_to_string ~offsets ~mode = let type_expr_to_string ~offsets ~mode = to_string ~offsets ~mode print_type_expr -(* Pretty-printing the AST *) +(* Pretty-printing the CST *) let pp_ident state {value=name; region} = let reg = compact state region in diff --git a/src/stages/1-cst/pascaligo/ParserLog.mli b/src/stages/1-cst/pascaligo/ParserLog.mli new file mode 100644 index 000000000..af3ab8528 --- /dev/null +++ b/src/stages/1-cst/pascaligo/ParserLog.mli @@ -0,0 +1,39 @@ +(** Printing the CST *) + +(** The type [state] captures the state that is threaded in the + printing iterators in this module. +*) +type state + +val mk_state : + offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state + +(** {1 Printing tokens from the CST in a buffer} + + Printing the tokens reconstructed from the CST. This is very useful + for debugging, as the output of [print_token ast] can be textually + compared to that of [Lexer.trace] (see module [LexerMain]). *) + +val print_tokens : state -> CST.t -> unit +val print_path : state -> CST.path -> unit +val print_pattern : state -> CST.pattern -> unit +val print_instruction : state -> CST.instruction -> unit +val print_expr : state -> CST.expr -> unit + +(** {1 Printing tokens from the CST in a string} *) + +val tokens_to_string : + offsets:bool -> mode:[`Point|`Byte] -> CST.t -> string +val path_to_string : + offsets:bool -> mode:[`Point|`Byte] -> CST.path -> string +val pattern_to_string : + offsets:bool -> mode:[`Point|`Byte] -> CST.pattern -> string +val instruction_to_string : + offsets:bool -> mode:[`Point|`Byte] -> CST.instruction -> string +val type_expr_to_string : + offsets:bool -> mode:[`Point|`Byte] -> CST.type_expr -> string + +(** {1 Pretty-printing of CST nodes} *) + +val pp_cst : state -> CST.t -> unit +val pp_expr : state -> CST.expr -> unit diff --git a/src/stages/1-cst/pascaligo/dune b/src/stages/1-cst/pascaligo/dune new file mode 100644 index 000000000..242fcfc0f --- /dev/null +++ b/src/stages/1-cst/pascaligo/dune @@ -0,0 +1,13 @@ +(library + (name cst_pascaligo) + (public_name ligo.cst.pascaligo) + (libraries + simple-utils + tezos-utils + parser_shared + ) + (preprocess + (pps ppx_let bisect_ppx --conditional) + ) + (flags (:standard -open Parser_shared -open Simple_utils )) +) diff --git a/src/stages/1-cst/pascaligo/pascaligo.ml b/src/stages/1-cst/pascaligo/pascaligo.ml new file mode 100644 index 000000000..0429a03db --- /dev/null +++ b/src/stages/1-cst/pascaligo/pascaligo.ml @@ -0,0 +1 @@ +include CST diff --git a/src/stages/1-ast_imperative/PP.ml b/src/stages/2-ast_imperative/PP.ml similarity index 100% rename from src/stages/1-ast_imperative/PP.ml rename to src/stages/2-ast_imperative/PP.ml diff --git a/src/stages/1-ast_imperative/ast_imperative.ml b/src/stages/2-ast_imperative/ast_imperative.ml similarity index 100% rename from src/stages/1-ast_imperative/ast_imperative.ml rename to src/stages/2-ast_imperative/ast_imperative.ml diff --git a/src/stages/1-ast_imperative/combinators.ml b/src/stages/2-ast_imperative/combinators.ml similarity index 100% rename from src/stages/1-ast_imperative/combinators.ml rename to src/stages/2-ast_imperative/combinators.ml diff --git a/src/stages/1-ast_imperative/combinators.mli b/src/stages/2-ast_imperative/combinators.mli similarity index 100% rename from src/stages/1-ast_imperative/combinators.mli rename to src/stages/2-ast_imperative/combinators.mli diff --git a/src/stages/1-ast_imperative/dune b/src/stages/2-ast_imperative/dune similarity index 100% rename from src/stages/1-ast_imperative/dune rename to src/stages/2-ast_imperative/dune diff --git a/src/stages/1-ast_imperative/formatter.ml b/src/stages/2-ast_imperative/formatter.ml similarity index 100% rename from src/stages/1-ast_imperative/formatter.ml rename to src/stages/2-ast_imperative/formatter.ml diff --git a/src/stages/1-ast_imperative/types.ml b/src/stages/2-ast_imperative/types.ml similarity index 100% rename from src/stages/1-ast_imperative/types.ml rename to src/stages/2-ast_imperative/types.ml diff --git a/src/stages/2-ast_sugar/PP.ml b/src/stages/3-ast_sugar/PP.ml similarity index 100% rename from src/stages/2-ast_sugar/PP.ml rename to src/stages/3-ast_sugar/PP.ml diff --git a/src/stages/2-ast_sugar/ast_sugar.ml b/src/stages/3-ast_sugar/ast_sugar.ml similarity index 100% rename from src/stages/2-ast_sugar/ast_sugar.ml rename to src/stages/3-ast_sugar/ast_sugar.ml diff --git a/src/stages/2-ast_sugar/combinators.ml b/src/stages/3-ast_sugar/combinators.ml similarity index 100% rename from src/stages/2-ast_sugar/combinators.ml rename to src/stages/3-ast_sugar/combinators.ml diff --git a/src/stages/2-ast_sugar/combinators.mli b/src/stages/3-ast_sugar/combinators.mli similarity index 100% rename from src/stages/2-ast_sugar/combinators.mli rename to src/stages/3-ast_sugar/combinators.mli diff --git a/src/stages/2-ast_sugar/dune b/src/stages/3-ast_sugar/dune similarity index 100% rename from src/stages/2-ast_sugar/dune rename to src/stages/3-ast_sugar/dune diff --git a/src/stages/2-ast_sugar/formatter.ml b/src/stages/3-ast_sugar/formatter.ml similarity index 100% rename from src/stages/2-ast_sugar/formatter.ml rename to src/stages/3-ast_sugar/formatter.ml diff --git a/src/stages/2-ast_sugar/types.ml b/src/stages/3-ast_sugar/types.ml similarity index 100% rename from src/stages/2-ast_sugar/types.ml rename to src/stages/3-ast_sugar/types.ml diff --git a/src/stages/3-ast_core/PP.ml b/src/stages/4-ast_core/PP.ml similarity index 100% rename from src/stages/3-ast_core/PP.ml rename to src/stages/4-ast_core/PP.ml diff --git a/src/stages/3-ast_core/ast_core.ml b/src/stages/4-ast_core/ast_core.ml similarity index 100% rename from src/stages/3-ast_core/ast_core.ml rename to src/stages/4-ast_core/ast_core.ml diff --git a/src/stages/3-ast_core/combinators.ml b/src/stages/4-ast_core/combinators.ml similarity index 100% rename from src/stages/3-ast_core/combinators.ml rename to src/stages/4-ast_core/combinators.ml diff --git a/src/stages/3-ast_core/combinators.mli b/src/stages/4-ast_core/combinators.mli similarity index 100% rename from src/stages/3-ast_core/combinators.mli rename to src/stages/4-ast_core/combinators.mli diff --git a/src/stages/3-ast_core/dune b/src/stages/4-ast_core/dune similarity index 100% rename from src/stages/3-ast_core/dune rename to src/stages/4-ast_core/dune diff --git a/src/stages/3-ast_core/formatter.ml b/src/stages/4-ast_core/formatter.ml similarity index 100% rename from src/stages/3-ast_core/formatter.ml rename to src/stages/4-ast_core/formatter.ml diff --git a/src/stages/3-ast_core/misc.ml b/src/stages/4-ast_core/misc.ml similarity index 100% rename from src/stages/3-ast_core/misc.ml rename to src/stages/4-ast_core/misc.ml diff --git a/src/stages/3-ast_core/misc.mli b/src/stages/4-ast_core/misc.mli similarity index 100% rename from src/stages/3-ast_core/misc.mli rename to src/stages/4-ast_core/misc.mli diff --git a/src/stages/3-ast_core/types.ml b/src/stages/4-ast_core/types.ml similarity index 100% rename from src/stages/3-ast_core/types.ml rename to src/stages/4-ast_core/types.ml diff --git a/src/stages/4-ast_typed/.gitignore b/src/stages/5-ast_typed/.gitignore similarity index 100% rename from src/stages/4-ast_typed/.gitignore rename to src/stages/5-ast_typed/.gitignore diff --git a/src/stages/4-ast_typed/PP.ml b/src/stages/5-ast_typed/PP.ml similarity index 100% rename from src/stages/4-ast_typed/PP.ml rename to src/stages/5-ast_typed/PP.ml diff --git a/src/stages/4-ast_typed/PP_generic.ml b/src/stages/5-ast_typed/PP_generic.ml similarity index 100% rename from src/stages/4-ast_typed/PP_generic.ml rename to src/stages/5-ast_typed/PP_generic.ml diff --git a/src/stages/4-ast_typed/ast.ml b/src/stages/5-ast_typed/ast.ml similarity index 100% rename from src/stages/4-ast_typed/ast.ml rename to src/stages/5-ast_typed/ast.ml diff --git a/src/stages/4-ast_typed/ast_typed.ml b/src/stages/5-ast_typed/ast_typed.ml similarity index 100% rename from src/stages/4-ast_typed/ast_typed.ml rename to src/stages/5-ast_typed/ast_typed.ml diff --git a/src/stages/4-ast_typed/combinators.ml b/src/stages/5-ast_typed/combinators.ml similarity index 100% rename from src/stages/4-ast_typed/combinators.ml rename to src/stages/5-ast_typed/combinators.ml diff --git a/src/stages/4-ast_typed/combinators.mli b/src/stages/5-ast_typed/combinators.mli similarity index 100% rename from src/stages/4-ast_typed/combinators.mli rename to src/stages/5-ast_typed/combinators.mli diff --git a/src/stages/4-ast_typed/comparable.ml b/src/stages/5-ast_typed/comparable.ml similarity index 100% rename from src/stages/4-ast_typed/comparable.ml rename to src/stages/5-ast_typed/comparable.ml diff --git a/src/stages/4-ast_typed/compare_generic.ml b/src/stages/5-ast_typed/compare_generic.ml similarity index 100% rename from src/stages/4-ast_typed/compare_generic.ml rename to src/stages/5-ast_typed/compare_generic.ml diff --git a/src/stages/4-ast_typed/compute_environment.ml b/src/stages/5-ast_typed/compute_environment.ml similarity index 100% rename from src/stages/4-ast_typed/compute_environment.ml rename to src/stages/5-ast_typed/compute_environment.ml diff --git a/src/stages/4-ast_typed/dune b/src/stages/5-ast_typed/dune similarity index 100% rename from src/stages/4-ast_typed/dune rename to src/stages/5-ast_typed/dune diff --git a/src/stages/4-ast_typed/environment.ml b/src/stages/5-ast_typed/environment.ml similarity index 100% rename from src/stages/4-ast_typed/environment.ml rename to src/stages/5-ast_typed/environment.ml diff --git a/src/stages/4-ast_typed/environment.mli b/src/stages/5-ast_typed/environment.mli similarity index 100% rename from src/stages/4-ast_typed/environment.mli rename to src/stages/5-ast_typed/environment.mli diff --git a/src/stages/4-ast_typed/fold.ml b/src/stages/5-ast_typed/fold.ml similarity index 100% rename from src/stages/4-ast_typed/fold.ml rename to src/stages/5-ast_typed/fold.ml diff --git a/src/stages/4-ast_typed/formatter.ml b/src/stages/5-ast_typed/formatter.ml similarity index 100% rename from src/stages/4-ast_typed/formatter.ml rename to src/stages/5-ast_typed/formatter.ml diff --git a/src/stages/4-ast_typed/helpers.ml b/src/stages/5-ast_typed/helpers.ml similarity index 100% rename from src/stages/4-ast_typed/helpers.ml rename to src/stages/5-ast_typed/helpers.ml diff --git a/src/stages/4-ast_typed/misc.ml b/src/stages/5-ast_typed/misc.ml similarity index 100% rename from src/stages/4-ast_typed/misc.ml rename to src/stages/5-ast_typed/misc.ml diff --git a/src/stages/4-ast_typed/misc.mli b/src/stages/5-ast_typed/misc.mli similarity index 100% rename from src/stages/4-ast_typed/misc.mli rename to src/stages/5-ast_typed/misc.mli diff --git a/src/stages/4-ast_typed/misc_smart.ml b/src/stages/5-ast_typed/misc_smart.ml similarity index 100% rename from src/stages/4-ast_typed/misc_smart.ml rename to src/stages/5-ast_typed/misc_smart.ml diff --git a/src/stages/4-ast_typed/misc_smart.mli b/src/stages/5-ast_typed/misc_smart.mli similarity index 100% rename from src/stages/4-ast_typed/misc_smart.mli rename to src/stages/5-ast_typed/misc_smart.mli diff --git a/src/stages/4-ast_typed/types.ml b/src/stages/5-ast_typed/types.ml similarity index 100% rename from src/stages/4-ast_typed/types.ml rename to src/stages/5-ast_typed/types.ml diff --git a/src/stages/4-ast_typed/types_utils.ml b/src/stages/5-ast_typed/types_utils.ml similarity index 100% rename from src/stages/4-ast_typed/types_utils.ml rename to src/stages/5-ast_typed/types_utils.ml diff --git a/src/stages/5-mini_c/PP.ml b/src/stages/6-mini_c/PP.ml similarity index 100% rename from src/stages/5-mini_c/PP.ml rename to src/stages/6-mini_c/PP.ml diff --git a/src/stages/5-mini_c/PP.mli b/src/stages/6-mini_c/PP.mli similarity index 100% rename from src/stages/5-mini_c/PP.mli rename to src/stages/6-mini_c/PP.mli diff --git a/src/stages/5-mini_c/combinators.ml b/src/stages/6-mini_c/combinators.ml similarity index 100% rename from src/stages/5-mini_c/combinators.ml rename to src/stages/6-mini_c/combinators.ml diff --git a/src/stages/5-mini_c/combinators.mli b/src/stages/6-mini_c/combinators.mli similarity index 100% rename from src/stages/5-mini_c/combinators.mli rename to src/stages/6-mini_c/combinators.mli diff --git a/src/stages/5-mini_c/combinators_smart.ml b/src/stages/6-mini_c/combinators_smart.ml similarity index 100% rename from src/stages/5-mini_c/combinators_smart.ml rename to src/stages/6-mini_c/combinators_smart.ml diff --git a/src/stages/5-mini_c/dune b/src/stages/6-mini_c/dune similarity index 100% rename from src/stages/5-mini_c/dune rename to src/stages/6-mini_c/dune diff --git a/src/stages/5-mini_c/environment.ml b/src/stages/6-mini_c/environment.ml similarity index 100% rename from src/stages/5-mini_c/environment.ml rename to src/stages/6-mini_c/environment.ml diff --git a/src/stages/5-mini_c/environment.mli b/src/stages/6-mini_c/environment.mli similarity index 100% rename from src/stages/5-mini_c/environment.mli rename to src/stages/6-mini_c/environment.mli diff --git a/src/stages/5-mini_c/formatter.ml b/src/stages/6-mini_c/formatter.ml similarity index 100% rename from src/stages/5-mini_c/formatter.ml rename to src/stages/6-mini_c/formatter.ml diff --git a/src/stages/5-mini_c/mini_c.ml b/src/stages/6-mini_c/mini_c.ml similarity index 100% rename from src/stages/5-mini_c/mini_c.ml rename to src/stages/6-mini_c/mini_c.ml diff --git a/src/stages/5-mini_c/misc.ml b/src/stages/6-mini_c/misc.ml similarity index 100% rename from src/stages/5-mini_c/misc.ml rename to src/stages/6-mini_c/misc.ml diff --git a/src/stages/5-mini_c/types.ml b/src/stages/6-mini_c/types.ml similarity index 100% rename from src/stages/5-mini_c/types.ml rename to src/stages/6-mini_c/types.ml diff --git a/src/test/dune b/src/test/dune index 5625b81e6..5dfff1321 100644 --- a/src/test/dune +++ b/src/test/dune @@ -25,9 +25,9 @@ (name parser-negative-tests) (action (run ./parser_negative_tests.exe)) (deps - ../passes/01-parser/pascaligo/all.ligo - ../passes/01-parser/cameligo/all.mligo - ../passes/01-parser/reasonligo/all.religo + ../passes/01-parsing/pascaligo/all.ligo + ../passes/01-parsing/cameligo/all.mligo + ../passes/01-parsing/reasonligo/all.religo )) (alias diff --git a/src/test/md_file_tests.ml b/src/test/md_file_tests.ml index 818f76381..bbb9d36e8 100644 --- a/src/test/md_file_tests.ml +++ b/src/test/md_file_tests.ml @@ -55,7 +55,7 @@ let get_groups md_file = evaluate each expression in each programs from the snippets group map **) let compile_groups filename grp_list = - let%bind (_michelsons : Compiler.compiled_expression list list) = bind_map_list + let%bind (_michelsons : Stacking.compiled_expression list list) = bind_map_list (fun ((s,grp),contents) -> trace (test_md_file_tracer filename s grp contents) @@ let%bind v_syntax = Compile.Helpers.syntax_to_variant (Syntax_name s) None in diff --git a/src/test/parser_negative_tests.ml b/src/test/parser_negative_tests.ml index 1aeb9b14f..e0096237e 100644 --- a/src/test/parser_negative_tests.ml +++ b/src/test/parser_negative_tests.ml @@ -4,13 +4,13 @@ open Main_errors type ('a,'err) sdata = { erroneous_source_file : string ; parser : string -> ('a,'err) result } let pascaligo_sdata = { - erroneous_source_file = "../passes/01-parser/pascaligo/all.ligo" ; + erroneous_source_file = "../passes/01-parsing/pascaligo/all.ligo" ; parser = Parser.Pascaligo.parse_expression } let cameligo_sdata = { - erroneous_source_file = "../passes/01-parser/cameligo/all.mligo" ; + erroneous_source_file = "../passes/01-parsing/cameligo/all.mligo" ; parser = Parser.Cameligo.parse_expression } let reasonligo_sdata = { - erroneous_source_file = "../passes/01-parser/reasonligo/all.religo" ; + erroneous_source_file = "../passes/01-parsing/reasonligo/all.religo" ; parser = Parser.Reasonligo.parse_expression } let get_exp_as_string filename = diff --git a/src/test/transpiler_tests.ml b/src/test/spilling_tests.ml similarity index 63% rename from src/test/transpiler_tests.ml rename to src/test/spilling_tests.ml index 8b05fe665..f99ffdca4 100644 --- a/src/test/transpiler_tests.ml +++ b/src/test/spilling_tests.ml @@ -3,5 +3,5 @@ * open Combinators *) open Test_helpers -let main = test_suite "Transpiler (from Ast_typed)" [ +let main = test_suite "Spilling (from Ast_typed)" [ ] diff --git a/src/test/test.ml b/src/test/test.ml index 9e6d3a927..d57e98602 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -6,7 +6,7 @@ let () = Printexc.record_backtrace true ; run_test @@ test_suite "LIGO" [ Integration_tests.main ; - Transpiler_tests.main ; + Spilling_tests.main ; Typer_tests.main ; Coase_tests.main ; Vote_tests.main ; diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 7ca0e5e24..12ea7cc9c 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -93,7 +93,7 @@ open Ast_imperative.Combinators let typed_program_with_imperative_input_to_michelson ((program , state): Ast_typed.program * Typesystem.Solver_types.typer_state) (entry_point: string) - (input: Ast_imperative.expression) : (Compiler.compiled_expression,_) result = + (input: Ast_imperative.expression) : (Stacking.compiled_expression,_) result = Printexc.record_backtrace true; let env = Ast_typed.program_environment Environment.default program in let%bind sugar = Compile.Of_imperative.compile_expression input in