Commits

Paweł Wieczorek  committed 175e09b

working on design for Analysis

  • Participants
  • Parent commits 6f849a0
  • Branches analysis_infastructure

Comments (0)

Files changed (5)

File src/Selen/Compiler/CPS/Analysis.hs

  -}
 
 module Selen.Compiler.CPS.Analysis
-    ( Selen.Compiler.CPS.Analysis.Basic
-    , Selen.Compiler.CPS.Analysis.CFA0
+    ( module Selen.Compiler.CPS.Analysis.Basic
+    , module Selen.Compiler.CPS.Analysis.CFA0
     ) where
 
 

File src/Selen/Compiler/CPS/Analysis/Basic.hs

  -}
 
 module Selen.Compiler.CPS.Analysis.Basic
-    ( BoundBy(..)
+    ( VarBoundBy(..)
+    , WithBasicAnalysis
+    , withBasicAnalysis
+
+    -- interface
+    , isEscapingVar
+    , varUsageCount
     ) where
 
 import qualified Data.Map as Map
 import Selen.Lang.IR.CPS
 import Selen.Lang.Defs
 import Selen.Compiler.CPS.Traversals
-import Control.Monad.State
-import Selen.Compiler.CPS.Monad hiding (BoundBy)
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans
+import Selen.Control.FreshMonad
+import Selen.Compiler.CPS.Monad hiding (BoundBy(..))
 
 {-------------------------------------------------------------------------
  -- Data
  -}
 
-data BoundBy
-    = ByPRIMOP IrPrimOp [IrValue]
-    | ByFIX
-    | ByRECORD [(IrValue, IrAccPath)]
-    | BySELECT
-    | ByOFFSET
+data VarBoundBy
+    = BbyPRIMOP IrPrimOp [IrValue]
+    | BbyFIX [VarName] Ir
+    | BbyRECORD [(IrValue, IrAccPath)]
+    | BbySELECT
+    | BbyOFFSET
+    | BbyARG
     deriving (Eq, Show)
 
 {-------------------------------------------------------------------------
+ -- Internal Monad
+ -}
+
+type AnalysisM m = StateT BasicAnalysisInfo m
+
+{-------------------------------------------------------------------------
  -- Internal state
  -}
 
 data BasicAnalysisInfo = MkBasicAnalysisInfo
-    { mapUsageCount :: Map VarName Int
-    , mapBoundBy    :: Map VarName BoundBy
-    , mapEscapes    :: Set VarName
-    , mapKnown      :: Set VarName
+    { mapVarUsageCount      :: Map VarName Int
+    , mapVarBoundBy            :: Map VarName VarBoundBy
+    , setEscapingVars       :: Set VarName
+    , setKnownCalls         :: Set VarName
     }
 
+defaultBasicAnalysisInfo :: BasicAnalysisInfo
+defaultBasicAnalysisInfo = MkBasicAnalysisInfo
+    { mapVarUsageCount      = Map.empty
+    , mapVarBoundBy            = Map.empty
+    , setEscapingVars       = Set.empty
+    , setKnownCalls         = Set.empty
+    }
+
+addVarBoundBy :: TransformationMonad m => VarName -> VarBoundBy -> AnalysisM m ()
+addVarBoundBy var bby = do
+    bai <- get
+    let bbymap = mapVarBoundBy bai
+    put $ bai { mapVarBoundBy = Map.insert var bby bbymap }
+
+
+incVarUsageCount :: TransformationMonad m => VarName -> AnalysisM m ()
+incVarUsageCount var = do
+    bai <- get
+    let ucmap = mapVarUsageCount bai
+    put $ bai { mapVarUsageCount = Map.alter msucc var ucmap }
+ where
+    msucc = maybe (Just 1) (Just . succ)
+
+addEscapingVar :: TransformationMonad m => VarName -> AnalysisM m ()
+addEscapingVar var = do
+    bai <- get
+    let escs = setEscapingVars bai
+    put $ bai { setEscapingVars = Set.insert var escs }
+
 {-------------------------------------------------------------------------
- --
+ -- Helpers
  -}
 
-basicAnalysis :: TransformationMonad m => Ir -> StateT BasicAnalysisInfo m ()
-basicAnalysis ir = bottomUpTraversal_ trans ir
+whenVar :: Monad m => (VarName -> m ()) -> IrValue -> m ()
+whenVar f (VVAR fn) = f fn
+whenVar _ _ = return ()
+
+{-------------------------------------------------------------------------
+ -- Analysis
+ -}
+
+basicAnalysis_ :: TransformationMonad m => Ir -> AnalysisM m ()
+basicAnalysis_ ir = bottomUpTraversal_ (\_ -> trans) ir
  where
-    trans _ (FIX defs expr) = return ()
-    trans _ _               = fail "No match"
+    trans (APP fn acargs) = do
+        mapM_ (lift . whenVar addEscapingVar) acargs
+        mapM_ (lift . whenVar incVarUsageCount) acargs
+        lift $ whenVar incVarUsageCount fn
 
+    trans (PRIMOP pop ins outs _) = do
+        mapM_ (lift . addBby) outs
+     where
+        addBby vn = addVarBoundBy vn (BbyPRIMOP pop ins)
 
+    trans (FIX defs _) = do
+        mapM_ (lift . addBby) defs
+     where
+        addBby (fn, fnargs, fnbody) = do
+            addVarBoundBy fn (BbyFIX fnargs fnbody)
+            mapM_ (\vn -> addVarBoundBy vn BbyARG) fnargs
+
+    trans (SWITCH val _) = do
+        lift . whenVar incVarUsageCount $ val
+
+    trans (SELECT _ val vn _) = do
+        lift $ whenVar incVarUsageCount val
+        lift $ addVarBoundBy vn (BbySELECT)
+
+    trans (OFFSET _ val vn _) = do
+        lift $ whenVar incVarUsageCount val
+        lift $ addVarBoundBy vn (BbyOFFSET)
+
+    trans (RECORD fields vn _) = do
+        lift $ addVarBoundBy vn (BbyRECORD fields)
+        lift $ mapM_ (whenVar incVarUsageCount . fst) fields
+
+basicAnalysis :: TransformationMonad m => Ir -> m BasicAnalysisInfo
+basicAnalysis ir = do
+    execStateT (basicAnalysis_ ir) defaultBasicAnalysisInfo
+
+
+{-------------------------------------------------------------------------
+ -- Exported monad
+ -}
+
+newtype TransformationMonad m => WithBasicAnalysis m a
+    = MkWithBasicAnalysis (ReaderT BasicAnalysisInfo m a)
+    deriving (Monad, MonadTrans, FreshMonad, TransformationMonad)
+
+withBasicAnalysis :: TransformationMonad m => WithBasicAnalysis m a -> Ir -> m a
+withBasicAnalysis (MkWithBasicAnalysis m) ir = do
+    bai <- basicAnalysis ir
+    runReaderT m bai
+
+{-------------------------------------------------------------------------
+ -- Analysis data interface
+ -}
+
+isEscapingVar :: TransformationMonad m => VarName -> WithBasicAnalysis m Bool
+isEscapingVar vn = MkWithBasicAnalysis $ do
+    bai <- ask
+    return $ Set.member vn $ setEscapingVars bai
+
+varUsageCount :: TransformationMonad m => VarName -> WithBasicAnalysis m Int
+varUsageCount vn = MkWithBasicAnalysis $ do
+    bai <- ask
+    return $ Map.findWithDefault 0 vn (mapVarUsageCount bai)
+

File src/Selen/Compiler/CPS/Monad.hs

 import qualified Data.Set as Set
 import Data.Set (Set)
 import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
 import Selen.Compiler.CPS.Analysis.CFA0()
 
 {-------------------------------------------------------------------------
     tick            = lift tick
     getRoundNo      = lift getRoundNo
 
+
+instance TransformationMonad m => TransformationMonad (ReaderT s m) where
+    varUsedCount    = lift . varUsedCount
+    varEscapes      = lift . varEscapes
+    varBoundBy      = lift . varBoundBy
+    getFunc         = lift . getFunc
+    translog        = lift . translog
+    isIrreducible   = lift . isIrreducible
+    markIrreducible = lift . markIrreducible
+    tick            = lift tick
+    getRoundNo      = lift getRoundNo
+
 varIsUsed :: TransformationMonad m => VarName -> m Bool
 varIsUsed v = do
     uc <- varUsedCount v

File src/Selen/Compiler/CPS/Traversals.hs

             nfnbody <- walk nstack fnbody
             return (fn, fnargs, nfnbody)
 
-bottomUpTraversal_ :: TransformationMonad m => ([[VarName]] -> Ir -> MaybeT m ()) -> Ir -> m ()
+bottomUpTraversal_ :: Monad m => ([[VarName]] -> Ir -> MaybeT m ()) -> Ir -> m ()
 bottomUpTraversal_ trans = walk []
  where
     compute stack ir0 = do

File src/Selen/Control/FreshMonad.hs

 import Control.Monad
 import Control.Monad.Trans
 import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
 import Control.Monad.State
 import Control.Monad.Identity
 
 instance FreshMonad m => FreshMonad (StateT s m) where
     freshString = lift freshString
 
+instance FreshMonad m => FreshMonad (ReaderT s m) where
+    freshString = lift freshString
+
 instance MonadIO m => MonadIO (FreshT m) where
     liftIO m = FreshT (\s0 -> liftIO m >>= \a -> return (a,s0))