module Vectorise.Utils.PRDict (
	prDFunOfTyCon,
	prDictOfType,
	prDictOfTyApp,
	prDFunApply,
	wrapPR
)
where
import Vectorise.Monad
import Vectorise.Builtins
import Vectorise.Utils.PADict

import CoreSyn
import Type
import TypeRep
import TyCon
import Outputable
import Control.Monad


prDFunOfTyCon :: TyCon -> VM CoreExpr
prDFunOfTyCon tycon
  = liftM Var
  . maybeCantVectoriseM "No PR dictionary for tycon" (ppr tycon)
  $ lookupTyConPR tycon



prDictOfType :: Type -> VM CoreExpr
prDictOfType ty = prDictOfTyApp ty_fn ty_args
  where
    (ty_fn, ty_args) = splitAppTys ty

prDictOfTyApp :: Type -> [Type] -> VM CoreExpr
prDictOfTyApp ty_fn ty_args
  | Just ty_fn' <- coreView ty_fn = prDictOfTyApp ty_fn' ty_args
prDictOfTyApp (TyConApp tc _) ty_args
  = do
      dfun <- liftM Var $ maybeV (lookupTyConPR tc)
      prDFunApply dfun ty_args
prDictOfTyApp _ _ = noV

prDFunApply :: CoreExpr -> [Type] -> VM CoreExpr
prDFunApply dfun tys
  = do
      dicts <- mapM prDictOfType tys
      return $ mkApps (mkTyApps dfun tys) dicts

wrapPR :: Type -> VM CoreExpr
wrapPR ty
  = do
      Just  pa_dict <- paDictOfType ty
      pr_dfun       <- prDFunOfTyCon =<< builtin wrapTyCon
      return $ mkApps pr_dfun [Type ty, pa_dict]