1 -- | Our extended FCode monad.
3 -- We add a mapping from names to CmmExpr, to support local variable names in
4 -- the concrete C-- code. The unique supply of the underlying FCode monad
5 -- is used to grab a new unique for each local variable.
7 -- In C--, a local variable can be declared anywhere within a proc,
8 -- and it scopes from the beginning of the proc to the end. Hence, we have
9 -- to collect declarations as we parse the proc, and feed the environment
10 -- back in circularly (to avoid a two-pass algorithm).
53 -- | The environment contains variable definitions or blockids.
55 = Var CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
56 -- eg, RtsLabel, ForeignLabel, CmmLabel etc.
58 | Fun PackageId -- ^ A function name from this package
59 | Label BlockId -- ^ A blockid of some code or data.
61 -- | An environment of named things.
62 type Env = UniqFM Named
64 -- | Local declarations that are in scope during code generation.
65 type Decls = [(FastString,Named)]
67 -- | Does a computation in the FCode monad, with a current environment
68 -- and a list of local declarations. Returns the resulting list of declarations.
70 = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
72 type ExtCode = ExtFCode ()
74 returnExtFC :: a -> ExtFCode a
75 returnExtFC a = EC $ \_ s -> return (s, a)
77 thenExtFC :: ExtFCode a -> (a -> ExtFCode b) -> ExtFCode b
78 thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
80 instance Monad ExtFCode where
85 -- | Takes the variable decarations and imports from the monad
86 -- and makes an environment, which is looped back into the computation.
87 -- In this way, we can have embedded declarations that scope over the whole
88 -- procedure, and imports that scope over the entire module.
89 -- Discards the local declaration contained within decl'
91 loopDecls :: ExtFCode a -> ExtFCode a
92 loopDecls (EC fcode) =
93 EC $ \e globalDecls -> do
94 (_, a) <- fixC (\ ~(decls, _) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
95 return (globalDecls, a)
98 -- | Get the current environment from the monad.
99 getEnv :: ExtFCode Env
100 getEnv = EC $ \e s -> return (s, e)
103 -- | Add a new variable to the list of local declarations.
104 -- The CmmExpr says where the value is stored.
105 addVarDecl :: FastString -> CmmExpr -> ExtCode
107 = EC $ \_ s -> return ((var, Var expr):s, ())
109 -- | Add a new label to the list of local declarations.
110 addLabel :: FastString -> BlockId -> ExtCode
111 addLabel name block_id
112 = EC $ \_ s -> return ((name, Label block_id):s, ())
115 -- | Create a fresh local variable of a given type.
117 :: CmmType -- ^ data type
118 -> FastString -- ^ name of variable
119 -> ExtFCode LocalReg -- ^ register holding the value
121 newLocal ty name = do
123 let reg = LocalReg u ty
124 addVarDecl name (CmmReg (CmmLocal reg))
128 -- | Allocate a fresh label.
129 newLabel :: FastString -> ExtFCode BlockId
132 addLabel name (BlockId u)
136 -- | Add add a local function to the environment.
138 :: FastString -- ^ name of the function
139 -> PackageId -- ^ package of the current module
142 newFunctionName name pkg
143 = EC $ \_ s -> return ((name, Fun pkg):s, ())
146 -- | Add an imported foreign label to the list of local declarations.
147 -- If this is done at the start of the module the declaration will scope
148 -- over the whole module.
149 -- CLabel's labelDynamic classifies these labels as dynamic, hence the
150 -- code generator emits PIC code for them.
151 newImport :: (Maybe PackageId, FastString) -> ExtFCode ()
152 newImport (Nothing, name)
153 = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
155 newImport (Just pkg, name)
156 = addVarDecl name (CmmLit (CmmLabel (mkCmmCodeLabel pkg name)))
158 -- | Lookup the BlockId bound to the label with this name.
159 -- If one hasn't been bound yet, create a fresh one based on the
160 -- Unique of the name.
161 lookupLabel :: FastString -> ExtFCode BlockId
162 lookupLabel name = do
165 case lookupUFM env name of
167 _other -> BlockId (newTagUnique (getUnique name) 'L')
170 -- | Lookup the location of a named variable.
171 -- Unknown names are treated as if they had been 'import'ed from the runtime system.
172 -- This saves us a lot of bother in the RTS sources, at the expense of
173 -- deferring some errors to link time.
174 lookupName :: FastString -> ExtFCode CmmExpr
178 case lookupUFM env name of
180 Just (Fun pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name))
181 _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
184 -- | Lift an FCode computation into the ExtFCode monad
185 code :: FCode a -> ExtFCode a
186 code fc = EC $ \_ s -> do
191 code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c)) -> ExtFCode b -> ExtFCode c
194 ((s', _),c) <- f (ec e s)
198 -- | Do nothing in the ExtFCode monad.
203 -- | Accumulate a CmmStmt into the monad state.
204 stmtEC :: CmmStmt -> ExtFCode ()
205 stmtEC stmt = code (stmtC stmt)
208 -- | Accumulate some CmmStmts into the monad state.
209 stmtsEC :: [CmmStmt] -> ExtFCode ()
210 stmtsEC stmts = code (stmtsC stmts)
213 -- | Get the generated statements out of the monad state.
214 getCgStmtsEC :: ExtFCode a -> ExtFCode CgStmts
215 getCgStmtsEC = code2 getCgStmts'
218 -- | Get the generated statements, and the return value out of the monad state.
219 getCgStmtsEC' :: ExtFCode a -> ExtFCode (a, CgStmts)
220 getCgStmtsEC' = code2 (\m -> getCgStmts' m >>= f)
221 where f ((decl, b), c) = return ((decl, b), (b, c))
224 -- | Emit a chunk of code outside the instruction stream,
225 -- and return its block id.
226 forkLabelledCodeEC :: ExtFCode a -> ExtFCode BlockId
227 forkLabelledCodeEC ec = do
228 stmts <- getCgStmtsEC ec
229 code (forkCgStmts stmts)