Add a textual preprocessor implementing a let%map syntax
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
c52d0676e8
commit
bad0294db3
|
@ -0,0 +1,2 @@
|
||||||
|
(executable (name pp))
|
||||||
|
(ocamllex pp)
|
|
@ -0,0 +1,186 @@
|
||||||
|
{
|
||||||
|
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