From 9f5b685c026d08456dc434cd3c9afb75e8870145 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Tue, 31 Mar 2009 11:51:02 +0000
Subject: [PATCH] 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).
---
 transformations/Unnest.hs | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

diff --git a/transformations/Unnest.hs b/transformations/Unnest.hs
index 2a3f458..24965a6 100644
--- a/transformations/Unnest.hs
+++ b/transformations/Unnest.hs
@@ -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