+++ /dev/null
-module gentest\r
-\r
-import StdEnv, GenLib\r
-\r
-:: Tree a b = Tip a | Bin b (Tree a b) (Tree a b)\r
-:: Rose a = Rose a .[Rose a]\r
-:: Fork a = Fork a a\r
-:: Sequ a = SequEmpty | SequZero .(Sequ .(Fork a)) | SequOne a .(Sequ .(Fork a))\r
-:: InfCons \r
- = :+: infixl 2 InfCons InfCons\r
- | :-: infixl 2 InfCons InfCons\r
- | :*: infixl 3 InfCons InfCons\r
- | :->: infixr 4 InfCons InfCons\r
- | U\r
- | I Int \r
-:: Rec a b c = { rec_fst :: a, rec_snd :: b, rec_thd :: c } \r
-:: Color = Red | Green | Blue\r
-\r
-derive bimap Tree, Rose, Fork, Sequ\r
-\r
-derive gEq Tree, Rose, Fork, Sequ, Color, InfCons, Rec, Maybe\r
-derive gLexOrd Tree, Rose, Fork, Sequ\r
-derive gMap Tree, Rose, Fork, Sequ\r
-derive gMapLSt Tree, Rose, Fork, Sequ\r
-derive gMapRSt Tree, Rose, Fork, Sequ\r
-derive gMapLM Tree, Rose, Fork, Sequ\r
-derive gMapRM Tree, Rose, Fork, Sequ\r
-derive gReduceLSt Tree, Rose, Fork, Sequ\r
-derive gReduceRSt Tree, Rose, Fork, Sequ\r
-derive gReduce Tree, Rose, Fork, Sequ\r
-derive gZip Tree, Rose, Fork, Sequ\r
-derive gMaybeZip Tree, Rose, Fork, Sequ\r
-derive gPrint Tree, Rose, Fork, Sequ, Color, InfCons, Rec\r
-derive gParse Tree, Rose, Fork, Sequ, Color, InfCons, Rec\r
-derive gCompress Tree, Rose, Fork, Sequ, Color\r
-derive gCompressedSize Tree, Rose, Fork, Sequ, Color\r
-derive gUncompress Tree, Rose, Fork, Sequ, Color\r
-derive gLookupFMap Tree, Rose, Fork, Sequ, Color\r
-derive gInsertFMap Tree, Rose, Fork, Sequ, Color\r
-\r
-tree = Bin 1 (Bin 2 (Tip 1.1) (Tip 2.2)) (Bin 3 (Tip 3.3) (Tip 4.4)) \r
-rose = Rose 1 [Rose 2 [], Rose 3 [Rose 5 [], Rose 6 []], Rose 4[]]\r
-sequ = SequZero (SequOne (Fork 1 2) (SequOne (Fork (Fork 3 4) (Fork 5 6)) SequEmpty))\r
-\r
-testEq :: [Bool]\r
-testEq = \r
- [ [1,2,3] === [1,2,3]\r
- , [1,2,3] =!= [1,2,3,4]\r
- , [1,2,3] =!= [1,2,4] \r
- , tree === tree\r
- , rose === rose\r
- , sequ === sequ\r
- ]\r
-\r
-testLexOrd = \r
- [ ([1,2,3] =?= [1,2,3]) === EQ \r
- , ([1,2,3] =?= [1,2,3,4]) === LT\r
- , ([1,2,4] =?= [1,2,3,4]) === GT\r
- , (Rose 1 [Rose 2 [], Rose 3 []] =?= Rose 1 [Rose 2 [], Rose 3 []]) === EQ \r
- , (Rose 1 [Rose 2 [], Rose 3 []] =?= Rose 1 [Rose 2 [], Rose 3 [], Rose 4 []]) === LT\r
- , (Rose 1 [Rose 2 [], Rose 4 []] =?= Rose 1 [Rose 2 [], Rose 3 [], Rose 4 []]) === GT\r
- ]\r
- \r
-testMap =\r
- [ gMap{|*->*|} inc [1,2,3] === [2,3,4]\r
- , gMap{|*->*->*|} inc dec (Bin 1 (Tip 2.0) (Tip 3.0)) === Bin 0 (Tip 3.0) (Tip 4.0)\r
- , gMap{|*->*|} inc (Rose 1 [Rose 2 [], Rose 3 []]) === Rose 2 [Rose 3 [], Rose 4 []] \r
- , gMap{|*->*|} inc (SequZero (SequOne (Fork 1 2) (SequOne (Fork (Fork 3 4) (Fork 5 6)) SequEmpty)))\r
- === SequZero (SequOne (Fork 2 3) (SequOne (Fork (Fork 4 5) (Fork 6 7)) SequEmpty))\r
- ]\r
-\r
-testMapRSt =\r
- [ gMapRSt{|*->*|} (\x st-> (dec x, [x:st])) [1,2,3] [] === ([0,1,2], [1,2,3]) \r
- ] \r
-\r
-testMapLSt =\r
- [ gMapLSt{|*->*|} (\x st-> (dec x, [x:st])) [1,2,3] [] === ([0,1,2], [3,2,1]) \r
- ] \r
-\r
-testReduceRSt =\r
- [ gReduceRSt{|*->*|} (\x st -> [x:st]) [1,2,3] [] === [1,2,3]\r
- ]\r
-\r
-testReduceLSt =\r
- [ gReduceLSt{|*->*|} (\x st -> [x:st]) [1,2,3] [] === [3,2,1]\r
- ]\r
-\r
-testMapRM =\r
- [ gMapRM{|*->*|} (Just o inc) [1,2,3] === (Just [2,3,4])\r
- , (gMapRM{|*->*|} (\x -> {st_monad=(\xs -> (inc x, [x:xs]))}) [1,2,3]).st_monad [] === ([2,3,4], [1,2,3]) \r
- ]\r
-\r
-testMapLM =\r
- [ gMapLM{|*->*|} (Just o inc) [1,2,3] === (Just [2,3,4])\r
- , (gMapLM{|*->*|} (\x -> {st_monad=(\xs -> (inc x, [x:xs]))}) [1,2,3]).st_monad [] === ([2,3,4], [3,2,1]) \r
- ] \r
-\r
-testParsePrint =\r
- [ test 1 \r
- , test 123\r
- , test -123\r
-\r
- , test 1.09\r
- , test 0.123\r
- , test -123.456\r
- , test 1.23E-12\r
- , test 1.23E+12\r
- , test 1.23E5\r
-\r
- , test True\r
- , test False\r
-\r
- , test 'a'\r
- , test '\n'\r
- , test '"'\r
- , test '\''\r
- , test "Hello"\r
- , test "Hello\n"\r
- , test "Hello \"string\""\r
-\r
- , test nil\r
- , test [1]\r
- , test [1,2,3]\r
-\r
- , test (arr nil)\r
- , test (arr [1])\r
- , test (arr [1,2,3])\r
-\r
- , test Red\r
- , test Green\r
- , test Blue\r
-\r
- , test {rec_fst=1, rec_snd='a', rec_thd=1.2}\r
-\r
- , test (Bin 'a' (Tip 1) (Bin 'b' (Tip 2) (Bin 'c' (Tip 3) (Tip 4))))\r
- , test (Rose 1 [Rose 2 [], Rose 3 [], Rose 4 [Rose 5 []]])\r
-\r
- , test (U :+: U)\r
- , test (U :+: U :+: U)\r
- , test (U :->: U :->: U)\r
- , test (U :+: U :*: U)\r
- , test (U :*: U :->: U)\r
- , test (I 1 :+: I 2 :+: I 3)\r
- , test (I 1 :*: I 2 :+: I 3)\r
- , test (I 1 :+: I 2 :*: I 3)\r
- , test (I 1 :+: I 2 :*: I 3 :+: I 4)\r
- , test (I 1 :+: (I 2 :+: I 3) :+: I 4)\r
-\r
- , test [I 1 :+: I 2 :+: I 3, I 4 :->: I 5 :->: I 6]\r
- , test (arr [I 1 :+: I 2 :+: I 3, I 4 :->: I 5 :->: I 6])\r
- , test \r
- { rec_fst = I 1 :+: I 2 :+: I 3\r
- , rec_snd = I 4 :->: I 5 :->: I 6\r
- , rec_thd = I 7 :*: I 8 :+: I 9\r
- }\r
- ]\r
-where\r
- test x = case parseString (printToString x) of\r
- Nothing -> False\r
- Just y -> x === y\r
-\r
- nil :: [Int]\r
- nil = []\r
-\r
- arr :: [a] -> {a}\r
- arr xs = {x\\x<-xs}\r
-\r
-\r
-testCompress =\r
- [ test True\r
- , test False\r
- , test 12345\r
- , test -2\r
- , test 1.2345E20\r
- , test [1 .. 100]\r
- , test (flatten (repeatn 100 [Red, Green, Blue]))\r
- //, test (flatten (repeatn 100000 [Red, Green, Blue]))\r
- , test "hello"\r
- , test 'a'\r
- , test Green\r
- , test Red\r
- , test Blue \r
- , test rose\r
- , test (Bin Red (Tip Green) (Bin Blue (Tip Red) (Tip Green))) \r
- , test sequ\r
- ]\r
-where \r
- test x = case uncompress (compress x) of\r
- Nothing -> False\r
- Just y -> x === y\r
-\r
-\r
-testFMap =\r
- [ lookupFMap 1 fmap_int === Just 10\r
- , lookupFMap 3 fmap_int === Just 30\r
- , lookupFMap "two" fmap_str === Just 2\r
- , lookupFMap "three" fmap_str === Just 3\r
- , lookupFMap (Rose 1 [Rose 2 [], Rose 30 []]) fmap_rose === Just 3\r
- , lookupFMap (Rose 1 [Rose 20 [], Rose 1 []]) fmap_rose === Just 100\r
- ]\r
-where \r
- fmap_int = emptyFMap \r
- <<= (1, 10) \r
- <<= (2, 20) \r
- <<= (3,30) \r
- <<= (4,40) \r
- <<= (5, 50)\r
- fmap_str = emptyFMap \r
- <<= ("one", 1) \r
- <<= ("two", 2) \r
- <<= ("three", 3) \r
- <<= ("four",4) \r
- <<= ("five", 5)\r
- fmap_rose = emptyFMap \r
- <<= (Rose 1 [Rose 2 [], Rose 10 []], 1)\r
- <<= (Rose 1 [Rose 2 [], Rose 20 []], 2)\r
- <<= (Rose 1 [Rose 2 [], Rose 30 []], 3)\r
- <<= (Rose 1 [Rose 2 [], Rose 40 []], 4)\r
- <<= (Rose 1 [Rose 2 [], Rose 50 []], 5)\r
- <<= (Rose 1 [Rose 20 [], Rose 1 []], 100)\r
-\r
-Start :: [[Bool]] \r
-Start\r
- # result = foldr (&&) True (flatten tests)\r
- | result\r
- = [[result]]\r
- = tests\r
-where\r
- tests =\r
- [ testEq\r
- , testLexOrd\r
- , testMap\r
- , testMapRSt\r
- , testMapLSt\r
- , testMapRM\r
- , testMapLM\r
- , testReduceRSt\r
- , testReduceLSt\r
- , testParsePrint\r
- , testCompress\r
- , testFMap\r
- ]\r
repositories / tt2015.git / blobdiff