Generics/gCons.icl

   1 implementation module Generics.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 import Data.List
  12
  13 generic consName a :: a -> String
  14 consName{|CONS of {gcd_name}|} f x = gcd_name
  15 consName{|UNIT|}   _ = "UNIT"
  16 consName{|PAIR|}   f g (PAIR x y) = f x
  17 consName{|EITHER|} f g (LEFT x)   = f x
  18 consName{|EITHER|} f g (RIGHT y)  = g y
  19 consName{|OBJECT|} f   (OBJECT x) = f x
  20 consName{|RECORD|} f   (RECORD x) = f x
  21 consName{|FIELD|}  f   (FIELD x)  = f x
  22 consName{|Int|}        i = toString i
  23 consName{|Bool|}       b = toString b
  24 consName{|Char|}       c = toString c
  25 consName{|String|}     s = s
  26 consName{|[]|} _ _ = "[]"
  27 consName{|()|} _ = "()"
  28 consName{|(,)|} _ _ _ = "(,)"
  29 consName{|(,,)|}  _ _ _ _ = "(,,)"
  30 consName{|(,,,)|}  _ _ _ _ _ = "(,,,)"
  31 consName{|(,,,,)|}  _ _ _ _ _ _ = "(,,,,)"
  32 consName{|(->)|}   f g x = g (x undef)
  33
  34 generic consIndex a :: a -> Int
  35 consIndex{|CONS of {gcd_index}|} f x = gcd_index
  36 consIndex{|UNIT|} _ = 0
  37 consIndex{|PAIR|} f g (PAIR x y) = f x
  38 consIndex{|EITHER|} f g (LEFT x) = f x
  39 consIndex{|EITHER|} f g (RIGHT y) = g y
  40 consIndex{|OBJECT|} f (OBJECT x) = f x
  41 consIndex{|Int|} i = i
  42 consIndex{|Bool|} b = if b 1 0
  43 consIndex{|Char|} c = toInt c
  44 consIndex{|String|} _ = 0
  45 consIndex{|[]|} _ _ = 0
  46 consIndex{|()|} _ = 0
  47 consIndex{|(,)|} _ _ _ = 0
  48 consIndex{|(,,)|}  _ _ _ _ = 0
  49 consIndex{|(,,,)|}  _ _ _ _ _ = 0
  50 consIndex{|(,,,,)|}  _ _ _ _ _ _ = 0
  51
  52 generic conses a :: [a]
  53 conses{|CONS|} f = [CONS (hd f)]
  54 conses{|UNIT|} = [UNIT]
  55 conses{|PAIR|} f g = []
  56 conses{|EITHER|} f g = map LEFT f ++ map RIGHT g
  57 conses{|OBJECT|} f = map OBJECT f
  58 conses{|RECORD|} f = map RECORD f
  59 conses{|FIELD|} f = map FIELD f
  60 conses{|Int|} = [0]
  61 conses{|Bool|} = [True]
  62 conses{|Char|} = ['\0']
  63 conses{|Real|} = [0.0]
  64 conses{|String|} = [""]
  65 conses{|[]|} _ = [[ ]]
  66 conses{|[!]|} _ = [[!]]
  67 conses{|[ !]|} _ = [[ !]]
  68 conses{|[!!]|} _ = [[!!]]
  69 conses{|()|} = [()]
  70 conses{|(,)|} f g = zip2 f g
  71 conses{|(,,)|}  f g h = zip3 f g h
  72 conses{|(,,,)|}  f g h i = zip4 f g h i
  73 conses{|(,,,,)|}  f g h i j = zip5 f g h i j
  74 conses{|{}|} _ = [{}]
  75 conses{|{!}|} _ = [{!}]
  76 conses{|(->)|} _ _ = [const undef]