Fixed constant folding to resolve any user types involved

Due to awkward module dependencies, some functions had to be moved around to accommodate this change.  Two from Types have gone to EvalLiterals, and two to CompState.  Everything still compiles just as before though.

common/EvalConstants.hs

@@ -479,3 +479,4 @@ renderLiteral m t v
               es <- sequence [renderValue m fieldT v | (fieldT, v) <- zip ts vs]
               return (t, A.RecordLiteral m es)
 --}}}
+

common/EvalLiterals.hs

@@ -33,6 +33,7 @@ import qualified AST as A
 import CompState hiding (CSM) -- everything here is read-only
 import Errors
 import Metadata
+import Traversal
 import TypeSizes
 
 type EvalM = ErrorT ErrorReport (StateT CompState Identity)
@@ -107,8 +108,8 @@ fromRead m cons reader s
 
 -- | Evaluate a simple (non-array) literal.
 evalSimpleLiteral :: A.Expression -> EvalM OccValue
-evalSimpleLiteral (A.Literal _ t lr)
+evalSimpleLiteral (A.Literal m t lr)
-    = case t of
+    = underlyingType m t >>= \t' -> case t' of
         A.Infer  -> defaults
         A.Byte   -> into OccByte
         A.UInt16 -> into OccUInt16
@@ -172,3 +173,25 @@ evalByteLiteral _ cons ['*', ch]
 evalByteLiteral _ cons [ch]
     = return $ cons (fromIntegral $ ord ch)
 evalByteLiteral m _ _ = throwError (Just m, "Bad BYTE literal")
+
+-- | Resolve a datatype into its underlying type -- i.e. if it's a named data
+-- type, then return the underlying real type. This will recurse.
+underlyingType :: forall m. (CSMR m, Die m) => Meta -> A.Type -> m A.Type
+underlyingType m = applyDepthM doType
+  where
+    doType :: A.Type -> m A.Type
+    -- This is fairly subtle: after resolving a user type, we have to recurse
+    -- on the resulting type.
+    doType t@(A.UserDataType _) = resolveUserType m t >>= underlyingType m
+    doType t = return t
+
+-- | Like underlyingType, but only do the "outer layer": if you give this a
+-- user type that's an array of user types, then you'll get back an array of
+-- user types.
+resolveUserType :: (CSMR m, Die m) => Meta -> A.Type -> m A.Type
+resolveUserType m (A.UserDataType n)
+    =  do st <- specTypeOfName n
+          case st of
+            A.DataType _ t -> resolveUserType m t
+            _ -> dieP m $ "Not a type name: " ++ show n
+resolveUserType _ t = return t

common/Types.hs

@@ -61,11 +61,6 @@ class ASTTypeable a where
 instance ASTTypeable A.Type where
   astTypeOf = return
 
--- | Gets the 'A.SpecType' for a given 'A.Name' from the recorded types in the 'CompState'.  Dies with an error if the name is unknown.
-specTypeOfName :: (CSMR m, Die m) => A.Name -> m A.SpecType
-specTypeOfName n
-    = liftM A.ndSpecType (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find type in specTypeOfName for: " ++ (show $ A.nameName n))
-
 -- | Gets the 'A.AbbrevMode' for a given 'A.Name' from the recorded types in the 'CompState'.  Dies with an error if the name is unknown.
 abbrevModeOfName :: (CSMR m, Die m) => A.Name -> m A.AbbrevMode
 abbrevModeOfName n
@@ -381,28 +376,6 @@ abbrevModeOfSpec s
         A.RetypesExpr _ am _ _ -> am
         _ -> A.Original
 
--- | Resolve a datatype into its underlying type -- i.e. if it's a named data
--- type, then return the underlying real type. This will recurse.
-underlyingType :: forall m. (CSMR m, Die m) => Meta -> A.Type -> m A.Type
-underlyingType m = applyDepthM doType
-  where
-    doType :: A.Type -> m A.Type
-    -- This is fairly subtle: after resolving a user type, we have to recurse
-    -- on the resulting type.
-    doType t@(A.UserDataType _) = resolveUserType m t >>= underlyingType m
-    doType t = return t
-
--- | Like underlyingType, but only do the "outer layer": if you give this a
--- user type that's an array of user types, then you'll get back an array of
--- user types.
-resolveUserType :: (CSMR m, Die m) => Meta -> A.Type -> m A.Type
-resolveUserType m (A.UserDataType n)
-    =  do st <- specTypeOfName n
-          case st of
-            A.DataType _ t -> resolveUserType m t
-            _ -> dieP m $ "Not a type name: " ++ show n
-resolveUserType _ t = return t
-
 -- | Add array dimensions to a type; if it's already an array it'll just add
 -- the new dimensions to the existing array.
 addDimensions :: [A.Dimension] -> A.Type -> A.Type

data/CompState.hs

@@ -241,13 +241,6 @@ modifyName n f
 lookupName :: (CSMR m, Die m) => A.Name -> m A.NameDef
 lookupName n = lookupNameOrError n (dieP (findMeta n) $ "cannot find name " ++ A.nameName n)
 
-lookupNameOrError :: CSMR m => A.Name -> m A.NameDef -> m A.NameDef
-lookupNameOrError n err
-    =  do ps <- getCompState
-          case Map.lookup (A.nameName n) (csNames ps) of
-            Just nd -> return nd
-            Nothing -> err
-
 nameSource :: (CSMR m, Die m) => A.Name -> m A.NameSource
 nameSource n = lookupName n >>* A.ndNameSource
 
@@ -421,3 +414,16 @@ getUniqueIdentifer = do st <- get
                         let n = csUnifyId st
                         put st {csUnifyId = n + 1}
                         return n
+
+lookupNameOrError :: CSMR m => A.Name -> m A.NameDef -> m A.NameDef
+lookupNameOrError n err
+    =  do ps <- getCompState
+          case Map.lookup (A.nameName n) (csNames ps) of
+            Just nd -> return nd
+            Nothing -> err
+
+-- | Gets the 'A.SpecType' for a given 'A.Name' from the recorded types in the 'CompState'.  Dies with an error if the name is unknown.
+specTypeOfName :: (CSMR m, Die m) => A.Name -> m A.SpecType
+specTypeOfName n
+    = liftM A.ndSpecType (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find type in specTypeOfName for: " ++ (show $ A.nameName n))
+