diff options
Diffstat (limited to 'test/Lex/output.ml')
| -rw-r--r-- | test/Lex/output.ml | 169 |
1 files changed, 0 insertions, 169 deletions
diff --git a/test/Lex/output.ml b/test/Lex/output.ml deleted file mode 100644 index 97d757771f..0000000000 --- a/test/Lex/output.ml +++ /dev/null @@ -1,169 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 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. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* Generating a DFA as a set of mutually recursive functions *) - -open Syntax - -let ic = ref stdin -let oc = ref stdout - -(* 1- Generating the actions *) - -let copy_buffer = String.create 1024 - -let copy_chunk (Location(start,stop)) = - seek_in !ic start; - let tocopy = ref(stop - start) in - while !tocopy > 0 do - let m = - input !ic copy_buffer 0 (min !tocopy (String.length copy_buffer)) in - output !oc copy_buffer 0 m; - tocopy := !tocopy - m - done - - -let output_action (i,act) = - output_string !oc ("action_" ^ string_of_int i ^ " lexbuf = (\n"); - copy_chunk act; - output_string !oc ")\nand " - - -(* 2- Generating the states *) - -let states = ref ([||] : automata array) - -type occurrence = - { mutable pos: int list; - mutable freq: int } - -let enumerate_vect v = - let env = ref [] in - for pos = 0 to Array.length v - 1 do - try - let occ = List.assoc v.(pos) !env in - occ.pos <- pos :: occ.pos; - occ.freq <- occ.freq + 1 - with Not_found -> - env := (v.(pos), {pos = [pos]; freq = 1 }) :: !env - done; - Sort.list (fun (e1, occ1) (e2, occ2) -> occ1.freq >= occ2.freq) !env - - -let output_move = function - Backtrack -> - output_string !oc "lexing.backtrack lexbuf" - | Goto dest -> - match !states.(dest) with - Perform act_num -> - output_string !oc ("action_" ^ string_of_int act_num ^ " lexbuf") - | _ -> - output_string !oc ("state_" ^ string_of_int dest ^ " lexbuf") - - -(* Cannot use standard char_for_read because the characters to escape - are not the same in CL6 and CL1999. *) - -let output_char_lit oc = function - '\'' -> output_string oc "\\'" - | '\\' -> output_string oc "\\\\" - | '\n' -> output_string oc "\\n" - | '\t' -> output_string oc "\\t" - | c -> if Char.code c >= 32 && Char.code c < 128 then - output_char oc c - else begin - let n = Char.code c in - output_char oc '\\'; - output_char oc (Char.chr (48 + n / 100)); - output_char oc (Char.chr (48 + (n / 10) mod 10)); - output_char oc (Char.chr (48 + n mod 10)) - end - -let rec output_chars = function - [] -> - failwith "output_chars" - | [c] -> - output_string !oc "'"; - output_char_lit !oc (Char.chr c); - output_string !oc "'" - | c::cl -> - output_string !oc "'"; - output_char_lit !oc (Char.chr c); - output_string !oc "'|"; - output_chars cl - -let output_one_trans (dest, occ) = - output_chars occ.pos; - output_string !oc " -> "; - output_move dest; - output_string !oc "\n | " - -let output_all_trans trans = - output_string !oc " match lexing.next_char lexbuf with\n "; - match enumerate_vect trans with - [] -> - failwith "output_all_trans" - | (default, _) :: rest -> - List.iter output_one_trans rest; - output_string !oc "_ -> "; - output_move default; - output_string !oc "\nand " - -let output_state state_num = function - Perform i -> - () - | Shift(what_to_do, moves) -> - output_string !oc - ("state_" ^ string_of_int state_num ^ " lexbuf =\n"); - begin match what_to_do with - No_remember -> () - | Remember i -> - output_string !oc - (" Lexing.set_backtrack lexbuf action_" ^ - string_of_int i ^ ";\n") - end; - output_all_trans moves - - -(* 3- Generating the entry points *) - -let rec output_entries = function - [] -> failwith "output_entries" - | (name,state_num) :: rest -> - output_string !oc (name ^ " lexbuf =\n"); - output_string !oc " Lexing.init lexbuf;\n"; - output_string !oc (" state_" ^ string_of_int state_num ^ - " lexbuf\n"); - match rest with - [] -> output_string !oc "\n"; () - | _ -> output_string !oc "\nand "; output_entries rest - - -(* All together *) - -let output_lexdef header (initial_st, st, actions) = - prerr_int (Array.length st); prerr_string " states, "; - prerr_int (List.length actions); prerr_string " actions."; - prerr_newline(); - copy_chunk header; - output_string !oc "\nlet rec "; - states := st; - List.iter output_action actions; - for i = 0 to Array.length st - 1 do - output_state i st.(i) - done; - output_entries initial_st - - - |