-
Notifications
You must be signed in to change notification settings - Fork 0
/
regexes.hs
128 lines (114 loc) · 4.9 KB
/
regexes.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
{-# Language CPP #-}
{-# Language DeriveDataTypeable, StandaloneDeriving #-}
import Test.Speculate
import Test.Speculate.Utils.Memoize
import Data.Function (on)
import Regex
instance Listable Symbol where
list = [Symbol 'a', Symbol 'b', Symbol 'c']
instance Listable a => Listable (RE a) where
tiers = cons0 Empty
\/ cons0 None
\/ cons1 Lit
\/ cons1 Star
\/ cons2 (:+)
\/ cons2 (:.)
instance Name Symbol where name _ = "c"
instance Name (RE a) where name _ = "r"
deriving instance Typeable Symbol
#if __GLASGOW_HASKELL__ < 708
deriving instance Typeable1 RE
#else
deriving instance Typeable RE
#endif
canonicalRE :: (Eq a, Ord a) => RE a -> Bool
-- by laws of size 3
canonicalRE (Star (Star r)) = False -- == Star r
canonicalRE (r :+ s) | r >= s = False -- == r or == s :+ r
canonicalRE (r :+ None) = False -- == r
canonicalRE (None :+ r) = False -- == r
canonicalRE (r :. Empty) = False -- == r
canonicalRE (Empty :. r) = False -- == r
canonicalRE (r :. None) = False -- == None
canonicalRE (None :. r) = False -- == None
-- by laws of size 4
canonicalRE (r :+ Star s) | r == s = False -- == Star r
canonicalRE (Star r :+ s) | r == s = False -- == Star r
canonicalRE (Star r :. s) | r == s = False -- == r :. Star r
canonicalRE (Star (r :+ Empty)) = False -- == Star r
canonicalRE (Star (Empty :+ r)) = False -- == Star r
canonicalRE (Empty :+ Star r) = False -- == Star r
canonicalRE (Star r :+ Empty) = False -- == Star r
-- by laws of size 5
canonicalRE ((r :+ s) :+ t) = False -- == r :+ (s :+ t)
canonicalRE ((r :. s) :. t) = False -- == r :. (s :. t)
canonicalRE (Star (r :+ Star s)) = False -- == Star (r :+ s)
canonicalRE (Star (Star r :+ s)) = False -- == Star (r :+ s)
canonicalRE (r :. (s :+ Empty)) = False -- == r :+ (r :. s)
canonicalRE ((r :+ Empty) :. s) = False -- == s :+ (r :. s)
canonicalRE (Star (r :. Star s)) | r == s = False -- == Star r
canonicalRE (Star (Star r :. s)) | r == s = False -- == Star r
canonicalRE (Star r :. Star s) | r == s = False -- == Star r
-- by laws of size 6
canonicalRE (r :+ Star (r' :+ s)) | r == r' = False -- == Star (r :+ s)
canonicalRE (r :+ Star (s :+ r')) | r == r' = False -- == Star (r :+ s)
canonicalRE (Star (r' :+ s) :+ r) | r == r' = False -- == Star (r :+ s)
canonicalRE (Star (s :+ r') :+ r) | r == r' = False -- == Star (r :+ s)
canonicalRE (Star r :. (r' :. s)) | r == r' = False -- == r :. (Star r :. s)
canonicalRE (Star (r :. s) :. r') | r == r' = False -- == r :. Star (s :. r)
canonicalRE (r :+ (r' :. Star s)) | r == r' = False -- == r :. Star s
canonicalRE (r :+ (Star s :. r')) | r == r' = False -- == Star s :. r
canonicalRE (Star (Star r :. Star s)) = False -- == Star (r :+ s)
canonicalRE (Star (r :+ (r' :. r''))) | r == r' && r == r'' = False -- == Star r
canonicalRE (Star r :+ (r' :. r'')) | r == r' && r == r'' = False -- == Star r
canonicalRE (Empty :+ (r :. Star r')) | r == r' = False -- == Star r
-- default
canonicalRE _ = True
deriving instance Eq a => Eq (RE a)
deriving instance Ord a => Ord (RE a)
class Charable a where toChar :: a -> Char
instance Charable Char where toChar = id
instance Charable Symbol where toChar (Symbol c) = c
testMatches :: (Listable a, Show a, Charable a, Ord a) => RE a -> [Bool]
testMatches = tm `withMemory` mem
where
tm r = map (\e -> match toChar e r) $ take 120 list
--mem = memoryFor 10000000 tm -- use when -t360
mem = memoryFor 1000000 tm -- induces "Ord a" constraint
observingList :: (a -> a -> Bool) -> (b -> [a]) -> b -> b -> Bool
observingList g f = and .: (zipWith g `on` f) where (.:) = (.) . (.)
(/==/) :: RE Symbol -> RE Symbol -> Bool
(/==/) = (==) `on` testMatches
(/<=/) :: RE Symbol -> RE Symbol -> Bool
(/<=/) = (<=) `observingList` testMatches
-- wrong laws appear when setting maxSize to 5, even when tests are increased
-- to 500 (or more)
main :: IO ()
main = speculate args
{ maxTests = 30
, maxSize = 4
, instances =
[ mkEq (/==/)
, mkOrdLessEqual (/<=/)
, reifyInstances (undefined :: Symbol)
, reifyInstances (undefined :: RE Symbol)
]
, constants =
[ constant "Empty" (Empty :: RE Symbol)
, constant "None" (None :: RE Symbol)
, constant "Star" (Star :: RE Symbol -> RE Symbol)
, constant ":+" ((:+) :: RE Symbol -> RE Symbol -> RE Symbol)
, constant ":." ((:.) :: RE Symbol -> RE Symbol -> RE Symbol)
-- , constant "=~" (=~)
-- , constant "Lit" (Lit :: Symbol -> RE Symbol)
, background
, constant "<=" (/<=/)
, constant "==" (/==/)
, showConstant False
, showConstant True
]
, showConditions = False
, force = True
}
where
_ = (canonicalRE :: RE Symbol -> Bool) -- just to silence a warning