I removed exceptions for error reporting through the

interfaces ([Stdlib.result] instead).

I added --verbose=preproc to print the preprocessed text until
the error.

Fixed a bug: some whitespace in skip mode was printed out.

vendors/Preproc/E_Lexer.mli

@@ -10,6 +10,8 @@ val string_of_token : E_Parser.token -> string
 
 type error = Invalid_character of char
 
+val error_to_string : error -> string
+
 val format :
   ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
 

vendors/Preproc/E_Lexer.mll

@@ -31,7 +31,7 @@ type error = Invalid_character of char
 
 let error_to_string = function
     Invalid_character c ->
-      sprintf "Invalid character '%c' (%d).\n" c (Char.code c)
+      sprintf "Invalid character '%c' (%d)." c (Char.code c)
 
 let format ?(offsets=true) Region.{region; value} ~file =
   let msg   = error_to_string value

vendors/Preproc/EvalOpt.ml

@@ -4,19 +4,23 @@
 
 type language = PascaLIGO | CameLIGO | ReasonLIGO
 
+module SSet = Set.Make (String)
+
 type options = <
   input   : string;
   libs    : string list;
   lang    : language;
-  offsets : bool
+  offsets : bool;
+  verbose : SSet.t
 >
 
-let make ~input ~libs ~lang ~offsets =
+let make ~input ~libs ~lang ~offsets ~verbose =
   object
     method input   = input
     method libs    = libs
     method lang    = lang
     method offsets = offsets
+    method verbose = verbose
   end
 
 (* Auxiliary functions and modules *)
@@ -42,8 +46,9 @@ let help () =
   printf "where <input> is the source file,\n";
   print "and each <option> (if any) is one of the following:";
   print "  -I <paths>             Inclusion paths (colon-separated)";
-  print "             --columns   Columns for source locations";
+  print "      --columns          Columns for source locations";
-  print "  -h,        --help      This help";
+  print "      --verbose=<stages> preproc";
+  print "  -h, --help             This help";
   exit 0
 
 (* Specifying the command-line options a la GNU *)
@@ -52,16 +57,23 @@ let input    = ref None
 and libs     = ref []
 and lang     = ref None
 and columns  = ref false
+and verbose  = ref SSet.empty
+and verb_str = ref ""
 
 let split_at_colon = Str.(split (regexp ":"))
 
 let add_path p = libs := !libs @ split_at_colon p
 
+let add_verbose d =
+  verbose := List.fold_left (fun x y -> SSet.add y x)
+                            !verbose
+                            (split_at_colon d)
 let specs =
   let open!Getopt in [
     'I',     nolong,    None, Some add_path;
     'h',     "help",    Some help, None;
-    noshort, "columns", set columns true, None
+    noshort, "columns", set columns true, None;
+    noshort, "verbose", None, Some add_verbose
   ]
 
 (* Handler of anonymous arguments *)
@@ -84,6 +96,8 @@ let check () =
 
   and offsets = not !columns
 
+  and verbose = !verbose
+
   and lang =
     match !lang with
       Some lang -> lang
@@ -94,12 +108,16 @@ let check () =
       Some file -> file
     | None -> abort "Missing input file."
 
- in make ~input ~libs ~lang ~offsets
+ in make ~input ~libs ~lang ~offsets ~verbose
 
 (* Parsing the command-line options *)
 
 let read () =
   try
     Getopt.parse_cmdline specs anonymous;
+    (verb_str :=
+       let apply e a =
+         if a = "" then e else sprintf "%s, %s" e a
+       in SSet.fold apply !verbose "");
     check ()
   with Getopt.Error msg -> abort msg

vendors/Preproc/EvalOpt.mli

@@ -4,11 +4,14 @@
 
 type language = PascaLIGO | CameLIGO | ReasonLIGO
 
+module SSet : Set.S with type elt = string
+
 type options = <
   input   : string;
   libs    : string list;
   lang    : language;
-  offsets : bool
+  offsets : bool;
+  verbose : SSet.t
 >
 
 val make :
@@ -16,6 +19,7 @@ val make :
   libs:string list ->
   lang:language ->
   offsets:bool ->
+  verbose:SSet.t ->
   options
 
 (* Parsing the command-line options on stdin. The first parameter is

vendors/Preproc/Preproc.mli

@@ -34,15 +34,17 @@ type error =
 | No_line_comment_or_blank
 | Invalid_symbol
 | File_not_found of string
+| Invalid_character of char
 
 val format :
   ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
 
-(* Preprocessing a lexing buffer (might raise [Error]). *)
+(* Preprocessing a lexing buffer *)
 
-exception Error of Buffer.t * error Region.reg
+val lex :
-
+  EvalOpt.options ->
-val lex : EvalOpt.options -> Lexing.lexbuf -> Buffer.t
+  Lexing.lexbuf ->
+  (Buffer.t, Buffer.t * error Region.reg) Stdlib.result
 
 (* Evaluation of boolean expressions *)
 

vendors/Preproc/Preproc.mll

@@ -105,6 +105,7 @@ type error =
 | No_line_comment_or_blank
 | Invalid_symbol
 | File_not_found of string
+| Invalid_character of char
 
 let error_to_string = function
   Invalid_directive name ->
@@ -167,6 +168,8 @@ let error_to_string = function
     "Expected a symbol (identifier)."
 | File_not_found name ->
     sprintf "File \"%s\" to include not found." name
+| Invalid_character c ->
+    E_Lexer.error_to_string (E_Lexer.Invalid_character c)
 
 let format ?(offsets=true) Region.{region; value} ~file =
   let msg   = error_to_string value
@@ -174,14 +177,20 @@ let format ?(offsets=true) Region.{region; value} ~file =
   let value = sprintf "Preprocessing error %s:\n%s" reg msg
   in Region.{value; region}
 
-exception Error of Buffer.t * error Region.reg
+exception Error of (Buffer.t * error Region.reg)
 
 let mk_reg buffer =
   let start  = Lexing.lexeme_start_p buffer |> Pos.from_byte
   and stop   = Lexing.lexeme_end_p buffer |> Pos.from_byte
   in Region.make ~start ~stop
 
-let stop value state region = raise (Error (state.out, Region.{region; value}))
+(* IMPORTANT : Make sure the function [stop] remains the only one
+   raising [Error]. *)
+
+let stop value state region =
+  List.iter close_in state.incl;
+  raise (Error (state.out, Region.{region; value}))
+
 let fail error state buffer = stop error state (mk_reg buffer)
 
 (* The function [reduce_cond] is called when a #endif directive is
@@ -277,10 +286,12 @@ let expand_offset state =
 let expr state buffer : mode =
   let ast =
     try E_Parser.expr E_Lexer.scan buffer with
-      E_Parser.Error ->
+      E_Lexer.Error Region.{value; region} ->
-        let region = mk_reg buffer in
+        (match value with
-        let value  = Parse_error
+           E_Lexer.Invalid_character c ->
-        in raise (Error (state.out, Region.{value; region})) in
+             stop (Invalid_character c) state region)
+    | E_Parser.Error ->
+        fail Parse_error state buffer in
   let () = print state "\n" in
   if eval state.env ast then Copy else Skip
 
@@ -431,8 +442,11 @@ rule scan state = parse
   nl    { proc_nl state lexbuf;
           scan {state with offset = Prefix 0} lexbuf }
 | blank { match state.offset with
-            Prefix n -> scan {state with offset = Prefix (n+1)} lexbuf
+            Prefix n ->
-          |   Inline -> copy state lexbuf; scan state lexbuf }
+              scan {state with offset = Prefix (n+1)} lexbuf
+          | Inline ->
+              if state.mode = Copy then copy state lexbuf;
+              scan state lexbuf }
 | directive {
     if   not (List.mem id directives)
     then fail (Invalid_directive id) state lexbuf;
@@ -452,7 +466,7 @@ rule scan state = parse
             Some channel -> channel
           | None -> stop (File_not_found incl_file) state reg in
         let state = {state with incl = incl_chan::state.incl} in
-        cat state (Lexing.from_channel incl_chan);
+        cat state (Lexing.from_channel incl_chan); (* TODO *)
         print state (sprintf "# %i \"%s\" 2" (line+1) base);
         scan state lexbuf
     | "if" ->
@@ -496,19 +510,6 @@ rule scan state = parse
         in scan state lexbuf
     | "error" ->
         stop (Error_directive (message [] lexbuf)) state region
-(*
-    | "warning" ->
-        let start_p, end_p = region in
-        let msg = message [] lexbuf in
-        let open Lexing
-        in prerr_endline
-             ("Warning at line " ^ string_of_int start_p.pos_lnum
-             ^ ", char "
-             ^ string_of_int (start_p.pos_cnum - start_p.pos_bol)
-             ^ "--" ^ string_of_int (end_p.pos_cnum - end_p.pos_bol)
-             ^ ":\n" ^ msg);
-           scan env mode (Prefix 0) trace lexbuf
- *)
     | "region" ->
         let msg = message [] lexbuf
         in expand_offset state;
@@ -526,6 +527,19 @@ rule scan state = parse
         print state ("#" ^ space ^ "line");
         line_ind state lexbuf;
         scan {state with offset = Prefix 0} lexbuf
+(*
+    | "warning" ->
+        let start_p, end_p = region in
+        let msg = message [] lexbuf in
+        let open Lexing
+        in prerr_endline
+             ("Warning at line " ^ string_of_int start_p.pos_lnum
+             ^ ", char "
+             ^ string_of_int (start_p.pos_cnum - start_p.pos_bol)
+             ^ "--" ^ string_of_int (end_p.pos_cnum - end_p.pos_bol)
+             ^ ":\n" ^ msg);
+           scan env mode (Prefix 0) trace lexbuf
+ *)
     | _ -> assert false
   }
 | eof   { match state.trace with
@@ -636,8 +650,8 @@ and in_line_com state = parse
 
 and reasonLIGO_com opening state = parse
   nl   { proc_nl state lexbuf; reasonLIGO_com opening state lexbuf }
-| "*/" { copy state lexbuf                                       }
+| "*/" { copy state lexbuf                                         }
-| eof  { stop Open_comment state opening                         }
+| eof  { stop Open_comment state opening                           }
 | _    { copy state lexbuf; reasonLIGO_com opening state lexbuf    }
 
 and cameLIGO_com opening state = parse
@@ -683,7 +697,7 @@ and in_string opening state = parse
    the trace is empty at the end.  Note that we discard the state at
    the end. *)
 
-let lex opt buffer : Buffer.t =
+let lex opt buffer =
   let state = {
     env    = Env.empty;
     mode   = Copy;
@@ -693,9 +707,10 @@ let lex opt buffer : Buffer.t =
     incl   = [];
     opt
   } in
-  let state = scan state buffer in
+  match scan state buffer with
-  let () = List.iter close_in state.incl
+    state -> List.iter close_in state.incl;
-in state.out
+             Stdlib.Ok state.out
+  | exception Error e -> Stdlib.Error e
 
 (* END OF TRAILER *)
 }

vendors/Preproc/PreprocMain.ml

@@ -13,15 +13,12 @@ match open_in options#input with
       buffer.lex_curr_p <-
         {buffer.lex_curr_p with pos_fname = options#input} in
     match Preproc.lex options buffer with
-      pp -> print_string (Buffer.contents pp)
+      Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer)
-    | exception E_Lexer.Error err ->
+    | Stdlib.Error (pp_buffer, err) ->
-        let formatted =
-          E_Lexer.format ~offsets:options#offsets ~file:true err
-        in highlight formatted.Region.value
-    | exception Preproc.Error (_out, err) ->
         let formatted =
           Preproc.format ~offsets:options#offsets ~file:true err in
         begin
-(*          print_string (Buffer.contents out);*)
+          if EvalOpt.SSet.mem "preproc" options#verbose then
+            Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
           highlight formatted.Region.value
         end