From dbc1b461a48e8b8eda4427ef3c1d30dac727b181 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 2 Apr 2009 20:02:11 +0000 Subject: [PATCH] Made makeNonce use the munged meta-tag, to stop wrapper PROCs from different files having name clashes at link-time --- backends/BackendPasses.hs | 8 ++++---- backends/GenerateC.hs | 26 +++++++++++++------------- backends/GenerateCPPCSP.hs | 24 ++++++++++++------------ data/CompState.hs | 17 +++++++++-------- frontends/RainPasses.hs | 6 +++--- transformations/Unnest.hs | 2 +- 6 files changed, 42 insertions(+), 41 deletions(-) diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index 70e7014..097898f 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -140,7 +140,7 @@ transformWaitFor = cOnlyPass "Transform wait for guards into wait until guards" doWaitFor :: Meta -> A.Alternative -> StateT ([A.Structured A.Process -> A.Structured A.Process], [A.Structured A.Process]) PassM (A.Structured A.Alternative) doWaitFor m'' a@(A.Alternative m cond tim (A.InputTimerFor m' e) p) = do (specs, init) <- get - id <- lift $ makeNonce "waitFor" + id <- lift $ makeNonce m "waitFor" let n = A.Name m id let var = A.Variable m n put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time))], @@ -338,7 +338,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays" case (spec, t) of (_, Just (A.Array ds elemT)) -> -- nonce_sizes is a suggested name, may not actually be used: - do nonce_sizes <- makeNonce (A.nameName n ++ "_sizes") >>* A.Name m + do nonce_sizes <- makeNonce m (A.nameName n ++ "_sizes") >>* A.Name m let varSize = varSizes m nonce_sizes (n_sizes, msizeSpec) <- case spec of @@ -385,7 +385,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays" = case (t, ext) of -- For externals, we always add extra formals (one per dimension!): (A.Array ds _, Just ExternalOldStyle) -> - do params <- replicateM (length ds) $ makeNonce "ext_size" + do params <- replicateM (length ds) $ makeNonce m "ext_size" let newfs = map (A.Formal A.ValAbbrev A.Int . A.Name m) params (rest, moreNew) <- transformFormals ext m fs return (f : newfs ++ rest, newfs ++ moreNew) @@ -395,7 +395,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays" (A.Array ds _, _) | A.UnknownDimension `elem` ds -> do let sizeType = A.Array [makeDimension m $ length ds] A.Int - n_sizes <- makeNonce (A.nameName n ++ "_sizes") >>* A.Name m + n_sizes <- makeNonce m (A.nameName n ++ "_sizes") >>* A.Name m addSizes (A.nameName n) n_sizes let newf = A.Formal A.ValAbbrev sizeType n_sizes (rest, moreNew) <- transformFormals ext m fs diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 56b79e6..ff2fcdb 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -202,9 +202,9 @@ cgenTopLevel headerName s when (csHasMain cs) $ do (tlpName, tlpChans) <- tlpInterface - chans <- sequence [csmLift $ makeNonce "tlp_channel" | _ <- tlpChans] - killChans <- sequence [csmLift $ makeNonce "tlp_channel_kill" | _ <- tlpChans] - workspaces <- sequence [csmLift $ makeNonce "tlp_channel_ws" | _ <- tlpChans] + chans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel" | _ <- tlpChans] + killChans <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_kill" | _ <- tlpChans] + workspaces <- sequence [csmLift $ makeNonce emptyMeta "tlp_channel_ws" | _ <- tlpChans] tell ["void tock_main (Workspace wptr) {\n"] @@ -1167,7 +1167,7 @@ cgenReplicatorLoop index (A.For m base count step) -- simple loop (without an additional counter), because step may be -- negative (and that may be determined at run-time. So we will generate the -- most general loop, and let the C compiler optimise if possibe: - = do counter <- csmLift $ makeNonce "replicator_count" + = do counter <- csmLift $ makeNonce m "replicator_count" tell ["int ", counter, "="] call genExpression count tell [","] @@ -1351,7 +1351,7 @@ cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualVariable v))) tell ["="] rhs tell [";"] -cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualExpression e))) +cintroduceSpec lvl (A.Specification m n (A.Is _ am t (A.ActualExpression e))) = do let rhs = abbrevExpression am t e case (am, t, e) of (A.ValAbbrev, A.Array _ ts, A.Literal _ _ _) -> @@ -1368,7 +1368,7 @@ cintroduceSpec lvl (A.Specification _ n (A.Is _ am t (A.ActualExpression e))) (A.ValAbbrev, A.Record _, A.Literal _ _ _) -> -- Record literals are even trickier, because there's no way of -- directly writing a struct literal in C that you can use -> on. - do tmp <- csmLift $ makeNonce "record_literal" + do tmp <- csmLift $ makeNonce m "record_literal" genStatic lvl n tell ["const "] genType t @@ -1638,7 +1638,7 @@ cgenProcAlloc n fs as return $ zip (repeat s) $ realActuals f a fct | (f@(A.Formal am t _), a) <- zip fs as] - ws <- csmLift $ makeNonce "workspace" + ws <- csmLift $ makeNonce (A.nameMeta n) "workspace" tell ["Workspace ", ws, " = TockProcAlloc (wptr, ", show $ length ras, ", "] genName n tell ["_stack_size);\n"] @@ -1827,7 +1827,7 @@ cgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain call genStop m "no choice matched in IF process" tell ["}"] | otherwise - = do label <- csmLift $ makeNonce "if_end" + = do label <- csmLift $ makeNonce m "if_end" tell ["/*",label,"*/"] genIfBody label s call genStop m "no choice matched in IF process" @@ -1902,10 +1902,10 @@ cgenWhile e p -- the same as PAR. cgenPar :: A.ParMode -> A.Structured A.Process -> CGen () cgenPar pm s - = do bar <- csmLift $ makeNonce "par_barrier" + = do bar <- csmLift $ makeNonce emptyMeta "par_barrier" tell ["LightProcBarrier ", bar, ";"] let count = countStructured s - wss <- csmLift $ makeNonce "wss" + wss <- csmLift $ makeNonce emptyMeta "wss" tell ["Workspace* ",wss,"=(Workspace*)malloc(sizeof(int)*"] call genExpression count tell [");"] @@ -1936,7 +1936,7 @@ cgenPar pm s --{{{ alt cgenAlt :: Bool -> A.Structured A.Alternative -> CGen () cgenAlt isPri s - = do id <- csmLift $ makeNonce "alt_id" + = do id <- csmLift $ makeNonce emptyMeta "alt_id" tell ["int ", id, " = 0;\n"] let isTimerAlt = containsTimers s @@ -1952,10 +1952,10 @@ cgenAlt isPri s genAltDisable id s tell ["}\n"] - fired <- csmLift $ makeNonce "alt_fired" + fired <- csmLift $ makeNonce emptyMeta "alt_fired" tell ["int ", fired, " = AltEnd (wptr);\n"] tell [id, " = 0;\n"] - label <- csmLift $ makeNonce "alt_end" + label <- csmLift $ makeNonce emptyMeta "alt_end" tell ["{\n"] genAltProcesses id fired label s tell ["}\n"] diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 0c94820..f1864c0 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -276,14 +276,14 @@ Otherwise, it must not have. -} genCPPCSPTime :: A.Expression -> CGen String genCPPCSPTime e - = do time <- csmLift $ makeNonce "time_exp" + = do time <- csmLift $ makeNonce emptyMeta "time_exp" tell ["unsigned ",time," = (unsigned)"] call genExpression e tell [" ; "] - curTime <- csmLift $ makeNonce "time_exp" - curTimeLow <- csmLift $ makeNonce "time_exp" - curTimeHigh <- csmLift $ makeNonce "time_exp" - retTime <- csmLift $ makeNonce "time_exp" + curTime <- csmLift $ makeNonce emptyMeta "time_exp" + curTimeLow <- csmLift $ makeNonce emptyMeta "time_exp" + curTimeHigh <- csmLift $ makeNonce emptyMeta "time_exp" + retTime <- csmLift $ makeNonce emptyMeta "time_exp" tell ["double ",curTime," = csp::GetSeconds(csp::CurrentTime());"] tell ["unsigned ",curTimeLow," = (unsigned)remainder(1000000.0 * ",curTime,",4294967296.0);"] tell ["unsigned ",curTimeHigh," = (unsigned)((1000000.0 * ",curTime,") / 4294967296.0);"] @@ -383,7 +383,7 @@ cppgenOutputCase c tag ois --We use forking instead of Run\/InParallelOneThread, because it is easier to use forking with replication. cppgenPar :: A.ParMode -> A.Structured A.Process -> CGen () cppgenPar _ s - = do forking <- csmLift $ makeNonce "forking" + = do forking <- csmLift $ makeNonce emptyMeta "forking" tell ["{ csp::ScopedForking ",forking," ; "] call genStructured NotTopLevel s (genPar' forking) tell [" }"] @@ -405,17 +405,17 @@ cppgenPar _ s -- | Changed to use C++CSP's Alternative class: cppgenAlt :: Bool -> A.Structured A.Alternative -> CGen () cppgenAlt _ s - = do guards <- csmLift $ makeNonce "alt_guards" + = do guards <- csmLift $ makeNonce emptyMeta "alt_guards" tell ["std::list< csp::Guard* > ", guards, " ; "] initAltGuards guards s - alt <- csmLift $ makeNonce "alt" + alt <- csmLift $ makeNonce emptyMeta "alt" tell ["csp::Alternative ",alt, " ( ", guards, " ); "] - id <- csmLift $ makeNonce "alt_id" + id <- csmLift $ makeNonce emptyMeta "alt_id" tell ["int ", id, " = 0;\n"] - fired <- csmLift $ makeNonce "alt_fired" + fired <- csmLift $ makeNonce emptyMeta "alt_fired" tell ["int ", fired, " = ", alt, " .priSelect();"] - label <- csmLift $ makeNonce "alt_end" + label <- csmLift $ makeNonce emptyMeta "alt_end" tell ["{\n"] genAltProcesses id fired label s tell ["}\n"] @@ -831,7 +831,7 @@ cppgenIf m s | justOnly s = do call genStructured NotTopLevel s doCplain call genStop m "no choice matched in IF process" tell ["}"] | otherwise - = do ifExc <- csmLift $ makeNonce "if_exc" + = do ifExc <- csmLift $ makeNonce emptyMeta "if_exc" tell ["class ",ifExc, "{};try{"] genIfBody ifExc s call genStop m "no choice matched in IF process" diff --git a/data/CompState.hs b/data/CompState.hs index d354aad..7ed17b7 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -261,12 +261,13 @@ nameSource n = lookupName n >>* A.ndNameSource -- | Make a name unique by appending a suffix to it. makeUniqueName :: CSM m => Meta -> String -> m String makeUniqueName m s - = let mungedFile = munge $ show m in return $ s ++ "_" ++ mungedFile - where - munge cs = [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']) + = let mungedFile = mungeMeta m in return $ s ++ "_" ++ mungedFile + +mungeMeta :: Meta -> String +mungeMeta m = [if c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']) then c else '_' - | c <- cs] + | c <- show m] -- | Find an unscoped name -- or define a new one if it doesn't already exist. findUnscopedName :: CSM m => A.Name -> m A.Name @@ -350,17 +351,17 @@ getTypeContext --{{{ nonces -- | Generate a throwaway unique name. -makeNonce :: CSM m => String -> m String -makeNonce s +makeNonce :: CSM m => Meta -> String -> m String +makeNonce m s = do ps <- get let i = csNonceCounter ps put ps { csNonceCounter = i + 1 } - return $ s ++ "_n" ++ show i + return $ s ++ mungeMeta m ++ "_n" ++ show i -- | Generate and define a nonce specification. defineNonce :: CSM m => Meta -> String -> A.SpecType -> A.AbbrevMode -> m A.Specification defineNonce m s st am - = do ns <- makeNonce s + = do ns <- makeNonce m s let n = A.Name m ns let nd = A.NameDef { A.ndMeta = m, diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index cf0b071..bfb5a4b 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -106,7 +106,7 @@ uniquifyAndResolveVars = rainOnlyPass --Variable declarations and replicators: uniquifyAndResolveVars' (A.Spec m (A.Specification m' n decl) scope) - = do n' <- makeNonce $ A.nameName n + = do n' <- makeNonce m $ A.nameName n defineName (n {A.nameName = n'}) A.NameDef {A.ndMeta = m', A.ndName = n', A.ndOrigName = A.nameName n, A.ndSpecType = decl, A.ndNameSource = A.NameUser, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced} @@ -126,7 +126,7 @@ uniquifyAndResolveVars = rainOnlyPass return ((f':fs'),s'') doFormals' :: Data t => A.Formal -> t -> PassM (A.Formal,t) doFormals' (A.Formal am t n) scope - = do n' <- makeNonce $ A.nameName n + = do n' <- makeNonce (A.nameMeta n) $ A.nameName n let newName = (n {A.nameName = n'}) let m = A.nameMeta n defineName newName A.NameDef {A.ndMeta = m, A.ndName = n', A.ndOrigName = A.nameName n, @@ -150,7 +150,7 @@ findMain :: Pass --Therefore this pass doesn't actually need to walk the tree, it just has to look for a process named "main" --in the CompState, and pull it out into csMainLocals findMain = rainOnlyPass "Find and tag the main function" Prop.agg_namesDone [Prop.mainTagged] - ( \x -> do newMainName <- makeNonce "main_" + ( \x -> do newMainName <- makeNonce emptyMeta "main_" modify (findMain' newMainName) applyDepthM (return . (replaceNameName "main" newMainName)) x) where diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs index 8be69f8..db61bec 100644 --- a/transformations/Unnest.hs +++ b/transformations/Unnest.hs @@ -133,7 +133,7 @@ removeFreeNames = pass "Convert free names to arguments" let ams = map makeAbbrevAM origAMs -- Generate and define new names to replace them with - newNamesS <- sequence [makeNonce (A.nameName n) | n <- freeNames] + newNamesS <- sequence [makeNonce (A.nameMeta n) (A.nameName n) | n <- freeNames] let newNames = [on { A.nameName = nn } | (on, nn) <- zip freeNames newNamesS] onds <- mapM (\n -> lookupNameOrError n $ dieP mp $ "Could not find recorded type for free name: " ++ (show $ A.nameName n)) freeNames sequence_ [defineName nn (ond { A.ndName = A.nameName nn,