lexing: comparison progs/haskell/re.hs

equal deleted inserted replaced

-:c9027db225cc
+:6a43ea9305ba
 let diff = (fromIntegral (end - start)) / (10^12)
 printf "%0.9f\n" (diff :: Double)
 return ()
 data Rexp =
-NULL
+ZERO
-| EMPTY
+| ONE
 | CHAR Char
 | ALT Rexp Rexp
 | SEQ Rexp Rexp
 | STAR Rexp
 | RECD String Rexp deriving (Eq, Show)
 data Value =
-Void
+Empty
 | Chr Char
 | Sequ Value Value
 | Lf Value
 | Rg Value
 | Stars [Value]
 string_repeat :: String -> Int -> String
 string_repeat s n = concat (replicate n s)
 sequ :: [Char] -> Rexp
 sequ s = case s of
-[] -> EMPTY
+[] -> ONE
 [c] -> CHAR c
 c:cs -> SEQ (CHAR c) (sequ cs)
 str :: String -> Rexp
 ($$) :: String -> Rexp -> Rexp
 x $$ r = RECD x r
 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
+ZERO -> 1
-EMPTY -> 1
+ONE -> 1
 CHAR _ -> 1
 ALT r1 r2 -> 1 + (size r1) + (size r2)
 SEQ r1 r2 -> 1 + (size r1) + (size r2)
 STAR r -> 1 + (size r)
 RECD _ r -> 1 + (size r)
 nullable :: Rexp -> Bool
 nullable r = case r of
-NULL -> False
+ZERO -> False
-EMPTY -> True
+ONE -> True
 CHAR _ -> False
 ALT r1 r2 -> nullable(r1) || nullable(r2)
 SEQ r1 r2 -> nullable(r1) && nullable(r2)
 STAR _ -> True
 RECD _ r -> nullable(r)
 der :: Char -> Rexp -> Rexp
 der c r = case r of
-NULL -> NULL
+ZERO -> ZERO
-EMPTY -> NULL
+ONE -> ZERO
-CHAR d -> if c == d then EMPTY else NULL
+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)
 else SEQ (der c r1) r2
 STAR r -> SEQ (der c r) (STAR r)
 [] -> r
 c:s -> ders s (der c r)
 flatten :: Value -> String
 flatten v = case v of
-Void -> ""
+Empty -> ""
 Chr c -> [c]
 Lf v -> flatten v
 Rg v -> flatten v
 Sequ v1 v2 -> flatten v1 ++ flatten v2
 Stars vs -> concat (map flatten vs)
 Rec _ v -> flatten v
 env :: Value -> [(String, String)]
 env v = case v of
-Void -> []
+Empty -> []
 Chr c -> []
 Lf v -> env v
 Rg v -> env v
 Sequ v1 v2 -> env v1 ++ env v2
 Stars vs -> foldl (++) [] (map env vs)
 string_of_env :: [(String, String)] -> String
 string_of_env xs = intercalate "," (map string_of_pair xs)
 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)
 STAR r -> Stars []
 RECD x r -> Rec x (mkeps r)
 (SEQ r1 r2, Sequ v1 v2) -> Sequ (inj r1 c v1) v2
 (SEQ r1 r2, Lf (Sequ v1 v2)) -> Sequ (inj r1 c v1) v2
 (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
 f_id v = v
 f_seq :: (Value -> Value) -> (Value -> Value) -> Value -> Value
 f_seq f1 f2 = \v -> case v of
 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
 Rec x v -> Rec x (f v)
 ALT r1 r2 ->
 let (r1s, f1s) = simp r1
 (r2s, f2s) = simp r2
 in
 (case (r1s, r2s) of
-(NULL, _) -> (r2s, f_right f2s)
+(ZERO, _) -> (r2s, f_right f2s)
-(_, NULL) -> (r1s, f_left f1s)
+(_, ZERO) -> (r1s, f_left f1s)
 (_, _)    -> if r1s == r2s then (r1s, f_left f1s)
 else (ALT r1s r2s, f_alt f1s f2s))
 SEQ r1 r2 ->
 let (r1s, f1s) = simp r1
 (r2s, f2s) = simp r2
 in
 (case (r1s, r2s) of
-(NULL, _)  -> (NULL, f_right f2s)
+(ZERO, _)  -> (ZERO, f_right f2s)
-(_, NULL)  -> (NULL, f_left f1s)
+(_, ZERO)  -> (ZERO, f_left f1s)
-(EMPTY, _) -> (r2s, f_seq_void1 f1s f2s)
+(ONE, _) -> (r2s, f_seq_void1 f1s f2s)
-(_, EMPTY) -> (r1s, f_seq_void2 f1s f2s)
+(_, ONE) -> (r1s, f_seq_void2 f1s f2s)
 (_, _)     -> (SEQ r1s r2s, f_seq f1s f2s))
 RECD x r1 ->
 let (r1s, f1s) = simp r1
 in
 (RECD x r1s, f_rec f1s)
 r -> (r, f_id)
 der_simp :: Char -> Rexp -> (Rexp, Value -> Value)
 der_simp c r = case r of
-NULL -> (NULL, f_id)
+ZERO -> (ZERO, f_id)
-EMPTY -> (NULL, f_id)
+ONE -> (ZERO, f_id)
-CHAR(d) -> ((if c == d then EMPTY else NULL), 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)
+(ZERO, _) -> (r2d, f_right f2d)
-(_, NULL) -> (r1d, f_left f1d)
+(_, ZERO) -> (r1d, f_left f1d)
 (_, _)    -> if r1d == r2d then (r1d, f_left f1d)
 else (ALT r1d r2d, f_alt f1d f2d))
 SEQ r1 r2 ->
 if nullable r1
 then
 let (r1d, f1d) = der_simp c r1
 (r2d, f2d) = der_simp c r2
 (r2s, f2s) = simp r2
 in
 (case (r1d, r2s, r2d) of
-(NULL, _, _)  -> (r2d, f_right f2d)
+(ZERO, _, _)  -> (r2d, f_right f2d)
-(_, NULL, _)  -> (r2d, f_right f2d)
+(_, ZERO, _)  -> (r2d, f_right f2d)
-(_, _, NULL)  -> (SEQ r1d r2s, f_left (f_seq f1d f2s))
+(_, _, ZERO)  -> (SEQ r1d r2s, f_left (f_seq f1d f2s))
-(EMPTY, _, _) -> (ALT r2s r2d, f_alt (f_seq_void1 f1d f2s) f2d)
+(ONE, _, _) -> (ALT r2s r2d, f_alt (f_seq_void1 f1d f2s) f2d)
-(_, EMPTY, _) -> (ALT r1d r2d, f_alt (f_seq_void2 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)
+(ZERO, _)  -> (ZERO, f_id)
-(_, NULL)  -> (NULL, f_id)
+(_, ZERO)  -> (ZERO, f_id)
-(EMPTY, _) -> (r2s, f_seq_void1 f1d f2s)
+(ONE, _) -> (r2s, f_seq_void1 f1d f2s)
-(_, EMPTY) -> (r1d, f_seq_void2 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)
+ZERO -> (ZERO, f_id)
-EMPTY -> (STAR r1, f_seq_void1 f1d 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

changeset 156	6a43ea9305ba
parent 3	94824659f6d7
child 359	fedc16924b76