[WIP] Added traces to debug

This commit is contained in:
Christian Rinderknecht 2020-01-24 12:56:05 +01:00
parent 4f4294bf56
commit 41d6956b66
5 changed files with 71 additions and 56 deletions

View File

@ -23,14 +23,16 @@ let syntax_to_variant : s_syntax -> string option -> v_syntax result =
| "reasonligo", _ -> ok ReasonLIGO | "reasonligo", _ -> ok ReasonLIGO
| _ -> simple_fail "unrecognized parser" | _ -> simple_fail "unrecognized parser"
let parsify_pascaligo = fun source -> let parsify_pascaligo source =
let () = prerr_endline "Helpers.parsify_pascaligo: BEFORE" in
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Pascaligo.parse_file source in Parser.Pascaligo.parse_file source in
let () = prerr_endline "Helpers.parsify_pascaligo: AFTER" in
let%bind simplified = let%bind simplified =
trace (simple_error "simplifying") @@ trace (simple_error "simplifying") @@
Simplify.Pascaligo.simpl_program raw in Simplify.Pascaligo.simpl_program raw
ok simplified in ok simplified
let parsify_expression_pascaligo = fun source -> let parsify_expression_pascaligo = fun source ->
let%bind raw = let%bind raw =
@ -81,9 +83,10 @@ let parsify = fun (syntax : v_syntax) source_filename ->
let%bind parsify = match syntax with let%bind parsify = match syntax with
| Pascaligo -> ok parsify_pascaligo | Pascaligo -> ok parsify_pascaligo
| Cameligo -> ok parsify_cameligo | Cameligo -> ok parsify_cameligo
| ReasonLIGO -> ok parsify_reasonligo | ReasonLIGO -> ok parsify_reasonligo in
in let () = prerr_endline "Helpers.parsify: BEFORE" in
let%bind parsified = parsify source_filename in let%bind parsified = parsify source_filename in
let () = prerr_endline "Helpers.parsify: AFTER" in
let%bind applied = Self_ast_simplified.all_program parsified in let%bind applied = Self_ast_simplified.all_program parsified in
ok applied ok applied

View File

@ -1,11 +1,10 @@
open Trace module AST = Parser_pascaligo.AST
module AST = Parser_pascaligo.AST
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
module Region = Simple_utils.Region module Region = Simple_utils.Region
module ParErr = Parser_pascaligo.ParErr module ParErr = Parser_pascaligo.ParErr
module SSet = Utils.String.Set
(* Mock IOs TODO: Fill them with CLI options *) (* Mock IOs TODO: Fill them with CLI options *)
@ -19,9 +18,8 @@ module PreIO =
struct struct
let ext = ".ligo" let ext = ".ligo"
let pre_options = let pre_options =
EvalOpt.make ~input:None EvalOpt.make ~libs:[]
~libs:[] ~verbose:(SSet.singleton "cpp") (* TODO (Debug) *)
~verbose:Utils.String.Set.empty
~offsets:true ~offsets:true
~mode:`Point ~mode:`Point
~cmd:EvalOpt.Quiet ~cmd:EvalOpt.Quiet
@ -53,7 +51,7 @@ module Errors =
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in error ~data title message in Trace.error ~data title message
let duplicate_parameter Region.{value; region} = let duplicate_parameter Region.{value; region} =
let title () = let title () =
@ -62,7 +60,7 @@ module Errors =
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in error ~data title message in Trace.error ~data title message
let duplicate_variant Region.{value; region} = let duplicate_variant Region.{value; region} =
let title () = let title () =
@ -72,7 +70,7 @@ module Errors =
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in error ~data title message in Trace.error ~data title message
let non_linear_pattern Region.{value; region} = let non_linear_pattern Region.{value; region} =
let title () = let title () =
@ -81,7 +79,7 @@ module Errors =
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in error ~data title message in Trace.error ~data title message
let duplicate_field Region.{value; region} = let duplicate_field Region.{value; region} =
let title () = let title () =
@ -91,7 +89,7 @@ module Errors =
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in error ~data title message in Trace.error ~data title message
let parser_error Region.{value; region} = let parser_error Region.{value; region} =
let title () = "" let title () = ""
@ -100,7 +98,7 @@ module Errors =
let data = let data =
[("parser_loc", [("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
in error ~data title message in Trace.error ~data title message
let lexer_error (e: Lexer.error AST.reg) = let lexer_error (e: Lexer.error AST.reg) =
let title () = "\nLexer error" in let title () = "\nLexer error" in
@ -108,7 +106,7 @@ module Errors =
let data = [ let data = [
("parser_loc", ("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)] fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)]
in error ~data title message in Trace.error ~data title message
end end
let parse (module IO : IO) parser = let parse (module IO : IO) parser =
@ -119,9 +117,9 @@ let parse (module IO : IO) parser =
match parser () with match parser () with
(* Scoping errors *) (* Scoping errors *)
Stdlib.Ok semantic_value -> ok semantic_value Stdlib.Ok semantic_value -> Trace.ok semantic_value
| Stdlib.Error error -> fail @@ Errors.parser_error error | Stdlib.Error error -> Trace.fail @@ Errors.parser_error error
| exception Lexer.Error e -> fail @@ Errors.lexer_error e | exception Lexer.Error e -> Trace.fail @@ Errors.lexer_error e
| exception Scoping.Error (Scoping.Reserved_name name) -> | exception Scoping.Error (Scoping.Reserved_name name) ->
let token = let token =
@ -133,7 +131,7 @@ let parse (module IO : IO) parser =
| Ok invalid -> | Ok invalid ->
let point = let point =
"Reserved name.\nHint: Change the name.\n", None, invalid "Reserved name.\nHint: Change the name.\n", None, invalid
in fail @@ Errors.reserved_name @@ mk_error point) in Trace.fail @@ Errors.reserved_name @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_parameter name) -> | exception Scoping.Error (Scoping.Duplicate_parameter name) ->
let token = let token =
@ -146,7 +144,7 @@ let parse (module IO : IO) parser =
let point = let point =
"Duplicate parameter.\nHint: Change the name.\n", "Duplicate parameter.\nHint: Change the name.\n",
None, invalid None, invalid
in fail @@ Errors.duplicate_parameter @@ mk_error point) in Trace.fail @@ Errors.duplicate_parameter @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_variant name) -> | exception Scoping.Error (Scoping.Duplicate_variant name) ->
let token = let token =
@ -155,7 +153,7 @@ let parse (module IO : IO) parser =
"Duplicate constructor in this sum type declaration.\n\ "Duplicate constructor in this sum type declaration.\n\
Hint: Change the constructor.\n", Hint: Change the constructor.\n",
None, token None, token
in fail @@ Errors.duplicate_variant @@ mk_error point in Trace.fail @@ Errors.duplicate_variant @@ mk_error point
| exception Scoping.Error (Scoping.Non_linear_pattern var) -> | exception Scoping.Error (Scoping.Non_linear_pattern var) ->
let token = let token =
@ -169,7 +167,7 @@ let parse (module IO : IO) parser =
"Repeated variable in this pattern.\n\ "Repeated variable in this pattern.\n\
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid None, invalid
in fail @@ Errors.non_linear_pattern @@ mk_error point) in Trace.fail @@ Errors.non_linear_pattern @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_field name) -> | exception Scoping.Error (Scoping.Duplicate_field name) ->
let token = let token =
@ -183,56 +181,75 @@ let parse (module IO : IO) parser =
"Duplicate field name in this record declaration.\n\ "Duplicate field name in this record declaration.\n\
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid None, invalid
in fail @@ Errors.duplicate_field @@ mk_error point) in Trace.fail @@ Errors.duplicate_field @@ mk_error point)
let parse_file (source: string) = let parse_file (source: string) =
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~expr:false let options =
PreIO.pre_options ~input:(Some source) ~expr:false
end in end in
let lib_path =
match IO.options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in
let prefix =
match IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension) in
let suffix = ".pp" ^ IO.ext in
let pp_input = let pp_input =
let prefix = Filename.(source |> basename |> remove_extension) if SSet.mem "cpp" IO.options#verbose
and suffix = ".pp.ligo" then prefix ^ suffix
in prefix ^ suffix in else let pp_input, pp_out =
let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s" Filename.open_temp_file prefix suffix
source pp_input in in close_out pp_out; pp_input in
let cpp_cmd =
match IO.options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
| Some file ->
Printf.sprintf "cpp -traditional-cpp%s %s > %s"
lib_path file pp_input in
let open Trace in
let%bind () = sys_command cpp_cmd in let%bind () = sys_command cpp_cmd in
let%bind channel =
generic_try (simple_error "Error when opening file") @@
(fun () -> open_in pp_input) in
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let instance = let instance =
match Lexer.open_token_stream (Lexer.Channel channel) with match Lexer.open_token_stream (Lexer.File pp_input) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_contract in let thunk () = Unit.apply instance Unit.parse_contract in
parse (module IO) thunk let res = parse (module IO) thunk in
let () = prerr_endline "Pascaligo.parse_file: Leaving." in
res
let parse_string (s: string) = let parse_string (s: string) =
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~expr:false let options = PreIO.pre_options ~input:None ~expr:false
end in end in
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let instance = let instance =
match Lexer.open_token_stream (Lexer.String s) with match Lexer.open_token_stream (Lexer.String s) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_contract in let thunk () = Unit.apply instance Unit.parse_contract
parse (module IO) thunk in parse (module IO) thunk
let parse_expression (s: string) = let parse_expression (s: string) =
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~expr:true let options = PreIO.pre_options ~input:None ~expr:true
end in end in
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let instance = let instance =
match Lexer.open_token_stream (Lexer.String s) with match Lexer.open_token_stream (Lexer.String s) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_expr in let thunk () = Unit.apply instance Unit.parse_expr
parse (module IO) thunk in parse (module IO) thunk

View File

@ -142,11 +142,11 @@ let lexer_inst =
match parse (fun () -> Unit.apply instance Unit.parse_expr) with match parse (fun () -> Unit.apply instance Unit.parse_expr) with
Stdlib.Ok _ -> () Stdlib.Ok _ -> ()
| Error Region.{value; _} -> | Error Region.{value; _} ->
Printf.eprintf "\027[31m%s\027[0m%!" value Printf.eprintf "\027[31m%s\027[0m%!" value
else else
(match parse (fun () -> Unit.apply instance Unit.parse_contract) with (match parse (fun () -> Unit.apply instance Unit.parse_contract) with
Stdlib.Ok _ -> () Stdlib.Ok _ -> ()
| Error Region.{value; _} -> | Error Region.{value; _} ->
Printf.eprintf "\027[31m%s\027[0m%!" value) Printf.eprintf "\027[31m%s\027[0m%!" value)
| Stdlib.Error (Lexer.File_opening msg) -> | Stdlib.Error (Lexer.File_opening msg) ->
Printf.eprintf "\027[31m%s\027[0m%!" msg Printf.eprintf "\027[31m%s\027[0m%!" msg

View File

@ -183,5 +183,4 @@ module Make (Lexer: Lexer.S)
| exception Sys_error error -> | exception Sys_error error ->
Stdlib.Error (Region.wrap_ghost error) Stdlib.Error (Region.wrap_ghost error)
end end

View File

@ -1312,12 +1312,9 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
| None -> e_skip () | None -> e_skip ()
| Some seq -> e_let_in (Var.of_name "#COMPILER#folded_record", None) false fold seq in (* TODO fresh *) | Some seq -> e_let_in (Var.of_name "#COMPILER#folded_record", None) false fold seq in (* TODO fresh *)
return_statement @@ final_sequence return_statement @@ final_sequence
(*
and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
*)
and simpl_declaration_list declarations : and simpl_declaration_list declarations :
Ast_simplified.declaration Location.wrap list result = Ast_simplified.declaration Location.wrap list result =
let open Raw in let open Raw in
let rec hook acc = function let rec hook acc = function
[] -> acc [] -> acc
@ -1378,8 +1375,7 @@ and simpl_declaration_list declarations :
Declaration_constant (name, ty_opt, inline, expr) in Declaration_constant (name, ty_opt, inline, expr) in
let res = Location.wrap ~loc new_decl in let res = Location.wrap ~loc new_decl in
hook (bind_list_cons res acc) declarations hook (bind_list_cons res acc) declarations
in in hook (ok @@ []) (List.rev declarations)
hook (ok @@ []) (List.rev declarations)
let simpl_program : Raw.ast -> program result = let simpl_program : Raw.ast -> program result =
fun t -> simpl_declaration_list @@ nseq_to_list t.decl fun t -> simpl_declaration_list @@ nseq_to_list t.decl