diff options
Diffstat (limited to 'compiler/cmm')
-rw-r--r-- | compiler/cmm/CmmInfo.hs | 2 | ||||
-rw-r--r-- | compiler/cmm/CmmParse.y | 40 | ||||
-rw-r--r-- | compiler/cmm/CmmPipeline.hs | 2 |
3 files changed, 22 insertions, 22 deletions
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 82abbb62bd..3ef3d5001e 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -74,7 +74,7 @@ cmmToRawCmm dflags cmms ; let do_one :: UniqSupply -> [CmmDecl] -> IO (UniqSupply, [RawCmmDecl]) do_one uniqs cmm = -- NB. strictness fixes a space leak. DO NOT REMOVE. - withTimingSilent (return dflags) (text "Cmm -> Raw Cmm") + withTimingSilent dflags (text "Cmm -> Raw Cmm") forceRes $ case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of (b,uniqs') -> return (uniqs',b) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 319286ba5a..3cfb7ecee2 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -375,8 +375,8 @@ cmm :: { CmmParse () } cmmtop :: { CmmParse () } : cmmproc { $1 } | cmmdata { $1 } - | decl { $1 } - | 'CLOSURE' '(' NAME ',' NAME lits ')' ';' + | decl { $1 } + | 'CLOSURE' '(' NAME ',' NAME lits ')' ';' {% liftP . withThisPackage $ \pkg -> do lits <- sequence $6; staticClosure pkg $3 $5 (map getLit lits) } @@ -391,30 +391,30 @@ cmmtop :: { CmmParse () } -- * we can derive closure and info table labels from a single NAME cmmdata :: { CmmParse () } - : 'section' STRING '{' data_label statics '}' + : 'section' STRING '{' data_label statics '}' { do lbl <- $4; ss <- sequence $5; code (emitDecl (CmmData (Section (section $2) lbl) (Statics lbl $ concat ss))) } data_label :: { CmmParse CLabel } - : NAME ':' + : NAME ':' {% liftP . withThisPackage $ \pkg -> return (mkCmmDataLabel pkg $1) } statics :: { [CmmParse [CmmStatic]] } : {- empty -} { [] } | static statics { $1 : $2 } - + static :: { CmmParse [CmmStatic] } : type expr ';' { do e <- $2; return [CmmStaticLit (getLit e)] } | type ';' { return [CmmUninitialised (widthInBytes (typeWidth $1))] } | 'bits8' '[' ']' STRING ';' { return [mkString $4] } - | 'bits8' '[' INT ']' ';' { return [CmmUninitialised + | 'bits8' '[' INT ']' ';' { return [CmmUninitialised (fromIntegral $3)] } - | typenot8 '[' INT ']' ';' { return [CmmUninitialised - (widthInBytes (typeWidth $1) * + | typenot8 '[' INT ']' ';' { return [CmmUninitialised + (widthInBytes (typeWidth $1) * fromIntegral $3)] } | 'CLOSURE' '(' NAME lits ')' { do { lits <- sequence $4 @@ -475,7 +475,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) } , cit_rep = rep , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing }, []) } - + | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')' -- ptrs, nptrs, closure type, description, type, fun type {% liftP . withThisPackage $ \pkg -> @@ -512,7 +512,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) } -- If profiling is on, this string gets duplicated, -- but that's the way the old code did it we can fix it some other time. - + | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')' -- selector, closure type, description, type {% liftP . withThisPackage $ \pkg -> @@ -575,7 +575,7 @@ importName -- A label imported without an explicit packageId. -- These are taken to come frome some foreign, unnamed package. - : NAME + : NAME { ($1, mkForeignLabel $1 Nothing ForeignLabelInExternalPackage IsFunction) } -- as previous 'NAME', but 'IsData' @@ -585,8 +585,8 @@ importName -- A label imported with an explicit packageId. | STRING NAME { ($2, mkCmmCodeLabel (fsToUnitId (mkFastString $1)) $2) } - - + + names :: { [FastString] } : NAME { [$1] } | NAME ',' names { $1 : $3 } @@ -672,9 +672,9 @@ bool_expr :: { CmmParse BoolExpr } | expr { do e <- $1; return (BoolTest e) } bool_op :: { CmmParse BoolExpr } - : bool_expr '&&' bool_expr { do e1 <- $1; e2 <- $3; + : bool_expr '&&' bool_expr { do e1 <- $1; e2 <- $3; return (BoolAnd e1 e2) } - | bool_expr '||' bool_expr { do e1 <- $1; e2 <- $3; + | bool_expr '||' bool_expr { do e1 <- $1; e2 <- $3; return (BoolOr e1 e2) } | '!' bool_expr { do e <- $2; return (BoolNot e) } | '(' bool_op ')' { $2 } @@ -760,7 +760,7 @@ expr :: { CmmParse CmmExpr } expr0 :: { CmmParse CmmExpr } : INT maybe_ty { return (CmmLit (CmmInt $1 (typeWidth $2))) } | FLOAT maybe_ty { return (CmmLit (CmmFloat $1 (typeWidth $2))) } - | STRING { do s <- code (newStringCLit $1); + | STRING { do s <- code (newStringCLit $1); return (CmmLit s) } | reg { $1 } | type '[' expr ']' { do e <- $3; return (CmmLoad e $1) } @@ -818,14 +818,14 @@ foreign_formal :: { CmmParse (LocalReg, ForeignHint) } local_lreg :: { CmmParse LocalReg } : NAME { do e <- lookupName $1; return $ - case e of + case e of CmmReg (CmmLocal r) -> r other -> pprPanic "CmmParse:" (ftext $1 <> text " not a local register") } lreg :: { CmmParse CmmReg } : NAME { do e <- lookupName $1; return $ - case e of + case e of CmmReg r -> r other -> pprPanic "CmmParse:" (ftext $1 <> text " not a register") } | GLOBALREG { return (CmmGlobal $1) } @@ -1376,7 +1376,7 @@ doSwitch :: Maybe (Integer,Integer) doSwitch mb_range scrut arms deflt = do -- Compile code for the default branch - dflt_entry <- + dflt_entry <- case deflt of Nothing -> return Nothing Just e -> do b <- forkLabelledCode e; return (Just b) @@ -1419,7 +1419,7 @@ initEnv dflags = listToUFM [ ] parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmGroup) -parseCmmFile dflags filename = withTiming (pure dflags) (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ do +parseCmmFile dflags filename = withTiming dflags (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ do buf <- hGetStringBuffer filename let init_loc = mkRealSrcLoc (mkFastString filename) 1 1 diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 5ac3fddb3b..071ec9442e 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -39,7 +39,7 @@ cmmPipeline -> CmmGroup -- Input C-- with Procedures -> IO (ModuleSRTInfo, CmmGroup) -- Output CPS transformed C-- -cmmPipeline hsc_env srtInfo prog = withTimingSilent (return dflags) (text "Cmm pipeline") forceRes $ +cmmPipeline hsc_env srtInfo prog = withTimingSilent dflags (text "Cmm pipeline") forceRes $ do let dflags = hsc_dflags hsc_env tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog |