diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 246524f1c..dec0ac0bf 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -152,6 +152,18 @@ let compile_file = let doc = "Subcommand: Compile a contract." in (Term.ret term , Term.info ~doc cmdname) +let preprocess = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind pp = + Compile.Of_source.preprocess source_file (Syntax_name syntax) in + ok @@ Format.asprintf "%s \n" (Buffer.contents pp) + ) in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "preprocess" in + let doc = "Subcommand: Preprocess the source file.\nWarning: Intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + let print_cst = let f source_file syntax display_format = ( toplevel ~display_format @@ @@ -470,4 +482,5 @@ let run ?argv () = print_ast_typed ; print_mini_c ; list_declarations ; + preprocess ] diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index f960cc6b9..d30f67155 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -53,6 +53,10 @@ let%expect_test _ = measure-contract Subcommand: Measure a contract's compiled size in bytes. + preprocess + Subcommand: Preprocess the source file. Warning: Intended for + development of LIGO and can break at any time. + print-ast Subcommand: Print the AST. Warning: Intended for development of LIGO and can break at any time. @@ -140,6 +144,10 @@ let%expect_test _ = measure-contract Subcommand: Measure a contract's compiled size in bytes. + preprocess + Subcommand: Preprocess the source file. Warning: Intended for + development of LIGO and can break at any time. + print-ast Subcommand: Print the AST. Warning: Intended for development of LIGO and can break at any time. diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 1b8b390fc..b6809a20a 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -148,18 +148,18 @@ let pretty_print_cameligo source = ~offsets:true ~mode:`Point ~buffer in - Parser.Cameligo.ParserLog.pp_ast state ast; + Parser_cameligo.ParserLog.pp_ast state ast; ok buffer let pretty_print_reasonligo source = let%bind ast = Parser.Reasonligo.parse_file source in let buffer = Buffer.create 59 in let state = (* TODO: Should flow from the CLI *) - Parser.Reasonligo.ParserLog.mk_state + Parser_cameligo.ParserLog.mk_state ~offsets:true ~mode:`Point ~buffer in - Parser.Reasonligo.ParserLog.pp_ast state ast; + Parser_cameligo.ParserLog.pp_ast state ast; ok buffer let pretty_print syntax source = @@ -169,3 +169,17 @@ let pretty_print syntax source = PascaLIGO -> pretty_print_pascaligo source | CameLIGO -> pretty_print_cameligo source | ReasonLIGO -> pretty_print_reasonligo source + +let preprocess_pascaligo = Parser.Pascaligo.preprocess + +let preprocess_cameligo = Parser.Cameligo.preprocess + +let preprocess_reasonligo = Parser.Reasonligo.preprocess + +let preprocess syntax source = + let%bind v_syntax = + syntax_to_variant syntax (Some source) in + match v_syntax with + PascaLIGO -> preprocess_pascaligo source + | CameLIGO -> preprocess_cameligo source + | ReasonLIGO -> preprocess_reasonligo source diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 8b737237b..75cb9f32c 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -19,5 +19,8 @@ let compile_contract_input : string -> string -> v_syntax -> Ast_imperative.expr let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in ok @@ Ast_imperative.e_pair storage parameter -let pretty_print source_filename syntax = - Helpers.pretty_print syntax source_filename +let pretty_print source_filename syntax = + Helpers.pretty_print syntax source_filename + +let preprocess source_filename syntax = + Helpers.preprocess syntax source_filename diff --git a/src/passes/1-parser/cameligo.ml b/src/passes/1-parser/cameligo.ml index f32c85084..3ae2063c1 100644 --- a/src/passes/1-parser/cameligo.ml +++ b/src/passes/1-parser/cameligo.ml @@ -140,3 +140,7 @@ let parse_string source = apply (fun () -> Unit.contract_in_string source) (* Parsing an expression in a string *) let parse_expression source = apply (fun () -> Unit.expr_in_string source) + +(* Preprocessing a contract in a file *) + +let preprocess source = apply (fun () -> Unit.preprocess source) diff --git a/src/passes/1-parser/cameligo.mli b/src/passes/1-parser/cameligo.mli new file mode 100644 index 000000000..c4f66a596 --- /dev/null +++ b/src/passes/1-parser/cameligo.mli @@ -0,0 +1,21 @@ +(** This file provides an interface to the CameLIGO parser. *) + +module AST = Parser_cameligo.AST + +(** Open a CameLIGO filename given by string and convert into an + abstract syntax tree. *) +val parse_file : string -> AST.t Trace.result + +(** Convert a given string into a CameLIGO abstract syntax tree *) +val parse_string : string -> AST.t Trace.result + +(** Parse a given string as a CameLIGO expression and return an + expression AST. + + 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 Trace.result + +(** Preprocess a given CameLIGO file and preprocess it. *) +val preprocess : string -> Buffer.t Trace.result diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 8b282e6c5..6e4759fe8 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -152,3 +152,7 @@ let parse_string source = apply (fun () -> Unit.contract_in_string source) (* Parsing an expression in a string *) let parse_expression source = apply (fun () -> Unit.expr_in_string source) + +(* Preprocessing a contract in a file *) + +let preprocess source = apply (fun () -> Unit.preprocess source) diff --git a/src/passes/1-parser/pascaligo.mli b/src/passes/1-parser/pascaligo.mli index 13e75b7e9..48ee3dadb 100644 --- a/src/passes/1-parser/pascaligo.mli +++ b/src/passes/1-parser/pascaligo.mli @@ -16,3 +16,6 @@ val parse_string : string -> AST.t Trace.result scenarios where you would want to parse a PascaLIGO expression outside of a contract. *) val parse_expression : string -> AST.expr Trace.result + +(** Preprocess a given PascaLIGO file and preprocess it. *) +val preprocess : string -> Buffer.t Trace.result diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index 332036dcd..0609ae116 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -88,10 +88,10 @@ module Errors = ("location", fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)] in error ~data title message - - let invalid_wild (expr: AST.expr) = +(* + let invalid_wild (expr: AST.expr) = let title () = "" in - let message () = + let message () = "It looks like you are using a wild pattern where it cannot be used." in let expression_loc = AST.expr_to_region expr in @@ -99,7 +99,7 @@ module Errors = ("location", fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)] in error ~data title message - + *) end let apply parser = @@ -172,3 +172,7 @@ let parse_string source = apply (fun () -> Unit.contract_in_string source) (* Parsing an expression in a string *) let parse_expression source = apply (fun () -> Unit.expr_in_string source) + +(* Preprocessing a contract in a file *) + +let preprocess source = apply (fun () -> Unit.preprocess source) diff --git a/src/passes/1-parser/reasonligo.mli b/src/passes/1-parser/reasonligo.mli new file mode 100644 index 000000000..890618a95 --- /dev/null +++ b/src/passes/1-parser/reasonligo.mli @@ -0,0 +1,21 @@ +(** This file provides an interface to the ReasonLIGO parser. *) + +module AST = Parser_cameligo.AST + +(** Open a ReasonLIGO filename given by string and convert into an + abstract syntax tree. *) +val parse_file : string -> AST.t Trace.result + +(** Convert a given string into a ReasonLIGO abstract syntax tree *) +val parse_string : string -> AST.t Trace.result + +(** Parse a given string as a ReasonLIGO expression and return an + expression AST. + + 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 Trace.result + +(** Preprocess a given ReasonLIGO file and preprocess it. *) +val preprocess : string -> Buffer.t Trace.result diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index f1d495157..948837c75 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -265,4 +265,26 @@ module Make (Lexer: Lexer.S) let options = SubIO.make ~input:None ~expr:true in gen_parser options (Lexer.Channel stdin) parse_expr + (* Preprocess only *) + + let preprocess (source : string) = + let options = SubIO.make ~input:(Some source) ~expr:false in + try + let cin = open_in source in + let lexbuf = Lexing.from_channel cin in + let () = + lexbuf.Lexing.lex_curr_p <- + {lexbuf.Lexing.lex_curr_p with pos_fname = source} + and options = (options :> Preprocessor.EvalOpt.options) in + match Preprocessor.Preproc.lex options lexbuf with + Stdlib.Ok _ as ok -> ok + | Error (_, err) -> + let formatted = + Preproc.format ~offsets:options#offsets + ~file:true + err + in close_in cin; Stdlib.Error formatted + with Sys_error error -> + flush_all (); Stdlib.Error (Region.wrap_ghost error) + end diff --git a/src/passes/1-parser/shared/ParserUnit.mli b/src/passes/1-parser/shared/ParserUnit.mli index 5d9f592bc..ebf577331 100644 --- a/src/passes/1-parser/shared/ParserUnit.mli +++ b/src/passes/1-parser/shared/ParserUnit.mli @@ -79,4 +79,7 @@ module Make (Lexer : Lexer.S) val expr_in_stdin : unit -> (AST.expr, message Region.reg) Stdlib.result + + val preprocess : + string -> (Buffer.t, message Region.reg) Stdlib.result end diff --git a/src/passes/2-concrete_to_imperative/cameligo.ml b/src/passes/2-concrete_to_imperative/cameligo.ml index 0fea68765..b685feb58 100644 --- a/src/passes/2-concrete_to_imperative/cameligo.ml +++ b/src/passes/2-concrete_to_imperative/cameligo.ml @@ -120,7 +120,7 @@ module Errors = struct let data = [ ("expression" , (** TODO: The labelled arguments should be flowing from the CLI. *) - thunk @@ Parser.Cameligo.ParserLog.expr_to_string + thunk @@ Parser_cameligo.ParserLog.expr_to_string ~offsets:true ~mode:`Point t)] in error ~data title message @@ -204,7 +204,7 @@ let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> | Raw.PPar pp -> typed_pattern_to_typed_vars pp.value.inside | Raw.PTyped pt -> let (p,t) = pt.value.pattern,pt.value.type_expr in - let%bind p = tuple_pattern_to_vars p in + let%bind p = tuple_pattern_to_vars p in let%bind t = compile_type_expression t in ok @@ (p,t) | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other) @@ -320,7 +320,7 @@ let rec compile_expression : | [] -> e_variable (Var.of_name name) | _ -> let aux expr (Label l) = e_record_accessor expr l in - List.fold_left aux (e_variable (Var.of_name name)) path in + List.fold_left aux (e_variable (Var.of_name name)) path in let updates = u.updates.value.ne_elements in let%bind updates' = let aux (f:Raw.field_path_assign Raw.reg) = @@ -330,13 +330,13 @@ let rec compile_expression : in bind_map_list aux @@ npseq_to_list updates in - let aux ur (path, expr) = + let aux ur (path, expr) = let rec aux record = function | [] -> failwith "error in parsing" | hd :: [] -> ok @@ e_record_update ~loc record hd expr - | hd :: tl -> + | hd :: tl -> let%bind expr = (aux (e_record_accessor ~loc record hd) tl) in - ok @@ e_record_update ~loc record hd expr + ok @@ e_record_update ~loc record hd expr in aux ur path in bind_fold_list aux record updates' @@ -392,9 +392,9 @@ let rec compile_expression : (chain_let_in tl body) | [] -> body (* Precluded by corner case assertion above *) in - let%bind ty_opt = match ty_opt with - | None -> (match let_rhs with - | EFun {value={binders;lhs_type}} -> + let%bind ty_opt = match ty_opt with + | None -> (match let_rhs with + | EFun {value={binders;lhs_type}} -> let f_args = nseq_to_list (binders) in let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in @@ -409,12 +409,12 @@ let rec compile_expression : (* Bind the right hand side so we only evaluate it once *) else ok (e_let_in (rhs_b, ty_opt) inline rhs' (chain_let_in prep_vars body)) in - let%bind ret_expr = match kwd_rec with + let%bind ret_expr = match kwd_rec with | None -> ok @@ ret_expr - | Some _ -> - match ret_expr.expression_content with + | Some _ -> + match ret_expr.expression_content with | E_let_in li -> ( - let%bind lambda = + let%bind lambda = let rec aux rhs = match rhs.expression_content with | E_lambda l -> ok @@ l | E_ascription a -> aux a.anno_expr @@ -423,9 +423,9 @@ let rec compile_expression : aux rhs' in let fun_name = fst @@ List.hd prep_vars in - let%bind fun_type = match ty_opt with + let%bind fun_type = match ty_opt with | Some t -> ok @@ t - | None -> match rhs'.expression_content with + | None -> match rhs'.expression_content with | E_ascription a -> ok a.type_annotation | _ -> fail @@ untyped_recursive_function e in @@ -878,9 +878,9 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty) in let%bind rhs' = compile_expression let_rhs in - let%bind lhs_type = match lhs_type with - | None -> (match let_rhs with - | EFun {value={binders;lhs_type}} -> + let%bind lhs_type = match lhs_type with + | None -> (match let_rhs with + | EFun {value={binders;lhs_type}} -> let f_args = nseq_to_list (binders) in let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in @@ -891,13 +891,13 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu | Some t -> ok @@ Some t in let binder = Var.of_name var.value in - let%bind rhs' = match recursive with - None -> ok @@ rhs' - | Some _ -> match rhs'.expression_content with + let%bind rhs' = match recursive with + None -> ok @@ rhs' + | Some _ -> match rhs'.expression_content with E_lambda lambda -> - (match lhs_type with - None -> fail @@ untyped_recursive_function var - | Some (lhs_type) -> + (match lhs_type with + None -> fail @@ untyped_recursive_function var + | Some (lhs_type) -> let expression_content = E_recursive {fun_name=binder;fun_type=lhs_type;lambda} in ok @@ {rhs' with expression_content}) | _ -> ok @@ rhs' @@ -996,7 +996,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten (** TODO: The labelled arguments should be flowing from the CLI. *) let content () = Printf.sprintf "Pattern : %s" - (Parser.Cameligo.ParserLog.pattern_to_string + (Parser_cameligo.ParserLog.pattern_to_string ~offsets:true ~mode:`Point x) in error title content in