Better reporting of invalid subscripts

This commit is contained in:
Adam Sampson 2007-04-27 18:39:32 +00:00
parent 3c8f79b2e8
commit 5e32facc59

View File

@ -36,8 +36,8 @@ typeOfName n
--{{{ identifying types --{{{ identifying types
-- | Apply a slice to a type. -- | Apply a slice to a type.
sliceType :: (PSM m, Die m) => A.Expression -> A.Expression -> A.Type -> m A.Type sliceType :: (PSM m, Die m) => Meta -> A.Expression -> A.Expression -> A.Type -> m A.Type
sliceType base count (A.Array (d:ds) t) sliceType m base count (A.Array (d:ds) t)
= case (isConstant base, isConstant count) of = case (isConstant base, isConstant count) of
(True, True) -> (True, True) ->
do b <- evalIntExpression base do b <- evalIntExpression base
@ -45,7 +45,7 @@ sliceType base count (A.Array (d:ds) t)
case d of case d of
A.Dimension size -> A.Dimension size ->
if (size - b) < c if (size - b) < c
then die "invalid slice" then dieP m $ "invalid slice " ++ show b ++ " -> " ++ show c ++ " of " ++ show size
else return $ A.Array (A.Dimension c : ds) t else return $ A.Array (A.Dimension c : ds) t
A.UnknownDimension -> A.UnknownDimension ->
return $ A.Array (A.Dimension c : ds) t return $ A.Array (A.Dimension c : ds) t
@ -54,50 +54,50 @@ sliceType base count (A.Array (d:ds) t)
do c <- evalIntExpression count do c <- evalIntExpression count
return $ A.Array (A.Dimension c : ds) t return $ A.Array (A.Dimension c : ds) t
(False, False) -> return $ A.Array (A.UnknownDimension : ds) t (False, False) -> return $ A.Array (A.UnknownDimension : ds) t
sliceType _ _ _ = die "slice of non-array type" sliceType m _ _ _ = dieP m "slice of non-array type"
-- | Get the type of a record field. -- | Get the type of a record field.
typeOfRecordField :: (PSM m, Die m) => A.Type -> A.Name -> m A.Type typeOfRecordField :: (PSM m, Die m) => Meta -> A.Type -> A.Name -> m A.Type
typeOfRecordField (A.UserDataType rec) field typeOfRecordField m (A.UserDataType rec) field
= do st <- specTypeOfName rec = do st <- specTypeOfName rec
case st of case st of
A.DataTypeRecord _ _ fs -> checkJust "unknown record field" $ lookup field fs A.DataTypeRecord _ _ fs -> checkJust "unknown record field" $ lookup field fs
_ -> die "not record type" _ -> dieP m "not record type"
typeOfRecordField _ _ = die "not record type" typeOfRecordField m _ _ = dieP m "not record type"
-- | Apply a plain subscript to a type. -- | Apply a plain subscript to a type.
plainSubscriptType :: (PSM m, Die m) => A.Expression -> A.Type -> m A.Type plainSubscriptType :: (PSM m, Die m) => Meta -> A.Expression -> A.Type -> m A.Type
plainSubscriptType sub (A.Array (d:ds) t) plainSubscriptType m sub (A.Array (d:ds) t)
= case (isConstant sub, d) of = case (isConstant sub, d) of
(True, A.Dimension size) -> (True, A.Dimension size) ->
do i <- evalIntExpression sub do i <- evalIntExpression sub
if (i < 0) || (i >= size) if (i < 0) || (i >= size)
then die "invalid subscript" then dieP m $ "invalid subscript " ++ show i ++ " of " ++ show size
else return ok else return ok
_ -> return ok _ -> return ok
where where
ok = case ds of ok = case ds of
[] -> t [] -> t
_ -> A.Array ds t _ -> A.Array ds t
plainSubscriptType _ _ = die "subscript of non-array type" plainSubscriptType m _ _ = dieP m "subscript of non-array type"
-- | Apply a subscript to a type, and return what the type is after it's been -- | Apply a subscript to a type, and return what the type is after it's been
-- subscripted. -- subscripted.
subscriptType :: (PSM m, Die m) => A.Subscript -> A.Type -> m A.Type subscriptType :: (PSM m, Die m) => A.Subscript -> A.Type -> m A.Type
subscriptType (A.SubscriptFromFor _ base count) t subscriptType (A.SubscriptFromFor m base count) t
= sliceType base count t = sliceType m base count t
subscriptType (A.SubscriptFrom _ base) (A.Array (d:ds) t) subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t)
= case (isConstant base, d) of = case (isConstant base, d) of
(True, A.Dimension size) -> (True, A.Dimension size) ->
do b <- evalIntExpression base do b <- evalIntExpression base
if (size - b) < 0 if (size - b) < 0
then die "invalid slice" then dieP m $ "invalid slice " ++ show b ++ " -> end of " ++ show size
else return $ A.Array (A.Dimension (size - b) : ds) t else return $ A.Array (A.Dimension (size - b) : ds) t
_ -> return $ A.Array (A.UnknownDimension : ds) t _ -> return $ A.Array (A.UnknownDimension : ds) t
subscriptType (A.SubscriptFor _ count) t subscriptType (A.SubscriptFor m count) t
= sliceType (makeConstant emptyMeta 0) count t = sliceType m (makeConstant emptyMeta 0) count t
subscriptType (A.SubscriptField _ tag) t = typeOfRecordField t tag subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
subscriptType (A.Subscript _ sub) t = plainSubscriptType sub t subscriptType (A.Subscript m sub) t = plainSubscriptType m sub t
subscriptType _ _ = die "unsubscriptable type" subscriptType _ _ = die "unsubscriptable type"
typeOfVariable :: (PSM m, Die m) => A.Variable -> m A.Type typeOfVariable :: (PSM m, Die m) => A.Variable -> m A.Type