diff options
Diffstat (limited to 'compiler/ghci/ByteCodeGen.hs')
| -rw-r--r-- | compiler/ghci/ByteCodeGen.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index 9aaaa7db64..e723258910 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -805,7 +805,7 @@ mkConAppCode orig_d _ p con args_r_to_l = do_pushery !d (arg : args) = do (push, arg_bytes) <- case arg of - (Padding l _) -> pushPadding l + (Padding l _) -> return $! pushPadding l (FieldOff a _) -> pushConstrAtom d p (fromNonVoid a) more_push_code <- do_pushery (d + arg_bytes) args return (push `appOL` more_push_code) @@ -1570,11 +1570,16 @@ pushConstrAtom d p (AnnVar v) pushConstrAtom d p expr = pushAtom d p expr -pushPadding :: Int -> BcM (BCInstrList, ByteOff) -pushPadding 1 = return (unitOL (PUSH_PAD8), 1) -pushPadding 2 = return (unitOL (PUSH_PAD16), 2) -pushPadding 4 = return (unitOL (PUSH_PAD32), 4) -pushPadding x = panic $ "pushPadding x=" ++ show x +pushPadding :: Int -> (BCInstrList, ByteOff) +pushPadding !n = go n (nilOL, 0) + where + go n acc@(!instrs, !off) = case n of + 0 -> acc + 1 -> (instrs `mappend` unitOL PUSH_PAD8, off + 1) + 2 -> (instrs `mappend` unitOL PUSH_PAD16, off + 2) + 3 -> go 1 (go 2 acc) + 4 -> (instrs `mappend` unitOL PUSH_PAD32, off + 4) + _ -> go (n - 4) (go 4 acc) -- ----------------------------------------------------------------------------- -- Given a bunch of alts code and their discrs, do the donkey work |