{-# LANGUAGE DoRec, PatternGuards #-}
module Language.Java.Paragon.TypeCheck.EvalEnv where

import Language.Java.Paragon.Syntax

import Language.Java.Paragon.TypeCheck.Actors
import Language.Java.Paragon.TypeCheck.Policy
import Language.Java.Paragon.TypeCheck.Locks
import Language.Java.Paragon.TypeCheck.Types
import Language.Java.Paragon.TypeCheck.TcEnv
import Language.Java.Paragon.TypeCheck.Uniq

import Language.Java.Paragon.TypeCheck.Monad

import qualified Data.Map as Map
import Control.Arrow ( first, second, (***) )
import Control.Monad ( msum )

import Data.Generics.Uniplate.Data
{-
type RawMap  = TypeMapExp -- TypeMap Type Exp     Exp      Lock
type AMap    = TypeMap ActorId Exp Lock
type EvalMap = SemTypeMap -- TypeMap ActorId TcPolicy TcLock

--evalEnv :: RawMap -> EvalMap
--evalEnv (TypeMap th fs ms cs ls ps as tms ts) =
--    TypeMap 
--      (evalType th) 
--      (Map.map evalVTI 


-- First transform all $newActor spawn points to fresh $k
pass1Transform :: Exp -> EvalM Exp
pass1Transform (ExpName (Name [Ident "$newActor"])) = do
  k <- freshK
  return $ ExpName $ Name [Ident $ '$' : show k]
pass1Transform e = return e

-- Second, lookup the known aliases, and turn
-- unknowns into 
pass2Transform :: RawMap -> Exp -> EvalM Exp
pass2Transform rm e@(ExpName n@(Name (Ident (c:_):_)))
    | c /= '$',
      Just a <- lookupNamedRaw actors n rm = return a
pass2Transform _ e = do
  k <- freshK
  return $ ExpName $ Name [Ident $ '£' : show k]

evalFirst :: RawMap -> EvalM RawMap
evalFirst rm =
    transformBiM pass1Transform rm >>= \rm1 ->
        transformBiM (pass2Transform rm1) rm1

lookupRawActor = undefined

--evalStage1 :: RawMap -> EvalM AMap
--evalStage1 = 

----------------------------------------------------
-- Evaluation of Actors
----------------------------------------------------

evalActors :: RawMap -> AMap
evalActors (TypeMap thisTy fs ms cs ls ps as tms ts) =
    TypeMap
       (evalActsT thisTy)
       (Map.map evalActsVTI fs)
       (Map.fromList $ evalActsMs $ Map.toList ms)
       (Map.fromList $ evalActsCs $ Map.toList cs)
       ls
       ps
       (Map.map evalActAct as)
       tms
       (Map.map (second evalActors) ts)

-- Note: TcActorIdT is not used at this stage
-- (nor is TcPolicyPolT or TcLockT)
evalActsT :: TcTypeRaw Exp p l -> TcTypeRaw ActorId p l
evalActsT typ =
    case typ of
      TcPrimT pt -> TcPrimT pt
      TcRefT rt  -> TcRefT $ evalActsRT rt
      TcVoidT    -> TcVoidT
      _ -> error $ "Internal compiler error: evalActsT"

evalActsRT :: TcRefTypeRaw Exp p l -> TcRefTypeRaw ActorId p l
evalActsRT rtyp =
    case rtyp of
      TcClsRefT ct -> TcClsRefT $ evalActsCT ct
      TcArrayT t   -> TcArrayT  $ evalActsT  t
      TcTypeVar i  -> TcTypeVar i

evalActsCT :: TcClassTypeRaw Exp p l -> TcClassTypeRaw ActorId p l
evalActsCT TcNullT = TcNullT
evalActsCT (TcClassT iargs) = 
    TcClassT $ map (second $ map evalActsTA) iargs

evalActsTA :: TcTypeArgRaw Exp p l -> TcTypeArgRaw ActorId p l
evalActsTA (TcActualType rt) = TcActualType $ evalActsRT rt
evalActsTA (TcActualLockState ls) = TcActualLockState ls

evalActsVTI :: VTypeInfo Exp p l -> VTypeInfo ActorId p l
evalActsVTI (VTI ty p s f) = VTI (evalActsT ty) p s f

evalActsMTI :: MTypeInfo Exp p l -> MTypeInfo ActorId p l
evalActsMTI (MTI retT retP ps w es mods exns) =
    MTI (evalActsT retT) retP ps w es mods $
      map (first evalActsT) exns

evalActsCTI :: CTypeInfo Exp p l -> CTypeInfo ActorId p l
evalActsCTI (CTI ps w es mods exns) =
    CTI ps w es mods $
      map (first evalActsT) exns

evalActsMs :: [((Ident, [TcTypeRaw Exp     p l]), (MTypeInfo Exp     p l))]
           -> [((Ident, [TcTypeRaw ActorId p l]), (MTypeInfo ActorId p l))]
evalActsMs = map $ second (map evalActsT) *** evalActsMTI

evalActsCs :: [([TcTypeRaw Exp     p l], (CTypeInfo Exp     p l))]
           -> [([TcTypeRaw ActorId p l], (CTypeInfo ActorId p l))]
evalActsCs = map $ (map evalActsT) *** evalActsCTI

-- Precondition: Only applied when we know we are
-- dealing with an actor that has already been
-- pre-generated to a $k form.
evalActAct :: Exp -> ActorId
evalActAct e = 
    case e of
      ExpName (Name [Ident ('$': k)]) -> Fresh $ read k
      ExpName (Name [Ident ('£': k)]) -> Alias $ read k

---------------------------------------------------------------
--
---------------------------------------------------------------
  
type EvalM = Tc
             
{-
newtype EvalM a = EvalM (Uniq -> IO a)

instance Monad EvalM where
    return x = EvalM $ \_ -> return x
    EvalM f >>= k = EvalM $ \u -> do
                       a <- f u
                       let EvalM g = k a
                       g u
-}                   

-- TODO: This should be in Monad
freshK :: EvalM Int
freshK = lift . getUniq =<< getUniqRef

--runEvalM :: EvalM a -> IO a
--runEvalM ema = do
--  u <- initUniq
  


{-

evalActors :: RawMap -> EvalM AMap
evalActors rawM@(TypeMap { actors = acts, types = typs }) = do
  rec newActs <- undefined
      newTyps <- undefined
      newMap  <- return $ rawM { actors = newActs, types = newTyps }
  return newMap













--evalActors :: RawMap -> EvalM (Map Name ActorId)
--evalActors rawM = do
--  let acts = getActors rawM
--  return undefined    

getActors :: RawMap -> [(Name, Exp)]
getActors tm =
    let typas = concatMap aux $ Map.assocs (types tm)
        acts  = map (first (Name . return)) $ Map.assocs (actors tm)
    in acts ++ typas
        where aux :: (Ident, ([TypeParam], RawMap)) -> [(Name, Exp)]
              aux (i, (_, rm)) =
                  map (first (\(Name is) -> Name $ i:is)) $ getActors rm


newtype EvalM a = EvalM ()

instance Monad EvalM

-}-}