implementation module gCons

/*
	Pieter Koopman 2015
	pieter@cs.ru.nl
	Radboud University, Nijmegen, The Netherlands
	ARDSL project
*/

import StdEnv, StdGeneric, GenBimap, _SystemStrictLists

generic consName a :: a -> String
consName{|CONS of {gcd_name}|} f x = gcd_name
consName{|UNIT|}   _ = "UNIT"
consName{|PAIR|}   f g (PAIR x y) = f x
consName{|EITHER|} f g (LEFT x)   = f x
consName{|EITHER|} f g (RIGHT y)  = g y
consName{|OBJECT|} f   (OBJECT x) = f x
consName{|RECORD|} f   (RECORD x) = f x
consName{|FIELD|}  f   (FIELD x)  = f x
consName{|Int|}        i = toString i
consName{|Bool|}       b = toString b
consName{|Char|}       c = toString c
consName{|String|}     s = s
consName{|(->)|}   f g x = g (x undef)

generic consIndex a :: a -> Int
consIndex{|CONS of {gcd_index}|} f x = gcd_index
consIndex{|UNIT|} _ = 0
consIndex{|PAIR|} f g (PAIR x y) = f x
consIndex{|EITHER|} f g (LEFT x) = f x
consIndex{|EITHER|} f g (RIGHT y) = g y
consIndex{|OBJECT|} f (OBJECT x) = f x
consIndex{|Int|} i = i
consIndex{|Bool|} b = if b 1 0
consIndex{|Char|} c = toInt c
consIndex{|String|} _ = 0

conses :: [a] | gconses{|*|} a
conses = gconses{|*|} True

generic gconses a :: Bool -> [a]
gconses{|CONS|} f True = map CONS (f False)
gconses{|CONS|} f b = [CONS (hd (f b))]
gconses{|UNIT|} _ = [UNIT]
gconses{|PAIR|} f g _ = []
gconses{|EITHER|} f g b = map LEFT (f b) ++ map RIGHT (g b)
gconses{|OBJECT|} f b = map OBJECT (f b)
gconses{|RECORD|} f b = map RECORD (f b)
gconses{|FIELD|} f b = map FIELD (f b)
gconses{|Int|} _ = [0]
gconses{|Bool|} _ = [True]
gconses{|Char|} _ = ['\0']
gconses{|Real|} _ = [0.0]
gconses{|String|} _ = [""]
gconses{|[]|} _ _ = [[ ]]
gconses{|[!]|} _ _ = [[!]]
gconses{|[ !]|} _ _ = [[ !]]
gconses{|[!!]|} _ _ = [[!!]]
gconses{|{}|} _ _ = [{}]
gconses{|{!}|} _ _ = [{!}]
gconses{|()|} _ = [()]
gconses{|(->)|} _ _ _ = [const undef]