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