diff --git a/bootstrap.ml b/bootstrap.ml index 6d79fd25..bc18be1e 100644 --- a/bootstrap.ml +++ b/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 -> diff --git a/src/let-syntax/lexer.mli b/src/let-syntax/lexer.mli new file mode 100644 index 00000000..efeb381e --- /dev/null +++ b/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 diff --git a/src/let-syntax/lexer.mll b/src/let-syntax/lexer.mll index d7d16588..6d79a535 100644 --- a/src/let-syntax/lexer.mll +++ b/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 } diff --git a/src/let-syntax/pp.ml b/src/let-syntax/pp.ml new file mode 100644 index 00000000..9d8d5cd1 --- /dev/null +++ b/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)