a3/code/Generics/gentest.icl

   1 module gentest
   2
   3 import StdEnv, GenLib
   4
   5 :: Tree a b = Tip a | Bin b (Tree a b) (Tree a b)
   6 :: Rose a = Rose a .[Rose a]
   7 :: Fork a = Fork a a
   8 :: Sequ a = SequEmpty | SequZero .(Sequ .(Fork a)) | SequOne a .(Sequ .(Fork a))
   9 :: InfCons
  10         = :+: infixl 2 InfCons InfCons
  11         | :-: infixl 2 InfCons InfCons
  12         | :*: infixl 3 InfCons InfCons
  13         | :->: infixr 4 InfCons InfCons
  14         | U
  15         | I Int
  16 :: Rec a b c = { rec_fst :: a, rec_snd :: b, rec_thd :: c }
  17 :: Color = Red | Green | Blue
  18
  19 derive bimap Tree, Rose, Fork, Sequ
  20
  21 derive gEq                              Tree, Rose, Fork, Sequ, Color, InfCons, Rec, Maybe
  22 derive gLexOrd                  Tree, Rose, Fork, Sequ
  23 derive gMap                     Tree, Rose, Fork, Sequ
  24 derive gMapLSt                  Tree, Rose, Fork, Sequ
  25 derive gMapRSt                  Tree, Rose, Fork, Sequ
  26 derive gMapLM                   Tree, Rose, Fork, Sequ
  27 derive gMapRM                   Tree, Rose, Fork, Sequ
  28 derive gReduceLSt               Tree, Rose, Fork, Sequ
  29 derive gReduceRSt               Tree, Rose, Fork, Sequ
  30 derive gReduce                  Tree, Rose, Fork, Sequ
  31 derive gZip                             Tree, Rose, Fork, Sequ
  32 derive gMaybeZip                Tree, Rose, Fork, Sequ
  33 derive gPrint                   Tree, Rose, Fork, Sequ, Color, InfCons, Rec
  34 derive gParse                   Tree, Rose, Fork, Sequ, Color, InfCons, Rec
  35 derive gCompress                Tree, Rose, Fork, Sequ, Color
  36 derive gCompressedSize  Tree, Rose, Fork, Sequ, Color
  37 derive gUncompress              Tree, Rose, Fork, Sequ, Color
  38 derive gLookupFMap              Tree, Rose, Fork, Sequ, Color
  39 derive gInsertFMap              Tree, Rose, Fork, Sequ, Color
  40
  41 tree = Bin 1 (Bin 2 (Tip 1.1) (Tip 2.2)) (Bin 3 (Tip 3.3) (Tip 4.4))
  42 rose = Rose 1 [Rose 2 [], Rose 3 [Rose 5 [], Rose 6 []], Rose 4[]]
  43 sequ = SequZero (SequOne (Fork 1 2) (SequOne (Fork (Fork 3 4) (Fork 5 6)) SequEmpty))
  44
  45 testEq :: [Bool]
  46 testEq =
  47         [ [1,2,3] === [1,2,3]
  48         , [1,2,3] =!= [1,2,3,4]
  49         , [1,2,3] =!= [1,2,4]
  50         , tree === tree
  51         , rose === rose
  52         , sequ === sequ
  53         ]
  54
  55 testLexOrd =
  56         [ ([1,2,3] =?= [1,2,3]) === EQ
  57         , ([1,2,3] =?= [1,2,3,4]) === LT
  58         , ([1,2,4] =?= [1,2,3,4]) === GT
  59         , (Rose 1 [Rose 2 [], Rose 3 []] =?= Rose 1 [Rose 2 [], Rose 3 []]) === EQ
  60         , (Rose 1 [Rose 2 [], Rose 3 []] =?= Rose 1 [Rose 2 [], Rose 3 [], Rose 4 []]) === LT
  61         , (Rose 1 [Rose 2 [], Rose 4 []] =?= Rose 1 [Rose 2 [], Rose 3 [], Rose 4 []]) === GT
  62         ]
  63
  64 testMap =
  65         [ gMap{|*->*|} inc [1,2,3] === [2,3,4]
  66         , gMap{|*->*->*|} inc dec (Bin 1 (Tip 2.0) (Tip 3.0)) === Bin 0 (Tip 3.0) (Tip 4.0)
  67         , gMap{|*->*|} inc (Rose 1 [Rose 2 [], Rose 3 []]) === Rose 2 [Rose 3 [], Rose 4 []]
  68         , gMap{|*->*|} inc (SequZero (SequOne (Fork 1 2) (SequOne (Fork (Fork 3 4) (Fork 5 6)) SequEmpty)))
  69                 === SequZero (SequOne (Fork 2 3) (SequOne (Fork (Fork 4 5) (Fork 6 7)) SequEmpty))
  70         ]
  71
  72 testMapRSt =
  73         [ gMapRSt{|*->*|} (\x st-> (dec x, [x:st])) [1,2,3] [] === ([0,1,2], [1,2,3])
  74         ]
  75
  76 testMapLSt =
  77         [ gMapLSt{|*->*|} (\x st-> (dec x, [x:st])) [1,2,3] [] === ([0,1,2], [3,2,1])
  78         ]
  79
  80 testReduceRSt =
  81         [ gReduceRSt{|*->*|} (\x st -> [x:st]) [1,2,3] [] === [1,2,3]
  82         ]
  83
  84 testReduceLSt =
  85         [ gReduceLSt{|*->*|} (\x st -> [x:st]) [1,2,3] [] === [3,2,1]
  86         ]
  87
  88 testMapRM =
  89         [ gMapRM{|*->*|} (Just o inc) [1,2,3] === (Just [2,3,4])
  90         , (gMapRM{|*->*|} (\x -> {st_monad=(\xs -> (inc x, [x:xs]))}) [1,2,3]).st_monad [] === ([2,3,4], [1,2,3])
  91         ]
  92
  93 testMapLM =
  94         [ gMapLM{|*->*|} (Just o inc) [1,2,3] === (Just [2,3,4])
  95         , (gMapLM{|*->*|} (\x -> {st_monad=(\xs -> (inc x, [x:xs]))}) [1,2,3]).st_monad [] === ([2,3,4], [3,2,1])
  96         ]
  97
  98 testParsePrint =
  99         [ test 1
 100         , test 123
 101         , test -123
 102
 103         , test 1.09
 104         , test 0.123
 105         , test -123.456
 106         , test 1.23E-12
 107         , test 1.23E+12
 108         , test 1.23E5
 109
 110         , test True
 111         , test False
 112
 113         , test 'a'
 114         , test '\n'
 115         , test '"'
 116         , test '\''
 117         , test "Hello"
 118         , test "Hello\n"
 119         , test "Hello \"string\""
 120
 121         , test nil
 122         , test [1]
 123         , test [1,2,3]
 124
 125         , test (arr nil)
 126         , test (arr [1])
 127         , test (arr [1,2,3])
 128
 129         , test Red
 130         , test Green
 131         , test Blue
 132
 133         , test {rec_fst=1, rec_snd='a', rec_thd=1.2}
 134
 135         , test (Bin 'a' (Tip 1) (Bin 'b' (Tip 2) (Bin 'c' (Tip 3) (Tip 4))))
 136         , test (Rose 1 [Rose 2 [], Rose 3 [], Rose 4 [Rose 5 []]])
 137
 138         , test (U :+: U)
 139         , test (U :+: U :+: U)
 140         , test (U :->: U :->: U)
 141         , test (U :+: U :*: U)
 142         , test (U :*: U :->: U)
 143         , test (I 1 :+: I 2 :+: I 3)
 144         , test (I 1 :*: I 2 :+: I 3)
 145         , test (I 1 :+: I 2 :*: I 3)
 146         , test (I 1 :+: I 2 :*: I 3 :+: I 4)
 147         , test (I 1 :+: (I 2 :+: I 3) :+: I 4)
 148
 149         , test [I 1 :+: I 2 :+: I 3, I 4 :->: I 5 :->: I 6]
 150         , test (arr [I 1 :+: I 2 :+: I 3, I 4 :->: I 5 :->: I 6])
 151         , test
 152                 {       rec_fst = I 1 :+: I 2 :+: I 3
 153                 ,       rec_snd = I 4 :->: I 5 :->: I 6
 154                 ,       rec_thd = I 7 :*: I 8 :+: I 9
 155                 }
 156         ]
 157 where
 158         test x = case parseString (printToString x) of
 159                 Nothing -> False
 160                 Just y -> x === y
 161
 162         nil :: [Int]
 163         nil = []
 164
 165         arr :: [a] -> {a}
 166         arr xs = {x\\x<-xs}
 167
 168
 169 testCompress =
 170         [ test True
 171         , test False
 172         , test 12345
 173         , test -2
 174         , test 1.2345E20
 175         , test [1 .. 100]
 176         , test (flatten (repeatn 100 [Red, Green, Blue]))
 177         //, test (flatten (repeatn 100000 [Red, Green, Blue]))
 178         , test "hello"
 179         , test 'a'
 180         , test Green
 181         , test Red
 182         , test Blue
 183         , test rose
 184         , test (Bin Red (Tip Green) (Bin Blue (Tip Red) (Tip Green)))
 185         , test sequ
 186         ]
 187 where
 188         test x = case uncompress (compress x) of
 189                 Nothing -> False
 190                 Just y -> x === y
 191
 192
 193 testFMap =
 194         [ lookupFMap 1 fmap_int === Just 10
 195         , lookupFMap 3 fmap_int === Just 30
 196         , lookupFMap "two" fmap_str === Just 2
 197         , lookupFMap "three" fmap_str === Just 3
 198         , lookupFMap (Rose 1 [Rose 2 [], Rose 30 []]) fmap_rose === Just 3
 199         , lookupFMap (Rose 1 [Rose 20 [], Rose 1 []]) fmap_rose === Just 100
 200         ]
 201 where
 202         fmap_int = emptyFMap
 203                 <<= (1, 10)
 204                 <<= (2, 20)
 205                 <<= (3,30)
 206                 <<= (4,40)
 207                 <<= (5, 50)
 208         fmap_str = emptyFMap
 209                 <<= ("one", 1)
 210                 <<= ("two", 2)
 211                 <<= ("three", 3)
 212                 <<= ("four",4)
 213                 <<= ("five", 5)
 214         fmap_rose = emptyFMap
 215                 <<= (Rose 1 [Rose 2 [], Rose 10 []], 1)
 216                 <<= (Rose 1 [Rose 2 [], Rose 20 []], 2)
 217                 <<= (Rose 1 [Rose 2 [], Rose 30 []], 3)
 218                 <<= (Rose 1 [Rose 2 [], Rose 40 []], 4)
 219                 <<= (Rose 1 [Rose 2 [], Rose 50 []], 5)
 220                 <<= (Rose 1 [Rose 20 [], Rose 1 []], 100)
 221
 222 Start :: [[Bool]]
 223 Start
 224         # result = foldr (&&) True (flatten tests)
 225         | result
 226                 = [[result]]
 227                 = tests
 228 where
 229         tests =
 230                 [ testEq
 231                 , testLexOrd
 232                 , testMap
 233                 , testMapRSt
 234                 , testMapLSt
 235                 , testMapRM
 236                 , testMapLM
 237                 , testReduceRSt
 238                 , testReduceLSt
 239                 , testParsePrint
 240                 , testCompress
 241                 , testFMap
 242                 ]