From 4551d97b28a3f80e7453f34c340876303724f230 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Thu, 3 May 2007 20:21:19 +0000
Subject: [PATCH] Make unsubscriptType produce the right types for slices

---
 fco2/Parse.hs |  1 +
 fco2/TODO     |  7 +++++++
 fco2/Types.hs | 12 +++++++++---
 3 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/fco2/Parse.hs b/fco2/Parse.hs
index c2fccde..ac650cd 100644
--- a/fco2/Parse.hs
+++ b/fco2/Parse.hs
@@ -7,6 +7,7 @@ import Control.Monad.State (MonadState, StateT, execStateT, liftIO, modify, get,
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe
+import Debug.Trace
 import qualified IO
 import Numeric (readHex)
 import Text.ParserCombinators.Parsec
diff --git a/fco2/TODO b/fco2/TODO
index 2f99193..53bd2d7 100644
--- a/fco2/TODO
+++ b/fco2/TODO
@@ -25,6 +25,13 @@ Add an option for whether to compile out overflow/bounds checks.
 
 ## Parser
 
+The way literal typing is done at the moment is a complete mess.
+We should probably have a smarter "can this literal be of this type?" function
+that walks both the wanted type and the parsed literal, and is smart about
+whether elements in an array are pure literals (in which case they can be
+type-coerced happily) or something else (in which case they must have the right
+type).
+
 Record literals aren't implemented.
 
 Inline C code should be supported; say something like "INLINE "C"" and the
diff --git a/fco2/Types.hs b/fco2/Types.hs
index 3d13a69..cd16ae8 100644
--- a/fco2/Types.hs
+++ b/fco2/Types.hs
@@ -8,6 +8,7 @@ import Control.Monad.State
 import Data.Generics
 import qualified Data.Map as Map
 import Data.Maybe
+import Debug.Trace
 
 import qualified AST as A
 import Errors
@@ -108,11 +109,11 @@ subscriptType _ t = die $ "unsubscriptable type: " ++ show t
 -- a subscript, return what the type being subscripted is.
 unsubscriptType :: (PSM m, Die m) => A.Subscript -> A.Type -> m A.Type
 unsubscriptType (A.SubscriptFromFor _ _ _) t
-    = return t
+    = return $ removeFixedDimension t
 unsubscriptType (A.SubscriptFrom _ _) t
-    = return t
+    = return $ removeFixedDimension t
 unsubscriptType (A.SubscriptFor _ _) t
-    = return t
+    = return $ removeFixedDimension t
 unsubscriptType (A.SubscriptField _ _) t
     = die $ "unsubscript of record type (but we can't tell which one)"
 unsubscriptType (A.Subscript _ sub) t
@@ -249,6 +250,11 @@ stripArrayType :: A.Type -> A.Type
 stripArrayType (A.Array _ t) = stripArrayType t
 stripArrayType t = t
 
+-- | Remove one fixed dimension from a type.
+removeFixedDimension :: A.Type -> A.Type
+removeFixedDimension (A.Array (A.Dimension _:ds) t) = A.Array (A.UnknownDimension:ds) t
+removeFixedDimension t = t
+
 -- | Remove any fixed array dimensions from a type.
 removeFixedDimensions :: A.Type -> A.Type
 removeFixedDimensions (A.Array ds t) = A.Array [A.UnknownDimension | _ <- ds] t