Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 7ce7630f16
Fetching contributors…

Cannot retrieve contributors at this time

194 lines (167 sloc) 6.06 kB
(***********************************************************************)
(* *)
(* 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$ *)
(* Output the DFA tables and its entry points *)
open Printf
open Syntax
open Lexgen
open Common
let output_auto_defs oc =
fprintf oc "let __ocaml_lex_init_lexbuf lexbuf mem_size =\n\
let pos = lexbuf.Lexing.lex_curr_pos in\n\
lexbuf.Lexing.lex_mem <- Array.create mem_size (-1) ;\n\
lexbuf.Lexing.lex_start_pos <- pos ;\n\
lexbuf.Lexing.lex_last_pos <- pos ;\n\
lexbuf.Lexing.lex_last_action <- -1\n\
\n\
" ;
output_string oc
"let rec __ocaml_lex_next_char lexbuf =\n\
if lexbuf.Lexing.lex_curr_pos >= lexbuf.Lexing.lex_buffer_len then begin\n\
if lexbuf.Lexing.lex_eof_reached then\n\
256\n\
else begin\n\
lexbuf.Lexing.refill_buff lexbuf ;\n\
__ocaml_lex_next_char lexbuf\n\
end\n\
end else begin\n\
let i = lexbuf.Lexing.lex_curr_pos in\n\
let c = lexbuf.Lexing.lex_buffer.[i] in\n\
lexbuf.Lexing.lex_curr_pos <- i+1 ;\n\
Char.code c\n\
end\n\
\n\
"
let output_pats oc pats = List.iter (fun p -> fprintf oc "|%d" p) pats
let output_action oc mems r =
output_memory_actions " " oc mems ;
match r with
| Backtrack ->
fprintf oc
" lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_last_pos ;\n" ;
fprintf oc " lexbuf.Lexing.lex_last_action\n"
| Goto n ->
fprintf oc " __ocaml_lex_state%d lexbuf\n" n
let output_pat oc i =
if i >= 256 then
fprintf oc "|eof"
else
fprintf oc "|'%s'" (Char.escaped (Char.chr i))
let output_clause oc pats mems r =
fprintf oc "(* " ;
List.iter (output_pat oc) pats ;
fprintf oc " *)\n" ;
fprintf oc " %a ->\n" output_pats pats ; output_action oc mems r
let output_default_clause oc mems r =
fprintf oc " | _ ->\n" ; output_action oc mems r
let output_moves oc moves =
let t = Hashtbl.create 17 in
let add_move i (m,mems) =
let mems,r = try Hashtbl.find t m with Not_found -> mems,[] in
Hashtbl.replace t m (mems,(i::r)) in
for i = 0 to 256 do
add_move i moves.(i)
done ;
let most_frequent = ref Backtrack
and most_mems = ref []
and size = ref 0 in
Hashtbl.iter
(fun m (mems,pats) ->
let size_m = List.length pats in
if size_m > !size then begin
most_frequent := m ;
most_mems := mems ;
size := size_m
end)
t ;
Hashtbl.iter
(fun m (mems,pats) ->
if m <> !most_frequent then output_clause oc (List.rev pats) mems m)
t ;
output_default_clause oc !most_mems !most_frequent
let output_tag_actions pref oc mvs =
output_string oc "(*" ;
List.iter
(fun i -> match i with
| SetTag (t,m) -> fprintf oc " t%d <- [%d] ;" t m
| EraseTag t -> fprintf oc " t%d <- -1 ;" t)
mvs ;
output_string oc " *)\n" ;
List.iter
(fun i -> match i with
| SetTag (t,m) ->
fprintf oc "%s%a <- %a ;\n"
pref output_mem_access t output_mem_access m
| EraseTag t ->
fprintf oc "%s%a <- -1 ;\n"
pref output_mem_access t)
mvs
let output_trans pref oc i trans =
fprintf oc "%s __ocaml_lex_state%d lexbuf = " pref i ;
match trans with
| Perform (n,mvs) ->
output_tag_actions " " oc mvs ;
fprintf oc " %d\n" n
| Shift (trans, move) ->
begin match trans with
| Remember (n,mvs) ->
output_tag_actions " " oc mvs ;
fprintf oc
" lexbuf.Lexing.lex_last_pos <- lexbuf.Lexing.lex_curr_pos ;\n" ;
fprintf oc " lexbuf.Lexing.lex_last_action <- %d ;\n" n
| No_remember -> ()
end ;
fprintf oc " match __ocaml_lex_next_char lexbuf with\n" ;
output_moves oc move
let output_automata oc auto =
output_auto_defs oc ;
let n = Array.length auto in
output_trans "let rec" oc 0 auto.(0) ;
for i = 1 to n-1 do
output_trans "\nand" oc i auto.(i)
done ;
output_char oc '\n'
(* Output the entries *)
let output_entry sourcefile ic oc tr e =
let init_num, init_moves = e.auto_initial_state in
fprintf oc "%s %alexbuf =\n\
__ocaml_lex_init_lexbuf lexbuf %d; %a\n\
let __ocaml_lex_result = __ocaml_lex_state%d lexbuf in\n\
lexbuf.Lexing.lex_start_p <- lexbuf.Lexing.lex_curr_p;\n\
lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with\n\
Lexing.pos_cnum = lexbuf.Lexing.lex_abs_pos + lexbuf.Lexing.lex_curr_pos};\n\
match __ocaml_lex_result with\n"
e.auto_name output_args e.auto_args
e.auto_mem_size (output_memory_actions " ") init_moves init_num ;
List.iter
(fun (num, env, loc) ->
fprintf oc " | ";
fprintf oc "%d ->\n" num;
output_env sourcefile ic oc tr env ;
copy_chunk sourcefile ic oc tr loc true;
fprintf oc "\n")
e.auto_actions;
fprintf oc " | _ -> raise (Failure \"lexing: empty token\")\n\n\n"
(* Main output function *)
let output_lexdef sourcefile ic oc tr header entry_points transitions trailer =
copy_chunk sourcefile ic oc tr header false;
output_automata oc transitions ;
begin match entry_points with
[] -> ()
| entry1 :: entries ->
output_string oc "let rec "; output_entry sourcefile ic oc tr entry1;
List.iter
(fun e -> output_string oc "and "; output_entry sourcefile ic oc tr e)
entries;
output_string oc ";;\n\n";
end;
copy_chunk sourcefile ic oc tr trailer false
Jump to Line
Something went wrong with that request. Please try again.