Merge branch 'refactor/passes' into 'dev'

Rename passes and refactor them

See merge request ligolang/ligo!679
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-06-23 14:59:13 +00:00
commit 8e558041f0
339 changed files with 1136 additions and 1238 deletions

View File

@ -6,13 +6,13 @@
simple-utils simple-utils
tezos-utils tezos-utils
parser parser
concrete_to_imperative tree_abstraction
ast_imperative ast_imperative
self_ast_imperative self_ast_imperative
imperative_to_sugar purification
ast_sugar ast_sugar
self_ast_sugar self_ast_sugar
sugar_to_core desugaring
ast_core ast_core
self_ast_core self_ast_core
typer_new typer_new
@ -20,10 +20,10 @@
ast_typed ast_typed
self_ast_typed self_ast_typed
interpreter interpreter
transpiler spilling
mini_c mini_c
self_mini_c self_mini_c
compiler stacking
self_michelson self_michelson
) )
(preprocess (preprocess

View File

@ -22,42 +22,42 @@ let parsify_pascaligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Pascaligo.parse_file source in Parser.Pascaligo.parse_file source in
let%bind imperative = trace cit_pascaligo_tracer @@ let%bind imperative = trace cit_pascaligo_tracer @@
Concrete_to_imperative.Pascaligo.compile_program raw Tree_abstraction.Pascaligo.compile_program raw
in ok imperative in ok imperative
let parsify_expression_pascaligo source = let parsify_expression_pascaligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Pascaligo.parse_expression source in Parser.Pascaligo.parse_expression source in
let%bind imperative = trace cit_pascaligo_tracer @@ let%bind imperative = trace cit_pascaligo_tracer @@
Concrete_to_imperative.Pascaligo.compile_expression raw Tree_abstraction.Pascaligo.compile_expression raw
in ok imperative in ok imperative
let parsify_cameligo source = let parsify_cameligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Cameligo.parse_file source in Parser.Cameligo.parse_file source in
let%bind imperative = trace cit_cameligo_tracer @@ let%bind imperative = trace cit_cameligo_tracer @@
Concrete_to_imperative.Cameligo.compile_program raw Tree_abstraction.Cameligo.compile_program raw
in ok imperative in ok imperative
let parsify_expression_cameligo source = let parsify_expression_cameligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Cameligo.parse_expression source in Parser.Cameligo.parse_expression source in
let%bind imperative = trace cit_cameligo_tracer @@ let%bind imperative = trace cit_cameligo_tracer @@
Concrete_to_imperative.Cameligo.compile_expression raw Tree_abstraction.Cameligo.compile_expression raw
in ok imperative in ok imperative
let parsify_reasonligo source = let parsify_reasonligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Reasonligo.parse_file source in Parser.Reasonligo.parse_file source in
let%bind imperative = trace cit_cameligo_tracer @@ let%bind imperative = trace cit_cameligo_tracer @@
Concrete_to_imperative.Cameligo.compile_program raw Tree_abstraction.Cameligo.compile_program raw
in ok imperative in ok imperative
let parsify_expression_reasonligo source = let parsify_expression_reasonligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Reasonligo.parse_expression source in Parser.Reasonligo.parse_expression source in
let%bind imperative = trace cit_cameligo_tracer @@ let%bind imperative = trace cit_cameligo_tracer @@
Concrete_to_imperative.Cameligo.compile_expression raw Tree_abstraction.Cameligo.compile_expression raw
in ok imperative in ok imperative
let parsify syntax source : (Ast_imperative.program, _) Trace.result = let parsify syntax source : (Ast_imperative.program, _) Trace.result =
@ -85,21 +85,21 @@ let parsify_string_reasonligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Reasonligo.parse_string source in Parser.Reasonligo.parse_string source in
let%bind imperative = trace cit_cameligo_tracer @@ let%bind imperative = trace cit_cameligo_tracer @@
Concrete_to_imperative.Cameligo.compile_program raw Tree_abstraction.Cameligo.compile_program raw
in ok imperative in ok imperative
let parsify_string_pascaligo source = let parsify_string_pascaligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Pascaligo.parse_string source in Parser.Pascaligo.parse_string source in
let%bind imperative = trace cit_pascaligo_tracer @@ let%bind imperative = trace cit_pascaligo_tracer @@
Concrete_to_imperative.Pascaligo.compile_program raw Tree_abstraction.Pascaligo.compile_program raw
in ok imperative in ok imperative
let parsify_string_cameligo source = let parsify_string_cameligo source =
let%bind raw = trace parser_tracer @@ let%bind raw = trace parser_tracer @@
Parser.Cameligo.parse_string source in Parser.Cameligo.parse_string source in
let%bind imperative = trace cit_cameligo_tracer @@ let%bind imperative = trace cit_cameligo_tracer @@
Concrete_to_imperative.Cameligo.compile_program raw Tree_abstraction.Cameligo.compile_program raw
in ok imperative in ok imperative
let parsify_string syntax source = 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%bind ast = trace parser_tracer @@ Parser.Pascaligo.parse_file source in
let buffer = Buffer.create 59 in let buffer = Buffer.create 59 in
let state = let state =
Parser_pascaligo.ParserLog.mk_state Cst_pascaligo.ParserLog.mk_state
~offsets:true ~offsets:true
~mode:`Byte ~mode:`Byte
~buffer in ~buffer in
Parser_pascaligo.ParserLog.pp_cst state ast; Cst_pascaligo.ParserLog.pp_cst state ast;
ok buffer ok buffer
let pretty_print_cameligo_cst source = let pretty_print_cameligo_cst source =
let%bind ast = trace parser_tracer @@ Parser.Cameligo.parse_file source in let%bind ast = trace parser_tracer @@ Parser.Cameligo.parse_file source in
let buffer = Buffer.create 59 in let buffer = Buffer.create 59 in
let state = (* TODO: Should flow from the CLI *) let state = (* TODO: Should flow from the CLI *)
Parser_cameligo.ParserLog.mk_state Cst_cameligo.ParserLog.mk_state
~offsets:true ~offsets:true
~mode:`Point ~mode:`Point
~buffer in ~buffer in
Parser_cameligo.ParserLog.pp_cst state ast; Cst_cameligo.ParserLog.pp_cst state ast;
ok buffer ok buffer
let pretty_print_reasonligo_cst source = let pretty_print_reasonligo_cst source =
let%bind ast = trace parser_tracer @@ Parser.Reasonligo.parse_file source in let%bind ast = trace parser_tracer @@ Parser.Reasonligo.parse_file source in
let buffer = Buffer.create 59 in let buffer = Buffer.create 59 in
let state = (* TODO: Should flow from the CLI *) let state = (* TODO: Should flow from the CLI *)
Parser_cameligo.ParserLog.mk_state Cst_cameligo.ParserLog.mk_state
~offsets:true ~offsets:true
~mode:`Point ~mode:`Point
~buffer in ~buffer in
Parser_cameligo.ParserLog.pp_cst state ast; Cst_cameligo.ParserLog.pp_cst state ast;
ok buffer ok buffer
let pretty_print_cst syntax source = let pretty_print_cst syntax source =

View File

@ -1,17 +1,17 @@
open Main_errors open Main_errors
open Trace open Trace
open Ast_imperative open Ast_imperative
open Imperative_to_sugar open Purification
type form = type form =
| Contract of string | Contract of string
| Env | Env
let compile (program : program) : (Ast_sugar.program, _) result = 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 = 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) = let pretty_print formatter (program : program) =
PP.program formatter program PP.program formatter program

View File

@ -3,7 +3,7 @@ open Tezos_utils
open Proto_alpha_utils open Proto_alpha_utils
open Trace 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 -> fun ?(disable_typecheck= false) compiled ->
let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = trace_option (entrypoint_not_a_function) @@ 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 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_gas -> fail @@ gas_exhaustion
| Err_unknown -> fail @@ unknown | 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 -> fun c compiled_prg compiled_param ->
let%bind (Ex_ty expected_ty) = let%bind (Ex_ty expected_ty) =
let%bind (c_param_ty,c_storage_ty) = trace_option (entrypoint_not_a_function) @@ let%bind (c_param_ty,c_storage_ty) = trace_option (entrypoint_not_a_function) @@

View File

@ -2,31 +2,32 @@ open Main_errors
open Mini_c open Mini_c
open Proto_alpha_utils open Proto_alpha_utils
open Trace 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 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 (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 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 expr = Self_michelson.optimize body in
let%bind expr_ty = trace compiler_tracer @@ Compiler.Type.Ty.type_ e.type_expression in let%bind expr_ty = trace stacking_tracer @@ Stacking.Type.Ty.type_ e.type_expression in
ok ({ expr_ty ; expr } : Compiler.Program.compiled_expression) ok ({ expr_ty ; expr } : Stacking.Program.compiled_expression)
let compile_expression : expression -> (Compiler.compiled_expression, _) result = fun e -> let compile_expression : expression -> (compiled_expression, _) result = fun e ->
trace compiler_tracer @@ trace stacking_tracer @@
let%bind expr = Compiler.Program.translate_expression e Compiler.Environment.empty in let%bind expr = Stacking.Program.translate_expression e Stacking.Environment.empty in
let expr = Self_michelson.optimize expr in let expr = Self_michelson.optimize expr in
let%bind expr_ty = Compiler.Type.Ty.type_ e.type_expression in let%bind expr_ty = Type.Ty.type_ e.type_expression in
ok ({ expr_ty ; expr } : Compiler.Program.compiled_expression) 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%bind aggregated = trace self_mini_c_tracer @@ Self_mini_c.aggregate_entry program form in
let aggregated' = Self_mini_c.all_expression aggregated in let aggregated' = Self_mini_c.all_expression aggregated in
match form with match form with
| ContractForm _ -> compile_contract aggregated' | ContractForm _ -> compile_contract aggregated'
| ExpressionForm _ -> compile_expression 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%bind (exp, idx) = trace_option entrypoint_not_found @@ Mini_c.get_entry program name in
let program' = List.take idx program in let program' = List.take idx program in
aggregate_and_compile program' (ContractForm exp) aggregate_and_compile program' (ContractForm exp)

View File

@ -1,6 +1,6 @@
open Trace open Trace
open Ast_sugar open Ast_sugar
open Sugar_to_core open Desugaring
open Main_errors open Main_errors
type form = type form =
@ -8,10 +8,10 @@ type form =
| Env | Env
let compile (program : program) : (Ast_core.program , _) result = 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 = 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 = let list_declarations (program : program) : string list =
List.fold_left List.fold_left

View File

@ -1,12 +1,13 @@
open Main_errors
open Trace open Trace
open Ast_typed open Ast_typed
open Spilling
open Main_errors
let compile : Ast_typed.program -> (Mini_c.program, _) result = fun p -> 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 -> 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 = 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 -> fun c entry contract param ->

View File

@ -4,19 +4,19 @@
(libraries (libraries
simple-utils simple-utils
parser parser
concrete_to_imperative tree_abstraction
self_ast_imperative self_ast_imperative
interpreter purification
imperative_to_sugar
ast_sugar ast_sugar
self_ast_sugar self_ast_sugar
sugar_to_core desugaring
self_ast_core self_ast_core
typer typer
self_ast_typed self_ast_typed
transpiler interpreter
spilling
self_mini_c self_mini_c
compiler stacking
self_michelson self_michelson
) )
(preprocess (preprocess

View File

@ -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_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_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_purification e -> Purification.Errors.error_ppformat ~display_format f e
| `Main_sugar_to_core _e -> () (*no error in this pass*) | `Main_desugaring _e -> () (*no error in this pass*)
| `Main_cit_pascaligo e -> Concrete_to_imperative.Errors_pascaligo.error_ppformat ~display_format f e | `Main_cit_pascaligo e -> Tree_abstraction.Pascaligo.Errors.error_ppformat ~display_format f e
| `Main_cit_cameligo e -> Concrete_to_imperative.Errors_cameligo.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_typer e -> Typer.Errors.error_ppformat ~display_format f e
| `Main_interpreter _ -> () (*no error*) | `Main_interpreter _ -> () (*no error*)
| `Main_self_ast_typed e -> Self_ast_typed.Errors.error_ppformat ~display_format f e | `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_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_spilling e -> Spilling.Errors.error_ppformat ~display_format f e
| `Main_compiler e -> Compiler.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_michelson e -> Stacking.Errors.error_ppformat ~display_format f e
| `Main_uncompile_mini_c e -> Transpiler.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 | `Main_uncompile_typed e -> Typer.Errors.error_ppformat ~display_format f e
) )
@ -273,19 +273,19 @@ let rec error_jsonformat : Types.all -> J.t = fun a ->
| `Main_parser e -> Parser.Errors.error_jsonformat e | `Main_parser e -> Parser.Errors.error_jsonformat e
| `Main_self_ast_imperative e -> Self_ast_imperative.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_purification e -> Purification.Errors.error_jsonformat e
| `Main_sugar_to_core _ -> `Null (*no error in this pass*) | `Main_desugaring _ -> `Null (*no error in this pass*)
| `Main_cit_pascaligo e -> Concrete_to_imperative.Errors_pascaligo.error_jsonformat e | `Main_cit_pascaligo e -> Tree_abstraction.Pascaligo.Errors.error_jsonformat e
| `Main_cit_cameligo e -> Concrete_to_imperative.Errors_cameligo.error_jsonformat e | `Main_cit_cameligo e -> Tree_abstraction.Cameligo.Errors.error_jsonformat e
| `Main_typer e -> Typer.Errors.error_jsonformat e | `Main_typer e -> Typer.Errors.error_jsonformat e
| `Main_interpreter _ -> `Null (*no error*) | `Main_interpreter _ -> `Null (*no error*)
| `Main_self_ast_typed e -> Self_ast_typed.Errors.error_jsonformat e | `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_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_michelson e -> Stacking.Errors.error_jsonformat e
| `Main_uncompile_mini_c e -> Transpiler.Errors.error_jsonformat e | `Main_uncompile_mini_c e -> Spilling.Errors.error_jsonformat e
| `Main_uncompile_typed e -> Typer.Errors.error_jsonformat e | `Main_uncompile_typed e -> Typer.Errors.error_jsonformat e
let error_format : _ Display.format = { let error_format : _ Display.format = {

View File

@ -5,21 +5,21 @@ type all = Types.all
(* passes tracers *) (* passes tracers *)
let parser_tracer (e:Parser.Errors.parser_error) : all = `Main_parser e 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_cameligo_tracer (e:Tree_abstraction.Cameligo.Errors.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_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 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 purification_tracer (e:Purification.Errors.purification_error) : all = `Main_purification e
let sugar_to_core_tracer (e:Sugar_to_core.Errors.sugar_to_core_error) : all = `Main_sugar_to_core 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 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_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 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 spilling_tracer (e:Spilling.Errors.spilling_error) : all = `Main_spilling e
let compiler_tracer (e:Compiler.Errors.compiler_error) : all = `Main_compiler 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 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_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) *) (* top-level glue (in between passes) *)

View File

@ -22,19 +22,19 @@ type all =
| `Main_parser of Parser.Errors.parser_error | `Main_parser of Parser.Errors.parser_error
| `Main_self_ast_imperative of Self_ast_imperative.Errors.self_ast_imperative_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_purification of Purification.Errors.purification_error
| `Main_sugar_to_core of Sugar_to_core.Errors.sugar_to_core_error | `Main_desugaring of Desugaring.Errors.desugaring_error
| `Main_cit_pascaligo of Concrete_to_imperative.Errors_pascaligo.abs_error | `Main_cit_pascaligo of Tree_abstraction.Pascaligo.Errors.abs_error
| `Main_cit_cameligo of Concrete_to_imperative.Errors_cameligo.abs_error | `Main_cit_cameligo of Tree_abstraction.Cameligo.Errors.abs_error
| `Main_typer of Typer.Errors.typer_error | `Main_typer of Typer.Errors.typer_error
| `Main_interpreter of Interpreter.interpreter_error | `Main_interpreter of Interpreter.interpreter_error
| `Main_self_ast_typed of Self_ast_typed.Errors.self_ast_typed_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_self_mini_c of Self_mini_c.Errors.self_mini_c_error
| `Main_transpiler of Transpiler.Errors.transpiler_error | `Main_spilling of Spilling.Errors.spilling_error
| `Main_compiler of Compiler.Errors.compiler_error | `Main_stacking of Stacking.Errors.stacking_error
| `Main_uncompile_michelson of Compiler.Errors.compiler_error | `Main_uncompile_michelson of Stacking.Errors.stacking_error
| `Main_uncompile_mini_c of Transpiler.Errors.transpiler_error | `Main_uncompile_mini_c of Spilling.Errors.spilling_error
| `Main_uncompile_typed of Typer.Errors.typer_error | `Main_uncompile_typed of Typer.Errors.typer_error
| `Main_entrypoint_not_a_function | `Main_entrypoint_not_a_function
| `Main_entrypoint_not_found | `Main_entrypoint_not_found

View File

@ -5,17 +5,17 @@
simple-utils simple-utils
tezos-utils tezos-utils
parser parser
concrete_to_imperative tree_abstraction
self_ast_imperative self_ast_imperative
sugar_to_core desugaring
ast_core ast_core
typer_new typer_new
typer typer
ast_typed ast_typed
transpiler spilling
mini_c mini_c
operators predefined
compiler stacking
compile compile
) )
(preprocess (preprocess

View File

@ -3,14 +3,14 @@
(public_name ligo.uncompile) (public_name ligo.uncompile)
(libraries (libraries
simple-utils simple-utils
compiler purification
imperative_to_sugar desugaring
sugar_to_core
typer_new typer_new
typer typer
ast_typed ast_typed
spilling
mini_c mini_c
transpiler stacking
main_errors main_errors
) )
(preprocess (preprocess

View File

@ -14,8 +14,8 @@ let uncompile_value func_or_expr program entry ex_ty_value =
| Function -> | Function ->
let%bind (_,output_type) = trace_option entrypoint_not_a_function @@ Ast_typed.get_t_function entry_expression.type_expression in let%bind (_,output_type) = trace_option entrypoint_not_a_function @@ Ast_typed.get_t_function entry_expression.type_expression in
ok output_type in ok output_type in
let%bind mini_c = trace uncompile_michelson @@ Compiler.Uncompiler.translate_value ex_ty_value in let%bind mini_c = trace uncompile_michelson @@ Stacking.Decompiler.decompile_value ex_ty_value in
let%bind typed = trace uncompile_mini_c @@ Transpiler.untranspile mini_c output_type 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 let%bind core = trace uncompile_typed @@ Typer.untype_expression typed in
ok @@ core ok @@ core
@ -37,8 +37,7 @@ let uncompile_expression type_value runned_result =
match runned_result with match runned_result with
| Fail s -> ok (Fail s) | Fail s -> ok (Fail s)
| Success ex_ty_value -> | Success ex_ty_value ->
let%bind mini_c = trace uncompile_michelson @@ Compiler.Uncompiler.translate_value ex_ty_value in let%bind mini_c = trace uncompile_michelson @@ Stacking.Decompiler.decompile_value ex_ty_value in
let%bind typed = trace uncompile_mini_c @@ Transpiler.untranspile mini_c type_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 let%bind uncompiled_value = trace uncompile_typed @@ Typer.untype_expression typed in
ok (Success uncompiled_value) ok (Success uncompiled_value)

View File

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

View File

@ -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]::[]

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,5 +0,0 @@
type error =
| WrongFunctionArguments of AST.expr
| InvalidWild of AST.expr
exception Error of error

View File

@ -1,5 +0,0 @@
type error =
| WrongFunctionArguments of AST.expr
| InvalidWild of AST.expr
exception Error of error

View File

@ -1,4 +1,4 @@
module AST = Parser_cameligo.AST module CST = Cst.Cameligo
module LexToken = Parser_cameligo.LexToken module LexToken = Parser_cameligo.LexToken
module Lexer = Lexer.Make(LexToken) module Lexer = Lexer.Make(LexToken)
module Scoping = Parser_cameligo.Scoping module Scoping = Parser_cameligo.Scoping
@ -54,20 +54,20 @@ module SubIO =
module Parser = module Parser =
struct struct
type ast = AST.t type ast = CST.t
type expr = AST.expr type expr = CST.expr
include Parser_cameligo.Parser include Parser_cameligo.Parser
end end
module ParserLog = module ParserLog =
struct struct
type ast = AST.t type ast = CST.t
type expr = AST.expr type expr = CST.expr
include Parser_cameligo.ParserLog include Cst_cameligo.ParserLog
end end
module Unit = module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) ParserUnit.Make (Lexer)(CST)(Parser)(ParErr)(ParserLog)(SubIO)
let apply parser = let apply parser =
let local_fail error = let local_fail error =

View File

@ -1,22 +1,22 @@
(** This file provides an interface to the CameLIGO parser. *) (** This file provides an interface to the CameLIGO parser. *)
open Trace open Trace
module AST = Parser_cameligo.AST module CST = Cst.Cameligo
(** Open a CameLIGO filename given by string and convert into an (** Open a CameLIGO filename given by string and convert into an
abstract syntax tree. *) 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 *) (** 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 (** 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 This is intended to be used for interactive interpreters, or other
scenarios where you would want to parse a CameLIGO expression scenarios where you would want to parse a CameLIGO expression
outside of a contract. *) 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. *) (** Preprocess a given CameLIGO file and preprocess it. *)
val preprocess : string -> (Buffer.t , Errors.parser_error) result val preprocess : string -> (Buffer.t , Errors.parser_error) result

View File

@ -4,7 +4,8 @@
[@@@warning "-42"] [@@@warning "-42"]
open Simple_utils.Region open Simple_utils.Region
open AST module CST = Cst.Cameligo
open CST
(* END HEADER *) (* END HEADER *)
%} %}
@ -14,8 +15,8 @@ open AST
(* Entry points *) (* Entry points *)
%start contract interactive_expr %start contract interactive_expr
%type <AST.t> contract %type <Cst.Cameligo.t> contract
%type <AST.expr> interactive_expr %type <Cst.Cameligo.expr> interactive_expr
%% %%
@ -108,7 +109,7 @@ contract:
declarations EOF { {decl=$1; eof=$2} } declarations EOF { {decl=$1; eof=$2} }
declarations: declarations:
declaration { $1,[] : AST.declaration Utils.nseq } declaration { $1,[] : CST.declaration Utils.nseq }
| declaration declarations { Utils.nseq_cons $1 $2 } | declaration declarations { Utils.nseq_cons $1 $2 }
declaration: declaration:

View File

@ -1,6 +1,7 @@
[@@@warning "-42"] [@@@warning "-42"]
open AST module CST=Cst.Cameligo
open CST
module Region = Simple_utils.Region module Region = Simple_utils.Region
open! Region open! Region
open! PPrint open! PPrint

View File

@ -1,12 +1,13 @@
[@@@warning "-42"] [@@@warning "-42"]
module Region = Simple_utils.Region module Region = Simple_utils.Region
module CST = Cst.Cameligo
type t = type t =
Reserved_name of AST.variable Reserved_name of CST.variable
| Duplicate_variant of AST.variable | Duplicate_variant of CST.variable
| Non_linear_pattern of AST.variable | Non_linear_pattern of CST.variable
| Duplicate_field of AST.variable | Duplicate_field of CST.variable
type error = t type error = t
@ -20,7 +21,7 @@ module SSet = Utils.String.Set
module Ord = module Ord =
struct struct
type t = AST.variable type t = CST.variable
let compare v1 v2 = let compare v1 v2 =
String.compare v1.value v2.value String.compare v1.value v2.value
end end
@ -71,7 +72,7 @@ let check_reserved_name var =
(* Checking the linearity of patterns *) (* Checking the linearity of patterns *)
open! AST open! CST
let rec vars_of_pattern env = function let rec vars_of_pattern env = function
PConstr p -> vars_of_pconstr env p PConstr p -> vars_of_pconstr env p

View File

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

View File

@ -1,5 +1,3 @@
module Parser = Parser module Parser = Parser
module AST = AST
module Lexer = Lexer module Lexer = Lexer
module LexToken = LexToken module LexToken = LexToken
module ParserLog = ParserLog

View File

@ -15,7 +15,7 @@
(name parser_cameligo) (name parser_cameligo)
(public_name ligo.parser.cameligo) (public_name ligo.parser.cameligo)
(modules (modules
Scoping AST cameligo Parser ParserLog LexToken ParErr Pretty) Scoping cameligo Parser LexToken ParErr Pretty)
(libraries (libraries
pprint pprint
terminal_size terminal_size
@ -23,7 +23,9 @@
parser_shared parser_shared
str str
simple-utils simple-utils
tezos-utils) tezos-utils
cst
)
(preprocess (preprocess
(pps bisect_ppx --conditional)) (pps bisect_ppx --conditional))
(flags (:standard -open Parser_shared -open Simple_utils))) (flags (:standard -open Parser_shared -open Simple_utils)))

View File

@ -1,10 +1,12 @@
open Trace open Trace
open Simple_utils.Display open Simple_utils.Display
module CST = Cst.Cameligo
type parser_error = [ type parser_error = [
| `Parser_generic of string Region.reg | `Parser_generic of string Region.reg
| `Parser_wrong_function_arguments of Parser_cameligo.AST.expr | `Parser_wrong_function_arguments of CST.expr
| `Parser_invalid_wild of Parser_cameligo.AST.expr | `Parser_invalid_wild of CST.expr
] ]
let stage = "parser" let stage = "parser"
@ -36,13 +38,13 @@ let error_ppformat : display_format:string display_format ->
| `Parser_wrong_function_arguments expr -> | `Parser_wrong_function_arguments expr ->
let loc = Format.asprintf "%a" 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 let s = Format.asprintf "%s\n%s" loc wrong_function_msg in
Format.pp_print_string f s ; Format.pp_print_string f s ;
| `Parser_invalid_wild expr -> | `Parser_invalid_wild expr ->
let loc = Format.asprintf "%a" 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 let s = Format.asprintf "%s\n%s" loc wild_pattern_msg in
Format.pp_print_string f s ; Format.pp_print_string f s ;
) )
@ -62,7 +64,7 @@ let error_jsonformat : parser_error -> J.t = fun a ->
json_error ~stage ~content json_error ~stage ~content
| `Parser_wrong_function_arguments expr -> | `Parser_wrong_function_arguments expr ->
let loc = Format.asprintf "%a" Location.pp_lift @@ 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 [ let content = `Assoc [
("message", `String wrong_function_msg); ("message", `String wrong_function_msg);
("location", `String loc); ] ("location", `String loc); ]
@ -70,7 +72,7 @@ let error_jsonformat : parser_error -> J.t = fun a ->
json_error ~stage ~content json_error ~stage ~content
| `Parser_invalid_wild expr -> | `Parser_invalid_wild expr ->
let loc = Format.asprintf "%a" Location.pp_lift @@ 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 [ let content = `Assoc [
("message", `String wild_pattern_msg); ("message", `String wild_pattern_msg);
("location", `String loc); ] ("location", `String loc); ]

View File

@ -1,4 +1,4 @@
module AST = Parser_pascaligo.AST module CST = Cst.Pascaligo
module LexToken = Parser_pascaligo.LexToken module LexToken = Parser_pascaligo.LexToken
module Lexer = Lexer.Make(LexToken) module Lexer = Lexer.Make(LexToken)
module Scoping = Parser_pascaligo.Scoping module Scoping = Parser_pascaligo.Scoping
@ -53,20 +53,20 @@ module SubIO =
module Parser = module Parser =
struct struct
type ast = AST.t type ast = CST.t
type expr = AST.expr type expr = CST.expr
include Parser_pascaligo.Parser include Parser_pascaligo.Parser
end end
module ParserLog = module ParserLog =
struct struct
type ast = AST.t type ast = CST.t
type expr = AST.expr type expr = CST.expr
include Parser_pascaligo.ParserLog include Cst_pascaligo.ParserLog
end end
module Unit = module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) ParserUnit.Make (Lexer)(CST)(Parser)(ParErr)(ParserLog)(SubIO)
let apply parser = let apply parser =
let local_fail error = let local_fail error =

View File

@ -2,22 +2,22 @@
open Errors open Errors
open Trace open Trace
module AST = Parser_pascaligo.AST module CST = Cst.Pascaligo
(** Open a PascaLIGO filename given by string and convert into an (** Open a PascaLIGO filename given by string and convert into an
abstract syntax tree. *) 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 *) (** 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 (** 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 This is intended to be used for interactive interpreters, or other
scenarios where you would want to parse a PascaLIGO expression scenarios where you would want to parse a PascaLIGO expression
outside of a contract. *) 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. *) (** Preprocess a given PascaLIGO file and preprocess it. *)
val preprocess : string -> (Buffer.t, parser_error) result val preprocess : string -> (Buffer.t, parser_error) result

View File

@ -4,7 +4,8 @@
[@@@warning "-42"] [@@@warning "-42"]
open Simple_utils.Region open Simple_utils.Region
open AST module CST = Cst.Pascaligo
open CST
(* END HEADER *) (* END HEADER *)
%} %}
@ -14,8 +15,8 @@ open AST
(* Entry points *) (* Entry points *)
%start contract interactive_expr %start contract interactive_expr
%type <AST.t> contract %type <Cst.Pascaligo.t> contract
%type <AST.expr> interactive_expr %type <Cst.Pascaligo.expr> interactive_expr
%% %%
@ -521,7 +522,7 @@ proc_call:
conditional: conditional:
"if" expr "then" if_clause ";"? "else" if_clause { "if" expr "then" if_clause ";"? "else" if_clause {
let region = cover $1 (if_clause_to_region $7) in let region = cover $1 (if_clause_to_region $7) in
let value : AST.conditional = { let value : CST.conditional = {
kwd_if = $1; kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
@ -668,7 +669,7 @@ expr:
cond_expr: cond_expr:
"if" expr "then" expr ";"? "else" expr { "if" expr "then" expr ";"? "else" expr {
let region = cover $1 (expr_to_region $7) in let region = cover $1 (expr_to_region $7) in
let value : AST.cond_expr = { let value : CST.cond_expr = {
kwd_if = $1; kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
@ -941,7 +942,7 @@ record_expr:
"record" sep_or_term_list(field_assignment,";") "end" { "record" sep_or_term_list(field_assignment,";") "end" {
let ne_elements, terminator = $2 in let ne_elements, terminator = $2 in
let region = cover $1 $3 let region = cover $1 $3
and value : field_assignment AST.reg ne_injection = { and value : field_assignment CST.reg ne_injection = {
kind = NEInjRecord $1; kind = NEInjRecord $1;
enclosing = End $3; enclosing = End $3;
ne_elements; ne_elements;
@ -951,7 +952,7 @@ record_expr:
| "record" "[" sep_or_term_list(field_assignment,";") "]" { | "record" "[" sep_or_term_list(field_assignment,";") "]" {
let ne_elements, terminator = $3 in let ne_elements, terminator = $3 in
let region = cover $1 $4 let region = cover $1 $4
and value : field_assignment AST.reg ne_injection = { and value : field_assignment CST.reg ne_injection = {
kind = NEInjRecord $1; kind = NEInjRecord $1;
enclosing = Brackets ($2,$4); enclosing = Brackets ($2,$4);
ne_elements; ne_elements;

View File

@ -2,7 +2,8 @@
[@@@warning "-27"] [@@@warning "-27"]
[@@@warning "-26"] [@@@warning "-26"]
open AST module CST = Cst.Pascaligo
open CST
module Region = Simple_utils.Region module Region = Simple_utils.Region
open! Region open! Region
open! PPrint open! PPrint

View File

@ -1,13 +1,14 @@
[@@@warning "-42"] [@@@warning "-42"]
module Region = Simple_utils.Region module Region = Simple_utils.Region
module CST = Cst.Pascaligo
type t = type t =
Reserved_name of AST.variable Reserved_name of CST.variable
| Duplicate_parameter of AST.variable | Duplicate_parameter of CST.variable
| Duplicate_variant of AST.variable | Duplicate_variant of CST.variable
| Non_linear_pattern of AST.variable | Non_linear_pattern of CST.variable
| Duplicate_field of AST.variable | Duplicate_field of CST.variable
type error = t type error = t
@ -21,7 +22,7 @@ module SSet = Utils.String.Set
module Ord = module Ord =
struct struct
type t = AST.variable type t = CST.variable
let compare v1 v2 = let compare v1 v2 =
String.compare v1.value v2.value String.compare v1.value v2.value
end end
@ -99,7 +100,7 @@ let check_reserved_name var =
(* Checking the linearity of patterns *) (* Checking the linearity of patterns *)
open! AST open! CST
let rec vars_of_pattern env = function let rec vars_of_pattern env = function
PConstr p -> vars_of_pconstr env p PConstr p -> vars_of_pconstr env p

View File

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

View File

@ -15,7 +15,7 @@
(name parser_pascaligo) (name parser_pascaligo)
(public_name ligo.parser.pascaligo) (public_name ligo.parser.pascaligo)
(modules (modules
Scoping AST pascaligo Parser ParserLog LexToken ParErr Pretty) Scoping pascaligo Parser LexToken ParErr Pretty)
(libraries (libraries
pprint pprint
terminal_size terminal_size
@ -23,7 +23,8 @@
parser_shared parser_shared
hex hex
Preprocessor Preprocessor
simple-utils) simple-utils
cst)
(preprocess (preprocess
(pps bisect_ppx --conditional)) (pps bisect_ppx --conditional))
(flags (:standard -open Parser_shared -open Simple_utils))) (flags (:standard -open Parser_shared -open Simple_utils)))

View File

@ -1,5 +1,3 @@
module Lexer = Lexer module Lexer = Lexer
module LexToken = LexToken module LexToken = LexToken
module AST = AST
module Parser = Parser module Parser = Parser
module ParserLog = ParserLog

Some files were not shown because too many files have changed in this diff Show More