diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-02-07 22:56:36 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-08 10:26:00 -0500 |
| commit | 3328ddb88b6eb11cb1f6e844f883e7e9d2b8f21b (patch) | |
| tree | 3bb04ff1f086a95e8f93041d13a10af7ec1f9011 /compiler/cmm/CmmNode.hs | |
| parent | 733e845d0f66541a06415c6b420e51fc99eb9d95 (diff) | |
| download | haskell-3328ddb88b6eb11cb1f6e844f883e7e9d2b8f21b.tar.gz | |
Cmm: Add support for undefined unwinding statements
And use to mark `stg_stack_underflow_frame`, which we are unable to
determine a caller from.
To simplify parsing at the moment we steal the `return` keyword to
indicate an undefined unwind value. Perhaps this should be revisited.
Reviewers: scpmw, simonmar, austin, erikd
Subscribers: dfeuer, thomie
Differential Revision: https://phabricator.haskell.org/D2738
Diffstat (limited to 'compiler/cmm/CmmNode.hs')
| -rw-r--r-- | compiler/cmm/CmmNode.hs | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index 7acf4c6d8b..a3393903ad 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -63,7 +63,7 @@ data CmmNode e x where -- debugger to "walk" the stack. -- -- See Note [What is this unwinding business?] in Debug - CmmUnwind :: [(GlobalReg, CmmExpr)] -> CmmNode O O + CmmUnwind :: [(GlobalReg, Maybe CmmExpr)] -> CmmNode O O CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O -- Assign to register @@ -461,7 +461,7 @@ mapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x mapExp _ f@(CmmEntry{}) = f mapExp _ m@(CmmComment _) = m mapExp _ m@(CmmTick _) = m -mapExp f (CmmUnwind regs) = CmmUnwind (map (fmap f) regs) +mapExp f (CmmUnwind regs) = CmmUnwind (map (fmap (fmap f)) regs) mapExp f (CmmAssign r e) = CmmAssign r (f e) mapExp f (CmmStore addr e) = CmmStore (f addr) (f e) mapExp f (CmmUnsafeForeignCall tgt fs as) = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as) @@ -492,7 +492,7 @@ mapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x) mapExpM _ (CmmEntry{}) = Nothing mapExpM _ (CmmComment _) = Nothing mapExpM _ (CmmTick _) = Nothing -mapExpM f (CmmUnwind regs) = CmmUnwind `fmap` mapM (\(r,e) -> f e >>= \e' -> pure (r,e')) regs +mapExpM f (CmmUnwind regs) = CmmUnwind `fmap` mapM (\(r,e) -> mapM f e >>= \e' -> pure (r,e')) regs mapExpM f (CmmAssign r e) = CmmAssign r `fmap` f e mapExpM f (CmmStore addr e) = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e] mapExpM _ (CmmBranch _) = Nothing @@ -545,7 +545,7 @@ foldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z foldExp _ (CmmEntry {}) z = z foldExp _ (CmmComment {}) z = z foldExp _ (CmmTick {}) z = z -foldExp f (CmmUnwind xs) z = foldr f z (map snd xs) +foldExp f (CmmUnwind xs) z = foldr (maybe id f) z (map snd xs) foldExp f (CmmAssign _ e) z = f e z foldExp f (CmmStore addr e) z = f addr $ f e z foldExp f (CmmUnsafeForeignCall t _ as) z = foldr f (foldExpForeignTarget f t z) as |