diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 34dd268..2f8c7ac 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -351,7 +351,8 @@ postSubscripts t postSubscript :: A.Type -> OccParser A.Subscript postSubscript t = do m <- md - case t of + t' <- resolveUserType t + case t' of A.Record _ -> do f <- tryXV sLeft fieldName sRight @@ -367,7 +368,7 @@ maybeSliced inner subscripter typer = do m <- md (v, ff1) <- tryXVV sLeft inner fromOrFor - t <- typer v + t <- typer v >>= underlyingType case t of (A.Array _ _) -> return () _ -> fail $ "slice of non-array type " ++ show t @@ -1754,7 +1755,8 @@ caseProcess sCASE sel <- expression t <- typeOfExpression sel - when (not $ isCaseableType t) $ fail "case selector has non-CASEable type" + t' <- underlyingType t + when (not $ isCaseableType t') $ fail "case selector has non-CASEable type" eol os <- maybeIndentedList m "empty CASE" (caseOption t) return $ A.Case m sel (A.Several m os) diff --git a/fco2/Types.hs b/fco2/Types.hs index 9a22a0f..4344313 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -81,11 +81,13 @@ plainSubscriptType m sub (A.Array (d:ds) t) ok = case ds of [] -> t _ -> A.Array ds t -plainSubscriptType m _ _ = dieP m "subscript of non-array type" +plainSubscriptType m _ t = dieP m $ "subscript of non-array type " ++ show t -- | Apply a subscript to a type, and return what the type is after it's been -- subscripted. subscriptType :: (PSM m, Die m) => A.Subscript -> A.Type -> m A.Type +subscriptType sub t@(A.UserDataType _) + = resolveUserType t >>= subscriptType sub subscriptType (A.SubscriptFromFor m base count) t = sliceType m base count t subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t) @@ -203,16 +205,24 @@ abbrevModeOfSpec s _ -> A.Original -- | Resolve a datatype into its underlying type -- i.e. if it's a named data --- type, then return the underlying real type. +-- type, then return the underlying real type. This will recurse. underlyingType :: (PSM m, Die m) => A.Type -> m A.Type -underlyingType (A.UserDataType n) - = do st <- specTypeOfName n - case st of - A.DataType _ t -> underlyingType t - _ -> die $ "not a type name " ++ show n +underlyingType t@(A.UserDataType _) + = resolveUserType t >>= underlyingType underlyingType (A.Array ds t) = liftM (A.Array ds) (underlyingType t) underlyingType 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 :: (PSM m, Die m) => A.Type -> m A.Type +resolveUserType (A.UserDataType n) + = do st <- specTypeOfName n + case st of + A.DataType _ t -> resolveUserType t + _ -> die $ "not a type name " ++ show n +resolveUserType t = return t + -- | Add an array dimension to a type; if it's already an array it'll just add -- a new dimension to the existing array. makeArrayType :: A.Dimension -> A.Type -> A.Type