-- 
-- (c) Susumu Katayama 2009
--
{-# OPTIONS -fglasgow-exts -cpp #-}
module MagicHaskeller.Instantiate(mkRandTrie, RTrie, -- arbitraries,
                   uncurryDyn, uncurryTy, mkUncurry, typeToOrd, typeToRandomsOrd, typeToRandomsOrdDM, mkCurry, curryDyn
                  , typeToArb -- exported just for testing Classification.tex
                  ) where

import MagicHaskeller.CoreLang
import qualified Data.Map as Map
import MagicHaskeller.MyCheck
import System.Random
import MagicHaskeller.Types
import Control.Monad.Search.Combinatorial
import Data.Array((!))
import MagicHaskeller.TyConLib
import MagicHaskeller.DebMT
import Data.List hiding (insert)
import Control.Monad
import qualified Data.IntMap as IntMap

import MagicHaskeller.MyDynamic
-- import Data.Typeable

import MagicHaskeller.ReadDynamic(dynI)

import Data.Memo

import MagicHaskeller.T10
-- import ReadTypeRep(typeToTR)

import Language.Haskell.TH hiding (Type)
-- import Debug.Trace
trace _ e = e

type Order = Maybe ([Dynamic], PackedOrd)

type ExpResult = ([Dynamic],CoreExpr)
mkUncurry :: TyConLib -> Dynamic
mkUncurry tcl =
                $(dynamic [|tcl|] [| uncurry :: (a->b->c)->((,) a b)->c |])

uncurryDyn :: Dynamic -> Type -> Dynamic -> Dynamic
uncurryDyn unc (_ :-> b@(_:->_)) f = dynAppErr "while uncurrying." unc (uncurryDyn unc b f)
uncurryDyn _   _                 x = x

mkCurry :: TyConLib -> Dynamic
mkCurry tcl =
                $(dynamic [|tcl|] [| curry :: ((,) a b -> c)-> a->b->c |])

curryDyn :: Dynamic -> Type -> Dynamic -> Dynamic
curryDyn cur (_ :-> b@(_:->_)) f = dynAppErr "while currying." cur (curryDyn cur b f)
curryDyn _   _                 x = x

{-
varsInts (TA t u) = TA (varsInts t) (varsInts u)
varsInts (u:->t)  = varsInts u :-> varsInts t
varsInts (TV 
-}
uniqueVars (TA t u) = TA (uniqueVars t) (uniqueVars u)
uniqueVars (u:->t)  = uniqueVars u :-> uniqueVars t
uniqueVars (TV _)   = TV 0
uniqueVars tc       = tc

-- uniqueVars はmemoizeしない場合はやってもしょうがないし，memoizeする場合はsynergeticとそうでないのと両方でやるべきでは?


-- memoizeしない場合
typeToRandomsOrd :: TyConLib -> RTrie -> Type -> Order
typeToRandomsOrd tcl = ttro (\(cmap,maps,_,_,_) -> argTypeToRandoms tcl cmap maps) tcl
typeToRandomsOrdDM :: [Int] -> TyConLib -> RTrie -> Type -> Maybe ([[Dynamic]], PackedOrd)
typeToRandomsOrdDM nrnds tcl = ttro (\(cmap,maps,_,_,_) -> argTypeToRandomss nrnds tcl cmap maps) tcl

{-
-- memoizeする場合
typeToRandomsOrd :: TyConLib -> RTrie -> Type -> Order
typeToRandomsOrd tcl rtrie = ttro (\(_,_,(mtrands,_)) -> lookupMT mtrands) tcl rtrie . uniqueVars
typeToRandomsOrdDM :: TyConLib -> RTrie -> Type -> Maybe ([[Dynamic]], PackedOrd)
typeToRandomsOrdDM tcl rtrie = ttro (\(_,_,(_,mtrands)) -> lookupMT mtrands) tcl rtrie . uniqueVars
-}

ttro :: (RTrie -> Type -> Maybe [a]) -> TyConLib -> RTrie -> Type -> Maybe ([a], PackedOrd)
ttro attr tcl rtrie@(cmap,_,_,_,_) (a1:->rest)
    = let (a,r) = uncurryTy' tcl a1 rest
      in do cmp  <- typeToCompare tcl cmap r
            rnds <- attr rtrie a
            return (rnds, cmp)
ttro attr tcl (cmap, _, _, _, _) t
    = do cmp <- typeToCompare tcl cmap t
         return ([], cmp)



dynToCompare :: TyConLib -> Dynamic -> (Dynamic -> Dynamic -> Ordering)
dynToCompare tcl dyn d0 d1 = fromDyn tcl (dynApp (dynApp dyn d0) d1) (error "dynToCompare: type mismatch")
--dynToCompare tcl dyn d0 d1 = aLittleSafeFromDyn (readType' tcl "Ordering") (dynApp (dynApp dyn d0) d1)

-- 引数の型が確定しても返り値の型が確定しない場合：たとえばundefinedやerrorとか．このへんをちゃんとtake careしとかないと，むりやりIntに変換することになる．...まあいっか？
-- procUndef = Just ([], mkHV (\_ _ -> True))

-- | 'uncurryTy' converts  @a->b->c->d->e->r@ into @((((a,b),c),d),e)->r@
--   Note that @Arbitrary (a,b,c,d,e)@ is not defined in @Test.QuickCheck@.
uncurryTy :: TyConLib -> Type -> Type
uncurryTy tcl (a:->b) = case uncurryTy' tcl a b of (c,r) -> c:->r
uncurryTy _   t       = t
uncurryTy' :: TyConLib -> Type -> Type -> (Type,Type)
uncurryTy' tcl a (b:->r) = uncurryTy' tcl (pair tcl a b) r
uncurryTy' tcl a r       = (a,r)

pair tcl a b = (TA (TA (TC (tuple tcl 2)) a) b)
{-
tupleに対応するやつないし，やっぱTH.Typeに一旦変換した方がよい？ あるいは，Types.TypeでTupleを特別視するか．まあ，律速段階ではないので"(,)"みたいな感じでやってもいいけど．
ただ，tclに"(,)"とかが含まれない場合は？ 単にdefaultTyConsに入れておけばいいか．ただ，Arbitraryは(,,,)までしか定義されていない．

$(support [t| forall a b c. ((Int,Integer,Char), ([a], Maybe a), (Either a b, (a,b))) |])
みたいに書くとtypeToOrdやtypeToRandomsが生成されてくれると便利．
まあとりあえずは限られた型だけでやってもいいけど．

てゆーか，Ordな型とArbitraryな型は別なので，supportOrd, supportArbの２つを用意しておくか．


てゆーか，Dynamicはどうよ？ 同じことか
-}

type PackedOrd = Dynamic -> Dynamic -> Ordering
type Cmp a = a->a->Ordering

type Maps  = (ArbMap, ArbMap, StdGen, StdGen) -- used if we do not memoize
type Tries = (MapType (Maybe [Dynamic]), MapType (Maybe [[Dynamic]])) -- used if we memoize

type RTrie = (CmpMap, Maps, MemoMap,
              Tries,  MapType (Dynamic,Dynamic))

mkRandTrie :: [Int] -> TyConLib -> StdGen -> RTrie
mkRandTrie nrnds tcl gen
                   = let arbtup   = mkArbMap tcl
                         coarbtup = mkCoarbMap tcl
                         (g0,g1)  = split gen
                         maps     = (arbtup, coarbtup, g0, g1)
                         cmap     = mkCmpMap tcl
                         mmap     = mkMemoMap tcl
                     in (cmap, maps, mmap,
                            (mkMT tcl (argTypeToRandoms tcl cmap maps), mkMT tcl (argTypeToRandomss nrnds tcl cmap maps)),
                            (mkMT tcl (typeToMemo mmap)))
argTypeToRandoms :: TyConLib -> CmpMap -> Maps -> Type -> Maybe [Dynamic]
argTypeToRandoms  tcl cmap (arbtup, coarbtup, gen, _) a
    = do arb  <- typeToArb arbtup coarbtup a
         let arbsDyn = arbitrariesByDyn tcl arb gen
         case typeToCompare tcl cmap a of Nothing  -> return arbsDyn
                                          Just cmp -> return $ nubByCmp cmp arbsDyn
argTypeToRandomss :: [Int] -> TyConLib -> CmpMap -> Maps -> Type -> Maybe [[Dynamic]]
argTypeToRandomss nrnds tcl cmap (arbtup, coarbtup, _, gen) a
    = do arb  <- typeToArb arbtup coarbtup a
         let arbssDyn = arbitrariessByDyn nrnds tcl arb gen
         case typeToCompare tcl cmap a of Nothing  -> return arbssDyn
                                          Just cmp -> return $ map (nubByCmp cmp) arbssDyn
nubByCmp cmp = nubBy (\a b -> cmp a b == EQ)

type MapTC a = IntMap.IntMap (IntMap.IntMap a)
type CmpMap = (MapTC Dynamic, Dynamic)


mkMap :: TyConLib -> [[(String,a)]] -> MapTC a
mkMap tcl@(mapNameTyCon,_) mcts = IntMap.fromAscList $ zip [0..] $ map (IntMap.fromList . map (\ (name, dyn) -> (mapNameTyCon Map.! name,  dyn))) mcts
mkCmpMap :: TyConLib -> CmpMap
mkCmpMap tcl = (mkMap tcl [mct0, mct1, mct2],
                                cmpChar)
    where
          cmpChar = $(dynamic [|tcl|] [| compare :: Char -> Char -> Ordering |])
          mct0, mct1, mct2 :: [(String,Dynamic)]
          mct0 = [("Int",     $(dynamic [|tcl|] [| compare      :: Int     -> Int     -> Ordering |])),
                  ("Integer", $(dynamic [|tcl|] [| compare      :: Integer -> Integer -> Ordering |])),
                  ("Char",    cmpChar),
                  ("Bool",    $(dynamic [|tcl|] [| compare      :: Bool    -> Bool    -> Ordering |])),
                  ("Double",  $(dynamic [|tcl|] [| compare      :: Double  -> Double  -> Ordering |])),
                  ("Float",   $(dynamic [|tcl|] [| compare      :: Float   -> Float   -> Ordering |])),
                  ("()",      $(dynamic [|tcl|] [| compare      :: ()      -> ()      -> Ordering |])),
                  ("Ordering",$(dynamic [|tcl|] [| compare      :: Ordering-> Ordering-> Ordering |]))]
          mct1 = [("Maybe",   $(dynamic [|tcl|] [| compareMaybe :: (a -> a -> Ordering) -> Maybe a -> Maybe a -> Ordering |])),
                  ("[]",      $(dynamic [|tcl|] [| compareList  :: (a -> a -> Ordering) -> [a]     -> [a]     -> Ordering |]))]
          mct2 = [("Either",  $(dynamic [|tcl|] [| compareEither:: (a -> a -> Ordering) ->
                                                                   (b -> b -> Ordering) -> Either a b -> Either a b -> Ordering |])),
                  ("(,)",     $(dynamic [|tcl|] [| comparePair  :: (a -> a -> Ordering) ->
                                                                   (b -> b -> Ordering) -> (a,b)      -> (a,b)      -> Ordering |]))]
--                  ("Array", unsafeToDyn (readType' tcl "Cmp a -> Cmp b -> Cmp (Array a b)") (\cmp0 cmp1 x y -> compareList (comparePair cmp0 cmp1) (assocs x) (assocs y)))]
--          tto (TA (TA (TA (TC tc) t) u) v) = case (ar ! 3) !! tc of ("(,,)",_) -> packCmp (\ (x0,x1,x2) (y0,y1,y2) -> compareTup  (pair tcl (pair tcl t u) v) ((x0,x1),x2) ((y0,y1),y2))
--                                                                    _          -> Nothing
compareMaybe _   Nothing  Nothing  = EQ
compareMaybe _   Nothing  _        = LT
compareMaybe _   _        Nothing  = GT
compareMaybe cmp (Just x) (Just y) = cmp x y
compareList _   []     []     = EQ
compareList _   []     _      = LT
compareList _   _      []     = GT
compareList cmp (x:xs) (y:ys) = case cmp x y of EQ -> compareList cmp xs ys
                                                c  -> c
compareEither cmp0 cmp1 (Left x)  (Left y)  = cmp0 x y
compareEither cmp0 cmp1 (Left _)  _         = LT
compareEither cmp0 cmp1 _         (Left _)  = GT
compareEither cmp0 cmp1 (Right x) (Right y) = cmp1 x y
comparePair   cmp0 cmp1 (x0,x1)  (y0,y1) = case cmp0 x0 y0 of EQ -> cmp1 x1 y1
                                                              c  -> c

typeToCompare :: TyConLib -> CmpMap -> Type -> Maybe (Dynamic -> Dynamic -> Ordering)
typeToCompare tcl cmap ty = do cmp <- typeToOrd cmap ty
                               return (dynToCompare tcl cmp)
typeToOrd :: CmpMap -> Type -> Maybe Dynamic
typeToOrd (cmpmap,cmpchar) ty = tto 0 ty
    where tto k (TA t u) = liftM2 dynApp (tto (k+1) t) (tto 0 u) -- Higher-order kinds break everything.
          tto _ (_:->_)  = Nothing -- error "Functions in containers are not allowed." -- note that ty is (part of) the return type, so this means higher-order datatype is returned.
          tto 0 (TV _)   = Just cmpchar -- same as the Char case
          tto _ (TV _)   = Nothing -- これについては一般的なやりかたはなさそう．
          tto k (TC tc)  = do guard (tc >= 0)
                              imap <- IntMap.lookup k cmpmap
                              IntMap.lookup tc imap
          tto _ _        = Nothing
type ArbMap = (MapTC Dynamic, Dynamic, Dynamic)

mkArbMap :: TyConLib -> ArbMap
mkArbMap tcl@(mapNameTyCon,_) = (mkMap tcl [mct0, mct1, mct2, mct3],
                                arbChar, -- same as the Char case
                                $(dynamic [|tcl|] [| arbitraryFun :: (a -> Gen b -> Gen b) -> Gen b -> Gen (a->b) |])
                                )

    where
          arbChar = $(dynamic [|tcl|] [| arbitraryChar :: Gen Char |])
          mct0, mct1, mct2, mct3 :: [(String,Dynamic)]
          mct0 = [("Int",     $(dynamic [|tcl|] [| arbitraryInt     :: Gen Int |])),
                  ("Char",    arbChar),
                  ("Integer", $(dynamic [|tcl|] [| arbitraryInteger :: Gen Integer |])),
                  ("Bool",    $(dynamic [|tcl|] [| arbitraryBool    :: Gen Bool    |])),
                  ("Double",  $(dynamic [|tcl|] [| arbitraryDouble  :: Gen Double  |])),
                  ("Float",   $(dynamic [|tcl|] [| arbitraryFloat   :: Gen Float   |])),
                  ("()",      $(dynamic [|tcl|] [| arbitraryVoid    :: Gen ()      |])),
                  ("Ordering",$(dynamic [|tcl|] [| arbitraryOrdering:: Gen Ordering|]))]
          mct1 = [("Maybe",   $(dynamic [|tcl|] [| arbitraryMaybe   :: Gen a -> Gen (Maybe a) |])),
                  ("[]",      $(dynamic [|tcl|] [| arbitraryList    :: Gen a -> Gen [a]       |]))]
          mct2 = [("Either",  $(dynamic [|tcl|] [| arbitraryEither  :: Gen a -> Gen b -> Gen (Either a b) |])),
                  ("(,)",     $(dynamic [|tcl|] [| arbitraryPair    :: Gen a -> Gen b -> Gen (a, b)       |]))]
          mct3 = [("(,,)",    $(dynamic [|tcl|] [| arbitraryTriplet :: Gen a -> Gen b -> Gen c -> Gen (a,b,c) |]))]

typeToArb :: ArbMap -> ArbMap -> Type -> Maybe Dynamic
typeToArb arbtup@(arbmap,arbchar,arbfun) coarbtup@(coarbmap,coarbchar,coarbfun) ty = tta 0 ty
    where
          tta 0 ty@(t :-> u) = do coarb <- typeToCoarb arbtup coarbtup t
                                  arb   <- tta 0 u
                                  return (-- trace ("t = "++show t++" and u = "++show u ++ " and coarb = "++show coarb) $
                                          dynApp (dynApp arbfun coarb) arb)
          tta 0 (TV _)  = Just arbchar -- same as the Char case
          tta _ (TV _)  = Nothing -- これについては一般的なやりかたはなさそう．
          tta k (TC tc)
              = do guard (tc >= 0)
                   imap <- IntMap.lookup k arbmap
                   IntMap.lookup tc imap
          tta k (TA t0 t1) = do arb0 <- tta (k+1) t0
                                arb1 <- tta 0     t1
                                return (-- trace ("t0 = "++show t0++" and t1 = "++show t1) $
                                        dynApp arb0 arb1)
          tta _ _ = Nothing
mkCoarbMap :: TyConLib -> ArbMap
mkCoarbMap tcl@(mapNameTyCon,_) = (mkMap tcl [mct0, mct1, mct2, mct3],
                                   coarbChar, -- same as the Char case
                                   $(dynamic [|tcl|] [| coarbitraryFun :: Gen a -> (b -> Gen x -> Gen x) -> (a->b) -> Gen x -> Gen x |])
                                  )
    where coarbChar = $(dynamic [|tcl|] [| coarbitraryChar :: Char -> Gen x -> Gen x |])
          mct0, mct1, mct2, mct3 :: [(String,Dynamic)]
          mct0 = [("Int",      $(dynamic [|tcl|] [| coarbitraryInt     :: Int     -> Gen x -> Gen x |])),
                  ("Char",     coarbChar),
                  ("Integer",  $(dynamic [|tcl|] [| coarbitraryInteger  :: Integer  -> Gen x -> Gen x |])),
                  ("Bool",     $(dynamic [|tcl|] [| coarbitraryBool     :: Bool     -> Gen x -> Gen x |])),
                  ("Double",   $(dynamic [|tcl|] [| coarbitraryDouble   :: Double   -> Gen x -> Gen x |])),
                  ("Float",    $(dynamic [|tcl|] [| coarbitraryFloat    :: Float    -> Gen x -> Gen x |])),
                  ("()",       $(dynamic [|tcl|] [| coarbitraryVoid     :: ()       -> Gen x -> Gen x |])),
                  ("Ordering", $(dynamic [|tcl|] [| coarbitraryOrdering :: Ordering -> Gen x -> Gen x |]))]
          mct1 = [("[]",     $(dynamic [|tcl|] [| coarbitraryList   :: (a -> Gen x -> Gen x) -> [a]     -> Gen x -> Gen x |])),
                  ("Maybe",  $(dynamic [|tcl|] [| coarbitraryMaybe  :: (a -> Gen x -> Gen x) -> Maybe a -> Gen x -> Gen x |]))]
          mct2 = [("Either", $(dynamic [|tcl|] [| coarbitraryEither :: (a -> Gen x -> Gen x) ->
                                                                       (b -> Gen x -> Gen x) -> Either a b -> Gen x -> Gen x |])),
                  ("(,)",    $(dynamic [|tcl|] [| coarbitraryPair   :: (a -> Gen x -> Gen x) ->
                                                                       (b -> Gen x -> Gen x) -> (a, b) -> Gen x -> Gen x |]))]
          mct3 = [("(,,)",   $(dynamic [|tcl|] [| coarbitraryTriplet:: (a -> Gen x -> Gen x) ->
                                                                       (b -> Gen x -> Gen x) ->
                                                                       (c -> Gen x -> Gen x) -> (a,b,c) -> Gen x -> Gen x |]))]
typeToCoarb :: ArbMap -> ArbMap -> Type -> Maybe Dynamic
typeToCoarb arbtup@(arbmap,arbchar,arbfun) coarbtup@(coarbmap,coarbchar,coarbfun) ty = ttc 0 ty
    where -- ttc :: Type -> Maybe (Coarb Dynamic)
          ttc 0 ty@(t :-> u) = do arb <- typeToArb arbtup coarbtup t
                                  coarb <- ttc 0 u
                                  return (dynApp (dynApp coarbfun arb) coarb)
          ttc 0 (TV _)  = Just coarbchar -- same as the Char case
          ttc _ (TV _)  = Nothing
          ttc k (TC tc)
              = do guard (tc >= 0)
                   imap <- IntMap.lookup k coarbmap
                   IntMap.lookup tc imap
          ttc k (TA t0 t1) = do arb0 <- ttc (k+1) t0
                                arb1 <- ttc 0     t1
                                return (-- trace ("arb0 = "++show arb0++"arb1 = "++show arb1) $
                                        dynApp arb0 arb1)
          ttc _ _ = Nothing -- めんどくさいので取り合えず．



type MemoMap = (IntMap.IntMap (IntMap.IntMap (Dynamic,Dynamic)), (Dynamic,Dynamic))
mkMemoMap :: TyConLib -> MemoMap
mkMemoMap tcl@(mapNameTyCon,_) = (mkMap tcl [mct0, mct1, mct2, mct3],
                                  memoAppChar)
    where memoAppChar = ( $(dynamic [|tcl|] [| memoChar :: (Char->a) -> MapChar a |]), 
                          $(dynamic [|tcl|] [| appChar  :: MapChar a -> (Char->a) |]) )
          mct0, mct1, mct2, mct3 :: [(String,(Dynamic,Dynamic))]
          mct0 = [("Int",     ($(dynamic  [|tcl|] [| memoIx3      :: (Int->a) -> MapIx Int a |]),
                               $(dynamic  [|tcl|] [| appIx       :: MapIx Int a -> (Int->a) |]))),
                  ("Char",    memoAppChar),
                  ("Integer", ($(dynamic  [|tcl|] [| memoInteger  :: (Integer->a) -> MapInteger a |]),
                               $(dynamic  [|tcl|] [| appInteger   :: MapInteger a -> (Integer->a) |]))),
                  ("Bool",    ($(dynamic  [|tcl|] [| memoBool     :: (Bool->a) -> MapBool a |]),
                               $(dynamic  [|tcl|] [| appBool      :: MapBool a -> (Bool->a) |]))),
                  ("Ordering",($(dynamic  [|tcl|] [| memoOrdering :: (Ordering->a) -> MapOrdering a |]),
                               $(dynamic  [|tcl|] [| appOrdering  :: MapOrdering a -> (Ordering->a) |]))),
                  ("()",      ($(dynamic  [|tcl|] [| memoUnit     :: (()->a) -> MapUnit a |]),
                               $(dynamic  [|tcl|] [| appUnit      :: MapUnit a -> (()->a) |]))),
                  ("Double",  ($(dynamic  [|tcl|] [| memoReal     :: (Double->a) -> MapReal a |]),
                               $(dynamic  [|tcl|] [| appReal      :: MapReal a -> (Double->a) |]))),
                  ("Float",   ($(dynamic  [|tcl|] [| memoReal     :: (Float->a) -> MapReal a |]),
                               $(dynamic  [|tcl|] [| appReal      :: MapReal a -> (Float->a) |])))]
          mct1 = [("[]",      ($(dynamicH [|tcl|] 'memoList      [t| forall m b a. (forall c. (b->c) -> m c) -> ([b] -> a) -> MapList m b a |]), -- use an undefined type, because forall is not supported. (But then does this work? I don't think so....) でも，単にforallを取ってinfinite typeを許せばOKって気もする．どうよ？
                               $(dynamicH [|tcl|] 'appList1     [t| forall m b a. (forall c. m c -> (b->c)) -> MapList m b a -> ([b]->a) |]))),
                  ("Maybe",   ($(dynamic  [|tcl|] [| memoMaybe    :: ((b->a)->m a) -> (Maybe b->a) -> MapMaybe m a |]),
                               $(dynamic  [|tcl|] [| appMaybe     :: (m a->(b->a)) -> MapMaybe m a -> (Maybe b -> a) |])))]
          mct2 = [("Either",  ($(dynamic  [|tcl|] [| memoEither   :: ((b->a) -> m a) ->
                                                                     ((d->a) -> n a) ->
                                                                        (Either b d -> a) -> MapEither m n a |]),
                               $(dynamic  [|tcl|] [| appEither    :: (m a -> (b->a)) ->
                                                                     (n a -> (d->a)) ->
                                                                        MapEither m n a -> (Either b d -> a) |]))),
                  ("(,)",     ($(dynamicH [|tcl|] 'memoPair      [t| forall m n b d a.
                                                                     (forall e. (b->e) -> m e) ->
                                                                     (forall f. (d->f) -> n f) ->
                                                                        ((b,d) -> a) -> MapPair m n a |]),
                               $(dynamicH [|tcl|] 'appPair       [t| forall m n b d a.
                                                                     (forall e. m e -> (b->e)) ->
                                                                     (forall f. n f -> (d->f)) ->
                                                                        MapPair m n a -> ((b,d) -> a) |])))]
          mct3 = [("(,,)",    ($(dynamicH [|tcl|] 'memoTriplet   [t| forall l m n b c d a.
                                                                     (forall f. (b->f) -> l f) ->
                                                                     (forall e. (c->e) -> m e) ->
                                                                     (forall e. (d->e) -> n e) ->
                                                                        ((b,c,d) -> a) -> MapTriplet l m n a |]),
                               $(dynamicH [|tcl|] 'appTriplet    [t| forall l m n b c d a.
                                                                     (forall e. l e -> (b->e)) ->
                                                                     (forall e. m e -> (c->e)) ->
                                                                     (forall e. n e -> (d->e)) ->
                                                                        MapTriplet l m n a -> ((b,c,d) -> a) |])))]
memoLength = 10
typeToMemo :: MemoMap -> Type -> (Dynamic,Dynamic)
typeToMemo memotup@(memomap,memochar) ty = case ttc 0 ty of Nothing -> (dynI,dynI) -- メモできない場合．テストするときは取り合えず全部(dynI,dynI)にしてもいいかも．
                                                            Just t  -> t
    where ttc 0 (t:->u) = Nothing
          ttc 0 (TV _)  = Just memochar
          ttc _ (TV _)  = Nothing
          ttc k (TC tc) | tc < 0    = Nothing
                        | otherwise = do imap <- IntMap.lookup k memomap
                                         IntMap.lookup tc imap
          ttc k (TA t0 t1) = do (m0,a0) <- ttc (k+1) t0
                                (m1,a1) <- ttc 0     t1
                                return (dynApp m0 m1, dynApp a0 a1)
          ttc _ _          = Nothing
-- Test.QuickCheck.GenはRandom.StdGen限定で，それ以外のRandomGen g => gではダメみたい．
-- Test.QuickCheck.generateの定義がちょっと変だと思う．usableだとは思うけど．

type Arb a = StdGen -> [a]

arbitrariesByDyn :: TyConLib -> Dynamic -> Arb Dynamic
arbitrariesByDyn tcl arb = arbsByDyn tcl arb 0
arbsByDyn :: TyConLib -> Dynamic -> Int -> StdGen -> [Dynamic]
arbsByDyn tcl arbDyn depth stdgen = zipWith (genAppDyn tcl arbDyn) [depth..] (gens stdgen)

genAppDyn :: TyConLib -> Dynamic -> Int -> StdGen -> Dynamic
genAppDyn tcl arbDyn size stdgen = dynApp $(dynamic [|tcl|] [| (\(Gen f) -> f size stdgen) :: Gen a -> a |] ) arbDyn

{- 実際もう使われていないし．間違えてこっちを編集しちゃうので，隠す．
arbitrariesBy :: Gen a -> Arb a
arbitrariesBy arb = arbsBy arb 0
arbsBy :: Gen a -> Int -> StdGen -> [a]
arbsBy (Gen f) n stdgen = case split stdgen of (g0,g1) -> f n g0 : arbsBy arb (n+1) g1

arbitraries :: Arbitrary a => Arb a
arbitraries = arbitrariesBy arbitrary
-}



-- nrndsは実はsizeを決めるためにしか使われていない．得られるのはStream (Bag Dynamic)ではなくStream (Stream Dynamic)
arbitrariessByDyn :: [Int] -> TyConLib -> Dynamic -> StdGen -> [[Dynamic]]
arbitrariessByDyn nrnds tcl arb gen = abd nrnds tcl arb 0 gen
-- abd _ _ arb depth gen = zipWith (arbsByDyn arb) [depth..] (gens gen) -- 乱数サイズを小さい値から増やしていく場合
abd nrnds tcl arb depth gen = zipWith (arbsByDyn' nrnds tcl arb) [depth..] (gens gen) -- 乱数サイズを一定にする場合
arbsByDyn' nrnds tcl arbDyn depth stdgen = map (genAppDyn tcl arbDyn size) (gens stdgen)
    where size = max depth (nrnds !! depth)
gens gen = case split gen of (g0,g1) -> g0 : gens g1
