[r2003-05-20 17:22:38 by cvscast] Better simplification of regexp for printing

Original author: cvscast
Date: 2003-05-20 17:22:38+00:00

misc/pretty.ml

@@ -90,6 +90,16 @@ module Decompile(H : Hashtbl.S)(S : Set.OrderedType) = struct
 	else x2::(merge l1 y2)
     | [], l | l,[] -> l
 
+  let rec sub l1 l2 =
+    (compare l1 l2 = 0) ||
+    match (l1,l2) with
+      | RSeq [x], y -> sub x y
+      | RPlus x, (RStar y | RPlus y) -> sub x y
+      | RSeq (x::y), (RPlus z | RStar z) -> 
+	  (sub x z) && (sub (RSeq y) (RStar z))
+      | x, (RStar y | RPlus y) -> sub x y
+      | _ -> false
+
 
   let rec absorb_epsilon = function
     | RPlus r :: l -> RStar r :: l
@@ -97,6 +107,14 @@ module Decompile(H : Hashtbl.S)(S : Set.OrderedType) = struct
     | r :: l -> r :: (absorb_epsilon l)
     | [] -> [ epsilon ]
 
+  let rec simplify_alt accu = function
+    | [] -> List.rev accu
+    | x::rest -> 
+	if (List.exists (sub x) accu) || (List.exists (sub x) rest)
+	then simplify_alt accu rest
+	else simplify_alt (x::accu) rest
+	
+
   let alt s1 s2 =
     let s1 = match s1 with RAlt x -> x | x -> [x] in
     let s2 = match s2 with RAlt x -> x | x -> [x] in
@@ -105,10 +123,22 @@ module Decompile(H : Hashtbl.S)(S : Set.OrderedType) = struct
       if has_epsilon l 
       then absorb_epsilon (remove_epsilon l)
       else l in
+    let l = simplify_alt [] l in
     match l with
       | [x] -> x
       | l -> RAlt l
 
+  let rec simplify_seq = function
+    | RStar x :: ((RStar y | RPlus y) :: _ as rest) 
+	when compare x y = 0 ->
+	simplify_seq rest
+    | RPlus x :: (RPlus y :: _ as rest) 
+	when compare x y = 0 ->
+	simplify_seq (x :: rest)
+    | RPlus x :: (RStar y :: rest) when compare x y = 0 ->
+	simplify_seq (RPlus y :: rest)
+    | x :: rest -> x :: (simplify_seq rest)
+    | [] -> []
 
   let rec seq s1 s2 =
     match (s1,s2) with
@@ -119,7 +149,8 @@ module Decompile(H : Hashtbl.S)(S : Set.OrderedType) = struct
 	  let s2 = match s2 with RSeq x -> x | x -> [x] in
 	  find_plus [] (s1 @ s2)
   and find_plus before = function
-    | [] -> (match before with [h] -> h | l -> RSeq (List.rev l))
+    | [] -> 
+	(match before with [h] -> h | l -> RSeq (simplify_seq (List.rev l)))
     | (RStar s)::after ->
 	let star = match s with RSeq x -> x | x -> [x] in
 	let (right,star',after') = factor [] star after in
@@ -135,6 +166,7 @@ module Decompile(H : Hashtbl.S)(S : Set.OrderedType) = struct
   let star = function
     | RAlt [] | RSeq [] -> epsilon
     | RStar _ as s -> s
+    | RPlus s -> RStar s
     | s -> RStar s
 
   type 'a slot = {