Make the preprocessor more generic
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
62f0e826ce
commit
9734b2e6d0
|
@ -1,2 +1,2 @@
|
||||||
(executable (name pp))
|
(executable (name pp))
|
||||||
(ocamllex pp)
|
(ocamllex lexer)
|
||||||
|
|
|
@ -0,0 +1,192 @@
|
||||||
|
{
|
||||||
|
open StdLabels
|
||||||
|
open Printf
|
||||||
|
|
||||||
|
type mode = Generated_code | Source_code
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ fname : string
|
||||||
|
; output_fname : string
|
||||||
|
; (* Line number in generated file *)
|
||||||
|
mutable line : int
|
||||||
|
; oc : out_channel
|
||||||
|
; mutable mode : mode
|
||||||
|
; buf : Buffer.t
|
||||||
|
}
|
||||||
|
|
||||||
|
let lexeme_len lb =
|
||||||
|
Lexing.lexeme_end lb - Lexing.lexeme_start lb
|
||||||
|
|
||||||
|
let fail t lb msg =
|
||||||
|
let start = Lexing.lexeme_start_p lb in
|
||||||
|
let stop = Lexing.lexeme_end_p lb in
|
||||||
|
Printf.eprintf
|
||||||
|
"File %S, line %d, characters %d-%d:\n\
|
||||||
|
Error: %s\n%!"
|
||||||
|
t.fname start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||||
|
(stop.pos_cnum - start.pos_bol)
|
||||||
|
msg;
|
||||||
|
exit 1
|
||||||
|
|
||||||
|
let ps t s =
|
||||||
|
String.iter s ~f:(function
|
||||||
|
| '\n' -> t.line <- t.line + 1
|
||||||
|
| _ -> ());
|
||||||
|
output_string t.oc s
|
||||||
|
let pc t = function
|
||||||
|
| '\n' -> t.line <- t.line + 1; output_char t.oc '\n'
|
||||||
|
| c -> output_char t.oc c
|
||||||
|
let npc t n c = for _ = 1 to n do pc t c done
|
||||||
|
let pf t fmt = ksprintf (ps t) fmt
|
||||||
|
|
||||||
|
let enter_generated_code t =
|
||||||
|
t.mode <- Generated_code;
|
||||||
|
pc t '\n';
|
||||||
|
pf t "# %d %S\n" t.line t.output_fname
|
||||||
|
|
||||||
|
let enter_source_code t (pos : Lexing.position) =
|
||||||
|
t.mode <- Source_code;
|
||||||
|
pc t '\n';
|
||||||
|
pf t "# %d %S\n" pos.pos_lnum t.fname;
|
||||||
|
let col = pos.pos_cnum - pos.pos_bol in
|
||||||
|
npc t col ' '
|
||||||
|
|
||||||
|
let pass_through t lb =
|
||||||
|
if t.mode = Generated_code then
|
||||||
|
enter_source_code t (Lexing.lexeme_start_p lb);
|
||||||
|
ps t (Lexing.lexeme lb)
|
||||||
|
|
||||||
|
type and_or_in = And | In
|
||||||
|
}
|
||||||
|
|
||||||
|
let space = [' ' '\t']
|
||||||
|
let newline = '\n' | "\r\n"
|
||||||
|
let id = ['a'-'z' '_'] ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']*
|
||||||
|
|
||||||
|
rule main t col = parse
|
||||||
|
| eof
|
||||||
|
{ In }
|
||||||
|
| newline
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
Lexing.new_line lexbuf;
|
||||||
|
after_newline t col lexbuf
|
||||||
|
}
|
||||||
|
| " in" newline
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
Lexing.new_line lexbuf;
|
||||||
|
after_in_and_newline t col lexbuf
|
||||||
|
}
|
||||||
|
| _
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
main t col lexbuf
|
||||||
|
}
|
||||||
|
| id as id
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
match id with
|
||||||
|
| "let" -> after_let t col (Lexing.lexeme_start_p lexbuf) lexbuf
|
||||||
|
| _ -> main t col lexbuf
|
||||||
|
}
|
||||||
|
|
||||||
|
and after_let t col pos = parse
|
||||||
|
| "%" (id as id)
|
||||||
|
{ if id <> "map" then begin
|
||||||
|
pass_through t lexbuf;
|
||||||
|
main t col lexbuf
|
||||||
|
end else begin
|
||||||
|
let col' = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
|
||||||
|
let rec loop i =
|
||||||
|
let pos = Lexing.lexeme_end_p lexbuf in
|
||||||
|
enter_generated_code t;
|
||||||
|
let id = sprintf "__x%d__" i in
|
||||||
|
ps t id;
|
||||||
|
lhs t lexbuf;
|
||||||
|
let pattern = Buffer.contents t.buf in
|
||||||
|
Buffer.clear t.buf;
|
||||||
|
(id, (pos, pattern)) ::
|
||||||
|
match main t col' lexbuf with
|
||||||
|
| And -> loop (i + 1)
|
||||||
|
| In -> []
|
||||||
|
in
|
||||||
|
let ids, patterns = List.split (loop 1) in
|
||||||
|
enter_generated_code t;
|
||||||
|
ps t "Let_syntax.(fun f -> const f";
|
||||||
|
List.iter ids ~f:(pf t "$ %s");
|
||||||
|
ps t ") @@ fun ";
|
||||||
|
List.iter patterns ~f:(fun (pos, pattern) ->
|
||||||
|
pc t '(';
|
||||||
|
enter_source_code t pos;
|
||||||
|
ps t pattern;
|
||||||
|
pc t ')');
|
||||||
|
ps t "->";
|
||||||
|
t.mode <- Generated_code;
|
||||||
|
main t col lexbuf
|
||||||
|
end
|
||||||
|
}
|
||||||
|
| ""
|
||||||
|
{ main t col lexbuf }
|
||||||
|
|
||||||
|
and after_newline t col = parse
|
||||||
|
| space*
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
if lexeme_len lexbuf = col then
|
||||||
|
after_indent t col lexbuf
|
||||||
|
else
|
||||||
|
main t col lexbuf
|
||||||
|
}
|
||||||
|
|
||||||
|
and after_indent t col = parse
|
||||||
|
| id as id
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
match id with
|
||||||
|
| "and" -> And
|
||||||
|
| "in" -> In
|
||||||
|
| _ -> fail t lexbuf "'and' or 'in' keyword expected"
|
||||||
|
}
|
||||||
|
|
||||||
|
and after_in_and_newline t col = parse
|
||||||
|
| space* newline
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
Lexing.new_line lexbuf;
|
||||||
|
after_in_and_newline t col lexbuf
|
||||||
|
}
|
||||||
|
| space*
|
||||||
|
{ pass_through t lexbuf;
|
||||||
|
if lexeme_len lexbuf = col then
|
||||||
|
In
|
||||||
|
else
|
||||||
|
main t col lexbuf
|
||||||
|
}
|
||||||
|
|
||||||
|
and lhs t = parse
|
||||||
|
| eof
|
||||||
|
{ ()
|
||||||
|
}
|
||||||
|
| newline as s
|
||||||
|
{ Buffer.add_string t.buf s;
|
||||||
|
Lexing.new_line lexbuf;
|
||||||
|
lhs t lexbuf
|
||||||
|
}
|
||||||
|
| "="
|
||||||
|
{ pass_through t lexbuf
|
||||||
|
}
|
||||||
|
| _ as c
|
||||||
|
{ Buffer.add_char t.buf c;
|
||||||
|
lhs t lexbuf
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
let process_file ~fname ~output_fname ~oc =
|
||||||
|
let (And | In) =
|
||||||
|
let t =
|
||||||
|
{ fname
|
||||||
|
; output_fname
|
||||||
|
; line = 1
|
||||||
|
; oc
|
||||||
|
; mode = Generated_code
|
||||||
|
; buf = Buffer.create 512
|
||||||
|
}
|
||||||
|
in
|
||||||
|
main t (-1) (Lexing.from_channel (open_in_bin fname))
|
||||||
|
in
|
||||||
|
()
|
||||||
|
}
|
|
@ -1,186 +0,0 @@
|
||||||
{
|
|
||||||
open StdLabels
|
|
||||||
open Printf
|
|
||||||
|
|
||||||
let fname = Sys.argv.(1)
|
|
||||||
let fname_gen = fname ^ ".generated"
|
|
||||||
|
|
||||||
let lexeme_len lb =
|
|
||||||
Lexing.lexeme_end lb - Lexing.lexeme_start lb
|
|
||||||
|
|
||||||
let fail lb msg =
|
|
||||||
let start = Lexing.lexeme_start_p lb in
|
|
||||||
let stop = Lexing.lexeme_end_p lb in
|
|
||||||
Printf.eprintf
|
|
||||||
"File %S, line %d, characters %d-%d:\n\
|
|
||||||
Error: %s\n%!"
|
|
||||||
fname start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
(stop.pos_cnum - start.pos_bol)
|
|
||||||
msg;
|
|
||||||
exit 1
|
|
||||||
|
|
||||||
(* Line number in generated file *)
|
|
||||||
let lnum = ref 1
|
|
||||||
|
|
||||||
let ps s =
|
|
||||||
String.iter s ~f:(function
|
|
||||||
| '\n' -> incr lnum
|
|
||||||
| _ -> ());
|
|
||||||
print_string s
|
|
||||||
let pc = function
|
|
||||||
| '\n' -> incr lnum; print_char '\n'
|
|
||||||
| c -> print_char c
|
|
||||||
let npc n c = for _ = 1 to n do pc c done
|
|
||||||
let pf fmt = ksprintf ps fmt
|
|
||||||
|
|
||||||
let gen_id =
|
|
||||||
let n = ref 0 in
|
|
||||||
fun () ->
|
|
||||||
incr n;
|
|
||||||
sprintf "__x%d__" !n
|
|
||||||
|
|
||||||
let buf = Buffer.create 512
|
|
||||||
let add_lexeme lb = Buffer.add_string buf (Lexing.lexeme lb)
|
|
||||||
|
|
||||||
type mode = Generated_code | Source_code
|
|
||||||
|
|
||||||
let mode = ref Generated_code
|
|
||||||
|
|
||||||
let enter_generated_code () =
|
|
||||||
mode := Generated_code;
|
|
||||||
pc '\n';
|
|
||||||
pf "# %d %S\n" !lnum fname_gen
|
|
||||||
|
|
||||||
let enter_source_code (pos : Lexing.position) =
|
|
||||||
mode := Source_code;
|
|
||||||
pc '\n';
|
|
||||||
pf "# %d %S\n" pos.pos_lnum fname;
|
|
||||||
let col = pos.pos_cnum - pos.pos_bol in
|
|
||||||
npc col ' '
|
|
||||||
|
|
||||||
let pass_through lb =
|
|
||||||
if !mode = Generated_code then
|
|
||||||
enter_source_code (Lexing.lexeme_start_p lb);
|
|
||||||
ps (Lexing.lexeme lb)
|
|
||||||
|
|
||||||
type and_or_in = And | In
|
|
||||||
}
|
|
||||||
|
|
||||||
let space = [' ' '\t']
|
|
||||||
let newline = '\n' | "\r\n"
|
|
||||||
let id = ['a'-'z' '_'] ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']*
|
|
||||||
|
|
||||||
rule main col = parse
|
|
||||||
| eof
|
|
||||||
{ In }
|
|
||||||
| newline
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
Lexing.new_line lexbuf;
|
|
||||||
after_newline col lexbuf
|
|
||||||
}
|
|
||||||
| " in" newline
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
Lexing.new_line lexbuf;
|
|
||||||
after_in_and_newline col lexbuf
|
|
||||||
}
|
|
||||||
| _
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
main col lexbuf
|
|
||||||
}
|
|
||||||
| id as id
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
match id with
|
|
||||||
| "let" -> after_let col (Lexing.lexeme_start_p lexbuf) lexbuf
|
|
||||||
| _ -> main col lexbuf
|
|
||||||
}
|
|
||||||
|
|
||||||
and after_let col pos = parse
|
|
||||||
| "%" (id as id)
|
|
||||||
{ if id <> "map" then begin
|
|
||||||
pass_through lexbuf;
|
|
||||||
main col lexbuf
|
|
||||||
end else begin
|
|
||||||
let col' = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
|
|
||||||
let rec loop () =
|
|
||||||
let pos = Lexing.lexeme_end_p lexbuf in
|
|
||||||
enter_generated_code ();
|
|
||||||
let id = gen_id () in
|
|
||||||
ps id;
|
|
||||||
lhs lexbuf;
|
|
||||||
let pattern = Buffer.contents buf in
|
|
||||||
Buffer.clear buf;
|
|
||||||
(id, (pos, pattern)) ::
|
|
||||||
match main col' lexbuf with
|
|
||||||
| And -> loop ()
|
|
||||||
| In -> []
|
|
||||||
in
|
|
||||||
let ids, patterns = List.split (loop ()) in
|
|
||||||
enter_generated_code ();
|
|
||||||
ps "Let_syntax.(fun f -> const f";
|
|
||||||
List.iter ids ~f:(pf "$ %s");
|
|
||||||
ps ") @@ fun ";
|
|
||||||
List.iter patterns ~f:(fun (pos, pattern) ->
|
|
||||||
pc '(';
|
|
||||||
enter_source_code pos;
|
|
||||||
ps pattern;
|
|
||||||
pc ')');
|
|
||||||
ps "->";
|
|
||||||
mode := Generated_code;
|
|
||||||
main col lexbuf
|
|
||||||
end
|
|
||||||
}
|
|
||||||
| ""
|
|
||||||
{ main col lexbuf }
|
|
||||||
|
|
||||||
and after_newline col = parse
|
|
||||||
| space*
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
if lexeme_len lexbuf = col then
|
|
||||||
after_indent col lexbuf
|
|
||||||
else
|
|
||||||
main col lexbuf
|
|
||||||
}
|
|
||||||
|
|
||||||
and after_indent col = parse
|
|
||||||
| id as id
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
match id with
|
|
||||||
| "and" -> And
|
|
||||||
| "in" -> In
|
|
||||||
| _ -> fail lexbuf "'and' or 'in' keyword expected"
|
|
||||||
}
|
|
||||||
|
|
||||||
and after_in_and_newline col = parse
|
|
||||||
| space* newline
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
Lexing.new_line lexbuf;
|
|
||||||
after_in_and_newline col lexbuf
|
|
||||||
}
|
|
||||||
| space*
|
|
||||||
{ pass_through lexbuf;
|
|
||||||
if lexeme_len lexbuf = col then
|
|
||||||
In
|
|
||||||
else
|
|
||||||
main col lexbuf
|
|
||||||
}
|
|
||||||
|
|
||||||
and lhs = parse
|
|
||||||
| eof
|
|
||||||
{ ()
|
|
||||||
}
|
|
||||||
| newline as s
|
|
||||||
{ Buffer.add_string buf s;
|
|
||||||
Lexing.new_line lexbuf;
|
|
||||||
lhs lexbuf
|
|
||||||
}
|
|
||||||
| "="
|
|
||||||
{ pass_through lexbuf
|
|
||||||
}
|
|
||||||
| _ as c
|
|
||||||
{ Buffer.add_char buf c;
|
|
||||||
lhs lexbuf
|
|
||||||
}
|
|
||||||
|
|
||||||
{
|
|
||||||
let (And | In) = main (-1) (Lexing.from_channel (open_in_bin fname))
|
|
||||||
}
|
|
Loading…
Reference in New Issue