Skip to content
4 changes: 2 additions & 2 deletions ssm.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: a0f8bd48de2115636fda8c0f782dfcf3b71c53ec06ad80fd9bbef24a1a513322
-- hash: 0ad0929e4602c4758fd406557510901ce0830bde9d2ee8f0ed2215c9aa709b01

name: ssm
version: 0.1.0.0
Expand All @@ -27,6 +27,7 @@ source-repository head

library
exposed-modules:
SSM.Backend.C.Analysis.WaitAnalysis
SSM.Backend.C.CodeGen
SSM.Backend.C.Compile
SSM.Backend.C.Exp
Expand All @@ -47,7 +48,6 @@ library
SSM.Language
SSM.Pretty
SSM.Pretty.Syntax
SSM.TestProgram
SSM.Util.Default
SSM.Util.HughesList
SSM.Util.Operators
Expand Down
87 changes: 87 additions & 0 deletions ssm/SSM/Backend/C/Analysis/WaitAnalysis.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,87 @@
{- | This module implements different strategies that are used to assign triggers to
sensitize/desensitize statements. The current strategy, `primitiveTriggerIDs`, work by
taking a naive approach and assigns a unique trigger to each reference that sensitizes
at least once.
-}
module SSM.Backend.C.Analysis.WaitAnalysis
( primitiveTriggerIDs
) where

import SSM.Backend.C.Types ( CStm(..) )
import SSM.Core.Syntax ( Procedure(body)
, Reference
, Stm
( Desensitize
, If
, Sensitize
, While
)
)

import Control.Monad.State ( State
, execState
, get
, gets
, modify
, put
, runState
)

import qualified Data.Map as Map

-- | State for the primitive trigger scheme
type PrimSt
= ( Int
, Map.Map Reference Int
, Map.Map (Reference, Int) Int
, Map.Map (Reference, Int) Int
)

{- | Return a triple containing

1. How many unique triggers are used
2. A map that associates @(Reference, Int)@ -pairs with trigger IDs to use when
sensitizing
3. A map that associates @(Reference, Int)@ -pairs with trigger IDs to use when
desensitizing.
-}
primitiveTriggerIDs
:: [CStm] -> (Int, Map.Map (Reference, Int) Int, Map.Map (Reference, Int) Int)
primitiveTriggerIDs stmts =
let st = (0, Map.empty, Map.empty, Map.empty)
(ww, _, se, de) =
execState (go stmts) (0, Map.empty, Map.empty, Map.empty)
in (ww, se, de)
where
go :: [CStm] -> State PrimSt ()
go stmts = flip mapM_ stmts $ \x -> case x of
Numbered n (Sensitize r) -> recordSensitize r n
Numbered n (Desensitize r) -> recordDesensitize r n
Numbered n stm -> return ()
CWhile n c bdy -> go bdy
CIf n c thn els -> go thn >> go els

{- | Look up the unique trigger associated with a reference. If none exist yet,
generate one and return that one. -}
lookupTrigID :: Reference -> State PrimSt Int
lookupTrigID r = do
(i, m1, m2, m3) <- get
case Map.lookup r m1 of
Just id -> return id
Nothing -> do
put (i + 1, Map.insert r (i + 1) m1, m2, m3)
return $ i + 1

-- | Record the information that the reference @r@ on statement @n@ is sensitized
recordSensitize :: Reference -> Int -> State PrimSt ()
recordSensitize r n = do
tid <- lookupTrigID r
(i, m1, m2, m3) <- get
put (i, m1, Map.insert (r, n) tid m2, m3)

-- | Record the information that the reference @r@ on statement @n@ is desensitized
recordDesensitize :: Reference -> Int -> State PrimSt ()
recordDesensitize r n = do
tid <- lookupTrigID r
(i, m1, m2, m3) <- get
put (i, m1, m2, Map.insert (r, n) tid m3)
Loading