-- 
-- (c) Susumu Katayama 2009
--
# ifdef REALDYNAMIC
module MagicHaskeller.MyDynamic(module MagicHaskeller.PolyDynamic, dynamic, dynamicH) where
import MagicHaskeller.PolyDynamic
# else
module MagicHaskeller.MyDynamic(module MagicHaskeller.FakeDynamic, dynamic, dynamicH) where
import MagicHaskeller.FakeDynamic -- MY dynamic
# endif

import MagicHaskeller.ReadTHType(thTypeToType)
import MagicHaskeller.ReadTypeRep(trToType)
import Language.Haskell.TH hiding (Type)
import MagicHaskeller.MHTH
import Data.Typeable(typeOf)
{-
$(dynamic [|tcl|] [| (,) :: forall a b. a->b->(a,b) |])
のようにできるようにする．CLEANのdynamicみたいな感じ．
-}
dynamic :: ExpQ -> ExpQ -> ExpQ
dynamic eqtcl eq = eq >>= p' eqtcl


-- Quasi-quotes with higher-rank types are not permitted. When that is the case, take the type info apart from the expression.
-- E.g. $(dynamicH [|tcl|] 'foo [t| forall a b. a->b->(a,b) |]) is equivalent to $(dynamic [|tcl|] [| foo :: forall a b. a->b->(a,b) |])
dynamicH :: ExpQ -> Name -> TypeQ -> ExpQ
dynamicH eqtcl nm tq = do t <- tq
                          px eqtcl (VarE nm) t
-- p' is like MagicHaskeller.p'
{- MagicHaskeller.lhsのイマイチな定義
p' eqtcl se@(SigE e ty) = [| unsafeToDyn $eqtcl (readType' $eqtcl $(return (LitE (StringL (pprintType ty))))) $(return se) $(expToExpExp e) |]
p' eqtcl e              = [| unsafeToDyn $eqtcl (readType' $eqtcl (show (typeOf $(return e))))                $(return e)  $(expToExpExp e) |]
-}
p' eqtcl (SigE e ty) = px eqtcl e ty
p' eqtcl e           = [| unsafeToDyn $eqtcl (trToType $eqtcl (typeOf $(return e)))    $(return e)  $(expToExpExp e) |]

px eqtcl e ty        = [| unsafeToDyn $eqtcl (thTypeToType $eqtcl $(typeToExpType ty)) $(return se) $(expToExpExp se) |]
    where se = SigE e ty