diff -r c9027db225cc -r 6a43ea9305ba progs/haskell/re.hs --- 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