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).
52 -- | The environment contains variable definitions or blockids.
54 = Var CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
55 -- eg, RtsLabel, ForeignLabel, CmmLabel etc.
57 | Fun PackageId -- ^ A function name from this package
58 | Label BlockId -- ^ A blockid of some code or data.
60 -- | An environment of named things.
61 type Env = UniqFM Named
63 -- | Local declarations that are in scope during code generation.
64 type Decls = [(FastString,Named)]
66 -- | Does a computation in the FCode monad, with a current environment
67 -- and a list of local declarations. Returns the resulting list of declarations.
69 = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
71 type ExtCode = ExtFCode ()
73 returnExtFC :: a -> ExtFCode a
74 returnExtFC a = EC $ \_ s -> return (s, a)
76 thenExtFC :: ExtFCode a -> (a -> ExtFCode b) -> ExtFCode b
77 thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
79 instance Monad ExtFCode where
84 -- | Takes the variable decarations and imports from the monad
85 -- and makes an environment, which is looped back into the computation.
86 -- In this way, we can have embedded declarations that scope over the whole
87 -- procedure, and imports that scope over the entire module.
88 -- Discards the local declaration contained within decl'
90 loopDecls :: ExtFCode a -> ExtFCode a
91 loopDecls (EC fcode) =
92 EC $ \e globalDecls -> do
93 (_, a) <- fixC (\ ~(decls, _) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
94 return (globalDecls, a)
97 -- | Get the current environment from the monad.
98 getEnv :: ExtFCode Env
99 getEnv = EC $ \e s -> return (s, e)
102 -- | Add a new variable to the list of local declarations.
103 -- The CmmExpr says where the value is stored.
104 addVarDecl :: FastString -> CmmExpr -> ExtCode
106 = EC $ \_ s -> return ((var, Var expr):s, ())
108 -- | Add a new label to the list of local declarations.
109 addLabel :: FastString -> BlockId -> ExtCode
110 addLabel name block_id
111 = EC $ \_ s -> return ((name, Label block_id):s, ())
114 -- | Create a fresh local variable of a given type.
116 :: CmmType -- ^ data type
117 -> FastString -- ^ name of variable
118 -> ExtFCode LocalReg -- ^ register holding the value
120 newLocal ty name = do
122 let reg = LocalReg u ty
123 addVarDecl name (CmmReg (CmmLocal reg))
127 -- | Allocate a fresh label.
128 newLabel :: FastString -> ExtFCode BlockId
131 addLabel name (BlockId u)
135 -- | Add add a local function to the environment.
137 :: FastString -- ^ name of the function
138 -> PackageId -- ^ package of the current module
141 newFunctionName name pkg
142 = EC $ \_ s -> return ((name, Fun pkg):s, ())
145 -- | Add an imported foreign label to the list of local declarations.
146 -- If this is done at the start of the module the declaration will scope
147 -- over the whole module.
149 :: (FastString, CLabel)
152 newImport (name, cmmLabel)
153 = addVarDecl name (CmmLit (CmmLabel cmmLabel))
156 -- | Lookup the BlockId bound to the label with this name.
157 -- If one hasn't been bound yet, create a fresh one based on the
158 -- Unique of the name.
159 lookupLabel :: FastString -> ExtFCode BlockId
160 lookupLabel name = do
163 case lookupUFM env name of
165 _other -> BlockId (newTagUnique (getUnique name) 'L')
168 -- | Lookup the location of a named variable.
169 -- Unknown names are treated as if they had been 'import'ed from the runtime system.
170 -- This saves us a lot of bother in the RTS sources, at the expense of
171 -- deferring some errors to link time.
172 lookupName :: FastString -> ExtFCode CmmExpr
176 case lookupUFM env name of
178 Just (Fun pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name))
179 _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
182 -- | Lift an FCode computation into the ExtFCode monad
183 code :: FCode a -> ExtFCode a
184 code fc = EC $ \_ s -> do
189 code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c)) -> ExtFCode b -> ExtFCode c
192 ((s', _),c) <- f (ec e s)
196 -- | Do nothing in the ExtFCode monad.
201 -- | Accumulate a CmmStmt into the monad state.
202 stmtEC :: CmmStmt -> ExtFCode ()
203 stmtEC stmt = code (stmtC stmt)
206 -- | Accumulate some CmmStmts into the monad state.
207 stmtsEC :: [CmmStmt] -> ExtFCode ()
208 stmtsEC stmts = code (stmtsC stmts)
211 -- | Get the generated statements out of the monad state.
212 getCgStmtsEC :: ExtFCode a -> ExtFCode CgStmts
213 getCgStmtsEC = code2 getCgStmts'
216 -- | Get the generated statements, and the return value out of the monad state.
217 getCgStmtsEC' :: ExtFCode a -> ExtFCode (a, CgStmts)
218 getCgStmtsEC' = code2 (\m -> getCgStmts' m >>= f)
219 where f ((decl, b), c) = return ((decl, b), (b, c))
222 -- | Emit a chunk of code outside the instruction stream,
223 -- and return its block id.
224 forkLabelledCodeEC :: ExtFCode a -> ExtFCode BlockId
225 forkLabelledCodeEC ec = do
226 stmts <- getCgStmtsEC ec
227 code (forkCgStmts stmts)