From 74e3f616147501a81a8f1bd81c6e4772405269a2 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Fri, 27 Mar 2009 16:24:15 +0000
Subject: [PATCH] Fixed arrays of user data types that are arrays to be
 flattened into a multidimensional array, rather than an array of arrays

---
 transformations/SimplifyTypes.hs | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/transformations/SimplifyTypes.hs b/transformations/SimplifyTypes.hs
index ad0e786..1ff5af7 100644
--- a/transformations/SimplifyTypes.hs
+++ b/transformations/SimplifyTypes.hs
@@ -32,6 +32,7 @@ import Pass
 import qualified Properties as Prop
 import Traversal
 import Types
+import Utils
 
 simplifyTypes :: [Pass]
 simplifyTypes
@@ -45,13 +46,13 @@ resolveNamedTypes
            (Prop.agg_namesDone
             ++ [Prop.expressionTypesChecked, Prop.processTypesChecked])
            [Prop.typesResolvedInAST, Prop.typesResolvedInState]
-           (\t -> do get >>= resolve >>= resolve_csNames >>= put
-                     resolve t)
+           (\t -> do get >>= resolve >>= flatten >>= onCsNames (flatten <.< resolve) >>= put
+                     resolve t >>= flatten)
   where
     -- Work-around for data types not being resolved:
-    resolve_csNames :: Transform CompState
-    resolve_csNames cs = do csNames' <- T.mapM resolve $ csNames cs
-                            return $ cs { csNames = csNames' }
+    onCsNames :: Transform A.NameDef -> Transform CompState
+    onCsNames f cs = do csNames' <- T.mapM f $ csNames cs
+                        return $ cs { csNames = csNames' }
     
     resolve :: PassType
     resolve = applyDepthM doType
@@ -59,3 +60,10 @@ resolveNamedTypes
         doType :: A.Type -> PassM A.Type
         doType t@(A.UserDataType _) = underlyingType emptyMeta t
         doType t = return t
+
+    flatten :: PassType
+    flatten = applyDepthM doType
+      where
+        doType :: Transform A.Type
+        doType (A.Array dsA (A.Array dsB t)) = return $ A.Array (dsA++dsB) t
+        doType t = return t