Added some interfaces and removed submodules [Error].

vendors/Preproc/E_Lexer.mli

@@ -0,0 +1,20 @@
+(* Module for lexing boolean expressions of conditional directives *)
+
+(* Regions *)
+
+module Region = Simple_utils.Region
+
+val string_of_token : E_Parser.token -> string
+
+(* Errors *)
+
+type error = Invalid_character of char
+
+val format :
+  ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
+
+(* Lexing boolean expressions (may raise [Error]) *)
+
+exception Error of error Region.reg
+
+val scan : Lexing.lexbuf -> E_Parser.token

vendors/Preproc/E_Lexer.mll

@@ -27,22 +27,19 @@ let string_of_token = function
 
 (* Errors *)
 
-module Error =
+type error = Invalid_character of char
-  struct
-    type t = Invalid_character of char
 
-    let to_string = function
+let error_to_string = function
     Invalid_character c ->
       sprintf "Invalid character '%c' (%d).\n" c (Char.code c)
 
 let format ?(offsets=true) Region.{region; value} ~file =
-      let msg   = to_string value
+  let msg   = error_to_string value
   and reg   = region#to_string ~file ~offsets `Byte in
   let value = sprintf "Preprocessing error %s:\n%s" reg msg
   in Region.{value; region}
-  end
 
-exception Error of Error.t Region.reg
+exception Error of error Region.reg
 
 let mk_reg buffer =
   let start  = Lexing.lexeme_start_p buffer |> Pos.from_byte
@@ -95,7 +92,7 @@ rule scan = parse
 | "!="        { NEQ       }
 | "!"         { NOT       }
 | "//"        { inline_com lexbuf }
-| _ as c      { fail (Error.Invalid_character c) lexbuf }
+| _ as c      { fail (Invalid_character c) lexbuf }
 
 and inline_com = parse
   newline { Lexing.new_line lexbuf; EOL }

vendors/Preproc/E_LexerMain.ml

@@ -5,7 +5,7 @@ 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
+  exception Sys_error msg -> highlight msg
 | cin ->
     let buffer = Lexing.from_channel cin in
     let open Lexing in
@@ -18,6 +18,6 @@ match open_in options#input with
                  if token <> E_Parser.EOL then iter ()
       | exception E_Lexer.Error err ->
           let formatted =
-            E_Lexer.Error.format ~offsets:options#offsets ~file:true err
+            E_Lexer.format ~offsets:options#offsets ~file:true err
           in highlight formatted.Region.value
     in iter (); close_in cin

vendors/Preproc/E_ParserMain.ml

@@ -5,7 +5,7 @@ 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
+  exception Sys_error msg -> highlight msg
 | cin ->
     let buffer = Lexing.from_channel cin in
     let open Lexing in
@@ -20,15 +20,15 @@ match open_in options#input with
       with
         E_Lexer.Error error ->
           let formatted =
-            E_Lexer.Error.format
+            E_Lexer.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
+          and value  = Preproc.Parse_error in
           let error  = Region.{value; region} in
           let formatted =
-            Preproc.Error.format ~offsets:options#offsets
+            Preproc.format ~offsets:options#offsets
                            ~file:true error
           in highlight formatted.Region.value
     in close_in cin

vendors/Preproc/Preproc.mli

@@ -0,0 +1,50 @@
+(* The main module of the preprocessor (see [lex]) *)
+
+(* Regions *)
+
+module Region = Simple_utils.Region
+
+val mk_reg : Lexing.lexbuf -> Region.t
+
+(* Errors *)
+
+type error =
+  Invalid_directive of string
+| Directive_inside_line
+| Missing_endif
+| Invalid_line_indicator of string
+| No_line_indicator
+| End_line_indicator
+| Newline_in_string
+| Open_comment
+| Open_string
+| Dangling_endif
+| Open_region_in_conditional
+| Dangling_endregion
+| Conditional_in_region
+| If_follows_elif
+| Else_follows_else
+| Dangling_else
+| Elif_follows_else
+| Dangling_elif
+| Reserved_symbol of string
+| Multiply_defined_symbol of string
+| Error_directive of string
+| Parse_error
+| No_line_comment_or_blank
+| Invalid_symbol
+
+val format :
+  ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
+
+(* Preprocessing a lexing buffer (might raise [Error]). *)
+
+exception Error of Buffer.t * error Region.reg
+
+val lex : Lexing.lexbuf -> Buffer.t
+
+(* Evaluation of boolean expressions *)
+
+module Env : Set.S with type elt = string
+
+val eval : Env.t -> E_AST.t -> bool

vendors/Preproc/Preproc.mll

@@ -22,16 +22,6 @@ let sprintf = Printf.sprintf
   | char::l -> Bytes.set bytes i char; fill (i-1) l
   in fill (len-1) p |> Bytes.to_string
 
-(* The call [explode s a] is the list made by pushing the characters
-   in the string [s] on top of [a], in reverse order. For example,
-   [explode "ba" ['c';'d'] = ['a'; 'b'; 'c'; 'd']]. *)
-
-let explode s acc =
-  let rec push = function
-    0 -> 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. *)
 
@@ -88,9 +78,7 @@ type state = {
 
 (* ERRORS *)
 
-module Error =
+type error =
-  struct
-    type t =
   Invalid_directive of string
 | Directive_inside_line
 | Missing_endif
@@ -116,7 +104,7 @@ module Error =
 | No_line_comment_or_blank
 | Invalid_symbol
 
-    let to_string = function
+let error_to_string = function
   Invalid_directive name ->
     sprintf "Invalid directive \"%s\"." name
 | Directive_inside_line ->
@@ -177,20 +165,19 @@ module Error =
     "Expected a symbol (identifier)."
 
 let format ?(offsets=true) Region.{region; value} ~file =
-      let msg   = to_string value
+  let msg   = error_to_string value
   and reg   = region#to_string ~file ~offsets `Byte in
   let value = sprintf "Preprocessing error %s:\n%s" reg msg
   in Region.{value; region}
-end
 
-exception Error of state * Error.t 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, Region.{region; value}))
+let stop value state region = 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
@@ -198,9 +185,9 @@ let fail error state buffer = stop error state (mk_reg buffer)
 
 let reduce_cond state region =
   let rec reduce = function
-                [] -> stop Error.Dangling_endif state region
+                [] -> stop Dangling_endif state region
   | If mode::trace -> trace, mode
-  |      Region::_ -> stop Error.Open_region_in_conditional state region
+  |      Region::_ -> stop Open_region_in_conditional state region
   |       _::trace -> reduce trace
   in reduce state.trace
 
@@ -209,9 +196,9 @@ let reduce_cond state region =
 
 let reduce_reg state region =
   match state.trace with
-               [] -> stop Error.Dangling_endregion state region
+               [] -> stop Dangling_endregion state region
   | Region::trace -> trace
-  |             _ -> stop Error.Conditional_in_region state region
+  |             _ -> stop Conditional_in_region state region
 
 (* The function [extend] is called when encountering conditional
    directives #if, #else and #elif. As its name suggests, it extends
@@ -220,11 +207,11 @@ let reduce_reg state region =
 
 let extend cond state region =
   match cond, state.trace with
-    If _, Elif _::_ -> stop Error.If_follows_elif state region
+    If _, Elif _::_ -> stop If_follows_elif state region
-  | Else,   Else::_ -> stop Error.Else_follows_else state region
+  | Else,   Else::_ -> stop Else_follows_else state region
-  | Else,        [] -> stop Error.Dangling_else state region
+  | Else,        [] -> stop Dangling_else state region
-  | Elif _, Else::_ -> stop Error.Elif_follows_else state region
+  | Elif _, Else::_ -> stop Elif_follows_else state region
-  | Elif _,      [] -> stop Error.Dangling_elif state region
+  | Elif _,      [] -> stop Dangling_elif state region
   |     hd,     tl  -> hd::tl
 
 (* The function [last_mode] seeks the last mode as recorded in the
@@ -272,8 +259,8 @@ let expr state buffer : mode =
     try E_Parser.expr E_Lexer.scan buffer with
       E_Parser.Error ->
         let region = mk_reg buffer in
-        let value  = Error.Parse_error
+        let value  = Parse_error
-        in raise (Error (state, Region.{value; region})) in
+        in raise (Error (state.out, Region.{value; region})) in
   let () = print state "\n" in
   if eval state.env ast then Copy else Skip
 
@@ -428,9 +415,9 @@ rule scan state = parse
           |   Inline -> copy state lexbuf; scan state lexbuf }
 | directive {
     if   not (List.mem id directives)
-    then fail (Error.Invalid_directive id) state lexbuf;
+    then fail (Invalid_directive id) state lexbuf;
     if   state.offset = Inline
-    then fail Error.Directive_inside_line state lexbuf;
+    then fail Directive_inside_line state lexbuf;
     let region = mk_reg lexbuf in
     match id with
       "include" ->
@@ -473,9 +460,9 @@ rule scan state = parse
     | "define" ->
         let id, region = variable state lexbuf in
         if id="true" || id="false"
-        then stop (Error.Reserved_symbol id) state region;
+        then stop (Reserved_symbol id) state region;
         if Env.mem id state.env
-        then stop (Error.Multiply_defined_symbol id) state region;
+        then stop (Multiply_defined_symbol id) state region;
         let state = {state with env = Env.add id state.env;
                                 offset = Prefix 0}
         in scan state lexbuf
@@ -485,7 +472,7 @@ rule scan state = parse
                                 offset = Prefix 0}
         in scan state lexbuf
     | "error" ->
-        stop (Error.Error_directive (message [] lexbuf)) state region
+        stop (Error_directive (message [] lexbuf)) state region
 (*
     | "warning" ->
         let start_p, end_p = region in
@@ -523,7 +510,7 @@ rule scan state = parse
   }
 | eof   { match state.trace with
             [] -> expand_offset state; state
-          |  _ -> fail Error.Missing_endif state lexbuf }
+          |  _ -> fail Missing_endif state lexbuf }
 | '"'   { if state.mode = Copy then
             begin
               expand_offset state;
@@ -560,7 +547,7 @@ and variable state = parse
 
 and symbol state = parse
   ident as id { id, mk_reg lexbuf                      }
-| _           { fail Error.Invalid_symbol state lexbuf }
+| _           { fail Invalid_symbol state lexbuf }
 
 
 (* Line indicator (#line) *)
@@ -574,8 +561,8 @@ and line_indicator state = parse
     match id with
       "default" | "hidden" ->
         print state (id ^ message [] lexbuf)
-    | _ -> fail (Error.Invalid_line_indicator id) state lexbuf }
+    | _ -> fail (Invalid_line_indicator id) state lexbuf }
-| _ { fail Error.No_line_indicator state lexbuf }
+| _ { fail No_line_indicator state lexbuf }
 
 and end_indicator state = parse
   blank+ { copy state lexbuf; end_indicator state lexbuf  }
@@ -586,7 +573,7 @@ and end_indicator state = parse
 | '"'    { copy state lexbuf;
            in_string (mk_reg lexbuf) state lexbuf;
            opt_line_com state lexbuf                      }
-| _      { fail Error.End_line_indicator state lexbuf     }
+| _      { fail End_line_indicator state lexbuf     }
 
 and opt_line_com state = parse
   nl     { proc_nl state lexbuf                         }
@@ -600,7 +587,7 @@ 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 state lexbuf }
+| _      { fail No_line_comment_or_blank state lexbuf }
 | eof    { ()                                               }
 
 and message acc = parse
@@ -620,7 +607,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.Open_comment state opening                   }
+| eof  { stop Open_comment state opening                   }
 | _    { copy state lexbuf; in_block_com opening state lexbuf    }
 
 (* Include a file *)
@@ -637,8 +624,8 @@ and scan_inclusion state = parse
 
 and in_inclusion opening acc len state = parse
   '"'    { mk_str len acc                                     }
-| nl     { fail Error.Newline_in_string state lexbuf          }
+| nl     { fail Newline_in_string state lexbuf          }
-| eof    { stop Error.Open_string state opening               }
+| eof    { stop Open_string state opening               }
 | _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf }
 
 (* Strings *)
@@ -646,8 +633,8 @@ and in_inclusion opening acc len state = parse
 and in_string opening state = parse
   "\\\"" { copy state lexbuf; in_string opening state lexbuf  }
 | '"'    { copy state lexbuf                                  }
-| nl     { fail Error.Newline_in_string state lexbuf          }
+| nl     { fail Newline_in_string state lexbuf          }
-| eof    { stop Error.Open_string state opening               }
+| eof    { stop Open_string state opening               }
 | _      { copy state lexbuf; in_string opening state lexbuf  }
 
 

vendors/Preproc/PreprocMain.ml

@@ -1,9 +1,11 @@
 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
+  exception Sys_error msg -> highlight msg
 | cin ->
     let buffer = Lexing.from_channel cin in
     let open Lexing in
@@ -14,12 +16,12 @@ match open_in options#input with
       pp -> print_string (Buffer.contents pp)
     | exception E_Lexer.Error err ->
         let formatted =
-          E_Lexer.Error.format ~offsets:options#offsets ~file:true err
+          E_Lexer.format ~offsets:options#offsets ~file:true err
-        in prerr_endline formatted.Region.value
+        in highlight formatted.Region.value
-    | exception Preproc.Error (state, err) ->
+    | exception Preproc.Error (out, err) ->
         let formatted =
-          Preproc.Error.format ~offsets:options#offsets ~file:true err in
+          Preproc.format ~offsets:options#offsets ~file:true err in
         begin
-          print_string (Buffer.contents state.Preproc.out);
+          print_string (Buffer.contents out);
-          prerr_endline formatted.Region.value
+          highlight formatted.Region.value
         end