Make it work during bootstrap

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

bootstrap.ml

@@ -362,30 +362,15 @@ let read_file fn =
 
 let generated_file = "boot.ml"
 
+let pp = run_ocamllex "src/let-syntax/lexer.mll";;
+#mod_use "src/let-syntax/lexer.ml";;
+
 let generate_file_with_all_the_sources () =
   let oc = open_out_bin generated_file in
-  let pos_in_generated_file = ref 1 in
-  let pr fmt =
-    ksprintf (fun s ->
-      output_string oc s;
-      output_char oc '\n';
-      incr pos_in_generated_file)
-      fmt
-  in
-  let dump fn =
-    let s = read_file fn in
-    pr "# 1 %S" fn;
-    output_string oc s;
-    let newlines = count_newlines s in
-    let newlines =
-      if s <> "" && s.[String.length s - 1] <> '\n' then begin
-        output_char oc '\n';
-        newlines + 1
-      end else
-        newlines
-    in
-    pos_in_generated_file := !pos_in_generated_file + newlines;
-    pr "# %d %S" (!pos_in_generated_file + 1) generated_file
+  let pp = Lexer.create ~oc ~output_fname:generated_file in
+  let pr fmt = ksprintf (Lexer.print_endline pp) fmt in
+  let dump fname =
+    Lexer.apply pp ~fname
   in
   let modules_by_lib =
     List.map topsorted_module_names ~f:(fun m ->

src/let-syntax/lexer.mli

@@ -0,0 +1,10 @@
+type t
+
+val create
+  :  output_fname:string
+  -> oc:out_channel
+  -> t
+
+val apply : t -> fname:string -> unit
+
+val print_endline : t -> string -> unit

src/let-syntax/lexer.mll

@@ -5,8 +5,7 @@ open Printf
 type mode = Generated_code | Source_code
 
 type t =
-  { fname        : string
-  ; output_fname : string
+  { output_fname : string
   ; (* Line number in generated file *)
     mutable line : int
   ; oc           : out_channel
@@ -17,13 +16,13 @@ type t =
 let lexeme_len lb =
   Lexing.lexeme_end lb - Lexing.lexeme_start lb
 
-let fail t lb msg =
+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%!"
-    t.fname start.pos_lnum (start.pos_cnum - start.pos_bol)
+    start.pos_fname start.pos_lnum (start.pos_cnum - start.pos_bol)
     (stop.pos_cnum - start.pos_bol)
     msg;
   exit 1
@@ -47,7 +46,7 @@ let enter_generated_code t =
 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;
+  pf t "# %d %S\n" pos.pos_lnum pos.pos_fname;
   let col = pos.pos_cnum - pos.pos_bol in
   npc t col ' '
 
@@ -140,7 +139,7 @@ and after_indent t col = parse
       match id with
       | "and" -> And
       | "in"  -> In
-      | _     -> fail t lexbuf "'and' or 'in' keyword expected"
+      | _     -> fail lexbuf "'and' or 'in' keyword expected"
     }
 
 and after_in_and_newline t col = parse
@@ -175,18 +174,30 @@ and lhs t = parse
     }
 
 {
-  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
-    ()
+  let create ~output_fname ~oc =
+    { output_fname
+    ; line = 1
+    ; oc
+    ; mode = Generated_code
+    ; buf = Buffer.create 512
+    }
+
+  let print_endline t s =
+    if t.mode = Source_code then
+      enter_generated_code t;
+    ps t s;
+    pc t '\n'
+
+  let apply t ~fname =
+    let ic = open_in_bin fname in
+    let lb = Lexing.from_channel ic in
+    lb.lex_curr_p <-
+      { pos_fname = fname
+      ; pos_lnum  = 1
+      ; pos_bol   = 0
+      ; pos_cnum  = 0
+      };
+    t.mode <- Generated_code;
+    let (And | In) = main t (-1) lb in
+    close_in ic
 }

src/let-syntax/pp.ml

@@ -0,0 +1,7 @@
+let () =
+  let pp =
+    Lexer.create
+      ~output_fname:(Sys.argv.(1) ^ ".generated")
+      ~oc:stdout
+  in
+  Lexer.apply pp ~fname:Sys.argv.(1)