Added a constructor to record types to help build record literals (especially those that contain array literals)
This commit is contained in:
parent
8518860cd3
commit
a9692f884a
|
@ -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 (cgenLiteralRepr, cgenOps, cintroduceSpec, cPreReq, fget, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, GenOps(..), indexOfFreeDimensions, seqComma, withIf ) where
|
module GenerateC (cgenOps, cintroduceSpec, cPreReq, fget, genComma, genCPasses, generate, generateC, genLeftB, genMeta, genName, genRightB, GenOps(..), indexOfFreeDimensions, seqComma, withIf ) where
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Generics
|
import Data.Generics
|
||||||
|
|
|
@ -75,7 +75,6 @@ import Control.Monad.Writer
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Generics
|
import Data.Generics
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Map as Map
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
|
@ -114,12 +113,10 @@ cppgenOps = cgenOps {
|
||||||
genGetTime = cppgenGetTime,
|
genGetTime = cppgenGetTime,
|
||||||
genIf = cppgenIf,
|
genIf = cppgenIf,
|
||||||
genInputItem = cppgenInputItem,
|
genInputItem = cppgenInputItem,
|
||||||
genLiteralRepr = cppgenLiteralRepr,
|
|
||||||
genOutputCase = cppgenOutputCase,
|
genOutputCase = cppgenOutputCase,
|
||||||
genOutputItem = cppgenOutputItem,
|
genOutputItem = cppgenOutputItem,
|
||||||
genPar = cppgenPar,
|
genPar = cppgenPar,
|
||||||
genProcCall = cppgenProcCall,
|
genProcCall = cppgenProcCall,
|
||||||
genRecordTypeSpec = cppgenRecordTypeSpec,
|
|
||||||
genRetypeSizes = cppgenRetypeSizes,
|
genRetypeSizes = cppgenRetypeSizes,
|
||||||
genSizeSuffix = cppgenSizeSuffix,
|
genSizeSuffix = cppgenSizeSuffix,
|
||||||
genSlice = cppgenSlice,
|
genSlice = cppgenSlice,
|
||||||
|
@ -1030,6 +1027,10 @@ cppgenUnfoldedVariable :: Meta -> A.Variable -> CGen ()
|
||||||
cppgenUnfoldedVariable m var
|
cppgenUnfoldedVariable m var
|
||||||
= do t <- typeOfVariable var
|
= do t <- typeOfVariable var
|
||||||
case t of
|
case t of
|
||||||
|
A.Array ds _ ->
|
||||||
|
do genLeftB
|
||||||
|
unfoldArray ds var
|
||||||
|
genRightB
|
||||||
A.Record _ ->
|
A.Record _ ->
|
||||||
do genLeftB
|
do genLeftB
|
||||||
fs <- recordFields m t
|
fs <- recordFields m t
|
||||||
|
@ -1137,103 +1138,3 @@ cppgenClearMobile _ v
|
||||||
tell ["=NULL;}"]
|
tell ["=NULL;}"]
|
||||||
where
|
where
|
||||||
genVar = call genVariable v
|
genVar = call genVariable v
|
||||||
|
|
||||||
cppgenRecordTypeSpec :: A.Name -> Bool -> [(A.Name, A.Type)] -> CGen ()
|
|
||||||
cppgenRecordTypeSpec recordName b fs
|
|
||||||
= do tell ["struct "]
|
|
||||||
genName recordName
|
|
||||||
tell [" {"]
|
|
||||||
sequence_ [call genDeclaration t n True | (n, t) <- fs]
|
|
||||||
genConstructor
|
|
||||||
tell ["}"]
|
|
||||||
when b $ tell [" occam_struct_packed "]
|
|
||||||
tell [";"]
|
|
||||||
where
|
|
||||||
-- A tweaked version of genFormals that makes the record type not be a pointer:
|
|
||||||
|
|
||||||
genParams :: (A.Name -> A.Name) -> [(A.Name, A.Type)] -> CGen ()
|
|
||||||
genParams nameFunc list = infixComma (map (genParam nameFunc) list)
|
|
||||||
|
|
||||||
genParam :: (A.Name -> A.Name) -> (A.Name, A.Type) -> CGen ()
|
|
||||||
genParam nameFunc (n, t)
|
|
||||||
= do case t of
|
|
||||||
A.Array {} -> cppgenArrayType True t 0
|
|
||||||
_ -> call genType t
|
|
||||||
tell [" "]
|
|
||||||
genName (nameFunc n)
|
|
||||||
|
|
||||||
genConstructor :: CGen ()
|
|
||||||
genConstructor
|
|
||||||
= do tell ["inline "]
|
|
||||||
genName recordName
|
|
||||||
tell ["(){}"]
|
|
||||||
tell ["inline explicit "]
|
|
||||||
genName recordName
|
|
||||||
tell ["("]
|
|
||||||
genParams prefixUnderscore fs
|
|
||||||
tell ["):"]
|
|
||||||
sequence_ $ intersperse (tell [","]) $ map genConsItem fs
|
|
||||||
tell ["{"]
|
|
||||||
mapM_ genBodyItem fs
|
|
||||||
tell ["}"]
|
|
||||||
|
|
||||||
genConsItem :: (A.Name, A.Type) -> CGen ()
|
|
||||||
genConsItem (n,at)
|
|
||||||
= case at of
|
|
||||||
A.Array ds t ->
|
|
||||||
do genName n
|
|
||||||
tell ["("]
|
|
||||||
cppgenArraySizesLiteral n at
|
|
||||||
tell [")"]
|
|
||||||
_ ->
|
|
||||||
do genName n
|
|
||||||
tell["(_"]
|
|
||||||
genName n
|
|
||||||
tell[")"]
|
|
||||||
|
|
||||||
genBodyItem :: (A.Name, A.Type) -> CGen ()
|
|
||||||
genBodyItem (n,at)
|
|
||||||
= case at of
|
|
||||||
A.Array ds t ->
|
|
||||||
-- Nasty. We temporarily define the field name to be a variable (and similarly
|
|
||||||
-- the constructor-parameter we are assigning from), then generate the assignment
|
|
||||||
-- then remove the things we inserted into csNames.
|
|
||||||
do modify (\cs -> cs { csNames = flip (Map.insert (A.nameName n)) (csNames cs) $
|
|
||||||
A.NameDef (A.nameMeta n) (A.nameName n) (A.nameName n) A.VariableName
|
|
||||||
(A.Declaration (A.nameMeta n) at Nothing)
|
|
||||||
A.Original A.Unplaced})
|
|
||||||
let n_ = "_" ++ A.nameName n
|
|
||||||
modify (\cs -> cs { csNames = flip (Map.insert n_) (csNames cs) $
|
|
||||||
A.NameDef (A.nameMeta n) n_ n_ A.VariableName
|
|
||||||
(A.Declaration (A.nameMeta n) at Nothing)
|
|
||||||
A.Original A.Unplaced})
|
|
||||||
call genOverArray (A.nameMeta n) fieldV (genElemCopy t)
|
|
||||||
modify (\cs -> cs { csNames = Map.delete (A.nameName n) (csNames cs)})
|
|
||||||
modify (\cs -> cs { csNames = Map.delete n_ (csNames cs)})
|
|
||||||
|
|
||||||
_ -> return ()
|
|
||||||
where
|
|
||||||
m = A.nameMeta n
|
|
||||||
fieldV = A.Variable m (A.Name m A.VariableName (A.nameName n))
|
|
||||||
|
|
||||||
genElemCopy :: A.Type -> (A.Variable -> A.Variable) -> Maybe (CGen ())
|
|
||||||
genElemCopy t f = Just $
|
|
||||||
case t of
|
|
||||||
A.Record recordName ->
|
|
||||||
do tell ["copy_"]
|
|
||||||
genName recordName
|
|
||||||
tell ["("]
|
|
||||||
call genVariable (f $ fieldV)
|
|
||||||
tell [","]
|
|
||||||
call genVariable (f $ A.Variable m (prefixUnderscore n))
|
|
||||||
tell [");"]
|
|
||||||
_ -> call genAssign m [f $ fieldV] $ A.ExpressionList m [A.ExprVariable m $ f $ A.Variable m (prefixUnderscore n)]
|
|
||||||
|
|
||||||
cppgenLiteralRepr :: A.LiteralRepr -> A.Type -> CGen ()
|
|
||||||
cppgenLiteralRepr (A.RecordLiteral _ es) (A.Record n)
|
|
||||||
= do genName n
|
|
||||||
tell["("]
|
|
||||||
seqComma $ map (call genUnfoldedExpression) es
|
|
||||||
tell[")"]
|
|
||||||
cppgenLiteralRepr lit t = cgenLiteralRepr lit t
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user