diff options
Diffstat (limited to 'lex/common.ml')
| -rw-r--r-- | lex/common.ml | 153 |
1 files changed, 0 insertions, 153 deletions
diff --git a/lex/common.ml b/lex/common.ml deleted file mode 100644 index f56e7a869d..0000000000 --- a/lex/common.ml +++ /dev/null @@ -1,153 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Luc Maranget, projet Moscova, *) -(* INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -open Printf -open Syntax -open Lexgen - - -(* To copy the ML code fragments *) - -type line_tracker = { - file : string; - oc : out_channel; - ic : in_channel; - mutable cur_line : int; -};; - -let open_tracker file oc = { - file = file; - oc = oc; - ic = open_in_bin file; - cur_line = 1; -};; - -let close_tracker tr = close_in_noerr tr.ic;; - -let update_tracker tr = - fprintf tr.oc "\n"; - flush tr.oc; - let cr_seen = ref false in - try while true do - match input_char tr.ic with - | '\010' when not !cr_seen -> tr.cur_line <- tr.cur_line + 1; - | '\013' -> cr_seen := true; tr.cur_line <- tr.cur_line + 1; - | _ -> cr_seen := false; - done with End_of_file -> - fprintf tr.oc "# %d \"%s\"\n" (tr.cur_line+1) tr.file; -;; - -let copy_buffer = String.create 1024 - -let copy_chars_unix ic oc start stop = - let n = ref (stop - start) in - while !n > 0 do - let m = input ic copy_buffer 0 (min !n 1024) in - output oc copy_buffer 0 m; - n := !n - m - done - -let copy_chars_win32 ic oc start stop = - for i = start to stop - 1 do - let c = input_char ic in - if c <> '\r' then output_char oc c - done - -let copy_chars = - match Sys.os_type with - "Win32" | "Cygwin" -> copy_chars_win32 - | _ -> copy_chars_unix - -let copy_chunk sourcefile ic oc trl loc add_parens = - if loc.start_pos < loc.end_pos || add_parens then begin - fprintf oc "# %d \"%s\"\n" loc.start_line sourcefile; - if add_parens then begin - for i = 1 to loc.start_col - 1 do output_char oc ' ' done; - output_char oc '('; - end else begin - for i = 1 to loc.start_col do output_char oc ' ' done; - end; - seek_in ic loc.start_pos; - copy_chars ic oc loc.start_pos loc.end_pos; - if add_parens then output_char oc ')'; - update_tracker trl; - end - -(* Various memory actions *) - -let output_mem_access oc i = fprintf oc "lexbuf.Lexing.lex_mem.(%d)" i - -let output_memory_actions pref oc = function - | [] -> () - | mvs -> - output_string oc "(* " ; - fprintf oc "L=%d " (List.length mvs) ; - List.iter - (fun mv -> match mv with - | Copy (tgt, src) -> - fprintf oc "[%d] <- [%d] ;" tgt src - | Set tgt -> - fprintf oc "[%d] <- p ; " tgt) - mvs ; - output_string oc " *)\n" ; - List.iter - (fun mv -> match mv with - | Copy (tgt, src) -> - fprintf oc - "%s%a <- %a ;\n" - pref output_mem_access tgt output_mem_access src - | Set tgt -> - fprintf oc "%s%a <- lexbuf.Lexing.lex_curr_pos ;\n" - pref output_mem_access tgt) - mvs - -let output_base_mem oc = function - | Mem i -> output_mem_access oc i - | Start -> fprintf oc "lexbuf.Lexing.lex_start_pos" - | End -> fprintf oc "lexbuf.Lexing.lex_curr_pos" - -let output_tag_access oc = function - | Sum (a,0) -> - output_base_mem oc a - | Sum (a,i) -> - fprintf oc "(%a + %d)" output_base_mem a i - -let output_env oc env = - let pref = ref "let" in - match env with - | [] -> () - | _ -> - List.iter - (fun (x,v) -> - begin match v with - | Ident_string (o,nstart,nend) -> - fprintf oc - "\n %s %s = Lexing.sub_lexeme%s lexbuf %a %a" - !pref x (if o then "_opt" else "") - output_tag_access nstart output_tag_access nend - | Ident_char (o,nstart) -> - fprintf oc - "\n %s %s = Lexing.sub_lexeme_char%s lexbuf %a" - !pref x (if o then "_opt" else "") - output_tag_access nstart - end ; - pref := "and") - env ; - fprintf oc " in\n" - -(* Output the user arguments *) -let output_args oc args = - List.iter (fun x -> (output_string oc x; output_char oc ' ')) args - -(* quiet flag *) -let quiet_mode = ref false;; |