Add a trivialSubscriptType function to avoid problems with 0-length slices
This commit is contained in:
parent
057a3a0a67
commit
f7029f6312
|
@ -498,7 +498,7 @@ genInputItem c (A.InCounted m cv av)
|
||||||
tell [", "]
|
tell [", "]
|
||||||
fst $ abbrevVariable A.Abbrev t av
|
fst $ abbrevVariable A.Abbrev t av
|
||||||
tell [", "]
|
tell [", "]
|
||||||
subT <- subscriptType (A.Subscript m $ makeConstant m 0) t
|
subT <- trivialSubscriptType t
|
||||||
genVariable cv
|
genVariable cv
|
||||||
tell [" * "]
|
tell [" * "]
|
||||||
genBytesInType subT
|
genBytesInType subT
|
||||||
|
@ -533,7 +533,7 @@ genOutputItem c (A.OutCounted m ce ae)
|
||||||
tell [", "]
|
tell [", "]
|
||||||
fst $ abbrevVariable A.Abbrev t v
|
fst $ abbrevVariable A.Abbrev t v
|
||||||
tell [", "]
|
tell [", "]
|
||||||
subT <- subscriptType (A.Subscript m $ makeConstant m 0) t
|
subT <- trivialSubscriptType t
|
||||||
genExpression ce
|
genExpression ce
|
||||||
tell [" * "]
|
tell [" * "]
|
||||||
genBytesInType subT
|
genBytesInType subT
|
||||||
|
|
|
@ -472,7 +472,7 @@ pushSubscriptTypeContext
|
||||||
= do ps <- get
|
= do ps <- get
|
||||||
case psTypeContext ps of
|
case psTypeContext ps of
|
||||||
(Just t):_ ->
|
(Just t):_ ->
|
||||||
do subT <- subscriptType (A.Subscript emptyMeta $ makeConstant emptyMeta 0) t
|
do subT <- trivialSubscriptType t
|
||||||
pushTypeContext $ Just subT
|
pushTypeContext $ Just subT
|
||||||
_ -> pushTypeContext Nothing
|
_ -> pushTypeContext Nothing
|
||||||
--}}}
|
--}}}
|
||||||
|
@ -1200,7 +1200,7 @@ chanArrayAbbrev
|
||||||
n <- newChannelName
|
n <- newChannelName
|
||||||
sIS
|
sIS
|
||||||
sLeft
|
sLeft
|
||||||
ct <- subscriptType (A.Subscript m $ makeConstant m 0) s
|
ct <- trivialSubscriptType s
|
||||||
case ct of
|
case ct of
|
||||||
A.Chan _ -> return (ct, s, n)
|
A.Chan _ -> return (ct, s, n)
|
||||||
_ -> pzero)
|
_ -> pzero)
|
||||||
|
|
|
@ -101,6 +101,15 @@ subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
|
||||||
subscriptType (A.Subscript m sub) t = plainSubscriptType m sub t
|
subscriptType (A.Subscript m sub) t = plainSubscriptType m sub t
|
||||||
subscriptType _ _ = die "unsubscriptable type"
|
subscriptType _ _ = die "unsubscriptable type"
|
||||||
|
|
||||||
|
-- | Just remove the first dimension from an array type -- like doing
|
||||||
|
-- subscriptType with constant 0 as a subscript, but without the checking.
|
||||||
|
-- This is used for the couple of cases where we know it's safe and don't want
|
||||||
|
-- the usage check.
|
||||||
|
trivialSubscriptType :: (Die m) => A.Type -> m A.Type
|
||||||
|
trivialSubscriptType (A.Array [d] t) = return t
|
||||||
|
trivialSubscriptType (A.Array (d:ds) t) = return $ A.Array ds t
|
||||||
|
trivialSubscriptType _ = die "not plain array type"
|
||||||
|
|
||||||
typeOfVariable :: (PSM m, Die m) => A.Variable -> m A.Type
|
typeOfVariable :: (PSM m, Die m) => A.Variable -> m A.Type
|
||||||
typeOfVariable (A.Variable m n) = typeOfName n
|
typeOfVariable (A.Variable m n) = typeOfName n
|
||||||
typeOfVariable (A.SubscriptedVariable m s v)
|
typeOfVariable (A.SubscriptedVariable m s v)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user