First working version.

vendors/Preproc/E_Lexer.mll

@@ -1,7 +1,7 @@
 (* Auxiliary scanner for boolean expressions of the C# preprocessor *)
 
 {
-(* START HEADER *)
+(* START OF HEADER *)
 
 module Region = Simple_utils.Region
 module Pos = Simple_utils.Pos
@@ -52,7 +52,7 @@ let mk_reg buffer =
 let stop value region = raise (Error Region.{region; value})
 let fail error buffer = stop error (mk_reg buffer)
 
-(* END HEADER *)
+(* END OF HEADER *)
 }
 
 (* Regular expressions for literals *)
@@ -103,6 +103,6 @@ and inline_com = parse
 | _       { inline_com lexbuf }
 
 {
-  (* START TRAILER *)
-  (* END TRAILER *)
+  (* START OF TRAILER *)
+  (* END OF TRAILER *)
 }

vendors/Preproc/E_LexerMain.ml

@@ -0,0 +1,23 @@
+module Region = Simple_utils.Region
+
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+
+let options = EvalOpt.read ();;
+
+match open_in options#input with
+  exception Sys_error msg -> prerr_endline msg
+| cin ->
+    let buffer = Lexing.from_channel cin in
+    let open Lexing in
+    let () =
+      buffer.lex_curr_p <-
+        {buffer.lex_curr_p with pos_fname = options#input} in
+    let rec iter () =
+      match E_Lexer.scan buffer with
+        token -> Printf.printf "%s\n" (E_Lexer.string_of_token token);
+                 if token <> E_Parser.EOL then iter ()
+      | exception E_Lexer.Error err ->
+          let formatted =
+            E_Lexer.Error.format ~offsets:options#offsets ~file:true err
+          in highlight formatted.Region.value
+    in iter (); close_in cin

vendors/Preproc/E_Main.ml

@@ -1,53 +0,0 @@
-(* This module is only used for testing modules [Escan] and [E_Parser]
-   as units *)
-
-module Lexer = struct
-  open E_Lexer
-
-  let run () =
-    let options = EvalOpt.read () in
-    match open_in options#input with
-      cin ->
-        let buffer = Lexing.from_channel cin in
-        let rec iter () =
-          match E_Lexer.scan buffer with
-            E_Parser.EOL -> close_in cin; close_out stdout
-          |           t -> begin
-                            output_string stdout (string_of_token t);
-                            output_string stdout "\n";
-                            flush stdout;
-                            iter ()
-                          end
-          | exception E_Lexer.Error err ->
-              let form = Error.format ~offsets:options#offsets
-                                      err
-                                      ~file:options#input
-              in output_string stdout (form ^ "\n")
-        in iter ()
-    | exception Sys_error msg -> prerr_endline msg
-
-end
-
-module Parser = struct
-  let run () =
-    if Array.length Sys.argv = 2
-    then
-      match open_in Sys.argv.(1) with
-        exception Sys_error msg -> prerr_endline msg
-      | cin ->
-          let buffer = Lexing.from_channel cin in
-          let open Error in
-          let () =
-            try
-              let tree = E_Parser.pp_expression E_Lexer.token buffer in
-              let value = Preproc.(eval Env.empty tree)
-              in (print_string (string_of_bool value);
-                  print_newline ())
-            with Lexer diag    -> print "Lexical" diag
-               | Parser diag   -> print "Syntactical" diag
-               | E_Parser.Error -> print "" ("Parse", mk_seg buffer, 1)
-          in close_in cin
-    else prerr_endline ("Usage: " ^ Sys.argv.(0) ^ " [file]")
-end
-
-let _ = Parser.run()

vendors/Preproc/E_ParserMain.ml

@@ -0,0 +1,34 @@
+module Region = Simple_utils.Region
+
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+
+let options = EvalOpt.read ();;
+
+match open_in options#input with
+  exception Sys_error msg -> prerr_endline msg
+| cin ->
+    let buffer = Lexing.from_channel cin in
+    let open Lexing in
+    let () =
+      buffer.lex_curr_p <-
+        {buffer.lex_curr_p with pos_fname = options#input} in
+    let () =
+      try
+        let tree  = E_Parser.expr E_Lexer.scan buffer in
+        let value = Preproc.(eval Env.empty tree)
+        in Printf.printf "%s\n" (string_of_bool value)
+      with
+        E_Lexer.Error error ->
+          let formatted =
+            E_Lexer.Error.format
+              ~offsets:options#offsets ~file:true error
+          in highlight formatted.Region.value
+      | E_Parser.Error ->
+          let region = Preproc.mk_reg buffer
+          and value  = Preproc.Error.Parse_error in
+          let error  = Region.{value; region} in
+          let formatted =
+            Preproc.Error.format ~offsets:options#offsets
+                                 ~file:true error
+          in highlight formatted.Region.value
+    in close_in cin

vendors/Preproc/Preproc.mll

@@ -1,7 +1,7 @@
 (* Simple preprocessor based on C#, to be processed by [ocamllex]. *)
 
 {
-(* START HEADER *)
+(* START OF HEADER *)
 
 module Region = Simple_utils.Region
 (*module Pos = Simple_utils.Pos*)
@@ -32,6 +32,60 @@ let explode s acc =
   | i -> s.[i-1] :: push (i-1)
 in push (String.length s)
 
+(* The type [mode] defines the two scanning modes of the preprocessor:
+   either we copy the current characters or we skip them. *)
+
+type mode = Copy | Skip
+
+(* Trace of directives
+
+   We keep track of directives #if, #elif, #else, #region and #endregion.
+*)
+
+type cond  = If of mode | Elif of mode | Else | Region
+type trace = cond list
+
+(* Line offsets
+
+   The value [Inline] of type [offset] means that the current location
+   cannot be reached from the start of the line with only white
+   space. The same holds for the special value [Prefix 0]. Values of
+   the form [Prefix n] mean that the current location can be reached
+   from the start of the line with [n] white spaces (padding). These
+   distinctions are needed because preprocessor directives cannot
+   occur inside lines.
+*)
+
+type offset = Prefix of int | Inline
+
+(* Environments *)
+
+module Env = Set.Make (String)
+
+let rec eval env =
+  let open E_AST
+in function
+   Or (e1,e2) -> eval env e1 || eval env e2
+| And (e1,e2) -> eval env e1 && eval env e2
+|  Eq (e1,e2) -> eval env e1 = eval env e2
+| Neq (e1,e2) -> eval env e1 != eval env e2
+|       Not e -> not (eval env e)
+|        True -> true
+|       False -> false
+|    Ident id -> Env.mem id env
+
+(* The type [state] groups the information that needs to be threaded
+   along the scanning functions. *)
+
+type state = {
+  env    : Env.t;
+  mode   : mode;
+  offset : offset;
+  trace  : trace;
+  out    : Buffer.t;
+  incl   : in_channel list
+}
+
 (* ERRORS *)
 
 module Error =
@@ -44,10 +98,10 @@ module Error =
     | No_line_indicator
     | End_line_indicator
     | Newline_in_string
-    | Unterminated_comment
-    | Unterminated_string
+    | Open_comment
+    | Open_string
     | Dangling_endif
-    | Unterminated_region_in_conditional
+    | Open_region_in_conditional
     | Dangling_endregion
     | Conditional_in_region
     | If_follows_elif
@@ -60,6 +114,7 @@ module Error =
     | Error_directive of string
     | Parse_error
     | No_line_comment_or_blank
+    | Invalid_symbol
 
     let to_string = function
       Invalid_directive name ->
@@ -78,15 +133,15 @@ module Error =
                  Hint: Try a string, end of line, or a line comment.\n"
     | Newline_in_string ->
         sprintf "Invalid newline character in string.\n"
-    | Unterminated_comment ->
+    | Open_comment ->
         sprintf "Unterminated comment.\n"
-    | Unterminated_string ->
+    | Open_string ->
         sprintf "Unterminated string.\n\
                  Hint: Close with double quotes.\n"
     | Dangling_endif ->
         sprintf "Dangling #endif directive.\n\
                  Hint: Remove it or add a #if before.\n"
-    | Unterminated_region_in_conditional ->
+    | Open_region_in_conditional ->
         sprintf "Unterminated of #region in conditional.\n\
                  Hint: Close with #endregion before #endif.\n"
     | Dangling_endregion ->
@@ -118,6 +173,8 @@ module Error =
         "Parse error in expression.\n"
     | No_line_comment_or_blank ->
         "Line comment or whitespace expected.\n"
+    | Invalid_symbol ->
+        "Expected a symbol (identifier).\n"
 
     let format ?(offsets=true) Region.{region; value} ~file =
       let msg   = to_string value
@@ -126,63 +183,49 @@ module Error =
       in Region.{value; region}
 end
 
-exception Error of Error.t Region.reg
+exception Error of state * Error.t 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 region = raise (Error Region.{region; value})
-let fail error buffer = stop error (mk_reg buffer)
-
-(* LEXING ENGINE *)
-
-(* C# PREPROCESSOR DIRECTIVES *)
-
-(* The type [mode] defines the two scanning modes of the preprocessor:
-   either we copy the current characters or we skip them. *)
-
-type mode = Copy | Skip
-
-(* Trace of directives
-
-   We keep track of directives #if, #elif, #else, #region and #endregion.
-*)
-
-type cond  = If of mode | Elif of mode | Else | Region
-type trace = cond list
+let stop value state region = raise (Error (state, 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
    found, and the trace (see type [trace] above) needs updating. *)
 
-let rec reduce_cond reg = function
-              [] -> stop Error.Dangling_endif reg
+let reduce_cond state region =
+  let rec reduce = function
+                [] -> stop Error.Dangling_endif state region
   | If mode::trace -> trace, mode
-|      Region::_ -> stop Error.Unterminated_region_in_conditional reg
-|       _::trace -> reduce_cond reg trace
+  |      Region::_ -> stop Error.Open_region_in_conditional state region
+  |       _::trace -> reduce trace
+  in reduce state.trace
 
 (* The function [reduce_reg] is called when a #endregion directive is
    read, and the trace needs updating. *)
 
-let reduce_reg reg = function
-             [] -> stop Error.Dangling_endregion reg
+let reduce_reg state region =
+  match state.trace with
+               [] -> stop Error.Dangling_endregion state region
   | Region::trace -> trace
-|             _ -> stop Error.Conditional_in_region reg
+  |             _ -> stop Error.Conditional_in_region state region
 
 (* The function [extend] is called when encountering conditional
    directives #if, #else and #elif. As its name suggests, it extends
    the current trace with the current conditional directive, whilst
    performing some validity checks. *)
 
-let extend reg cond trace =
-  match cond, trace with
-    If _, Elif _::_ -> stop Error.If_follows_elif reg
-  | Else,   Else::_ -> stop Error.Else_follows_else reg
-  | Else,        [] -> stop Error.Dangling_else reg
-  | Elif _, Else::_ -> stop Error.Elif_follows_else reg
-  | Elif _,      [] -> stop Error.Dangling_elif reg
-  |               _ -> cond::trace
+let extend cond state region =
+  match cond, state.trace with
+    If _, Elif _::_ -> stop Error.If_follows_elif state region
+  | Else,   Else::_ -> stop Error.Else_follows_else state region
+  | Else,        [] -> stop Error.Dangling_else state region
+  | Elif _, Else::_ -> stop Error.Elif_follows_else state region
+  | Elif _,      [] -> stop Error.Dangling_elif state region
+  |     hd,     tl  -> hd::tl
 
 (* The function [last_mode] seeks the last mode as recorded in the
    trace (see type [trace] above). *)
@@ -192,74 +235,6 @@ let rec last_mode = function
 | (If mode | Elif mode)::_ -> mode
 |                 _::trace -> last_mode trace
 
-(* Line offsets
-
-   The value [Inline] of type [offset] means that the current location
-   cannot be reached from the start of the line with only white
-   space. The same holds for the special value [Prefix 0]. Values of
-   the form [Prefix n] mean that the current location can be reached
-   from the start of the line with [n] white spaces (padding). These
-   distinctions are needed because preprocessor directives cannot
-   occur inside lines.
-*)
-
-type offset = Prefix of int | Inline
-
-(* Directives *)
-
-let directives = [
-  "if"; "else"; "elif"; "endif"; "define"; "undef";
-  "error"; (*"warning";*) "line"; "region"; "endregion";
-  "include"]
-
-(* Environments *)
-
-module Env = Set.Make (String)
-
-let rec eval env =
-  let open E_AST
-in function
-   Or (e1,e2) -> eval env e1 || eval env e2
-| And (e1,e2) -> eval env e1 && eval env e2
-|  Eq (e1,e2) -> eval env e1 = eval env e2
-| Neq (e1,e2) -> eval env e1 != eval env e2
-|       Not e -> not (eval env e)
-|        True -> true
-|       False -> false
-|    Ident id -> Env.mem id env
-
-(* The type [state] groups the information that needs to be threaded
-   along the scanning functions. *)
-
-type state = {
-  env    : Env.t;
-  mode   : mode;
-  offset : offset;
-  trace  : trace;
-  out    : Buffer.t;
-  incl   : in_channel list
-}
-
-(* Evaluating a preprocessor expression
-
-   The evaluation of conditional directives may involve symbols whose
-   value may be defined using #define directives, or undefined by
-   means of #undef. Therefore, we need to evaluate conditional
-   expressions in an environment made of a set of defined symbols.
-
-   Note that we rely on an external lexer and parser for the
-   conditional expressions. See modules [E_Lexer] and [E_Parser].
-*)
-
-let expr state buffer =
-  let ast =
-    try E_Parser.expr E_Lexer.scan buffer with
-      E_Parser.Error ->
-        let region = mk_reg buffer in
-        let value  = Error.Parse_error
-        in raise (Error Region.{value; region})
-  in if eval state.env ast then Copy else Skip
-
 (* PRINTING *)
 
 (* Copying the current lexeme to [stdout] *)
@@ -281,6 +256,34 @@ let expand_offset state =
     Prefix 0 | Inline -> ()
   | Prefix n -> print state (String.make n ' ')
 
+(* Evaluating a preprocessor expression
+
+   The evaluation of conditional directives may involve symbols whose
+   value may be defined using #define directives, or undefined by
+   means of #undef. Therefore, we need to evaluate conditional
+   expressions in an environment made of a set of defined symbols.
+
+   Note that we rely on an external lexer and parser for the
+   conditional expressions. See modules [E_Lexer] and [E_Parser].
+*)
+
+let expr state buffer : mode =
+  let ast =
+    try E_Parser.expr E_Lexer.scan buffer with
+      E_Parser.Error ->
+        let region = mk_reg buffer in
+        let value  = Error.Parse_error
+        in raise (Error (state, Region.{value; region})) in
+  let () = print state "\n" in
+  if eval state.env ast then Copy else Skip
+
+(* DIRECTIVES *)
+
+let directives = [
+  "if"; "else"; "elif"; "endif"; "define"; "undef";
+  "error"; (*"warning";*) "line"; "region"; "endregion";
+  "include"]
+
 (* END OF HEADER *)
 }
 
@@ -290,12 +293,11 @@ let nl        = '\n' | '\r' | "\r\n"
 let blank     = ' ' | '\t'
 let digit     = ['0'-'9']
 let natural   = digit | digit (digit | '_')* digit
-let decimal   = digit+ '.' digit+
 let small     = ['a'-'z']
 let capital   = ['A'-'Z']
 let letter    = small | capital
-let ident     = small (letter | '_' | digit)*
-let directive = '#' (blank* as space) (ident as id)
+let ident     = letter (letter | '_' | digit)*
+let directive = '#' (blank* as space) (small+ as id)
 
 (* Rules *)
 
@@ -426,16 +428,16 @@ rule scan state = parse
           |   Inline -> copy state lexbuf; scan state lexbuf }
 | directive {
     if   not (List.mem id directives)
-    then fail (Error.Invalid_directive id) lexbuf;
+    then fail (Error.Invalid_directive id) state lexbuf;
     if   state.offset = Inline
-    then fail Error.Directive_inside_line lexbuf;
-    let reg = mk_reg lexbuf in
+    then fail Error.Directive_inside_line state lexbuf;
+    let region = mk_reg lexbuf in
     match id with
       "include" ->
         let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
         and file = Lexing.(lexbuf.lex_curr_p.pos_fname)
                    |> Filename.basename
-        and incl_file = scan_inclusion lexbuf in
+        and incl_file = scan_inclusion state lexbuf in
         print state (sprintf "# 1 \"%s\" 1\n" incl_file);
         let incl_chan = open_in incl_file in
         let state = {state with incl = incl_chan::state.incl} in
@@ -445,7 +447,7 @@ rule scan state = parse
     | "if" ->
         let mode  = expr state lexbuf in
         let mode  = if state.mode = Copy then mode else Skip in
-        let trace = extend reg (If state.mode) state.trace in
+        let trace = extend (If state.mode) state region in
         let state = {state with mode; offset = Prefix 0; trace}
         in scan state lexbuf
     | "else" ->
@@ -453,27 +455,27 @@ rule scan state = parse
         let mode = match state.mode with
                      Copy -> Skip
                    | Skip -> last_mode state.trace in
-        let trace = extend reg Else state.trace
+        let trace = extend Else state region
         in scan {state with mode; offset = Prefix 0; trace} lexbuf
     | "elif" ->
         let mode = expr state lexbuf in
         let trace, mode =
           match state.mode with
-            Copy -> extend reg (Elif Skip) state.trace, Skip
+            Copy -> extend (Elif Skip) state region, Skip
           | Skip -> let old_mode = last_mode state.trace
-                    in extend reg (Elif old_mode) state.trace,
+                    in extend (Elif old_mode) state region,
                        if old_mode = Copy then mode else Skip
         in scan {state with mode; offset = Prefix 0; trace} lexbuf
     | "endif" ->
         let () = skip_line state lexbuf in
-        let trace, mode = reduce_cond reg state.trace
+        let trace, mode = reduce_cond state region
         in scan {state with mode; offset = Prefix 0; trace} lexbuf
     | "define" ->
-        let id, reg = variable state lexbuf in
+        let id, region = variable state lexbuf in
         if id="true" || id="false"
-        then stop (Error.Reserved_symbol id) reg;
+        then stop (Error.Reserved_symbol id) state region;
         if Env.mem id state.env
-        then stop (Error.Multiply_defined_symbol id) reg;
+        then stop (Error.Multiply_defined_symbol id) state region;
         let state = {state with env = Env.add id state.env;
                                 offset = Prefix 0}
         in scan state lexbuf
@@ -483,10 +485,10 @@ rule scan state = parse
                                 offset = Prefix 0}
         in scan state lexbuf
     | "error" ->
-        stop (Error.Error_directive (message [] lexbuf)) reg
+        stop (Error.Error_directive (message [] lexbuf)) state region
 (*
     | "warning" ->
-        let start_p, end_p = reg in
+        let start_p, end_p = region in
         let msg = message [] lexbuf in
         let open Lexing
         in prerr_endline
@@ -510,7 +512,7 @@ rule scan state = parse
            print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
            let state =
              {state with offset = Prefix 0;
-                         trace  = reduce_reg reg state.trace}
+                         trace  = reduce_reg state region}
            in scan state lexbuf
     | "line" ->
         expand_offset state;
@@ -521,7 +523,7 @@ rule scan state = parse
   }
 | eof   { match state.trace with
             [] -> expand_offset state; state
-          |  _ -> fail Error.Missing_endif lexbuf }
+          |  _ -> fail Error.Missing_endif state lexbuf }
 | '"'   { if state.mode = Copy then
             begin
               expand_offset state;
@@ -553,11 +555,13 @@ rule scan state = parse
 (* Support for #define and #undef *)
 
 and variable state = parse
-  blank* { let id = __ident lexbuf
+  blank+ { let id = symbol state lexbuf
            in skip_line state lexbuf; id }
 
-and __ident = parse
+and symbol state = parse
   ident as id { id, mk_reg lexbuf                      }
+| _           { fail Error.Invalid_symbol state lexbuf }
+
 
 (* Line indicator (#line) *)
 
@@ -565,24 +569,24 @@ and line_ind state = parse
   blank* { copy state lexbuf; line_indicator state lexbuf }
 
 and line_indicator state = parse
-  decimal  { copy state lexbuf; end_indicator state lexbuf }
-| nl | eof { fail Error.No_line_indicator lexbuf     }
+  natural  { copy state lexbuf; end_indicator state lexbuf }
 | ident as id {
     match id with
       "default" | "hidden" ->
         print state (id ^ message [] lexbuf)
-    | _ -> fail (Error.Invalid_line_indicator id) lexbuf }
+    | _ -> fail (Error.Invalid_line_indicator id) state lexbuf }
+| _ { fail Error.No_line_indicator state lexbuf }
 
 and end_indicator state = parse
   blank+ { copy state lexbuf; end_indicator state lexbuf  }
-| nl     { copy state lexbuf; proc_nl state lexbuf        }
+| nl     { proc_nl state lexbuf                           }
 | eof    { copy state lexbuf                              }
 | "//"   { copy state lexbuf;
            print state (message [] lexbuf ^ "\n")         }
 | '"'    { copy state lexbuf;
            in_string (mk_reg lexbuf) state lexbuf;
            opt_line_com state lexbuf                      }
-| _      { fail Error.End_line_indicator lexbuf           }
+| _      { fail Error.End_line_indicator state lexbuf     }
 
 and opt_line_com state = parse
   nl     { proc_nl state lexbuf                         }
@@ -596,7 +600,8 @@ and skip_line state = parse
   nl     { proc_nl state lexbuf                             }
 | blank+ { skip_line state lexbuf                           }
 | "//"   { in_line_com {state with mode=Skip} lexbuf        }
-| _      { fail Error.No_line_comment_or_blank lexbuf }
+| _      { fail Error.No_line_comment_or_blank state lexbuf }
+| eof    { ()                                               }
 
 and message acc = parse
   nl     { Lexing.new_line lexbuf;
@@ -615,7 +620,7 @@ and in_line_com state = parse
 and in_block_com opening state = parse
   nl   { proc_nl state lexbuf; in_block_com opening state lexbuf }
 | "*/" { copy state lexbuf                                       }
-| eof  { stop Error.Unterminated_comment opening                 }
+| eof  { stop Error.Open_comment state opening                   }
 | _    { copy state lexbuf; in_block_com opening state lexbuf    }
 
 (* Include a file *)
@@ -626,32 +631,34 @@ and cat state = parse
 
 (* Included filename *)
 
-and scan_inclusion = parse
-  blank+ { scan_inclusion lexbuf                    }
-| '"'    { in_inclusion (mk_reg lexbuf) [] 0 lexbuf }
+and scan_inclusion state = parse
+  blank+ { scan_inclusion state lexbuf                    }
+| '"'    { in_inclusion (mk_reg lexbuf) [] 0 state lexbuf }
 
-and in_inclusion opening acc len = parse
+and in_inclusion opening acc len state = parse
   '"'    { mk_str len acc                                     }
-| nl     { fail Error.Newline_in_string lexbuf          }
-| eof    { stop Error.Unterminated_string opening       }
-| _ as c { in_inclusion opening (c::acc) (len+1) lexbuf }
+| nl     { fail Error.Newline_in_string state lexbuf          }
+| eof    { stop Error.Open_string state opening               }
+| _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf }
 
 (* Strings *)
 
 and in_string opening state = parse
   "\\\"" { copy state lexbuf; in_string opening state lexbuf  }
 | '"'    { copy state lexbuf                                  }
-| nl     { fail Error.Newline_in_string lexbuf                }
-| eof    { stop Error.Unterminated_string opening             }
+| nl     { fail Error.Newline_in_string state lexbuf          }
+| eof    { stop Error.Open_string state opening               }
 | _      { copy state lexbuf; in_string opening state lexbuf  }
 
 
 {
-(* The function [lex] is a wrapper of [scan], which also checks that
-   the trace is empty at the end.  Note that we discard the
-   environment at the end. *)
+  (* START OF TRAILER *)
 
-let lex buffer =
+(* The function [lex] is a wrapper of [scan], which also checks that
+   the trace is empty at the end.  Note that we discard the state at
+   the end. *)
+
+let lex buffer : Buffer.t =
   let state = {
     env    = Env.empty;
     mode   = Copy;
@@ -660,30 +667,9 @@ let lex buffer =
     out    = Buffer.create 80;
     incl   = []
   } in
-  let state = scan state buffer
-in ()
+  let state = scan state buffer in
+  let () = List.iter close_in state.incl
+in state.out
 
-(* Exported definitions *)
-(*
-let trace options : unit =
-  match open_in options#input with
-    cin ->
-      let open Lexing in
-      let buffer = from_channel cin in
-      let pos_fname = Filename.basename options#input in
-      let () = buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname}
-      in (try lex buffer with
-            Error err ->
-              let msg =
-                Error.format ~offsets:options#offsets err ~file:options#input
-              in prerr_endline msg
-          | E_Lexer.Error err ->
-              let msg =
-                E_Lexer.Error.format ~offsets:options#offsets
-                                     err ~file:options#input
-              in prerr_endline msg
-          | Sys_error msg -> prerr_endline msg);
-         close_in cin
-  | exception Sys_error msg -> prerr_endline msg
- *)
+(* END OF TRAILER *)
 }

vendors/Preproc/PreprocMain.ml

@@ -0,0 +1,25 @@
+module Region = Simple_utils.Region
+
+let options = EvalOpt.read ();;
+
+match open_in options#input with
+  exception Sys_error msg -> prerr_endline msg
+| cin ->
+    let buffer = Lexing.from_channel cin in
+    let open Lexing in
+    let () =
+      buffer.lex_curr_p <-
+        {buffer.lex_curr_p with pos_fname = options#input} in
+    match Preproc.lex buffer with
+      pp -> print_string (Buffer.contents pp)
+    | exception E_Lexer.Error err ->
+        let formatted =
+          E_Lexer.Error.format ~offsets:options#offsets ~file:true err
+        in prerr_endline formatted.Region.value
+    | exception Preproc.Error (state, err) ->
+        let formatted =
+          Preproc.Error.format ~offsets:options#offsets ~file:true err in
+        begin
+          print_string (Buffer.contents state.Preproc.out);
+          prerr_endline formatted.Region.value
+        end

vendors/Preproc/ProcMain.ml

@@ -1,5 +0,0 @@
-(* This is the entry point of the C# preprocessor. See [Makefile.cfg]. *)
-
-let options = EvalOpt.read ()
-
-let () = Preproc.trace options

vendors/Preproc/README.md

@@ -1 +0,0 @@
-# A C# preprocessor in OCaml