Corrected a nasty problem with pulling up free names into arguments

The problem was that the free name could involved in an array dimension (and hence a type) of something in the PROC.  When the name was then replaced in the type, CompState was not updated to have the new type, and instead kept the old type (potentially) all the way through to the backend, where it might be used for checking the bounds of an array index (against the old name taken from CompState, not the replaced name).
This commit is contained in:
Neil Brown 2009-03-31 11:51:02 +00:00
parent 334d22acd8
commit 9f5b685c02

View File

@ -35,6 +35,7 @@ import Pass
import qualified Properties as Prop
import Traversal
import Types
import Utils
unnest :: [Pass]
unnest =
@ -76,14 +77,35 @@ freeNamesIn = doGeneric
doSpecType st = doGeneric st
-- | Replace names.
replaceNames :: Data t => [(A.Name, A.Name)] -> t -> t
replaceNames map v = runIdentity $ applyDepthM doName v
--
-- This has to have extra cleverness due to a really nasty bug. Array types can
-- have expressions as dimensions, and those expressions can contain free names
-- which are being replaced. This is fine, but when that happens we need to update
-- CompState so that the type has the replaced name, not the old name.
replaceNames :: Data t => [(A.Name, A.Name)] -> t -> PassM t
replaceNames map v = recurse v
where
smap = Map.fromList [(A.nameName f, t) | (f, t) <- map]
doName :: A.Name -> Identity A.Name
ops :: Ops
ops = baseOp `extOp` doName `extOp` doSpecification
recurse :: Data a => Transform a
recurse = makeRecurse ops
doName :: Transform A.Name
doName n = return $ Map.findWithDefault n (A.nameName n) smap
doSpecification :: Transform A.Specification
doSpecification (A.Specification m n sp)
= do prevT <- typeOfSpec sp
n' <- doName n
sp' <- recurse sp
afterT <- typeOfSpec sp'
-- The only way the type will change is if there was a name replace:
when (prevT /= afterT) $
modifyName n' $ \nd -> nd { A.ndSpecType = sp' }
return $ A.Specification m n' sp'
-- | Turn free names in PROCs into arguments.
removeFreeNames :: Pass
removeFreeNames = pass "Convert free names to arguments"
@ -120,7 +142,7 @@ removeFreeNames = pass "Convert free names to arguments"
-- Add formals for each of the free names
let newFs = [A.Formal am t n | (am, t, n) <- zip3 ams types newNames]
let st' = A.Proc mp sm (fs ++ newFs) $ replaceNames (zip freeNames newNames) p
st' <- replaceNames (zip freeNames newNames) p >>* A.Proc mp sm (fs ++ newFs)
let spec' = A.Specification m n st'
-- Update the definition of the proc