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