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 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
  47 conses{|Int|} = [0]
  48 conses{|Bool|} = [True]
  49 conses{|Char|} = ['\0']
  50 conses{|Real|} = [0.0]
  51 conses{|String|} = [""]
  52 conses{|[]|} _ = [[ ]]
  53 conses{|[!]|} _ = [[!]]
  54 conses{|[ !]|} _ = [[ !]]
  55 conses{|[!!]|} _ = [[!!]]
  56 conses{|{}|} _ = [{}]
  57 conses{|{!}|} _ = [{!}]
  58 conses{|()|} = [()]
  59 conses{|(->)|} _ _ = [const undef]