Changed csParProcs to be a map that indicates whether the process is a wrapper for FORK or PAR

This commit is contained in:
Neil Brown 2009-04-16 10:25:02 +00:00
parent 2af2563773
commit ff9cabd80b
4 changed files with 13 additions and 7 deletions

View File

@ -1581,7 +1581,7 @@ realFormals (A.Formal am t n)
genProcSpec :: Level -> A.Name -> A.SpecType -> Bool -> CGen () genProcSpec :: Level -> A.Name -> A.SpecType -> Bool -> CGen ()
genProcSpec lvl n (A.Proc _ (sm, rm) fs (Just p)) forwardDecl genProcSpec lvl n (A.Proc _ (sm, rm) fs (Just p)) forwardDecl
= do cs <- getCompState = do cs <- getCompState
let (header, params) = if n `Set.member` csParProcs cs let (header, params) = if n `Map.member` csParProcs cs
|| rm == A.Recursive || rm == A.Recursive
then (genParHeader, genParParams) then (genParHeader, genParParams)
else (genNormalHeader, return ()) else (genNormalHeader, return ())

View File

@ -71,6 +71,10 @@ data NameType =
-- | An item that has been pulled up. -- | An item that has been pulled up.
type PulledItem = (Meta, Either A.Specification A.Process) -- Either Spec or ProcThen type PulledItem = (Meta, Either A.Specification A.Process) -- Either Spec or ProcThen
-- | Whether a wrapper is for a FORK or a PAR
data ParOrFork = ParWrapper | ForkWrapper
deriving (Show, Eq, Typeable, Data)
-- | An index to identify an item involved in the type unification. -- | An index to identify an item involved in the type unification.
newtype UnifyIndex = UnifyIndex (Meta, Either Int A.Name) newtype UnifyIndex = UnifyIndex (Meta, Either Int A.Name)
deriving (Typeable, Data) deriving (Typeable, Data)
@ -154,7 +158,7 @@ data CompState = CompState {
csFunctionReturns :: Map String [A.Type], csFunctionReturns :: Map String [A.Type],
csPulledItems :: [[PulledItem]], csPulledItems :: [[PulledItem]],
csAdditionalArgs :: Map String [A.Actual], csAdditionalArgs :: Map String [A.Actual],
csParProcs :: Set A.Name, csParProcs :: Map A.Name ParOrFork,
csUnifyId :: Int, csUnifyId :: Int,
-- The string is the operator, the name is the munged function name -- The string is the operator, the name is the munged function name
csOperators :: [(String, A.Name, [A.Type])], csOperators :: [(String, A.Name, [A.Type])],
@ -215,7 +219,7 @@ emptyState = CompState {
csFunctionReturns = Map.empty, csFunctionReturns = Map.empty,
csPulledItems = [], csPulledItems = [],
csAdditionalArgs = Map.empty, csAdditionalArgs = Map.empty,
csParProcs = Set.empty, csParProcs = Map.empty,
csUnifyId = 0, csUnifyId = 0,
csOperators = [], csOperators = [],
csWarnings = [] csWarnings = []

View File

@ -42,6 +42,7 @@ main = do
, genMapInstance (undefined :: String) (undefined :: [AST.Type]) , genMapInstance (undefined :: String) (undefined :: [AST.Type])
, genMapInstance (undefined :: String) (undefined :: [AST.Actual]) , genMapInstance (undefined :: String) (undefined :: [AST.Actual])
, genMapInstance (undefined :: String) (undefined :: Set.Set CompState.NameAttr) , genMapInstance (undefined :: String) (undefined :: Set.Set CompState.NameAttr)
, genMapInstance (undefined :: AST.Name) (undefined :: CompState.ParOrFork)
-- All the sets that are in CompState: -- All the sets that are in CompState:
, genSetInstance (undefined :: Errors.WarningType) , genSetInstance (undefined :: Errors.WarningType)
, genSetInstance (undefined :: String) , genSetInstance (undefined :: String)

View File

@ -21,6 +21,7 @@ module SimplifyProcs (simplifyProcs, fixLowReplicators) where
import Control.Monad.State import Control.Monad.State
import Data.Generics (Data) import Data.Generics (Data)
import qualified Data.Map as Map
import Data.Maybe import Data.Maybe
import qualified Data.Set as Set import qualified Data.Set as Set
@ -122,16 +123,16 @@ parsToProcs = pass "Wrap PAR subprocesses in PROCs"
= do s' <- doStructured s = do s' <- doStructured s
return $ A.Par m pm s' return $ A.Par m pm s'
doProcess (A.Fork m n p) doProcess (A.Fork m n p)
= wrapProcess (A.Fork m n) m p >>* A.Seq m = wrapProcess (A.Fork m n, ForkWrapper) m p >>* A.Seq m
doProcess p = return p doProcess p = return p
-- FIXME This should be generic and in Pass. -- FIXME This should be generic and in Pass.
doStructured :: A.Structured A.Process -> PassM (A.Structured A.Process) doStructured :: A.Structured A.Process -> PassM (A.Structured A.Process)
doStructured = transformOnly (wrapProcess id) doStructured = transformOnly (wrapProcess (id, ParWrapper))
wrapProcess wrap m p wrapProcess (wrap, ty) m p
= do s@(A.Specification _ n _) <- makeNonceProc m p = do s@(A.Specification _ n _) <- makeNonceProc m p
modify (\cs -> cs { csParProcs = Set.insert n (csParProcs cs) }) modify (\cs -> cs { csParProcs = Map.insert n ty (csParProcs cs) })
return $ A.Spec m s (A.Only m (wrap $ A.ProcCall m n [])) return $ A.Spec m s (A.Only m (wrap $ A.ProcCall m n []))
-- | Turn parallel assignment into multiple single assignments through temporaries. -- | Turn parallel assignment into multiple single assignments through temporaries.