gengen/test.icl

   1 module test
   2
   3 import StdEnv, StdGeneric, StdMaybe
   4
   5 import Data.Func
   6 import Data.Functor
   7 import Data.List
   8 import Data.Tuple
   9 import Data.Bifunctor
  10 import Control.GenBimap
  11 import Data.Maybe
  12 import Data.Either
  13
  14 import Data.GenType
  15 import Data.GenType.CType
  16
  17 derive gType Either, Maybe, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT, Blurp, EnumList
  18
  19 :: T a =: T2 a
  20 :: NT =: NT Int
  21 :: SR = {f1 :: Int, f2 :: Bool}
  22 :: R a = {f1 :: Maybe (R a), f2 :: Bool, f3 :: T a, f4 :: Char -> Dynamic,
  23         f5 :: [([#Int], [#Int!], [!Int!], [!Int], [Int!])],
  24         f6 :: ({!Int}, {R Bool}, {#Char}, {32#Int}),/*({!Int}, {#Char}, {R Bool})*/
  25         f7 :: {!Int}}
  26 :: Tr m b= Tr (m Int b)
  27 :: Frac a = (/.) infixl 7 a a  | Flurp
  28 :: Fix f = Fix (f (Fix f))
  29
  30 :: List a = Cons a (List a) | Nil
  31
  32 :: Blurp a = Blurp (List a) | Blorp
  33
  34 :: EnumList = ECons Enum EnumList | ENil
  35
  36 ////Start :: [String]
  37 ////Start = foldr (\i c->print i ["\n":c]) [] $ catMaybes $ map gTypeToType $ flattenGType $ unBox t
  38 //:: Pair a b = Pair a b
  39 //instance == (Pair a b) | == a where (==) (Pair a1 _) (Pair a2 _) = a1 == a2
  40 //instance < (Pair a b) | < a where (<) (Pair a1 _) (Pair a2 _) = a1 < a2
  41 :: Odd a = Odd (Even a) | OddBlurp
  42 :: Even a = Even (Odd a) | EvenBlurp
  43 :: Enum = A | B | C
  44 Start = typedefs //$ (\x->[[gTypeToType x]])
  45 //      $ map (/*filter (not o isBuiltin) o*/ catMaybes o map gTypeToType)
  46 //      $ (\x->[[x]])
  47         $ map (map gTypeToType)
  48         $ map (filter (not o isBasic))
  49         $ flattenGType
  50         $ unBox t
  51
  52
  53 //t :: Box GType (?# Int)
  54 //t :: Box GType (Maybe [Maybe (Either Bool String)])
  55 //t :: Box GType ([SR], Enum, T Int, NT, Blurp Int)
  56 //t :: Box GType [EnumList]
  57 //t :: Box GType (Tr Either Enum)
  58 t :: Box GType (Odd Int, (), [Either (R (T *World)) (Frac Real)], Tr Either Bool, Fix Maybe)
  59 t = gType{|*|}
  60
  61 //Start = toString t
  62 //
  63 //t :: GGType [Int]
  64 //t = ggType{|*|}
  65 //
  66 //:: BM a b =
  67 //      { ab :: a -> b
  68 //      , ba :: b -> a
  69 ////    , mab :: A.m: (m a) -> m b
  70 ////    , mba :: A.m: (m b) -> m a
  71 //      }
  72 //bm :: BM a a
  73 //bm = {ab=id, ba=id}//, mab=id, mba=id}
  74 //
  75 //:: GGType a
  76 //      = GGBasicType BasicType
  77 //      | GGTyRef String
  78 //      | GGUnit
  79 //      | E.e:   GGObject (BM a (OBJECT e))   GenericTypeDefDescriptor (GGType e)
  80 //      | E.e:   GGRecord (BM a (RECORD e))   GenericRecordDescriptor  (GGType e)
  81 //      | E.e:   GGCons   (BM a (CONS e))     GenericConsDescriptor    (GGType e)
  82 //      | E.e:   GGField  (BM a (FIELD e))    GenericFieldDescriptor   (GGType e)
  83 //      | E.l r: GGEither (BM a (EITHER l r)) (GGType l) (GGType r)
  84 //      | E.l r: GGPair   (BM a (PAIR l r))   (GGType l) (GGType r)
  85 //      | E.l r: GGArrow  (BM a (l -> r))     (GGType l) (GGType r)
  86 //
  87 //instance toString (GGType a)
  88 //where
  89 //      toString (GGBasicType t) = toString t
  90 //      toString GGUnit = "UNIT"
  91 //      toString (GGObject bm i e) = "(OBJECT " +++ i.gtd_name +++ " " +++ toString e +++ ")"
  92 //      toString (GGRecord bm i e) = "(RECORD " +++ i.grd_name +++ " " +++ toString e +++ ")"
  93 //      toString (GGCons bm i e) = "(CONS " +++ i.gcd_name +++ " " +++ toString e +++ ")"
  94 //      toString (GGField bm i e) = "(FIELD " +++ i.gfd_name +++ " " +++ toString e +++ ")"
  95 //      toString (GGEither bm l r) = "(EITHER " +++ toString l +++ " " +++ toString r +++ ")"
  96 //      toString (GGPair bm l r) = "(PAIR " +++ toString l +++ " " +++ toString r +++ ")"
  97 //
  98 //ggtypemap :: (.a -> .b) (.b -> .a) u:(GGType .a) -> u:GGType .b
  99 //ggtypemap ab ba (GGBasicType t) = (GGBasicType t)
 100 //ggtypemap ab ba GGUnit = GGUnit
 101 //ggtypemap ab ba (GGObject bm i a) = GGObject {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 102 //ggtypemap ab ba (GGRecord bm i a) = GGRecord {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 103 //ggtypemap ab ba (GGCons bm i a) = GGCons {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 104 //ggtypemap ab ba (GGField bm i a) = GGField {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 105 //ggtypemap ab ba (GGEither bm l r) = GGEither {bm & ab=bm.ab o ba, ba=ab o bm.ba} l r
 106 //ggtypemap ab ba (GGPair bm l r) = GGPair {bm & ab=bm.ab o ba, ba=ab o bm.ba} l r
 107 //ggtypemap ab ba (GGArrow bm l r) = GGArrow {bm & ab=bm.ab o ba, ba=ab o bm.ba} l r
 108 //
 109 //bimap{|GGType|} ab ba t = ggtypemap ab ba t
 110 //
 111 //generic ggType a :: GGType a
 112 //ggType{|UNIT|} = GGUnit
 113 //ggType{|OBJECT of gtd|} f = GGObject bm gtd f
 114 //ggType{|CONS of gcd|} f = GGCons bm gcd f
 115 //ggType{|RECORD of grd|} f = GGRecord bm grd f
 116 //ggType{|FIELD of gfd|} f = GGField bm gfd f
 117 //ggType{|EITHER|} fl fr = GGEither bm fl fr
 118 //ggType{|PAIR|} fl fr = GGPair bm fl fr
 119 //
 120 //ggType{|Int|} = GGBasicType BTInt
 121 //ggType{|Bool|} =  GGBasicType BTBool
 122 //ggType{|Real|} = GGBasicType BTReal
 123 //ggType{|Char|} = GGBasicType BTChar
 124 //ggType{|World|} = GGBasicType BTWorld
 125 //ggType{|Dynamic|} = GGBasicType BTDynamic
 126 //ggType{|File|} = GGBasicType BTFile
 127 //
 128 //ggType{|(->)|} fl fr = GGArrow bm fl fr
 129 ////ggType{|[#]|} f = GGUList ULLazy f
 130 ////ggType{|[#!]|} f = GGUList ULStrict f
 131 ////ggType{|{}|} f = GGArray ALazy f
 132 ////ggType{|{!}|} f = GGAray AStrict f
 133 ////ggType{|{#}|} f = GGArray AUnboxed f
 134 ////ggType{|{32#}|} f = GGArray APacked f
 135 //derive ggType []