Commit 5d2625ae authored by Pietro Abate's avatar Pietro Abate

[r2003-03-23 11:34:36 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-23 11:34:37+00:00
parent 7bab897a
......@@ -86,3 +86,66 @@ and regexp =
| WeakStar of regexp
| SeqCapture of id * regexp
let rec equal_ppat p1 p2 =
let p1 = p1.descr and p2 = p2.descr in
(p1 == p2) ||
match (p1,p2) with
| PatVar x1, PatVar x2 -> x1 = x2
| Internal x1, Internal x2 -> Types.equal_descr x1 x2
| Or (x1,y1), Or (x2,y2)
| And (x1,y1), And (x2,y2)
| Diff (x1,y1), Diff (x2,y2)
| Prod (x1,y1), Prod (x2,y2)
| XmlT (x1,y1), XmlT (x2,y2)
| Arrow (x1,y1), Arrow (x2,y2)
-> (equal_ppat x1 x2) && (equal_ppat y1 y2)
| Optional x1, Optional x2 -> equal_ppat x1 x2
| Record (o1,r1), Record (o2,r2) ->
(o1 == o2) && (LabelMap.equal equal_ppat r1 r2)
| Capture x1, Capture x2 -> x1 == x2
| Constant (x1,y1), Constant (x2,y2) ->
(x1 == x2) && (Types.equal_const y1 y2)
| Regexp (x1,y1), Regexp (x2,y2) ->
(equal_regexp x1 x2) && (equal_ppat y1 y2)
(* todo: Recurs *)
| _ -> false
and equal_regexp r1 r2 =
(r1 == r2) ||
match (r1,r2) with
| Elem x1, Elem x2 -> equal_ppat x1 x2
| Seq (x1,y1), Seq (x2,y2)
| Alt (x1,y1), Alt (x2,y2) -> (equal_regexp x1 x2) && (equal_regexp y1 y2)
| Star x1, Star x2
| WeakStar x1, WeakStar x2 -> equal_regexp x1 x2
| SeqCapture (x1,y1), SeqCapture (x2,y2) ->
(x1 == x2) && (equal_regexp y1 y2)
| _ -> false
let rec hash_ppat p =
match p.descr with
| PatVar x -> 1 + 17 * (Hashtbl.hash x)
| Internal x -> 2 + 17 * (Types.hash_descr x)
| Or (x,y) -> 3 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
| And (x,y) -> 4 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
| Diff (x,y) -> 5 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
| Prod (x,y) -> 6 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
| XmlT (x,y) -> 7 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
| Arrow (x,y) -> 8 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
| Optional x -> 9 + 17 * (hash_ppat x)
| Record (o,r) ->
(if o then 10 else 11) + (LabelMap.hash hash_ppat r)
| Capture x -> 12 + 17 * (Id.hash x)
| Constant (x,y) -> 13 + 17 * (Id.hash x) + 257 * (Types.hash_const y)
| Regexp (x,y) ->
14 + 17 * (hash_regexp x) + 16637 * (hash_ppat y)
| Recurs (x,l) ->
15 + 17 * (hash_ppat x) (* todo: hash l *)
and hash_regexp = function
| Epsilon -> 1
| Elem x -> 2 + 17 * (hash_ppat x)
| Seq (x,y) -> 3 + 17 * (hash_regexp x) + 257 * (hash_regexp y)
| Alt (x,y) -> 4 + 17 * (hash_regexp x) + 257 * (hash_regexp y)
| Star x -> 5 + 17 * (hash_regexp x)
| WeakStar x -> 6 + 17 * (hash_regexp x)
| SeqCapture (x,y) -> 7 + 17 * (Id.hash x) + 257 * (hash_regexp y)
......@@ -84,6 +84,7 @@ sig
val compare: ('b -> 'b -> int) -> ('a,'b) map -> ('a,'b) map -> int
val hash: ('b -> int) -> ('a,'b) map -> int
val equal: ('b -> 'b -> bool) -> ('a,'b) map -> ('a,'b) map -> bool
end
end
......@@ -386,6 +387,14 @@ module Map = struct
let rec hash f = function
| [] -> 1
| (x,y)::l -> X.hash x + 17 * (f y) + 257 * (hash f l)
let rec equal f l1 l2 =
(l1 == l2) ||
match (l1,l2) with
| (x1,y1)::l1, (x2,y2)::l2 ->
(X.equal x1 x2) && (f y1 y2) && (equal f l1 l2)
| _ -> false
end
end
......
......@@ -80,6 +80,7 @@ sig
val assoc_present: 'a elem -> ('a,'b) map -> 'b
val compare: ('b -> 'b -> int) -> ('a,'b) map -> ('a,'b) map -> int
val hash: ('b -> int) -> ('a,'b) map -> int
val equal: ('b -> 'b -> bool) -> ('a,'b) map -> ('a,'b) map -> bool
end
end
......
......@@ -44,6 +44,8 @@ let hash_const = function
| Atom x -> Atoms.vhash x
| Char x -> Chars.vhash x
let equal_const c1 c2 = compare_const c1 c2 = 0
type pair_kind = [ `Normal | `XML ]
type 'a node0 = { id : int; mutable descr : 'a }
......
......@@ -6,6 +6,7 @@ type const = | Integer of Intervals.v
val compare_const: const -> const -> int
val hash_const: const -> int
val equal_const: const -> const -> bool
(** Algebra **)
......
(* TODO:
rewrite type-checking of operators to propagate constraint *)
- rewrite type-checking of operators to propagate constraint
- rewrite translation of types and patterns -> hash cons
*)
(* I. Transform the abstract syntax of types and patterns into
the internal form *)
......@@ -165,65 +168,6 @@ module Regexp = struct
defs := (n,d) :: !defs;
v
(*
type trans = [ `Alt of gnode * gnode | `Elem of Ast.ppat * gnode | `Final ]
and gnode =
{
mutable seen : bool;
mutable compile : bool;
name : string;
mutable trans : trans;
}
let new_node() = { seen = false; compile = false;
name = name(); trans = `Final }
let to_compile = ref []
let rec compile after = function
| `Epsilon -> after
| `Elem (_,p) ->
if not after.compile then (after.compile <- true;
to_compile := after :: !to_compile);
{ new_node () with trans = `Elem (p, after) }
| `Seq(r1,r2) -> compile (compile after r2) r1
| `Alt(r1,r2) ->
let r1 = compile after r1 and r2 = compile after r2 in
{ new_node () with trans = `Alt (r1,r2) }
| `Star r ->
let n = new_node() in
n.trans <- `Alt (compile n r, after);
n
| `WeakStar r ->
let n = new_node() in
n.trans <- `Alt (after, compile n r);
n
let seens = ref []
let rec collect_aux accu n =
if n.seen then accu
else ( seens := n :: !seens;
match n.trans with
| `Alt (n1,n2) -> collect_aux (collect_aux accu n2) n1
| _ -> n :: accu
)
let collect fin n =
let l = collect_aux [] n in
List.iter (fun n -> n.seen <- false) !seens;
let l = List.map (fun n ->
match n.trans with
| `Final -> fin
| `Elem (p,a) ->
mk !re_loc (Prod(p, mk !re_loc (PatVar a.name)))
| _ -> assert false
) l in
match l with
| h::t ->
List.fold_left (fun accu p -> mk !re_loc (Or (accu,p))) h t
| _ -> assert false
*)
let constant_nil t v =
mk_loc !re_loc
(And (t, (mk_loc !re_loc (Constant (v, Types.Atom Sequence.nil_atom)))))
......@@ -237,15 +181,29 @@ module Regexp = struct
memo := Memo.empty;
let d = !defs in
defs := [];
mk_loc !re_loc (Recurs (n,d))
(*
let after = new_node() in
let n = collect queue (compile after re) in
let d = List.map (fun n -> (n.name, collect queue n)) !to_compile in
to_compile := [];
*)
module H = Hashtbl.Make(
struct
type t = Ast.regexp * Ast.ppat
let equal (r1,p1) (r2,p2) =
(Ast.equal_regexp r1 r2) &&
(Ast.equal_ppat p1 p2)
let hash (r,p) =
(Ast.hash_regexp r) + 16637 * (Ast.hash_ppat p)
end)
let hash = H.create 67
mk_loc !re_loc (Recurs (n,d))
let compile loc regexp queue : ppat =
try
let c = H.find hash (regexp,queue) in
(* Printf.eprintf "regexp cached\n"; flush stderr; *)
c
with
Not_found ->
let c = compile loc regexp queue in
H.add hash (regexp,queue) c;
c
end
let compile_regexp = Regexp.compile noloc
......
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