Better reporting of invalid subscripts
This commit is contained in:
parent
3c8f79b2e8
commit
5e32facc59
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user