implementation module genLibTest

/*
	GAST: A Generic Automatic Software Test-system
	
	genLibtest: library for generic testing: showing and comparing values

	Pieter Koopman, 2004
	Radboud Universty, Nijmegen
	The Netherlands
	pieter@cs.ru.nl
*/

import StdEnv, StdGeneric, GenEq

instance + String where (+) s t = s +++ t

(@)infixl 2 :: (a->b) a -> b
(@) f x = f x

(@!)infixl 2 :: (a->b) !a -> b
(@!) f x = f x

//--- show ---//
generic genShow a :: String Bool a [String] -> [String]

genShow{|Int|}  			sep p x				rest = [toString x: rest]
genShow{|Char|} 			sep p x				rest = ["'",showChar x,"'": rest]
genShow{|Bool|} 			sep p x				rest = [toString x: rest]
genShow{|Real|} 			sep p x				rest = [toString x: rest]
genShow{|String|}			sep p s				rest = ["\"",s,"\"":rest] 
genShow{|UNIT|} 			sep p _				rest = rest
genShow{|PAIR|} 	fx fy	sep p (PAIR x y)	rest
//	| p
//		= ["(":fx sep p x [sep: fy sep p y [")":rest]]]
		= fx sep p x [sep: fy sep p y rest]
//genShow{|PAIR|} 	fx fy	sep p (PAIR x y)	rest = fx sep True x [sep: fy sep True y rest]
genShow{|EITHER|}	fl fr	sep p (LEFT x)		rest = fl sep p x rest
genShow{|EITHER|}	fl fr	sep p (RIGHT x)		rest = fr sep p x rest
genShow{|OBJECT|}	f    	sep p (OBJECT x)	rest = f sep p x rest
genShow{|(->)|} 	fa fr	sep p f				rest = ["<function>": rest]
genShow{|{}|}		fx		sep p xs			rest = ["{" :showList fx [x\\x<-:xs] ["}":rest]]
genShow{|{!}|}		fx		sep p xs			rest = ["{!":showList fx [x\\x<-:xs] ["}":rest]]
//genShow{|{#}|}		fx		sep p xs			rest = ["{#":showList fx [x\\x<-:xs] ["}":rest]]
genShow{|[]|}		f		sep p xs			rest = ["[" :showList f xs ["]":rest]]
genShow{|(,)|}		f1 f2	sep p (x1,x2)		rest = ["(":f1 sep False x1 [",":f2 sep False x2 [")":rest]]]
genShow{|(,,)|}		f1 f2 f3 sep p (x1,x2,x3)	rest = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [")":rest]]]]
genShow{|(,,,)|}	f1 f2 f3 f4 sep p (x1,x2,x3,x4) rest
 = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [")":rest]]]]]
genShow{|(,,,,)|}	f1 f2 f3 f4 f5 sep p (x1,x2,x3,x4,x5) rest
 = ["(":f1 sep False x1 [",":f2 sep False x2 [",":f3 sep False x3 [",":f4 sep False x4 [",":f5 sep False x5 [")":rest]]]]]]
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]]]]]]]
genShow{|(,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 sep p (x1,x2,x3,x4,x5,x6,x7) 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 [",":f7 sep False x7 [")":rest]]]]]]]]
genShow{|(,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 sep p (x1,x2,x3,x4,x5,x6,x7,x8) 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 [",":f7 sep False x7 [",":f8 sep False x8 [")":rest]]]]]]]]]
genShow{|(,,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 f9 sep p (x1,x2,x3,x4,x5,x6,x7,x8,x9) 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 [",":f7 sep False x7 [",":f8 sep False x8 [",":f9 sep False x9 [")":rest]]]]]]]]]]
genShow{|(,,,,,,,,,)|}f1 f2 f3 f4 f5 f6 f7 f8 f9 f0 sep p (x1,x2,x3,x4,x5,x6,x7,x8,x9,x0) 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 [",":f7 sep False x7 [",":f8 sep False x8 [",":f9 sep False x9 [",":f0 sep False x0 [")":rest]]]]]]]]]]]
genShow{|RECORD of d|} fx sep p (RECORD x) rest
	= ["{",{d.grd_name.[i]\\i<-[1..size d.grd_name-1]},"|":fx "," False x ["}":rest]]
genShow{|CONS of d|} fx sep p (CONS x) rest
	| d.gcd_arity == 0
		= [d.gcd_name: rest]
    | p // parentheses needed
        = ["(", d.gcd_name," ":fx " " True x [")":rest]]
        = [d.gcd_name," ":fx " " True x rest]
genShow{|FIELD of d|} fx sep p (FIELD x) rest
	= [d.gfd_name,"=":fx sep False x rest]

showChar :: Char -> String
showChar c
 = case c of
	'\n' = "\\n"
	'\t' = "\\t"
	'\r' = "\\r"
	'\b' = "\\b"
	'\'' = "\\'"
	c = toString c

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]
showList f []		rest = rest
showList f [x]		rest = f "" False x rest
showList f [x:xs]	rest = f "" False x [",":showList f xs rest]

show :: !a -> [String] | genShow{|*|} a
show x = genShow{|*|} "" False x []

show1 :: !a -> String | genShow{|*|} a
show1 x = glue (genShow{|*|} "" True x [])
where
	glue :: [String] -> String
	glue [] = ""
	glue [x:xs]
		= case xs of
			[] = x
			   = x+glue xs

//--- comparision ---//
/*
instance < Bool
where
	(<) True  b = not b
	(<) False _ = False
*/
generic gLess a  :: a a -> Bool

gLess{|UNIT|} _ _ 								= False
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
gLess{|EITHER|} fl fr (LEFT x)   (LEFT y) 		= fl x y
gLess{|EITHER|} fl fr (RIGHT x)  (RIGHT y)		= fr x y
gLess{|EITHER|} fl fr (LEFT x)   (RIGHT y) 		= True
gLess{|EITHER|} fl fr (RIGHT x)  (LEFT y)		= False
gLess{|CONS|}   f     (CONS x)   (CONS y) 		= f x y
gLess{|OBJECT|} f     (OBJECT x) (OBJECT y) 	= f x y
gLess{|RECORD|} f     (RECORD x) (RECORD y) 	= f x y
gLess{|FIELD|}  f     (FIELD x)  (FIELD y) 		= f x y
gLess{|Int|} 	x y 							= x < y
gLess{|Char|} x y 								= x < y
gLess{|Bool|} False y 							= y
gLess{|Bool|} x y 								= False
gLess{|Real|} x y 								= x < y
gLess{|String|} x y 							= x < y

derive gLess [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)

(-<-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(-<-) x y = gLess{|*|} x y

(->-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(->-) x y = gLess{|*|} y x

(-<=) infix 4 :: !a !a -> Bool | gLess{|*|} a
(-<=) x y = not (gLess{|*|} y x)

(=>-) infix 4 :: !a !a -> Bool | gLess{|*|} a
(=>-) x y = not (gLess{|*|} x y)