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{|Real|}       r = toString r
  26 consName{|String|}     s = s
  27 consName{|[]|} _ _ = "[]"
  28 consName{|[!]|} _ _ = "[!]"
  29 consName{|[ !]|} _ _ = "[ !]"
  30 consName{|[!!]|} _ _ = "[!!]"
  31 consName{|{}|} _ _ = "{}"
  32 consName{|{!}|} _ _ = "{!}"
  33 consName{|(->)|}   f g x = g (x undef)
  34 consName{|()|} _ = "()"
  35 consName{|(,)|} _ _ _ = "(,)"
  36 consName{|(,,)|}  _ _ _ _ = "(,,)"
  37 consName{|(,,,)|}  _ _ _ _ _ = "(,,,)"
  38 consName{|(,,,,)|}  _ _ _ _ _ _ = "(,,,,)"
  39 consName{|(,,,,,)|}  _ _ _ _ _ _ _ = "(,,,,,)"
  40 consName{|(,,,,,,)|}  _ _ _ _ _ _ _ _ = "(,,,,,,)"
  41 consName{|(,,,,,,,)|}  _ _ _ _ _ _ _ _ _ = "(,,,,,,,)"
  42 consName{|(,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,)"
  43 consName{|(,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,)"
  44 consName{|(,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,)"
  45 consName{|(,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,)"
  46 consName{|(,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,)"
  47 consName{|(,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,)"
  48 consName{|(,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,)"
  49 consName{|(,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,)"
  50 consName{|(,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,)"
  51 consName{|(,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,)"
  52 consName{|(,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,)"
  53 consName{|(,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,)"
  54 consName{|(,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,)"
  55 consName{|(,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,)"
  56 consName{|(,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,)"
  57 consName{|(,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,)"
  58 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,)"
  59 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,)"
  60 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,)"
  61 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
  62 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
  63 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
  64 consName{|(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)|}  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = "(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)"
  65
  66 generic consIndex a :: a -> Int
  67 consIndex{|CONS of {gcd_index}|} f x = gcd_index
  68 consIndex{|UNIT|} _ = 0
  69 consIndex{|PAIR|} f g (PAIR x y) = f x
  70 consIndex{|EITHER|} f g (LEFT x) = f x
  71 consIndex{|EITHER|} f g (RIGHT y) = g y
  72 consIndex{|OBJECT|} f (OBJECT x) = f x
  73 consIndex{|RECORD|} f (RECORD x) = f x
  74 consIndex{|FIELD|} f (FIELD x) = f x
  75 consIndex{|Int|} i = i
  76 consIndex{|Bool|} b = if b 1 0
  77 consIndex{|Char|} c = toInt c
  78 consIndex{|Real|} r = toInt r
  79 consIndex{|String|} _ = 0
  80 consIndex{|{}|} _ _ = 0
  81 consIndex{|{!}|} _ _ = 0
  82 consIndex{|(->)|} _ _ _ = 0
  83 derive consIndex [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
  84
  85 generic conses a :: [a]
  86 conses{|CONS|} f = [CONS (hd f)]
  87 conses{|UNIT|} = [UNIT]
  88 conses{|PAIR|} f g = []
  89 conses{|EITHER|} f g = map LEFT f ++ map RIGHT g
  90 conses{|OBJECT|} f = map OBJECT f
  91 conses{|RECORD|} f = map RECORD f
  92 conses{|FIELD|} f = map FIELD f
  93 conses{|Int|} = [0]
  94 conses{|Bool|} = [True]
  95 conses{|Char|} = ['\0']
  96 conses{|Real|} = [0.0]
  97 conses{|String|} = [""]
  98 conses{|{}|} _ = [{}]
  99 conses{|{!}|} _ = [{!}]
 100 conses{|(->)|} _ _ = [const undef]
 101 derive conses [],[!],[ !],[!!],(),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)