First working version.
This commit is contained in:
parent
37faf9022e
commit
9c9321029a
0
vendors/Preproc/.PreprocMain.ml
vendored
Normal file
0
vendors/Preproc/.PreprocMain.ml
vendored
Normal file
0
vendors/Preproc/.PreprocMain.tag
vendored
Normal file
0
vendors/Preproc/.PreprocMain.tag
vendored
Normal file
8
vendors/Preproc/E_Lexer.mll
vendored
8
vendors/Preproc/E_Lexer.mll
vendored
@ -1,7 +1,7 @@
|
|||||||
(* Auxiliary scanner for boolean expressions of the C# preprocessor *)
|
(* Auxiliary scanner for boolean expressions of the C# preprocessor *)
|
||||||
|
|
||||||
{
|
{
|
||||||
(* START HEADER *)
|
(* START OF HEADER *)
|
||||||
|
|
||||||
module Region = Simple_utils.Region
|
module Region = Simple_utils.Region
|
||||||
module Pos = Simple_utils.Pos
|
module Pos = Simple_utils.Pos
|
||||||
@ -52,7 +52,7 @@ let mk_reg buffer =
|
|||||||
let stop value region = raise (Error Region.{region; value})
|
let stop value region = raise (Error Region.{region; value})
|
||||||
let fail error buffer = stop error (mk_reg buffer)
|
let fail error buffer = stop error (mk_reg buffer)
|
||||||
|
|
||||||
(* END HEADER *)
|
(* END OF HEADER *)
|
||||||
}
|
}
|
||||||
|
|
||||||
(* Regular expressions for literals *)
|
(* Regular expressions for literals *)
|
||||||
@ -103,6 +103,6 @@ and inline_com = parse
|
|||||||
| _ { inline_com lexbuf }
|
| _ { inline_com lexbuf }
|
||||||
|
|
||||||
{
|
{
|
||||||
(* START TRAILER *)
|
(* START OF TRAILER *)
|
||||||
(* END TRAILER *)
|
(* END OF TRAILER *)
|
||||||
}
|
}
|
||||||
|
23
vendors/Preproc/E_LexerMain.ml
vendored
Normal file
23
vendors/Preproc/E_LexerMain.ml
vendored
Normal file
@ -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
|
53
vendors/Preproc/E_Main.ml
vendored
53
vendors/Preproc/E_Main.ml
vendored
@ -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()
|
|
34
vendors/Preproc/E_ParserMain.ml
vendored
Normal file
34
vendors/Preproc/E_ParserMain.ml
vendored
Normal file
@ -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
|
342
vendors/Preproc/Preproc.mll
vendored
342
vendors/Preproc/Preproc.mll
vendored
@ -1,7 +1,7 @@
|
|||||||
(* Simple preprocessor based on C#, to be processed by [ocamllex]. *)
|
(* Simple preprocessor based on C#, to be processed by [ocamllex]. *)
|
||||||
|
|
||||||
{
|
{
|
||||||
(* START HEADER *)
|
(* START OF HEADER *)
|
||||||
|
|
||||||
module Region = Simple_utils.Region
|
module Region = Simple_utils.Region
|
||||||
(*module Pos = Simple_utils.Pos*)
|
(*module Pos = Simple_utils.Pos*)
|
||||||
@ -32,6 +32,60 @@ let explode s acc =
|
|||||||
| i -> s.[i-1] :: push (i-1)
|
| i -> s.[i-1] :: push (i-1)
|
||||||
in push (String.length s)
|
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 *)
|
(* ERRORS *)
|
||||||
|
|
||||||
module Error =
|
module Error =
|
||||||
@ -44,10 +98,10 @@ module Error =
|
|||||||
| No_line_indicator
|
| No_line_indicator
|
||||||
| End_line_indicator
|
| End_line_indicator
|
||||||
| Newline_in_string
|
| Newline_in_string
|
||||||
| Unterminated_comment
|
| Open_comment
|
||||||
| Unterminated_string
|
| Open_string
|
||||||
| Dangling_endif
|
| Dangling_endif
|
||||||
| Unterminated_region_in_conditional
|
| Open_region_in_conditional
|
||||||
| Dangling_endregion
|
| Dangling_endregion
|
||||||
| Conditional_in_region
|
| Conditional_in_region
|
||||||
| If_follows_elif
|
| If_follows_elif
|
||||||
@ -60,6 +114,7 @@ module Error =
|
|||||||
| Error_directive of string
|
| Error_directive of string
|
||||||
| Parse_error
|
| Parse_error
|
||||||
| No_line_comment_or_blank
|
| No_line_comment_or_blank
|
||||||
|
| Invalid_symbol
|
||||||
|
|
||||||
let to_string = function
|
let to_string = function
|
||||||
Invalid_directive name ->
|
Invalid_directive name ->
|
||||||
@ -78,15 +133,15 @@ module Error =
|
|||||||
Hint: Try a string, end of line, or a line comment.\n"
|
Hint: Try a string, end of line, or a line comment.\n"
|
||||||
| Newline_in_string ->
|
| Newline_in_string ->
|
||||||
sprintf "Invalid newline character in string.\n"
|
sprintf "Invalid newline character in string.\n"
|
||||||
| Unterminated_comment ->
|
| Open_comment ->
|
||||||
sprintf "Unterminated comment.\n"
|
sprintf "Unterminated comment.\n"
|
||||||
| Unterminated_string ->
|
| Open_string ->
|
||||||
sprintf "Unterminated string.\n\
|
sprintf "Unterminated string.\n\
|
||||||
Hint: Close with double quotes.\n"
|
Hint: Close with double quotes.\n"
|
||||||
| Dangling_endif ->
|
| Dangling_endif ->
|
||||||
sprintf "Dangling #endif directive.\n\
|
sprintf "Dangling #endif directive.\n\
|
||||||
Hint: Remove it or add a #if before.\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\
|
sprintf "Unterminated of #region in conditional.\n\
|
||||||
Hint: Close with #endregion before #endif.\n"
|
Hint: Close with #endregion before #endif.\n"
|
||||||
| Dangling_endregion ->
|
| Dangling_endregion ->
|
||||||
@ -118,6 +173,8 @@ module Error =
|
|||||||
"Parse error in expression.\n"
|
"Parse error in expression.\n"
|
||||||
| No_line_comment_or_blank ->
|
| No_line_comment_or_blank ->
|
||||||
"Line comment or whitespace expected.\n"
|
"Line comment or whitespace expected.\n"
|
||||||
|
| Invalid_symbol ->
|
||||||
|
"Expected a symbol (identifier).\n"
|
||||||
|
|
||||||
let format ?(offsets=true) Region.{region; value} ~file =
|
let format ?(offsets=true) Region.{region; value} ~file =
|
||||||
let msg = to_string value
|
let msg = to_string value
|
||||||
@ -126,63 +183,49 @@ module Error =
|
|||||||
in Region.{value; region}
|
in Region.{value; region}
|
||||||
end
|
end
|
||||||
|
|
||||||
exception Error of Error.t Region.reg
|
exception Error of state * Error.t Region.reg
|
||||||
|
|
||||||
let mk_reg buffer =
|
let mk_reg buffer =
|
||||||
let start = Lexing.lexeme_start_p buffer |> Pos.from_byte
|
let start = Lexing.lexeme_start_p buffer |> Pos.from_byte
|
||||||
and stop = Lexing.lexeme_end_p buffer |> Pos.from_byte
|
and stop = Lexing.lexeme_end_p buffer |> Pos.from_byte
|
||||||
in Region.make ~start ~stop
|
in Region.make ~start ~stop
|
||||||
|
|
||||||
let stop value region = raise (Error Region.{region; value})
|
let stop value state region = raise (Error (state, Region.{region; value}))
|
||||||
let fail error buffer = stop error (mk_reg buffer)
|
let fail error state buffer = stop error state (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
|
|
||||||
|
|
||||||
(* The function [reduce_cond] is called when a #endif directive is
|
(* The function [reduce_cond] is called when a #endif directive is
|
||||||
found, and the trace (see type [trace] above) needs updating. *)
|
found, and the trace (see type [trace] above) needs updating. *)
|
||||||
|
|
||||||
let rec reduce_cond reg = function
|
let reduce_cond state region =
|
||||||
[] -> stop Error.Dangling_endif reg
|
let rec reduce = function
|
||||||
| If mode::trace -> trace, mode
|
[] -> stop Error.Dangling_endif state region
|
||||||
| Region::_ -> stop Error.Unterminated_region_in_conditional reg
|
| If mode::trace -> trace, mode
|
||||||
| _::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
|
(* The function [reduce_reg] is called when a #endregion directive is
|
||||||
read, and the trace needs updating. *)
|
read, and the trace needs updating. *)
|
||||||
|
|
||||||
let reduce_reg reg = function
|
let reduce_reg state region =
|
||||||
[] -> stop Error.Dangling_endregion reg
|
match state.trace with
|
||||||
| Region::trace -> trace
|
[] -> stop Error.Dangling_endregion state region
|
||||||
| _ -> stop Error.Conditional_in_region reg
|
| Region::trace -> trace
|
||||||
|
| _ -> stop Error.Conditional_in_region state region
|
||||||
|
|
||||||
(* The function [extend] is called when encountering conditional
|
(* The function [extend] is called when encountering conditional
|
||||||
directives #if, #else and #elif. As its name suggests, it extends
|
directives #if, #else and #elif. As its name suggests, it extends
|
||||||
the current trace with the current conditional directive, whilst
|
the current trace with the current conditional directive, whilst
|
||||||
performing some validity checks. *)
|
performing some validity checks. *)
|
||||||
|
|
||||||
let extend reg cond trace =
|
let extend cond state region =
|
||||||
match cond, trace with
|
match cond, state.trace with
|
||||||
If _, Elif _::_ -> stop Error.If_follows_elif reg
|
If _, Elif _::_ -> stop Error.If_follows_elif state region
|
||||||
| Else, Else::_ -> stop Error.Else_follows_else reg
|
| Else, Else::_ -> stop Error.Else_follows_else state region
|
||||||
| Else, [] -> stop Error.Dangling_else reg
|
| Else, [] -> stop Error.Dangling_else state region
|
||||||
| Elif _, Else::_ -> stop Error.Elif_follows_else reg
|
| Elif _, Else::_ -> stop Error.Elif_follows_else state region
|
||||||
| Elif _, [] -> stop Error.Dangling_elif reg
|
| Elif _, [] -> stop Error.Dangling_elif state region
|
||||||
| _ -> cond::trace
|
| hd, tl -> hd::tl
|
||||||
|
|
||||||
(* The function [last_mode] seeks the last mode as recorded in the
|
(* The function [last_mode] seeks the last mode as recorded in the
|
||||||
trace (see type [trace] above). *)
|
trace (see type [trace] above). *)
|
||||||
@ -192,74 +235,6 @@ let rec last_mode = function
|
|||||||
| (If mode | Elif mode)::_ -> mode
|
| (If mode | Elif mode)::_ -> mode
|
||||||
| _::trace -> last_mode trace
|
| _::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 *)
|
(* PRINTING *)
|
||||||
|
|
||||||
(* Copying the current lexeme to [stdout] *)
|
(* Copying the current lexeme to [stdout] *)
|
||||||
@ -281,6 +256,34 @@ let expand_offset state =
|
|||||||
Prefix 0 | Inline -> ()
|
Prefix 0 | Inline -> ()
|
||||||
| Prefix n -> print state (String.make n ' ')
|
| 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 *)
|
(* END OF HEADER *)
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -290,12 +293,11 @@ let nl = '\n' | '\r' | "\r\n"
|
|||||||
let blank = ' ' | '\t'
|
let blank = ' ' | '\t'
|
||||||
let digit = ['0'-'9']
|
let digit = ['0'-'9']
|
||||||
let natural = digit | digit (digit | '_')* digit
|
let natural = digit | digit (digit | '_')* digit
|
||||||
let decimal = digit+ '.' digit+
|
|
||||||
let small = ['a'-'z']
|
let small = ['a'-'z']
|
||||||
let capital = ['A'-'Z']
|
let capital = ['A'-'Z']
|
||||||
let letter = small | capital
|
let letter = small | capital
|
||||||
let ident = small (letter | '_' | digit)*
|
let ident = letter (letter | '_' | digit)*
|
||||||
let directive = '#' (blank* as space) (ident as id)
|
let directive = '#' (blank* as space) (small+ as id)
|
||||||
|
|
||||||
(* Rules *)
|
(* Rules *)
|
||||||
|
|
||||||
@ -426,16 +428,16 @@ rule scan state = parse
|
|||||||
| Inline -> copy state lexbuf; scan state lexbuf }
|
| Inline -> copy state lexbuf; scan state lexbuf }
|
||||||
| directive {
|
| directive {
|
||||||
if not (List.mem id directives)
|
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
|
if state.offset = Inline
|
||||||
then fail Error.Directive_inside_line lexbuf;
|
then fail Error.Directive_inside_line state lexbuf;
|
||||||
let reg = mk_reg lexbuf in
|
let region = mk_reg lexbuf in
|
||||||
match id with
|
match id with
|
||||||
"include" ->
|
"include" ->
|
||||||
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
|
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
|
||||||
and file = Lexing.(lexbuf.lex_curr_p.pos_fname)
|
and file = Lexing.(lexbuf.lex_curr_p.pos_fname)
|
||||||
|> Filename.basename
|
|> 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);
|
print state (sprintf "# 1 \"%s\" 1\n" incl_file);
|
||||||
let incl_chan = open_in incl_file in
|
let incl_chan = open_in incl_file in
|
||||||
let state = {state with incl = incl_chan::state.incl} in
|
let state = {state with incl = incl_chan::state.incl} in
|
||||||
@ -445,7 +447,7 @@ rule scan state = parse
|
|||||||
| "if" ->
|
| "if" ->
|
||||||
let mode = expr state lexbuf in
|
let mode = expr state lexbuf in
|
||||||
let mode = if state.mode = Copy then mode else Skip 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}
|
let state = {state with mode; offset = Prefix 0; trace}
|
||||||
in scan state lexbuf
|
in scan state lexbuf
|
||||||
| "else" ->
|
| "else" ->
|
||||||
@ -453,27 +455,27 @@ rule scan state = parse
|
|||||||
let mode = match state.mode with
|
let mode = match state.mode with
|
||||||
Copy -> Skip
|
Copy -> Skip
|
||||||
| Skip -> last_mode state.trace in
|
| 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
|
in scan {state with mode; offset = Prefix 0; trace} lexbuf
|
||||||
| "elif" ->
|
| "elif" ->
|
||||||
let mode = expr state lexbuf in
|
let mode = expr state lexbuf in
|
||||||
let trace, mode =
|
let trace, mode =
|
||||||
match state.mode with
|
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
|
| 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
|
if old_mode = Copy then mode else Skip
|
||||||
in scan {state with mode; offset = Prefix 0; trace} lexbuf
|
in scan {state with mode; offset = Prefix 0; trace} lexbuf
|
||||||
| "endif" ->
|
| "endif" ->
|
||||||
let () = skip_line state lexbuf in
|
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
|
in scan {state with mode; offset = Prefix 0; trace} lexbuf
|
||||||
| "define" ->
|
| "define" ->
|
||||||
let id, reg = variable state lexbuf in
|
let id, region = variable state lexbuf in
|
||||||
if id="true" || id="false"
|
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
|
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;
|
let state = {state with env = Env.add id state.env;
|
||||||
offset = Prefix 0}
|
offset = Prefix 0}
|
||||||
in scan state lexbuf
|
in scan state lexbuf
|
||||||
@ -483,10 +485,10 @@ rule scan state = parse
|
|||||||
offset = Prefix 0}
|
offset = Prefix 0}
|
||||||
in scan state lexbuf
|
in scan state lexbuf
|
||||||
| "error" ->
|
| "error" ->
|
||||||
stop (Error.Error_directive (message [] lexbuf)) reg
|
stop (Error.Error_directive (message [] lexbuf)) state region
|
||||||
(*
|
(*
|
||||||
| "warning" ->
|
| "warning" ->
|
||||||
let start_p, end_p = reg in
|
let start_p, end_p = region in
|
||||||
let msg = message [] lexbuf in
|
let msg = message [] lexbuf in
|
||||||
let open Lexing
|
let open Lexing
|
||||||
in prerr_endline
|
in prerr_endline
|
||||||
@ -510,7 +512,7 @@ rule scan state = parse
|
|||||||
print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
|
print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
|
||||||
let state =
|
let state =
|
||||||
{state with offset = Prefix 0;
|
{state with offset = Prefix 0;
|
||||||
trace = reduce_reg reg state.trace}
|
trace = reduce_reg state region}
|
||||||
in scan state lexbuf
|
in scan state lexbuf
|
||||||
| "line" ->
|
| "line" ->
|
||||||
expand_offset state;
|
expand_offset state;
|
||||||
@ -521,7 +523,7 @@ rule scan state = parse
|
|||||||
}
|
}
|
||||||
| eof { match state.trace with
|
| eof { match state.trace with
|
||||||
[] -> expand_offset state; state
|
[] -> expand_offset state; state
|
||||||
| _ -> fail Error.Missing_endif lexbuf }
|
| _ -> fail Error.Missing_endif state lexbuf }
|
||||||
| '"' { if state.mode = Copy then
|
| '"' { if state.mode = Copy then
|
||||||
begin
|
begin
|
||||||
expand_offset state;
|
expand_offset state;
|
||||||
@ -553,11 +555,13 @@ rule scan state = parse
|
|||||||
(* Support for #define and #undef *)
|
(* Support for #define and #undef *)
|
||||||
|
|
||||||
and variable state = parse
|
and variable state = parse
|
||||||
blank* { let id = __ident lexbuf
|
blank+ { let id = symbol state lexbuf
|
||||||
in skip_line state lexbuf; id }
|
in skip_line state lexbuf; id }
|
||||||
|
|
||||||
and __ident = parse
|
and symbol state = parse
|
||||||
ident as id { id, mk_reg lexbuf }
|
ident as id { id, mk_reg lexbuf }
|
||||||
|
| _ { fail Error.Invalid_symbol state lexbuf }
|
||||||
|
|
||||||
|
|
||||||
(* Line indicator (#line) *)
|
(* Line indicator (#line) *)
|
||||||
|
|
||||||
@ -565,24 +569,24 @@ and line_ind state = parse
|
|||||||
blank* { copy state lexbuf; line_indicator state lexbuf }
|
blank* { copy state lexbuf; line_indicator state lexbuf }
|
||||||
|
|
||||||
and line_indicator state = parse
|
and line_indicator state = parse
|
||||||
decimal { copy state lexbuf; end_indicator state lexbuf }
|
natural { copy state lexbuf; end_indicator state lexbuf }
|
||||||
| nl | eof { fail Error.No_line_indicator lexbuf }
|
|
||||||
| ident as id {
|
| ident as id {
|
||||||
match id with
|
match id with
|
||||||
"default" | "hidden" ->
|
"default" | "hidden" ->
|
||||||
print state (id ^ message [] lexbuf)
|
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
|
and end_indicator state = parse
|
||||||
blank+ { copy state lexbuf; end_indicator state lexbuf }
|
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 }
|
| eof { copy state lexbuf }
|
||||||
| "//" { copy state lexbuf;
|
| "//" { copy state lexbuf;
|
||||||
print state (message [] lexbuf ^ "\n") }
|
print state (message [] lexbuf ^ "\n") }
|
||||||
| '"' { copy state lexbuf;
|
| '"' { copy state lexbuf;
|
||||||
in_string (mk_reg lexbuf) state lexbuf;
|
in_string (mk_reg lexbuf) state lexbuf;
|
||||||
opt_line_com 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
|
and opt_line_com state = parse
|
||||||
nl { proc_nl state lexbuf }
|
nl { proc_nl state lexbuf }
|
||||||
@ -596,7 +600,8 @@ and skip_line state = parse
|
|||||||
nl { proc_nl state lexbuf }
|
nl { proc_nl state lexbuf }
|
||||||
| blank+ { skip_line state lexbuf }
|
| blank+ { skip_line state lexbuf }
|
||||||
| "//" { in_line_com {state with mode=Skip} 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
|
and message acc = parse
|
||||||
nl { Lexing.new_line lexbuf;
|
nl { Lexing.new_line lexbuf;
|
||||||
@ -615,7 +620,7 @@ and in_line_com state = parse
|
|||||||
and in_block_com opening state = parse
|
and in_block_com opening state = parse
|
||||||
nl { proc_nl state lexbuf; in_block_com opening state lexbuf }
|
nl { proc_nl state lexbuf; in_block_com opening state lexbuf }
|
||||||
| "*/" { copy 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 }
|
| _ { copy state lexbuf; in_block_com opening state lexbuf }
|
||||||
|
|
||||||
(* Include a file *)
|
(* Include a file *)
|
||||||
@ -626,32 +631,34 @@ and cat state = parse
|
|||||||
|
|
||||||
(* Included filename *)
|
(* Included filename *)
|
||||||
|
|
||||||
and scan_inclusion = parse
|
and scan_inclusion state = parse
|
||||||
blank+ { scan_inclusion lexbuf }
|
blank+ { scan_inclusion state lexbuf }
|
||||||
| '"' { in_inclusion (mk_reg lexbuf) [] 0 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 }
|
'"' { mk_str len acc }
|
||||||
| nl { fail Error.Newline_in_string lexbuf }
|
| nl { fail Error.Newline_in_string state lexbuf }
|
||||||
| eof { stop Error.Unterminated_string opening }
|
| eof { stop Error.Open_string state opening }
|
||||||
| _ as c { in_inclusion opening (c::acc) (len+1) lexbuf }
|
| _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf }
|
||||||
|
|
||||||
(* Strings *)
|
(* Strings *)
|
||||||
|
|
||||||
and in_string opening state = parse
|
and in_string opening state = parse
|
||||||
"\\\"" { copy state lexbuf; in_string opening state lexbuf }
|
"\\\"" { copy state lexbuf; in_string opening state lexbuf }
|
||||||
| '"' { copy state lexbuf }
|
| '"' { copy state lexbuf }
|
||||||
| nl { fail Error.Newline_in_string lexbuf }
|
| nl { fail Error.Newline_in_string state lexbuf }
|
||||||
| eof { stop Error.Unterminated_string opening }
|
| eof { stop Error.Open_string state opening }
|
||||||
| _ { copy state lexbuf; in_string opening state lexbuf }
|
| _ { copy state lexbuf; in_string opening state lexbuf }
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
(* The function [lex] is a wrapper of [scan], which also checks that
|
(* START OF TRAILER *)
|
||||||
the trace is empty at the end. Note that we discard the
|
|
||||||
environment at the end. *)
|
|
||||||
|
|
||||||
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 = {
|
let state = {
|
||||||
env = Env.empty;
|
env = Env.empty;
|
||||||
mode = Copy;
|
mode = Copy;
|
||||||
@ -660,30 +667,9 @@ let lex buffer =
|
|||||||
out = Buffer.create 80;
|
out = Buffer.create 80;
|
||||||
incl = []
|
incl = []
|
||||||
} in
|
} in
|
||||||
let state = scan state buffer
|
let state = scan state buffer in
|
||||||
in ()
|
let () = List.iter close_in state.incl
|
||||||
|
in state.out
|
||||||
|
|
||||||
(* Exported definitions *)
|
(* END OF TRAILER *)
|
||||||
(*
|
|
||||||
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
|
|
||||||
*)
|
|
||||||
}
|
}
|
||||||
|
25
vendors/Preproc/PreprocMain.ml
vendored
Normal file
25
vendors/Preproc/PreprocMain.ml
vendored
Normal file
@ -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
|
5
vendors/Preproc/ProcMain.ml
vendored
5
vendors/Preproc/ProcMain.ml
vendored
@ -1,5 +0,0 @@
|
|||||||
(* This is the entry point of the C# preprocessor. See [Makefile.cfg]. *)
|
|
||||||
|
|
||||||
let options = EvalOpt.read ()
|
|
||||||
|
|
||||||
let () = Preproc.trace options
|
|
1
vendors/Preproc/README.md
vendored
1
vendors/Preproc/README.md
vendored
@ -1 +0,0 @@
|
|||||||
# A C# preprocessor in OCaml
|
|
Loading…
Reference in New Issue
Block a user