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{|[]|} _ _ = "[]"
  26 consName{|(->)|}   f g x = g (x undef)
  27
  28 generic consIndex a :: a -> Int
  29 consIndex{|CONS of {gcd_index}|} f x = gcd_index
  30 consIndex{|UNIT|} _ = 0
  31 consIndex{|PAIR|} f g (PAIR x y) = f x
  32 consIndex{|EITHER|} f g (LEFT x) = f x
  33 consIndex{|EITHER|} f g (RIGHT y) = g y
  34 consIndex{|OBJECT|} f (OBJECT x) = f x
  35 consIndex{|Int|} i = i
  36 consIndex{|Bool|} b = if b 1 0
  37 consIndex{|Char|} c = toInt c
  38 consIndex{|String|} _ = 0
  39 consIndex{|[]|} _ _ = 0
  40
  41 generic conses a :: [a]
  42 conses{|CONS|} f = [CONS (hd f)]
  43 conses{|UNIT|} = [UNIT]
  44 conses{|PAIR|} f g = []
  45 conses{|EITHER|} f g = map LEFT f ++ map RIGHT g
  46 conses{|OBJECT|} f = map OBJECT f
  47 conses{|RECORD|} f = map RECORD f
  48 conses{|FIELD|} f = map FIELD f
  49 conses{|Int|} = [0]
  50 conses{|Bool|} = [True]
  51 conses{|Char|} = ['\0']
  52 conses{|Real|} = [0.0]
  53 conses{|String|} = [""]
  54 conses{|[]|} _ = [[ ]]
  55 conses{|[!]|} _ = [[!]]
  56 conses{|[ !]|} _ = [[ !]]
  57 conses{|[!!]|} _ = [[!!]]
  58 conses{|{}|} _ = [{}]
  59 conses{|{!}|} _ = [{!}]
  60 conses{|()|} = [()]
  61 conses{|(->)|} _ _ = [const undef]