    module Vectorise.Utils.Poly (
    	polyAbstract,
    	polyApply,
    	polyVApply,
    	polyArity
    )
    where
    import Vectorise.Vect
    import Vectorise.Monad
    import Vectorise.Utils.PADict
    import CoreSyn
    import Type
    import Var
    import FastString
    import Control.Monad

    -- Poly Functions -------------------------------------------------------------
    polyAbstract :: [TyVar] -> ([Var] -> VM a) -> VM a
    polyAbstract tvs p
      = localV
      $ do
          mdicts <- mapM mk_dict_var tvs
          zipWithM_ (\tv -> maybe (defLocalTyVar tv)
                                  (defLocalTyVarWithPA tv . Var)) tvs mdicts
          p (mk_args mdicts)
      where
        mk_dict_var tv = do
                           r <- paDictArgType tv
                           case r of
                             Just ty -> liftM Just (newLocalVar (fsLit "dPA") ty)
                             Nothing -> return Nothing

        mk_args mdicts = [dict | Just dict <- mdicts]

    polyArity :: [TyVar] -> VM Int
    polyArity tvs = do
                      tys <- mapM paDictArgType tvs
                      return $ length [() | Just _ <- tys]

    polyApply :: CoreExpr -> [Type] -> VM CoreExpr
    polyApply expr tys
     = do Just dicts <- liftM sequence $ mapM paDictOfType tys
          return $ expr `mkTyApps` tys `mkApps` dicts

    polyVApply :: VExpr -> [Type] -> VM VExpr
    polyVApply expr tys
     = do Just dicts <- liftM sequence $ mapM paDictOfType tys
          return     $ mapVect (\e -> e `mkTyApps` tys `mkApps` dicts) expr