Fixed genRetypeSizes and its associated tests in light of the new array sizes passes
This commit is contained in:
parent
dd14f6b62a
commit
3189c066b5
|
@ -17,7 +17,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
-- | Generate C code from the mangled AST.
|
-- | 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.Char
|
||||||
import Data.Generics
|
import Data.Generics
|
||||||
|
@ -1048,21 +1048,6 @@ cgenRetypeSizes m destT destN srcT srcV
|
||||||
tell [","]
|
tell [","]
|
||||||
genMeta m
|
genMeta m
|
||||||
tell [")"] in
|
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("]
|
do tell ["if("]
|
||||||
size
|
size
|
||||||
tell ["!=1){"]
|
tell ["!=1){"]
|
||||||
|
|
|
@ -39,7 +39,7 @@ import System.IO
|
||||||
|
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
import CompState
|
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 GenerateCBased
|
||||||
import Metadata
|
import Metadata
|
||||||
import Pass
|
import Pass
|
||||||
|
@ -70,7 +70,6 @@ cppgenOps = cgenOps {
|
||||||
genOutputItem = cppgenOutputItem,
|
genOutputItem = cppgenOutputItem,
|
||||||
genPar = cppgenPar,
|
genPar = cppgenPar,
|
||||||
genProcCall = cppgenProcCall,
|
genProcCall = cppgenProcCall,
|
||||||
genRetypeSizes = cppgenRetypeSizes,
|
|
||||||
genStop = cppgenStop,
|
genStop = cppgenStop,
|
||||||
genTimerRead = cppgenTimerRead,
|
genTimerRead = cppgenTimerRead,
|
||||||
genTimerWait = cppgenTimerWait,
|
genTimerWait = cppgenTimerWait,
|
||||||
|
@ -744,34 +743,6 @@ cppgenDirectedVariable v A.DirInput = tell ["(("] >> v >> tell [")->reader())"]
|
||||||
cppgenDirectedVariable v A.DirOutput = tell ["(("] >> v >> tell [")->writer())"]
|
cppgenDirectedVariable v A.DirOutput = tell ["(("] >> v >> tell [")->writer())"]
|
||||||
cppgenDirectedVariable v dir = call genMissing $ "Cannot direct variable to direction: " ++ show dir
|
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 :: Meta -> A.Type -> Maybe A.Expression -> CGen ()
|
||||||
cppgenAllocMobile m (A.Mobile t) me
|
cppgenAllocMobile m (A.Mobile t) me
|
||||||
= do tell ["new "]
|
= do tell ["new "]
|
||||||
|
|
|
@ -702,10 +702,10 @@ testRetypeSizes = TestList
|
||||||
,test 4 "if(occam_check_retype(#S,#D,#M)!=1){@}"
|
,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)
|
(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:
|
-- Array types with a free dimension should also act like the free type:
|
||||||
,test 100 "^({occam_check_retype(#S,#D,#M)})"
|
,test 100 "if(occam_check_retype(#S,#D,#M)!=1){@}"
|
||||||
(A.Array [A.UnknownDimension] A.Int) (A.Array [A.Dimension 8] A.Byte)
|
(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)
|
(A.Array [A.Dimension 2,A.UnknownDimension,A.Dimension 4] A.Int) (A.Array [A.UnknownDimension] A.Byte)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in New Issue
Block a user