progs/haskell/re.hs
changeset 156 6a43ea9305ba
parent 3 94824659f6d7
child 359 fedc16924b76
--- a/progs/haskell/re.hs	Fri Mar 18 15:03:54 2016 +0000
+++ b/progs/haskell/re.hs	Sat Mar 19 23:27:29 2016 +0000
@@ -22,8 +22,8 @@
     return ()
 
 data Rexp =
-   NULL 
- | EMPTY 
+   ZERO 
+ | ONE 
  | CHAR Char
  | ALT Rexp Rexp
  | SEQ Rexp Rexp 
@@ -31,7 +31,7 @@
  | RECD String Rexp deriving (Eq, Show) 
 
 data Value =
-   Void
+   Empty
  | Chr Char
  | Sequ Value Value
  | Lf Value
@@ -44,7 +44,7 @@
 
 sequ :: [Char] -> Rexp
 sequ s = case s of
-  [] -> EMPTY
+  [] -> ONE
   [c] -> CHAR c
   c:cs -> SEQ (CHAR c) (sequ cs)
 
@@ -66,14 +66,14 @@
 
 alts :: [Rexp] -> Rexp
 alts rs = case rs of
-  [] -> NULL
+  [] -> ZERO
   [r] -> r
   r:rs -> foldl (ALT) r rs
 
 size :: Rexp -> Int
 size r = case r of
-  NULL -> 1
-  EMPTY -> 1
+  ZERO -> 1
+  ONE -> 1
   CHAR _ -> 1
   ALT r1 r2 -> 1 + (size r1) + (size r2)
   SEQ r1 r2 -> 1 + (size r1) + (size r2)
@@ -82,8 +82,8 @@
 
 nullable :: Rexp -> Bool
 nullable r = case r of
-  NULL -> False
-  EMPTY -> True
+  ZERO -> False
+  ONE -> True
   CHAR _ -> False
   ALT r1 r2 -> nullable(r1) || nullable(r2)
   SEQ r1 r2 -> nullable(r1) && nullable(r2)
@@ -92,9 +92,9 @@
 
 der :: Char -> Rexp -> Rexp
 der c r = case r of
-  NULL -> NULL
-  EMPTY -> NULL
-  CHAR d -> if c == d then EMPTY else NULL
+  ZERO -> ZERO
+  ONE -> ZERO
+  CHAR d -> if c == d then ONE else ZERO
   ALT r1 r2 -> ALT (der c r1) (der c r2)
   SEQ r1 r2 -> 
       if nullable r1 then ALT (SEQ (der c r1) r2) (der c r2)
@@ -109,7 +109,7 @@
 
 flatten :: Value -> String
 flatten v = case v of 
-  Void -> ""
+  Empty -> ""
   Chr c -> [c]
   Lf v -> flatten v
   Rg v -> flatten v
@@ -119,7 +119,7 @@
 
 env :: Value -> [(String, String)]
 env v = case v of 
-  Void -> []
+  Empty -> []
   Chr c -> []
   Lf v -> env v
   Rg v -> env v
@@ -135,7 +135,7 @@
 
 mkeps :: Rexp -> Value
 mkeps r = case r of 
-  EMPTY -> Void
+  ONE -> Empty
   ALT r1 r2 -> 
       if nullable r1 then Lf (mkeps r1) else Rg (mkeps r2)
   SEQ r1 r2 -> Sequ (mkeps r1) (mkeps r2)
@@ -150,7 +150,7 @@
   (SEQ r1 r2, Rg v2) -> Sequ (mkeps r1) (inj r2 c v2)
   (ALT r1 r2, Lf v1) -> Lf (inj r1 c v1)
   (ALT r1 r2, Rg v2) -> Rg (inj r2 c v2)
-  (CHAR d, Void) -> Chr d 
+  (CHAR d, Empty) -> Chr d 
   (RECD x r1, _) -> Rec x (inj r1 c v)
 
 f_id :: Value -> Value
@@ -172,10 +172,10 @@
   Sequ v1 v2 -> Sequ (f1 v1) (f2 v2)
 
 f_seq_void1 :: (Value -> Value) -> (Value -> Value) -> Value -> Value
-f_seq_void1 f1 f2 = \v -> Sequ (f1 Void) (f2 v)
+f_seq_void1 f1 f2 = \v -> Sequ (f1 Empty) (f2 v)
 
 f_seq_void2 :: (Value -> Value) -> (Value -> Value) -> Value -> Value
-f_seq_void2 f1 f2 = \v -> Sequ(f1 v) (f2 Void)
+f_seq_void2 f1 f2 = \v -> Sequ(f1 v) (f2 Empty)
 
 f_rec :: (Value -> Value) -> Value -> Value
 f_rec f = \v -> case v of
@@ -188,8 +188,8 @@
           (r2s, f2s) = simp r2 
       in
         (case (r1s, r2s) of
-            (NULL, _) -> (r2s, f_right f2s)
-            (_, NULL) -> (r1s, f_left f1s)
+            (ZERO, _) -> (r2s, f_right f2s)
+            (_, ZERO) -> (r1s, f_left f1s)
             (_, _)    -> if r1s == r2s then (r1s, f_left f1s)
                          else (ALT r1s r2s, f_alt f1s f2s))
     SEQ r1 r2 -> 
@@ -197,10 +197,10 @@
           (r2s, f2s) = simp r2 
       in
         (case (r1s, r2s) of
-          (NULL, _)  -> (NULL, f_right f2s)
-          (_, NULL)  -> (NULL, f_left f1s)
-          (EMPTY, _) -> (r2s, f_seq_void1 f1s f2s)
-          (_, EMPTY) -> (r1s, f_seq_void2 f1s f2s)
+          (ZERO, _)  -> (ZERO, f_right f2s)
+          (_, ZERO)  -> (ZERO, f_left f1s)
+          (ONE, _) -> (r2s, f_seq_void1 f1s f2s)
+          (_, ONE) -> (r1s, f_seq_void2 f1s f2s)
           (_, _)     -> (SEQ r1s r2s, f_seq f1s f2s))
     RECD x r1 -> 
       let (r1s, f1s) = simp r1 
@@ -210,16 +210,16 @@
 
 der_simp :: Char -> Rexp -> (Rexp, Value -> Value)
 der_simp c r = case r of
-    NULL -> (NULL, f_id)
-    EMPTY -> (NULL, f_id)
-    CHAR(d) -> ((if c == d then EMPTY else NULL), f_id)
+    ZERO -> (ZERO, f_id)
+    ONE -> (ZERO, f_id)
+    CHAR(d) -> ((if c == d then ONE else ZERO), f_id)
     ALT r1 r2 -> 
       let (r1d, f1d) = der_simp c r1
           (r2d, f2d) = der_simp c r2 
       in
         (case (r1d, r2d) of 
-          (NULL, _) -> (r2d, f_right f2d)
-          (_, NULL) -> (r1d, f_left f1d)
+          (ZERO, _) -> (r2d, f_right f2d)
+          (_, ZERO) -> (r1d, f_left f1d)
           (_, _)    -> if r1d == r2d then (r1d, f_left f1d)
                        else (ALT r1d r2d, f_alt f1d f2d))
     SEQ r1 r2 -> 
@@ -230,28 +230,28 @@
             (r2s, f2s) = simp r2 
         in
           (case (r1d, r2s, r2d) of
-             (NULL, _, _)  -> (r2d, f_right f2d)
-             (_, NULL, _)  -> (r2d, f_right f2d)
-             (_, _, NULL)  -> (SEQ r1d r2s, f_left (f_seq f1d f2s))
-             (EMPTY, _, _) -> (ALT r2s r2d, f_alt (f_seq_void1 f1d f2s) f2d)
-             (_, EMPTY, _) -> (ALT r1d r2d, f_alt (f_seq_void2 f1d f2s) f2d)
+             (ZERO, _, _)  -> (r2d, f_right f2d)
+             (_, ZERO, _)  -> (r2d, f_right f2d)
+             (_, _, ZERO)  -> (SEQ r1d r2s, f_left (f_seq f1d f2s))
+             (ONE, _, _) -> (ALT r2s r2d, f_alt (f_seq_void1 f1d f2s) f2d)
+             (_, ONE, _) -> (ALT r1d r2d, f_alt (f_seq_void2 f1d f2s) f2d)
              (_, _, _)     -> (ALT (SEQ r1d r2s) r2d, f_alt (f_seq f1d f2s) f2d))
       else 
         let (r1d, f1d) = der_simp c r1 
             (r2s, f2s) = simp r2 
         in
           (case (r1d, r2s) of
-             (NULL, _)  -> (NULL, f_id)
-             (_, NULL)  -> (NULL, f_id)
-             (EMPTY, _) -> (r2s, f_seq_void1 f1d f2s)
-             (_, EMPTY) -> (r1d, f_seq_void2 f1d f2s)
+             (ZERO, _)  -> (ZERO, f_id)
+             (_, ZERO)  -> (ZERO, f_id)
+             (ONE, _) -> (r2s, f_seq_void1 f1d f2s)
+             (_, ONE) -> (r1d, f_seq_void2 f1d f2s)
              (_, _) -> (SEQ r1d r2s, f_seq f1d f2s))	  
     STAR r1 -> 
       let (r1d, f1d) = der_simp c r1 
       in
         (case r1d of
-           NULL -> (NULL, f_id)
-           EMPTY -> (STAR r1, f_seq_void1 f1d f_id)
+           ZERO -> (ZERO, f_id)
+           ONE -> (STAR r1, f_seq_void1 f1d f_id)
            _ -> (SEQ r1d (STAR r1), f_seq f1d f_id))
     RECD x r1 -> der_simp c r1