Fixed genRetypeSizes and its associated tests in light of the new array sizes passes

This commit is contained in:
Neil Brown 2008-03-09 16:58:05 +00:00
parent dd14f6b62a
commit 3189c066b5
3 changed files with 5 additions and 49 deletions

View File

@ -17,7 +17,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-}
-- | Generate C code from the mangled AST.
module GenerateC (cgenOps, cgenDeclaration, cgenType, cintroduceSpec, cPreReq, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, indexOfFreeDimensions, seqComma, withIf ) where
module GenerateC (cgenOps, cgenDeclaration, cgenType, cintroduceSpec, cPreReq, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, seqComma, withIf ) where
import Data.Char
import Data.Generics
@ -1048,21 +1048,6 @@ cgenRetypeSizes m destT destN srcT srcV
tell [","]
genMeta m
tell [")"] in
case destT of
-- An array -- figure out the genMissing dimension, if there is one.
A.Array destDS _ ->
do let free = listToMaybe (indexOfFreeDimensions destDS)
case free of
-- No free dimensions; check the complete array matches in size.
Nothing ->
do tell ["if("]
size
tell ["!=1){"]
call genStop m "array size mismatch in RETYPES"
tell ["}"]
_ -> return ()
-- Not array; just check the size is 1.
_ ->
do tell ["if("]
size
tell ["!=1){"]

View File

@ -39,7 +39,7 @@ import System.IO
import qualified AST as A
import CompState
import GenerateC (cgenDeclaration, cgenOps, cintroduceSpec, cgenType, generate, genComma, genLeftB, genMeta, genName, genRightB, indexOfFreeDimensions, seqComma, withIf)
import GenerateC (cgenDeclaration, cgenOps, cintroduceSpec, cgenType, generate, genComma, genLeftB, genMeta, genName, genRightB, seqComma, withIf)
import GenerateCBased
import Metadata
import Pass
@ -70,7 +70,6 @@ cppgenOps = cgenOps {
genOutputItem = cppgenOutputItem,
genPar = cppgenPar,
genProcCall = cppgenProcCall,
genRetypeSizes = cppgenRetypeSizes,
genStop = cppgenStop,
genTimerRead = cppgenTimerRead,
genTimerWait = cppgenTimerWait,
@ -744,34 +743,6 @@ cppgenDirectedVariable v A.DirInput = tell ["(("] >> v >> tell [")->reader())"]
cppgenDirectedVariable v A.DirOutput = tell ["(("] >> v >> tell [")->writer())"]
cppgenDirectedVariable v dir = call genMissing $ "Cannot direct variable to direction: " ++ show dir
-- | Generate the size part of a RETYPES\/RESHAPES abbrevation of a variable.
cppgenRetypeSizes :: Meta -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen ()
cppgenRetypeSizes _ (A.Chan {}) _ (A.Chan {}) _ = return ()
cppgenRetypeSizes m destT destN srcT srcV
= let checkSize
= do tell ["if(occam_check_retype("]
call genBytesIn m srcT (Right srcV)
tell [","]
call genBytesIn m destT (Left True)
tell [","]
genMeta m
tell [")!=1){"]
call genStop m "size mismatch in RETYPES"
tell ["}"] in
case destT of
-- TODO we should be able to remove this check now that arrays have changed
-- TODO or at least it needs fixing in some way...
-- An array -- figure out the genMissing dimension, if there is one.
A.Array destDS _ ->
case (indexOfFreeDimensions destDS) of
-- No free dimensions; check the complete array matches in size.
[] -> checkSize
_ -> return ()
-- Not array; just check the size is 1.
_ -> checkSize
cppgenAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> CGen ()
cppgenAllocMobile m (A.Mobile t) me
= do tell ["new "]

View File

@ -702,10 +702,10 @@ testRetypeSizes = TestList
,test 4 "if(occam_check_retype(#S,#D,#M)!=1){@}"
(A.Array [A.Dimension 2,A.Dimension 3,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
-- Array types with a free dimension in the destination type must calculate it and used it:
,test 100 "^({occam_check_retype(#S,#D,#M)})"
-- Array types with a free dimension should also act like the free type:
,test 100 "if(occam_check_retype(#S,#D,#M)!=1){@}"
(A.Array [A.UnknownDimension] A.Int) (A.Array [A.Dimension 8] A.Byte)
,test 101 "^({2,occam_check_retype(#S,#D,#M),4})"
,test 101 "if(occam_check_retype(#S,#D,#M)!=1){@}"
(A.Array [A.Dimension 2,A.UnknownDimension,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
]
where