Commit 43dd7103 authored by Pietro Abate's avatar Pietro Abate

[r2003-06-26 09:10:05 by cvscast] Optim dispatch on atoms

Original author: cvscast
Date: 2003-06-26 09:10:05+00:00
parent 187f7f26
......@@ -47,13 +47,16 @@ let args = List.map int_of_string (split ',' args)
let sp = sprintf
let langs =
[
"CDuce PXP", ".cd",
(* "CDuce PXP", ".cd",
(fun script xml ->
sp "%s --pxp --quiet %s --arg %s" cduce_cmd script xml);
sp "%s --pxp --quiet %s --arg %s" cduce_cmd script xml); *)
"CDuce expat", ".cd",
"CDuce", ".cd",
(fun script xml ->
sp "%s --expat --quiet %s --arg %s" cduce_cmd script xml);
sp "%s --quiet %s --arg %s" cduce_cmd script xml);
"CDuce.old", ".cd",
(fun script xml ->
sp "%s --quiet %s --arg %s" (cduce_cmd^".old") script xml);
"XDuce 0.4.0", ".q",
(fun script xml ->
......
open Encodings
(* TODO:
- pretty-printing
- efficient dispatch
*)
module Ns = struct
include Pool.Make(Utf8)
......@@ -293,6 +288,12 @@ module IMap = struct
| Empty
| Leaf of int * 'a
| Branch of int * int * 'a t * 'a t
type 'a s =
| DError
| DReturn of 'a
| DLeaf of int * 'a * 'a
| DBranch of int * int * 'a s * 'a s
let zero_bit k m = (k land m) == 0
let lowest_bit x = x land (-x)
......@@ -300,15 +301,30 @@ module IMap = struct
let mask p m = p land (m-1)
let match_prefix k p m = (mask k m) == p
let rec find_def def k = function
| Empty -> def
| Leaf (j,x) -> if k == j then x else def
| Branch (_, m, l, r) -> find_def def k (if zero_bit k m then l else r)
let rec prepare_def y = function
| Empty -> DReturn y
| Leaf (k,x) -> DLeaf (k,x,y)
| Branch (p,m,t0,t1) ->
DBranch (p,m,prepare_def y t0, prepare_def y t1)
let rec prepare_nodef = function
| Empty -> DError
| Leaf (k,x) -> DReturn x
| Branch (p,m,t0,t1) ->
match (prepare_nodef t0, prepare_nodef t1) with
| (DReturn x0, DReturn x1) when x0 == x1 -> DReturn x0
| (t0,t1) -> DBranch (p,m,t0,t1)
let prepare def y =
match def with
| None -> prepare_nodef y
| Some def -> prepare_def def y
let rec find k = function
| Empty -> assert false
| Leaf (j,x) -> x
| Branch (_, m, l, r) -> find k (if zero_bit k m then l else r)
| DError -> assert false
| DReturn y -> y
| DLeaf (j,x,y) -> if k == j then x else y
| DBranch (_, m, l, r) -> find k (if zero_bit k m then l else r)
let join p0 t0 p1 t1 =
let m = branching_bit p0 p1 in
......@@ -328,59 +344,69 @@ module IMap = struct
else Branch (p, m, t0, add k x t1)
else
join k (Leaf (k,x)) p t
end
(* TODO: avoid option (using functional types instead ?) *)
let rec dump f ppf = function
| DError -> Format.fprintf ppf "Error"
| DReturn x -> Format.fprintf ppf "Return %a" f x
| DLeaf(j,x,y) -> Format.fprintf ppf "Leaf(%i,%a,%a)" j f x f y
| DBranch (p,m,t0,t1) ->
Format.fprintf ppf "B(%i,%i,%a,%a)" p m (dump f) t0 (dump f) t1
end
type 'a map =
{ min_ns : int;
table : 'a IMap.t array;
table_def : 'a option array;
def : 'a option }
type 'a map = 'a IMap.s IMap.s
let get_map (ns,x) m =
let i = ns - m.min_ns in
if (i < 0) || (i >= Array.length m.table)
then (match m.def with Some y -> y | None -> assert false)
else
match m.table_def.(i) with
| Some def -> IMap.find_def def x m.table.(i)
| None -> IMap.find x m.table.(i)
let get_map (ns,x) m = IMap.find x (IMap.find ns m)
let rec get_max = function
| [ (ns,_) ] -> ns
| _ :: l -> get_max l
| [] -> assert false
module IntSet =
Set.Make(struct type t = int let compare (x:int) y = Pervasives.compare x y end)
let mk_map l =
let min_ns = ref max_int and max_ns = ref min_int in
let all_ns = ref IntSet.empty in
let def = ref None in
List.iter
(function
| (Finite s, _) ->
(match T.get s with
| [] -> ()
| (ns,_)::_ as l ->
min_ns := min !min_ns ns;
max_ns := max !max_ns (get_max l))
| (Cofinite _, y) -> def := Some y) l;
let n = !max_ns - !min_ns + 1 in
let table = Array.make n IMap.Empty in
let table_def = Array.make n None in
let ofs = !min_ns in
for ns = ofs to !max_ns do
table.(ns - ofs) <-
List.iter (fun (ns,_) -> all_ns := IntSet.add ns !all_ns) (T.get s)
| (Cofinite _, y) -> def := Some (IMap.DReturn y)) l;
let one_ns ns =
let def = ref None in
let t =
List.fold_left
(fun accu (s, y) ->
match (symbol_set ns s) with
| SymbolSet.Finite syms ->
List.fold_left (fun accu x -> IMap.add x y accu) accu syms
| SymbolSet.Cofinite syms ->
table_def.(ns - ofs) <- Some y; accu)
def := Some y; accu)
IMap.Empty
l;
done;
{ min_ns = ofs; table = table; table_def = table_def; def = !def }
l in
IMap.prepare !def t
in
let t =
List.fold_left (fun accu ns -> IMap.add ns (one_ns ns) accu)
IMap.Empty
(IntSet.elements !all_ns) in
let t = IMap.prepare !def t in
(*
let rec rank y i = function
| (_,x)::_ when x == y -> i
| _::r -> rank y (succ i) r
| [] -> assert false in
let dump_ns =
IMap.dump (fun ppf y -> Format.fprintf ppf "[%i]" (rank y 0 l)) in
Format.fprintf Format.std_formatter "table: %a@."
(IMap.dump (fun ppf y -> Format.fprintf ppf "[%a]" dump_ns y)) t;
*)
t
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment