Add SubscriptCheck field to SubscriptFromFor etc.

This makes it possible to mark a slice as not needing runtime
checking, which is immediately useful for _sizes arrays.

This fixes cgtest03, which was previously failing to compile because
the _sizes array for one of the constants in it contained a runtime
check and thus wasn't itself constant. I've added a testcase file for
the relevant bit of code.
This commit is contained in:
Adam Sampson 2008-05-26 17:36:26 +00:00
parent d8d6ab12cc
commit 8b3eba594d
11 changed files with 56 additions and 42 deletions

View File

@ -97,7 +97,7 @@ declareSizesArray = applyDepthSM doStructured
findInnerVar :: A.Variable -> (Maybe A.Expression, A.Variable)
findInnerVar wv@(A.SubscriptedVariable m sub v) = case sub of
A.SubscriptField {} -> (Nothing, wv)
A.SubscriptFromFor _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most
A.SubscriptFromFor _ _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most
A.Subscript {} -> findInnerVar v
findInnerVar v = (Nothing, v)
@ -162,7 +162,7 @@ declareSizesArray = applyDepthSM doStructured
(A.Array srcDs _) <- astTypeOf innerV
-- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination:
let sizeDiff = length srcDs - length ds
subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m A.NoCheck (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
sizeType = A.Array [makeDimension m $ length ds] A.Int
sizeExpr = case sliceSize of
Just exp -> let subDims = [A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m n) varSrcSizes | n <- [1 .. (length srcDs - 1)]] in
@ -295,12 +295,12 @@ simplifySlices :: PassType
simplifySlices = applyDepthM doVariable
where
doVariable :: A.Variable -> PassM A.Variable
doVariable (A.SubscriptedVariable m (A.SubscriptFor m' for) v)
= return (A.SubscriptedVariable m (A.SubscriptFromFor m' (makeConstant m' 0) for) v)
doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' from) v)
doVariable (A.SubscriptedVariable m (A.SubscriptFor m' check for) v)
= return (A.SubscriptedVariable m (A.SubscriptFromFor m' check (makeConstant m' 0) for) v)
doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' check from) v)
= do A.Array (d:_) _ <- astTypeOf v
limit <- case d of
A.Dimension n -> return n
A.UnknownDimension -> return $ A.SizeVariable m' v
return (A.SubscriptedVariable m (A.SubscriptFromFor m' from (A.Dyadic m A.Subtr limit from)) v)
return (A.SubscriptedVariable m (A.SubscriptFromFor m' check from (A.Dyadic m A.Subtr limit from)) v)
doVariable v = return v

View File

@ -260,6 +260,7 @@ qcTestDeclareSizes =
specSizes = A.IsExpr emptyMeta A.ValAbbrev (A.Array [dimension $ length destDims] A.Int) $
A.ExprVariable m $
A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta
A.NoCheck
(intLiteral $ toInteger $ length srcDims - length destDims)
(intLiteral $ toInteger $ length destDims)
) (variable "src_sizes")

View File

@ -780,20 +780,23 @@ cgenVariable' checkValid v
outerInd = if indirectedType t then -1 else 0
return (addPrefix (addPrefix cg ind' >> tell ["->"] >> genName n) outerInd, 0)
inner ind sv@(A.SubscriptedVariable m (A.SubscriptFromFor m' start count) v) mt
inner ind sv@(A.SubscriptedVariable m (A.SubscriptFromFor m' subCheck start count) v) mt
= return (
do tell ["(&"]
do let check = if checkValid then subCheck else A.NoCheck
tell ["(&"]
join $ liftM fst $ inner ind v mt
call genArraySubscript A.NoCheck v [(m',
do tell ["occam_check_slice("]
call genExpression start
genComma
call genExpression count
genComma
call genExpression (A.SizeVariable m' v)
genComma
genMeta m'
tell [")"]
case check of
A.NoCheck -> call genExpression start
_ -> do tell ["occam_check_slice("]
call genExpression start
genComma
call genExpression count
genComma
call genExpression (A.SizeVariable m' v)
genComma
genMeta m'
tell [")"]
)]
tell [")"], 0)

View File

@ -383,7 +383,7 @@ testArraySlice = TestList
testSlice index exp nm start count ds
= testBothSameS ("genSlice " ++ show index) exp
(tcall genVariable
(A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta (intLiteral start) (intLiteral count)) (variable nm))
(A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta A.CheckBoth (intLiteral start) (intLiteral count)) (variable nm))
)
(defineName (simpleName nm) $ simpleDefDecl nm (A.Array ds A.Int))

View File

@ -375,11 +375,11 @@ instance ShowRain A.LiteralRepr where
instance ShowOccam A.Subscript where
showOccamM (A.Subscript _ _ e) = getTempItem >> tell ["["] >> showOccamM e >> tell ["]"]
showOccamM (A.SubscriptField _ n) = getTempItem >> tell ["["] >> showName n >> tell ["]"]
showOccamM (A.SubscriptFromFor _ start count)
showOccamM (A.SubscriptFromFor _ _ start count)
= tell ["["] >> getTempItem >> tell [" FROM "] >> showOccamM start >> tell [" FOR "] >> showOccamM count >> tell ["]"]
showOccamM (A.SubscriptFor _ count)
showOccamM (A.SubscriptFor _ _ count)
= tell ["["] >> getTempItem >> tell [" FOR "] >> showOccamM count >> tell ["]"]
showOccamM (A.SubscriptFrom _ start)
showOccamM (A.SubscriptFrom _ _ start)
= tell ["["] >> getTempItem >> tell [" FROM "] >> showOccamM start >> tell ["]"]

View File

@ -141,15 +141,15 @@ subscriptType sub A.Infer
= return $ A.Infer
subscriptType sub t@(A.UserDataType _)
= resolveUserType (findMeta sub) t >>= subscriptType sub
subscriptType (A.SubscriptFromFor m _ count) (A.Array (_:ds) t)
subscriptType (A.SubscriptFromFor m _ _ count) (A.Array (_:ds) t)
= return $ A.Array (dimensionFromExpr count : ds) t
subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t)
subscriptType (A.SubscriptFrom m _ base) (A.Array (d:ds) t)
= return $ A.Array (dim : ds) t
where
dim = case d of
A.Dimension size -> dimensionFromExpr $ A.Dyadic m A.Subtr size base
_ -> A.UnknownDimension
subscriptType (A.SubscriptFor m count) (A.Array (_:ds) t)
subscriptType (A.SubscriptFor m _ count) (A.Array (_:ds) t)
= return $ A.Array (dimensionFromExpr count : ds) t
subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
subscriptType (A.Subscript m _ _) t = plainSubscriptType m t
@ -160,11 +160,11 @@ subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %
unsubscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type
unsubscriptType _ A.Infer
= return $ A.Infer
unsubscriptType (A.SubscriptFromFor _ _ _) t
unsubscriptType (A.SubscriptFromFor _ _ _ _) t
= return $ removeFixedDimension t
unsubscriptType (A.SubscriptFrom _ _) t
unsubscriptType (A.SubscriptFrom _ _ _) t
= return $ removeFixedDimension t
unsubscriptType (A.SubscriptFor _ _) t
unsubscriptType (A.SubscriptFor _ _ _) t
= return $ removeFixedDimension t
unsubscriptType (A.SubscriptField m _) t
= dieP m $ "unsubscript of record type (but we can't tell which one)"

View File

@ -208,13 +208,13 @@ data Subscript =
-- inclusive.
-- The second 'Expression' is the @FOR@; the count of items to include in the
-- slice.
| SubscriptFromFor Meta Expression Expression
| SubscriptFromFor Meta SubscriptCheck Expression Expression
-- | Like 'SubscriptFromFor', but without a @FOR@; it goes to the end of the
-- array.
| SubscriptFrom Meta Expression
| SubscriptFrom Meta SubscriptCheck Expression
-- | Like 'SubscriptFromFor', but without a @FROM@; it starts from the
-- beginning of the array.
| SubscriptFor Meta Expression
| SubscriptFor Meta SubscriptCheck Expression
deriving (Show, Eq, Typeable, Data)
-- | The representation of a literal.

View File

@ -229,10 +229,10 @@ checkSubscript m s rawT
-- Check the subscript itself.
case s of
A.Subscript m _ e -> checkExpressionInt e
A.SubscriptFromFor m e f ->
A.SubscriptFromFor m _ e f ->
checkExpressionInt e >> checkExpressionInt f
A.SubscriptFrom m e -> checkExpressionInt e
A.SubscriptFor m e -> checkExpressionInt e
A.SubscriptFrom m _ e -> checkExpressionInt e
A.SubscriptFor m _ e -> checkExpressionInt e
_ -> ok
-- | Classes of operators.

View File

@ -88,12 +88,12 @@ testOccamTypes = TestList
-- Subscript expressions
testOK 0 $ subex $ A.Subscript m A.NoCheck intE
, testFail 1 $ subex $ A.Subscript m A.NoCheck byteE
, testOK 2 $ subex $ A.SubscriptFromFor m intE intE
, testFail 3 $ subex $ A.SubscriptFromFor m byteE byteE
, testOK 4 $ subex $ A.SubscriptFrom m intE
, testFail 5 $ subex $ A.SubscriptFrom m byteE
, testOK 6 $ subex $ A.SubscriptFor m intE
, testFail 7 $ subex $ A.SubscriptFor m byteE
, testOK 2 $ subex $ A.SubscriptFromFor m A.NoCheck intE intE
, testFail 3 $ subex $ A.SubscriptFromFor m A.NoCheck byteE byteE
, testOK 4 $ subex $ A.SubscriptFrom m A.NoCheck intE
, testFail 5 $ subex $ A.SubscriptFrom m A.NoCheck byteE
, testOK 6 $ subex $ A.SubscriptFor m A.NoCheck intE
, testFail 7 $ subex $ A.SubscriptFor m A.NoCheck byteE
-- Trivial literals
, testOK 20 $ intE

View File

@ -289,13 +289,13 @@ maybeSliced inner subscripter
"FROM" ->
(do f <- tryXV sFOR expression
sRight
return $ A.SubscriptFromFor m e f)
return $ A.SubscriptFromFor m A.CheckBoth e f)
<|>
(do sRight
return $ A.SubscriptFrom m e)
return $ A.SubscriptFrom m A.CheckBoth e)
"FOR" ->
do sRight
return $ A.SubscriptFor m e
return $ A.SubscriptFor m A.CheckBoth e
return $ subscripter m sub v
where

10
testcases/fold-sizes.occ Normal file
View File

@ -0,0 +1,10 @@
-- Test that _sizes arrays for constants are themselves constant.
-- (This testcase taken from cgtest03.)
PROC p ()
[10]BYTE dest:
INT y:
SEQ
y := 5
s IS [dest FROM 2 FOR y]:
s := "hello"
: