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

Plugged the preprocessor into the compiler's CLI.

Browse Source
This commit is contained in:
Christian Rinderknecht 2020-04-12 15:26:47 +02:00
parent 6c02482bf9
commit b23b2d1dbb
13 changed files with 154 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/bin/cli.ml
View File

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

8
src/bin/expect_tests/help_tests.ml
View File

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

20
src/main/compile/helpers.ml
View File

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

7
src/main/compile/of_source.ml
View File

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

4
src/passes/1-parser/cameligo.ml
View File

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

21
src/passes/1-parser/cameligo.mli Normal file
View File

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

4
src/passes/1-parser/pascaligo.ml
View File

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

3
src/passes/1-parser/pascaligo.mli
View File

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

12
src/passes/1-parser/reasonligo.ml
View File

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

21
src/passes/1-parser/reasonligo.mli Normal file
View File

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

22
src/passes/1-parser/shared/ParserUnit.ml
View File

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

3
src/passes/1-parser/shared/ParserUnit.mli
View File

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

50
src/passes/2-concrete_to_imperative/cameligo.ml
View File

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