extend gcons and make symbol generating smaller
[mTask.git] / gCons.icl
1 implementation module gCons
2
3 /*
4 Pieter Koopman 2015
5 pieter@cs.ru.nl
6 Radboud University, Nijmegen, The Netherlands
7 ARDSL project
8 */
9
10 import StdEnv, StdGeneric, GenBimap, _SystemStrictLists
11
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)
26
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
38
39 conses :: [a] | gconses{|*|} a
40 conses = gconses{|*|} True
41
42 generic gconses a :: Bool -> [a]
43 gconses{|CONS|} f True = map CONS (f False)
44 gconses{|CONS|} f b = [CONS (hd (f b))]
45 gconses{|UNIT|} _ = [UNIT]
46 gconses{|PAIR|} f g _ = []
47 gconses{|EITHER|} f g b = map LEFT (f b) ++ map RIGHT (g b)
48 gconses{|OBJECT|} f b = map OBJECT (f b)
49 gconses{|RECORD|} f b = map RECORD (f b)
50 gconses{|FIELD|} f b = map FIELD (f b)
51 gconses{|Int|} _ = [0]
52 gconses{|Bool|} _ = [True]
53 gconses{|Char|} _ = ['\0']
54 gconses{|Real|} _ = [0.0]
55 gconses{|String|} _ = [""]
56 gconses{|[]|} _ _ = [[ ]]
57 gconses{|[!]|} _ _ = [[!]]
58 gconses{|[ !]|} _ _ = [[ !]]
59 gconses{|[!!]|} _ _ = [[!!]]
60 gconses{|{}|} _ _ = [{}]
61 gconses{|{!}|} _ _ = [{!}]
62 gconses{|()|} _ = [()]
63 gconses{|(->)|} _ _ _ = [const undef]