+++ /dev/null
-implementation module genLibTest\r
-\r
-/*\r
- GAST: A Generic Automatic Software Test-system\r
- \r
- genLibtest: library for generic testing: showing and comparing values\r
-\r
- Pieter Koopman, 2004\r
- Radboud Universty, Nijmegen\r
- The Netherlands\r
- pieter@cs.ru.nl\r
-*/\r
-\r
-import StdEnv, StdGeneric, GenEq\r
-\r
-instance + String where (+) s t = s +++ t\r
-\r
-(@)infixl 2 :: (a->b) a -> b\r
-(@) f x = f x\r
-\r
-(@!)infixl 2 :: (a->b) !a -> b\r
-(@!) f x = f x\r
-\r
-//--- show ---//\r
-generic genShow a :: String Bool a [String] -> [String]\r
-\r
-genShow{|Int|} sep p x rest = [toString x: rest]\r
-genShow{|Char|} sep p x rest = ["'",showChar x,"'": rest]\r
-genShow{|Bool|} sep p x rest = [toString x: rest]\r
-genShow{|Real|} sep p x rest = [toString x: rest]\r
-genShow{|String|} sep p s rest = ["\"",s,"\"":rest] \r
-genShow{|UNIT|} sep p _ rest = rest\r
-genShow{|PAIR|} fx fy sep p (PAIR x y) rest\r
-// | p\r
-// = ["(":fx sep p x [sep: fy sep p y [")":rest]]]\r
- = fx sep p x [sep: fy sep p y rest]\r
-//genShow{|PAIR|} fx fy sep p (PAIR x y) rest = fx sep True x [sep: fy sep True y rest]\r
-genShow{|EITHER|} fl fr sep p (LEFT x) rest = fl sep p x rest\r
-genShow{|EITHER|} fl fr sep p (RIGHT x) rest = fr sep p x rest\r
-genShow{|OBJECT|} f sep p (OBJECT x) rest = f sep p x rest\r
-genShow{|(->)|} fa fr sep p f rest = ["<function>": rest]\r
-genShow{|{}|} fx sep p xs rest = ["{" :showList fx [x\\x<-:xs] ["}":rest]]\r
-genShow{|{!}|} fx sep p xs rest = ["{!":showList fx [x\\x<-:xs] ["}":rest]]\r
-//genShow{|{#}|} fx sep p xs rest = ["{#":showList fx [x\\x<-:xs] ["}":rest]]\r
-genShow{|[]|} f sep p xs rest = ["[" :showList f xs ["]":rest]]\r
-genShow{|(,)|} f1 f2 sep p (x1,x2) rest = ["(":f1 sep False x1 [",":f2 sep False x2 [")":rest]]]\r
-genShow{|(,,)|} f1 f2 f3 sep p (x1,x2,x3) rest = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [")":rest]]]]\r
-genShow{|(,,,)|} f1 f2 f3 f4 sep p (x1,x2,x3,x4) rest\r
- = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [")":rest]]]]]\r
-genShow{|(,,,,)|} f1 f2 f3 f4 f5 sep p (x1,x2,x3,x4,x5) rest\r
- = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [")":rest]]]]]]\r
-genShow{|(,,,,,)|} f1 f2 f3 f4 f5 f6 sep p (x1,x2,x3,x4,x5, x6) rest = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [")":rest]]]]]]]\r
-genShow{|(,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 sep p (x1,x2,x3,x4,x5,x6,x7) rest\r
- = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [")":rest]]]]]]]]\r
-genShow{|(,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 sep p (x1,x2,x3,x4,x5,x6,x7,x8) rest\r
- = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [",":f8 sep False x8 [")":rest]]]]]]]]]\r
-genShow{|(,,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 f9 sep p (x1,x2,x3,x4,x5,x6,x7,x8,x9) rest\r
- = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [",":f8 sep False x8 [",":f9 sep False x9 [")":rest]]]]]]]]]]\r
-genShow{|(,,,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 f9 f0 sep p (x1,x2,x3,x4,x5,x6,x7,x8,x9,x0) rest\r
- = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [",":f6 sep False x6 [",":f7 sep False x7 [",":f8 sep False x8 [",":f9 sep False x9 [",":f0 sep False x0 [")":rest]]]]]]]]]]]\r
-genShow{|CONS of {gcd_name, gcd_arity, gcd_fields}|} fx sep p (CONS x) rest\r
- | gcd_arity == 0\r
- = [gcd_name: rest]\r
- | isEmpty gcd_fields // ordinary constructor\r
- | p // parentheses needed\r
-// = ["(",gcd_name," ":fx " " False x [")":rest]]\r
-// = [gcd_name," ":fx " " False x rest]\r
- = ["(",gcd_name," ":fx " " True x [")":rest]]\r
- = [gcd_name," ":fx " " True x rest]\r
- | otherwise // record\r
- = ["{",{gcd_name.[i]\\i<-[1..size gcd_name-1]},"|":fx "," False x ["}":rest]]\r
-genShow{|FIELD of {gfd_name}|} fx sep p (FIELD x) rest\r
- = [gfd_name,"=":fx sep False x rest]\r
-\r
-showChar :: Char -> String\r
-showChar c\r
- = case c of\r
- '\n' = "\\n"\r
- '\t' = "\\t"\r
- '\r' = "\\r"\r
- '\b' = "\\b"\r
- '\'' = "\\'"\r
- c = toString c\r
-\r
-showList :: (.String -> .(.Bool -> .(.a -> .(u:[v:String] -> w:[x:String])))) ![.a] z:[u0:String] -> w0:[x0:String], [w0 <= u,x0 <= v,z w <= w0,u0 x <= x0]\r
-showList f [] rest = rest\r
-showList f [x] rest = f "" False x rest\r
-showList f [x:xs] rest = f "" False x [",":showList f xs rest]\r
-\r
-show :: !a -> [String] | genShow{|*|} a\r
-show x = genShow{|*|} "" False x []\r
-\r
-show1 :: !a -> String | genShow{|*|} a\r
-show1 x = glue (genShow{|*|} "" True x [])\r
-where\r
- glue :: [String] -> String\r
- glue [] = ""\r
- glue [x:xs]\r
- = case xs of\r
- [] = x\r
- = x+glue xs\r
-\r
-//--- comparision ---//\r
-/*\r
-instance < Bool\r
-where\r
- (<) True b = not b\r
- (<) False _ = False\r
-*/\r
-generic gLess a :: a a -> Bool\r
-\r
-gLess{|UNIT|} _ _ = False\r
-gLess{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 || (not (fx x2 x1) && fy y1 y2) // x1<x2 || (x1==x2) && y1<y2\r
-gLess{|EITHER|} fl fr (LEFT x) (LEFT y) = fl x y\r
-gLess{|EITHER|} fl fr (RIGHT x) (RIGHT y) = fr x y\r
-gLess{|EITHER|} fl fr (LEFT x) (RIGHT y) = True\r
-gLess{|EITHER|} fl fr (RIGHT x) (LEFT y) = False\r
-gLess{|CONS|} f (CONS x) (CONS y) = f x y\r
-gLess{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y\r
-gLess{|FIELD|} f (FIELD x) (FIELD y) = f x y\r
-gLess{|Int|} x y = x < y\r
-gLess{|Char|} x y = x < y\r
-gLess{|Bool|} False y = y\r
-gLess{|Bool|} x y = False\r
-gLess{|Real|} x y = x < y\r
-gLess{|String|} x y = x < y\r
-\r
-derive gLess [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)\r
-\r
-(-<-) infix 4 :: !a !a -> Bool | gLess{|*|} a\r
-(-<-) x y = gLess{|*|} x y\r
-\r
-(->-) infix 4 :: !a !a -> Bool | gLess{|*|} a\r
-(->-) x y = gLess{|*|} y x\r
-\r
-(-<=) infix 4 :: !a !a -> Bool | gLess{|*|} a\r
-(-<=) x y = not (gLess{|*|} y x)\r
-\r
-(=>-) infix 4 :: !a !a -> Bool | gLess{|*|} a\r
-(=>-) x y = not (gLess{|*|} x y)\r
-\r
repositories / tt2015.git / blobdiff