1 implementation module gCons
6 Radboud University, Nijmegen, The Netherlands
10 import StdEnv, StdGeneric, GenBimap, _SystemStrictLists
12 generic consName a :: a -> String
13 consName{|CONS of {gcd_name}|} f x = gcd_name
14 consName{|UNIT|} _ = "UNIT"
15 consName{|PAIR|} f g (PAIR x y) = f x
16 consName{|EITHER|} f g (LEFT x) = f x
17 consName{|EITHER|} f g (RIGHT y) = g y
18 consName{|OBJECT|} f (OBJECT x) = f x
19 consName{|RECORD|} f (RECORD x) = f x
20 consName{|FIELD|} f (FIELD x) = f x
21 consName{|Int|} i = toString i
22 consName{|Bool|} b = toString b
23 consName{|Char|} c = toString c
24 consName{|String|} s = s
25 consName{|(->)|} f g x = g (x undef)
27 generic consIndex a :: a -> Int
28 consIndex{|CONS of {gcd_index}|} f x = gcd_index
29 consIndex{|UNIT|} _ = 0
30 consIndex{|PAIR|} f g (PAIR x y) = f x
31 consIndex{|EITHER|} f g (LEFT x) = f x
32 consIndex{|EITHER|} f g (RIGHT y) = g y
33 consIndex{|OBJECT|} f (OBJECT x) = f x
34 consIndex{|Int|} i = i
35 consIndex{|Bool|} b = if b 1 0
36 consIndex{|Char|} c = toInt c
37 consIndex{|String|} _ = 0
39 generic conses a :: [a]
40 conses{|CONS|} f = [CONS (hd f)]
41 conses{|UNIT|} = [UNIT]
42 conses{|PAIR|} f g = []
43 conses{|EITHER|} f g = map LEFT f ++ map RIGHT g
44 conses{|OBJECT|} f = map OBJECT f
45 conses{|RECORD|} f = map RECORD f
46 conses{|FIELD|} f = map FIELD f
48 conses{|Bool|} = [True]
49 conses{|Char|} = ['\0']
50 conses{|Real|} = [0.0]
51 conses{|String|} = [""]
52 conses{|[]|} _ = [[ ]]
53 conses{|[!]|} _ = [[!]]
54 conses{|[ !]|} _ = [[ !]]
55 conses{|[!!]|} _ = [[!!]]
57 conses{|{!}|} _ = [{!}]
59 conses{|(->)|} _ _ = [const undef]