suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed the C genRetypeSizes function to pass the tests

Browse Source
This commit is contained in:
Neil Brown 2007-10-13 17:54:46 +00:00
parent acd09137f6
commit 1885518b8d
1 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
backends/GenerateC.hs
View File

@ -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 (call, CGen, cgenOps, cintroduceSpec, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, GenOps(..), seqComma, SubscripterFunction, withIf ) where module GenerateC (call, CGen, cgenOps, cintroduceSpec, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, GenOps(..), indexOfFreeDimensions, seqComma, SubscripterFunction, withIf ) where
import Data.Char import Data.Char
import Data.Generics import Data.Generics
@ -1131,15 +1131,13 @@ abbrevVariable ops am t v
cgenRetypeSizes :: GenOps -> Meta -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen () cgenRetypeSizes :: GenOps -> Meta -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen ()
cgenRetypeSizes _ _ (A.Chan {}) _ (A.Chan {}) _ = return () cgenRetypeSizes _ _ (A.Chan {}) _ (A.Chan {}) _ = return ()
cgenRetypeSizes ops m destT destN srcT srcV cgenRetypeSizes ops m destT destN srcT srcV
= do size <- makeNonce "retype_size" = let size = do tell ["occam_check_retype("]
tell ["int ", size, " = occam_check_retype ("] call genBytesIn ops srcT (Right srcV)
call genBytesIn ops srcT (Right srcV) tell [","]
tell [", "] call genBytesIn ops destT (Left True)
call genBytesIn ops destT (Left True) tell [","]
tell [", "] genMeta m
genMeta m tell [")"] in
tell [");\n"]
case destT of case destT of
-- An array -- figure out the genMissing dimension, if there is one. -- An array -- figure out the genMissing dimension, if there is one.
A.Array destDS _ -> A.Array destDS _ ->
@ -1147,16 +1145,18 @@ cgenRetypeSizes ops m destT destN srcT srcV
case free of case free of
-- No free dimensions; check the complete array matches in size. -- No free dimensions; check the complete array matches in size.
Nothing -> Nothing ->
do tell ["if (", size, " != 1) {\n"] do tell ["if("]
size
tell ["!=1){"]
call genStop ops m "array size mismatch in RETYPES" call genStop ops m "array size mismatch in RETYPES"
tell ["}\n"] tell ["}"]
_ -> return () _ -> return ()
let dims = [case d of let dims = [case d of
A.UnknownDimension -> A.UnknownDimension ->
-- Unknown dimension -- insert it. -- Unknown dimension -- insert it.
case free of case free of
Just _ -> tell [size] Just _ -> size
Nothing -> Nothing ->
die "genRetypeSizes expecting free dimension" die "genRetypeSizes expecting free dimension"
A.Dimension n -> tell [show n] A.Dimension n -> tell [show n]
@ -1165,9 +1165,11 @@ cgenRetypeSizes ops m destT destN srcT srcV
-- Not array; just check the size is 1. -- Not array; just check the size is 1.
_ -> _ ->
do tell ["if (", size, " != 1) {\n"] do tell ["if("]
size
tell ["!=1){"]
call genStop ops m "size mismatch in RETYPES" call genStop ops m "size mismatch in RETYPES"
tell ["}\n"] tell ["}"]
-- | Generate the right-hand side of an abbreviation of an expression. -- | Generate the right-hand side of an abbreviation of an expression.
abbrevExpression :: GenOps -> A.AbbrevMode -> A.Type -> A.Expression -> (CGen (), A.Name -> CGen ()) abbrevExpression :: GenOps -> A.AbbrevMode -> A.Type -> A.Expression -> (CGen (), A.Name -> CGen ())