From 9c9321029a92e8fc9ad18dccea710ae9b494b1e8 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Tue, 24 Mar 2020 17:47:24 +0100 Subject: [PATCH] First working version. --- .../Preproc/{.E_Main.tag => .E_LexerMain.tag} | 0 .../{.ProcMain.tag => .E_ParserMain.tag} | 0 vendors/Preproc/.PreprocMain.ml | 0 vendors/Preproc/.PreprocMain.tag | 0 vendors/Preproc/E_Lexer.mll | 8 +- vendors/Preproc/E_LexerMain.ml | 23 ++ vendors/Preproc/E_Main.ml | 53 --- vendors/Preproc/E_ParserMain.ml | 34 ++ vendors/Preproc/Preproc.mll | 352 +++++++++--------- vendors/Preproc/PreprocMain.ml | 25 ++ vendors/Preproc/ProcMain.ml | 5 - vendors/Preproc/README.md | 1 - 12 files changed, 255 insertions(+), 246 deletions(-) rename vendors/Preproc/{.E_Main.tag => .E_LexerMain.tag} (100%) rename vendors/Preproc/{.ProcMain.tag => .E_ParserMain.tag} (100%) create mode 100644 vendors/Preproc/.PreprocMain.ml create mode 100644 vendors/Preproc/.PreprocMain.tag create mode 100644 vendors/Preproc/E_LexerMain.ml delete mode 100644 vendors/Preproc/E_Main.ml create mode 100644 vendors/Preproc/E_ParserMain.ml create mode 100644 vendors/Preproc/PreprocMain.ml delete mode 100644 vendors/Preproc/ProcMain.ml delete mode 100644 vendors/Preproc/README.md diff --git a/vendors/Preproc/.E_Main.tag b/vendors/Preproc/.E_LexerMain.tag similarity index 100% rename from vendors/Preproc/.E_Main.tag rename to vendors/Preproc/.E_LexerMain.tag diff --git a/vendors/Preproc/.ProcMain.tag b/vendors/Preproc/.E_ParserMain.tag similarity index 100% rename from vendors/Preproc/.ProcMain.tag rename to vendors/Preproc/.E_ParserMain.tag diff --git a/vendors/Preproc/.PreprocMain.ml b/vendors/Preproc/.PreprocMain.ml new file mode 100644 index 000000000..e69de29bb diff --git a/vendors/Preproc/.PreprocMain.tag b/vendors/Preproc/.PreprocMain.tag new file mode 100644 index 000000000..e69de29bb diff --git a/vendors/Preproc/E_Lexer.mll b/vendors/Preproc/E_Lexer.mll index 814cf0e6d..41b0c312e 100644 --- a/vendors/Preproc/E_Lexer.mll +++ b/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 *) } diff --git a/vendors/Preproc/E_LexerMain.ml b/vendors/Preproc/E_LexerMain.ml new file mode 100644 index 000000000..a45d3118e --- /dev/null +++ b/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 diff --git a/vendors/Preproc/E_Main.ml b/vendors/Preproc/E_Main.ml deleted file mode 100644 index 0e5d79fdf..000000000 --- a/vendors/Preproc/E_Main.ml +++ /dev/null @@ -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() diff --git a/vendors/Preproc/E_ParserMain.ml b/vendors/Preproc/E_ParserMain.ml new file mode 100644 index 000000000..564745af8 --- /dev/null +++ b/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 diff --git a/vendors/Preproc/Preproc.mll b/vendors/Preproc/Preproc.mll index 6072e96ef..5f0a0fed1 100644 --- a/vendors/Preproc/Preproc.mll +++ b/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 -| If mode::trace -> trace, mode -| Region::_ -> stop Error.Unterminated_region_in_conditional reg -| _::trace -> reduce_cond reg trace +let reduce_cond state region = + let rec reduce = function + [] -> stop Error.Dangling_endif state region + | If mode::trace -> trace, mode + | 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 -| Region::trace -> trace -| _ -> stop Error.Conditional_in_region reg +let reduce_reg state region = + match state.trace with + [] -> stop Error.Dangling_endregion state region + | Region::trace -> trace + | _ -> 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 - ident as id { id, mk_reg lexbuf } +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 } @@ -593,10 +597,11 @@ and opt_line_com state = parse (* New lines and verbatim sequence of characters *) 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 } + 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 } +| 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 - '"' { 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 } +and in_inclusion opening acc len state = parse + '"' { mk_str len acc } +| 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 *) } diff --git a/vendors/Preproc/PreprocMain.ml b/vendors/Preproc/PreprocMain.ml new file mode 100644 index 000000000..93b00c193 --- /dev/null +++ b/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 diff --git a/vendors/Preproc/ProcMain.ml b/vendors/Preproc/ProcMain.ml deleted file mode 100644 index f71abd461..000000000 --- a/vendors/Preproc/ProcMain.ml +++ /dev/null @@ -1,5 +0,0 @@ -(* This is the entry point of the C# preprocessor. See [Makefile.cfg]. *) - -let options = EvalOpt.read () - -let () = Preproc.trace options diff --git a/vendors/Preproc/README.md b/vendors/Preproc/README.md deleted file mode 100644 index b15c65fef..000000000 --- a/vendors/Preproc/README.md +++ /dev/null @@ -1 +0,0 @@ -# A C# preprocessor in OCaml