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, f3 :: Tr Either Bool, f4 :: Enum}
  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 =
  45         ( flatTypedef $ gTypeToType $ unBox t
  46         , typedefs $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
  47         )
  48 //Start = typedefs //$ (\x->[[gTypeToType x]])
  49 //      $ map (/*filter (not o isBuiltin) o*/ catMaybes o map gTypeToType)
  50 //      $ (\x->[[x]])
  51 //      $ map (map gTypeToType)
  52 //      $ map (filter (not o isBasic))
  53 //      $ flattenGType
  54 //      $ unBox t
  55
  56
  57 //t :: Box GType (?# Int)
  58 //t :: Box GType (Maybe [Maybe (Either Bool String)])
  59 //t :: Box GType ([SR], Enum, T Int, NT, Blurp Int)
  60 //t :: Box GType [EnumList]
  61 t :: Box GType (Int -> SR)
  62 //t :: Box GType (Odd Int, (), [Either (R (T *World)) (Frac Real)], Tr Either Bool, Fix Maybe)
  63 t = gType{|*|}
  64
  65 //Start = toString t
  66 //
  67 //t :: GGType [Int]
  68 //t = ggType{|*|}
  69 //
  70 //:: BM a b =
  71 //      { ab :: a -> b
  72 //      , ba :: b -> a
  73 ////    , mab :: A.m: (m a) -> m b
  74 ////    , mba :: A.m: (m b) -> m a
  75 //      }
  76 //bm :: BM a a
  77 //bm = {ab=id, ba=id}//, mab=id, mba=id}
  78 //
  79 //:: GGType a
  80 //      = GGBasicType BasicType
  81 //      | GGTyRef String
  82 //      | GGUnit
  83 //      | E.e:   GGObject (BM a (OBJECT e))   GenericTypeDefDescriptor (GGType e)
  84 //      | E.e:   GGRecord (BM a (RECORD e))   GenericRecordDescriptor  (GGType e)
  85 //      | E.e:   GGCons   (BM a (CONS e))     GenericConsDescriptor    (GGType e)
  86 //      | E.e:   GGField  (BM a (FIELD e))    GenericFieldDescriptor   (GGType e)
  87 //      | E.l r: GGEither (BM a (EITHER l r)) (GGType l) (GGType r)
  88 //      | E.l r: GGPair   (BM a (PAIR l r))   (GGType l) (GGType r)
  89 //      | E.l r: GGArrow  (BM a (l -> r))     (GGType l) (GGType r)
  90 //
  91 //instance toString (GGType a)
  92 //where
  93 //      toString (GGBasicType t) = toString t
  94 //      toString GGUnit = "UNIT"
  95 //      toString (GGObject bm i e) = "(OBJECT " +++ i.gtd_name +++ " " +++ toString e +++ ")"
  96 //      toString (GGRecord bm i e) = "(RECORD " +++ i.grd_name +++ " " +++ toString e +++ ")"
  97 //      toString (GGCons bm i e) = "(CONS " +++ i.gcd_name +++ " " +++ toString e +++ ")"
  98 //      toString (GGField bm i e) = "(FIELD " +++ i.gfd_name +++ " " +++ toString e +++ ")"
  99 //      toString (GGEither bm l r) = "(EITHER " +++ toString l +++ " " +++ toString r +++ ")"
 100 //      toString (GGPair bm l r) = "(PAIR " +++ toString l +++ " " +++ toString r +++ ")"
 101 //
 102 //ggtypemap :: (.a -> .b) (.b -> .a) u:(GGType .a) -> u:GGType .b
 103 //ggtypemap ab ba (GGBasicType t) = (GGBasicType t)
 104 //ggtypemap ab ba GGUnit = GGUnit
 105 //ggtypemap ab ba (GGObject bm i a) = GGObject {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 106 //ggtypemap ab ba (GGRecord bm i a) = GGRecord {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 107 //ggtypemap ab ba (GGCons bm i a) = GGCons {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 108 //ggtypemap ab ba (GGField bm i a) = GGField {bm & ab=bm.ab o ba, ba=ab o bm.ba} i a
 109 //ggtypemap ab ba (GGEither bm l r) = GGEither {bm & ab=bm.ab o ba, ba=ab o bm.ba} l r
 110 //ggtypemap ab ba (GGPair bm l r) = GGPair {bm & ab=bm.ab o ba, ba=ab o bm.ba} l r
 111 //ggtypemap ab ba (GGArrow bm l r) = GGArrow {bm & ab=bm.ab o ba, ba=ab o bm.ba} l r
 112 //
 113 //bimap{|GGType|} ab ba t = ggtypemap ab ba t
 114 //
 115 //generic ggType a :: GGType a
 116 //ggType{|UNIT|} = GGUnit
 117 //ggType{|OBJECT of gtd|} f = GGObject bm gtd f
 118 //ggType{|CONS of gcd|} f = GGCons bm gcd f
 119 //ggType{|RECORD of grd|} f = GGRecord bm grd f
 120 //ggType{|FIELD of gfd|} f = GGField bm gfd f
 121 //ggType{|EITHER|} fl fr = GGEither bm fl fr
 122 //ggType{|PAIR|} fl fr = GGPair bm fl fr
 123 //
 124 //ggType{|Int|} = GGBasicType BTInt
 125 //ggType{|Bool|} =  GGBasicType BTBool
 126 //ggType{|Real|} = GGBasicType BTReal
 127 //ggType{|Char|} = GGBasicType BTChar
 128 //ggType{|World|} = GGBasicType BTWorld
 129 //ggType{|Dynamic|} = GGBasicType BTDynamic
 130 //ggType{|File|} = GGBasicType BTFile
 131 //
 132 //ggType{|(->)|} fl fr = GGArrow bm fl fr
 133 ////ggType{|[#]|} f = GGUList ULLazy f
 134 ////ggType{|[#!]|} f = GGUList ULStrict f
 135 ////ggType{|{}|} f = GGArray ALazy f
 136 ////ggType{|{!}|} f = GGAray AStrict f
 137 ////ggType{|{#}|} f = GGArray AUnboxed f
 138 ////ggType{|{32#}|} f = GGArray APacked f
 139 //derive ggType []