[WIP] Added traces to debug
This commit is contained in:
parent
4f4294bf56
commit
41d6956b66
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user