Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/620d885bfd30263384497c06423b1cfe2ace0872 >--------------------------------------------------------------- commit 620d885bfd30263384497c06423b1cfe2ace0872 Author: Simon Marlow <marlo...@gmail.com> Date: Fri Oct 5 09:51:24 2012 +0100 expand tabs >--------------------------------------------------------------- compiler/codeGen/StgCmmExtCode.hs | 100 ++++++++++++++++++------------------ 1 files changed, 50 insertions(+), 50 deletions(-) diff --git a/compiler/codeGen/StgCmmExtCode.hs b/compiler/codeGen/StgCmmExtCode.hs index b060822..f73122b 100644 --- a/compiler/codeGen/StgCmmExtCode.hs +++ b/compiler/codeGen/StgCmmExtCode.hs @@ -10,21 +10,21 @@ -- back in circularly (to avoid a two-pass algorithm). module StgCmmExtCode ( - CmmParse(..), + CmmParse(..), Named(..), Env, - loopDecls, - getEnv, + loopDecls, + getEnv, - newLocal, + newLocal, newLabel, newBlockId, - newFunctionName, - newImport, - lookupLabel, - lookupName, + newFunctionName, + newImport, + lookupLabel, + lookupName, - code, + code, emit, emitLabel, emitAssign, emitStore, getCode, getCodeR, emitOutOfLine, @@ -51,27 +51,27 @@ import Unique -- | The environment contains variable definitions or blockids. data Named - = VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type, - -- eg, RtsLabel, ForeignLabel, CmmLabel etc. + = VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type, + -- eg, RtsLabel, ForeignLabel, CmmLabel etc. - | FunN PackageId -- ^ A function name from this package - | LabelN BlockId -- ^ A blockid of some code or data. + | FunN PackageId -- ^ A function name from this package + | LabelN BlockId -- ^ A blockid of some code or data. -- | An environment of named things. -type Env = UniqFM Named +type Env = UniqFM Named -- | Local declarations that are in scope during code generation. -type Decls = [(FastString,Named)] +type Decls = [(FastString,Named)] -- | Does a computation in the FCode monad, with a current environment --- and a list of local declarations. Returns the resulting list of declarations. +-- and a list of local declarations. Returns the resulting list of declarations. newtype CmmParse a - = EC { unEC :: Env -> Decls -> FCode (Decls, a) } + = EC { unEC :: Env -> Decls -> FCode (Decls, a) } type ExtCode = CmmParse () returnExtFC :: a -> CmmParse a -returnExtFC a = EC $ \_ s -> return (s, a) +returnExtFC a = EC $ \_ s -> return (s, a) thenExtFC :: CmmParse a -> (a -> CmmParse b) -> CmmParse b thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s' @@ -86,40 +86,40 @@ instance HasDynFlags CmmParse where -- | Takes the variable decarations and imports from the monad --- and makes an environment, which is looped back into the computation. --- In this way, we can have embedded declarations that scope over the whole --- procedure, and imports that scope over the entire module. --- Discards the local declaration contained within decl' +-- and makes an environment, which is looped back into the computation. +-- In this way, we can have embedded declarations that scope over the whole +-- procedure, and imports that scope over the entire module. +-- Discards the local declaration contained within decl' -- loopDecls :: CmmParse a -> CmmParse a loopDecls (EC fcode) = EC $ \e globalDecls -> do (_, a) <- F.fixC (\ ~(decls, _) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls) - return (globalDecls, a) + return (globalDecls, a) -- | Get the current environment from the monad. getEnv :: CmmParse Env -getEnv = EC $ \e s -> return (s, e) +getEnv = EC $ \e s -> return (s, e) -- | Add a new variable to the list of local declarations. --- The CmmExpr says where the value is stored. +-- The CmmExpr says where the value is stored. addVarDecl :: FastString -> CmmExpr -> ExtCode addVarDecl var expr - = EC $ \_ s -> return ((var, VarN expr):s, ()) + = EC $ \_ s -> return ((var, VarN expr):s, ()) -- | Add a new label to the list of local declarations. addLabel :: FastString -> BlockId -> ExtCode addLabel name block_id - = EC $ \_ s -> return ((name, LabelN block_id):s, ()) + = EC $ \_ s -> return ((name, LabelN block_id):s, ()) -- | Create a fresh local variable of a given type. newLocal - :: CmmType -- ^ data type - -> FastString -- ^ name of variable - -> CmmParse LocalReg -- ^ register holding the value + :: CmmType -- ^ data type + -> FastString -- ^ name of variable + -> CmmParse LocalReg -- ^ register holding the value newLocal ty name = do u <- code newUnique @@ -140,56 +140,56 @@ newBlockId = code F.newLabelC -- | Add add a local function to the environment. newFunctionName - :: FastString -- ^ name of the function - -> PackageId -- ^ package of the current module - -> ExtCode + :: FastString -- ^ name of the function + -> PackageId -- ^ package of the current module + -> ExtCode newFunctionName name pkg - = EC $ \_ s -> return ((name, FunN pkg):s, ()) + = EC $ \_ s -> return ((name, FunN pkg):s, ()) -- | Add an imported foreign label to the list of local declarations. --- If this is done at the start of the module the declaration will scope --- over the whole module. +-- If this is done at the start of the module the declaration will scope +-- over the whole module. newImport - :: (FastString, CLabel) - -> CmmParse () + :: (FastString, CLabel) + -> CmmParse () newImport (name, cmmLabel) = addVarDecl name (CmmLit (CmmLabel cmmLabel)) -- | Lookup the BlockId bound to the label with this name. --- If one hasn't been bound yet, create a fresh one based on the --- Unique of the name. +-- If one hasn't been bound yet, create a fresh one based on the +-- Unique of the name. lookupLabel :: FastString -> CmmParse BlockId lookupLabel name = do env <- getEnv return $ case lookupUFM env name of - Just (LabelN l) -> l - _other -> mkBlockId (newTagUnique (getUnique name) 'L') + Just (LabelN l) -> l + _other -> mkBlockId (newTagUnique (getUnique name) 'L') -- | Lookup the location of a named variable. --- Unknown names are treated as if they had been 'import'ed from the runtime system. --- This saves us a lot of bother in the RTS sources, at the expense of --- deferring some errors to link time. +-- Unknown names are treated as if they had been 'import'ed from the runtime system. +-- This saves us a lot of bother in the RTS sources, at the expense of +-- deferring some errors to link time. lookupName :: FastString -> CmmParse CmmExpr lookupName name = do env <- getEnv return $ case lookupUFM env name of - Just (VarN e) -> e - Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name)) - _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name)) + Just (VarN e) -> e + Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name)) + _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name)) -- | Lift an FCode computation into the CmmParse monad code :: FCode a -> CmmParse a code fc = EC $ \_ s -> do - r <- fc - return (s, r) + r <- fc + return (s, r) emit :: CmmAGraph -> CmmParse () emit = code . F.emit _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
