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:
parent
d8d6ab12cc
commit
8b3eba594d
|
@ -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
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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 ["]"]
|
||||
|
||||
|
||||
|
|
|
@ -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)"
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
10
testcases/fold-sizes.occ
Normal 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"
|
||||
:
|
Loading…
Reference in New Issue
Block a user