module Vectorise.Convert
  ( fromVect
  )
where

import Vectorise.Monad
import Vectorise.Builtins
import Vectorise.Type.Type

import CoreSyn
import TyCon
import Type
import TypeRep
import FastString
import Outputable


-- |Convert a vectorised expression such that it computes the non-vectorised equivalent of its
-- value.
--
-- For functions, we eta expand the function and convert the arguments and result:

-- For example
-- @   
--    \(x :: Double) -> 
--    \(y :: Double) -> 
--    ($v_foo $: x) $: y
-- @
--
-- We use the type of the original binding to work out how many outer lambdas to add.
--
fromVect :: Type        -- ^ The type of the original binding.
         -> CoreExpr    -- ^ Expression giving the closure to use, eg @$v_foo@.
         -> VM CoreExpr
  
-- Convert the type to the core view if it isn't already.
--
fromVect ty expr 
  | Just ty' <- coreView ty 
  = fromVect ty' expr

-- For each function constructor in the original type we add an outer 
-- lambda to bind the parameter variable, and an inner application of it.
fromVect (FunTy arg_ty res_ty) expr
  = do
      arg     <- newLocalVar (fsLit "x") arg_ty
      varg    <- toVect arg_ty (Var arg)
      varg_ty <- vectType arg_ty
      vres_ty <- vectType res_ty
      apply   <- builtin applyVar
      body    <- fromVect res_ty
               $ Var apply `mkTyApps` [varg_ty, vres_ty] `mkApps` [expr, varg]
      return $ Lam arg body

-- If the type isn't a function, then we can't current convert it unless the type is scalar (i.e.,
-- is identical to the non-vectorised version).
--
fromVect ty expr
  = identityConv ty >> return expr

-- Convert an expression such that it evaluates to the vectorised equivalent of the value of the
-- original expression.
--
-- WARNING: Currently only works for the scalar types, where the vectorised value coincides with the
--          original one.
--
toVect :: Type -> CoreExpr -> VM CoreExpr
toVect ty expr = identityConv ty >> return expr

-- |Check that the type is neutral under type vectorisation — i.e., all involved type constructor
-- are not altered by vectorisation as they contain no parallel arrays.
--
identityConv :: Type -> VM ()
identityConv ty 
  | Just ty' <- coreView ty 
  = identityConv ty'
identityConv (TyConApp tycon tys)
  = do { mapM_ identityConv tys
       ; identityConvTyCon tycon
       }
identityConv (LitTy {})    = noV $ text "identityConv: not sure about literal types under vectorisation"
identityConv (TyVarTy {})  = noV $ text "identityConv: type variable changes under vectorisation"
identityConv (AppTy {})    = noV $ text "identityConv: type appl. changes under vectorisation"
identityConv (FunTy {})    = noV $ text "identityConv: function type changes under vectorisation"
identityConv (ForAllTy {}) = noV $ text "identityConv: quantified type changes under vectorisation"

-- |Check that this type constructor is neutral under type vectorisation — i.e., it is not altered
-- by vectorisation as they contain no parallel arrays.
--
identityConvTyCon :: TyCon -> VM ()
identityConvTyCon tc
  | isBoxedTupleTyCon tc = return ()
  | isUnLiftedTyCon tc   = return ()
  | otherwise 
  = do tc' <- maybeV notVectErr (lookupTyCon tc)
       if tc == tc' then return () else noV idErr
  where
    notVectErr = text "identityConvTyCon: no vectorised version for type constructor" <+> ppr tc
    idErr      = text "identityConvTyCon: type constructor contains parallel arrays"   <+> ppr tc