Remove commented out imports

[ghc-hetmet.git] / compiler / ghci / ByteCodeGen.lhs

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 9330c71..9047fe6 100644 (file)
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -30,9 +30,7 @@ import CoreFVs
 import Type
 import DataCon
 import TyCon
--- import Type
 import Util
--- import DataCon
 import Var
 import VarSet
 import TysPrim
@@ -50,8 +48,6 @@ import Data.List
 import Foreign
 import Foreign.C
 
--- import GHC.Exts             ( Int(..) )
-
 import Control.Monad   ( when )
 import Data.Char
 
@@ -298,7 +294,7 @@ schemeER_wrk d p rhs
    | Just (tickInfo, (_annot, newRhs)) <- isTickedExp' rhs = do 
         code <- schemeE d 0 p newRhs 
         arr <- getBreakArray 
-        let idOffSets = getVarOffSets (fromIntegral d) p tickInfo 
+        let idOffSets = getVarOffSets d p tickInfo
         let tickNumber = tickInfo_number tickInfo
         let breakInfo = BreakInfo 
                         { breakInfo_module = tickInfo_module tickInfo
@@ -640,13 +636,13 @@ schemeT d s p app
       -- Detect and extract relevant info for the tagToEnum kludge.
       maybe_is_tagToEnum_call
          = let extract_constr_Names ty
-                | Just (tyc, []) <- splitTyConApp_maybe (repType ty),
+                 | Just (tyc, _) <- splitTyConApp_maybe (repType ty),
                   isDataTyCon tyc
                   = map (getName . dataConWorkId) (tyConDataCons tyc)
                   -- NOTE: use the worker name, not the source name of
                   -- the DataCon.  See DataCon.lhs for details.
                 | otherwise
-                  = panic "maybe_is_tagToEnum_call.extract_constr_Ids"
+                   = pprPanic "maybe_is_tagToEnum_call.extract_constr_Ids" (ppr ty)
            in
            case app of
               (AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType t)) arg)
@@ -923,7 +919,7 @@ generateCCall :: Word16 -> Sequel           -- stack and sequel depths
               -> [AnnExpr' Id VarSet]  -- args (atoms)
               -> BcM BCInstrList
 
-generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
+generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
    = let 
          -- useful constants
          addr_sizeW :: Word16
@@ -1092,7 +1088,8 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
      recordItblMallocBc (ItblPtr (castFunPtrToPtr addr_of_marshaller))
      let
          -- do the call
-         do_call      = unitOL (CCALL stk_offset (castFunPtrToPtr addr_of_marshaller))
+         do_call      = unitOL (CCALL stk_offset (castFunPtrToPtr addr_of_marshaller)
+                                 (fromIntegral (fromEnum (playInterruptible safety))))
          -- slide and return
          wrapup       = mkSLIDE r_sizeW (d_after_r - r_sizeW - s)
                         `snocOL` RETURN_UBX (primRepToCgRep r_rep)
@@ -1308,7 +1305,7 @@ mkMultiBranch maybe_ncons raw_ways
             = return (snd val)
             | otherwise
             = do label_neq <- getLabelBc
-                 return (mkTestEQ (fst val) label_neq 
+                 return (testEQ (fst val) label_neq 
                          `consOL` (snd val
                          `appOL`   unitOL (LABEL label_neq)
                           `appOL`   the_default))
@@ -1322,7 +1319,7 @@ mkMultiBranch maybe_ncons raw_ways
               label_geq <- getLabelBc
               code_lo <- mkTree vals_lo range_lo (dec v_mid)
               code_hi <- mkTree vals_hi v_mid range_hi
-              return (mkTestLT v_mid label_geq
+              return (testLT v_mid label_geq
                         `consOL` (code_lo
                        `appOL`   unitOL (LABEL label_geq)
                        `appOL`   code_hi))
@@ -1332,34 +1329,32 @@ mkMultiBranch maybe_ncons raw_ways
                             [(_, def)] -> def
                             _ -> panic "mkMultiBranch/the_default"
 
+         testLT (DiscrI i) fail_label = TESTLT_I i fail_label
+         testLT (DiscrW i) fail_label = TESTLT_W i fail_label
+         testLT (DiscrF i) fail_label = TESTLT_F i fail_label
+         testLT (DiscrD i) fail_label = TESTLT_D i fail_label
+         testLT (DiscrP i) fail_label = TESTLT_P i fail_label
+         testLT NoDiscr    _          = panic "mkMultiBranch NoDiscr"
+
+         testEQ (DiscrI i) fail_label = TESTEQ_I i fail_label
+         testEQ (DiscrW i) fail_label = TESTEQ_W i fail_label
+         testEQ (DiscrF i) fail_label = TESTEQ_F i fail_label
+         testEQ (DiscrD i) fail_label = TESTEQ_D i fail_label
+         testEQ (DiscrP i) fail_label = TESTEQ_P i fail_label
+         testEQ NoDiscr    _          = panic "mkMultiBranch NoDiscr"
+
          -- None of these will be needed if there are no non-default alts
-         (mkTestLT, mkTestEQ, init_lo, init_hi)
+         (init_lo, init_hi)
             | null notd_ways
             = panic "mkMultiBranch: awesome foursome"
             | otherwise
-            = case fst (head notd_ways) of {
-              DiscrI _ -> ( \(DiscrI i) fail_label -> TESTLT_I i fail_label,
-                            \(DiscrI i) fail_label -> TESTEQ_I i fail_label,
-                            DiscrI minBound,
-                            DiscrI maxBound );
-              DiscrW _ -> ( \(DiscrW i) fail_label -> TESTLT_W i fail_label,
-                            \(DiscrW i) fail_label -> TESTEQ_W i fail_label,
-                            DiscrW minBound,
-                            DiscrW maxBound );
-              DiscrF _ -> ( \(DiscrF f) fail_label -> TESTLT_F f fail_label,
-                            \(DiscrF f) fail_label -> TESTEQ_F f fail_label,
-                            DiscrF minF,
-                            DiscrF maxF );
-              DiscrD _ -> ( \(DiscrD d) fail_label -> TESTLT_D d fail_label,
-                            \(DiscrD d) fail_label -> TESTEQ_D d fail_label,
-                            DiscrD minD,
-                            DiscrD maxD );
-              DiscrP _ -> ( \(DiscrP i) fail_label -> TESTLT_P i fail_label,
-                            \(DiscrP i) fail_label -> TESTEQ_P i fail_label,
-                            DiscrP algMinBound,
-                            DiscrP algMaxBound );
-              NoDiscr -> panic "mkMultiBranch NoDiscr"
-              }
+            = case fst (head notd_ways) of
+               DiscrI _ -> ( DiscrI minBound,  DiscrI maxBound )
+               DiscrW _ -> ( DiscrW minBound,  DiscrW maxBound )
+               DiscrF _ -> ( DiscrF minF,      DiscrF maxF )
+               DiscrD _ -> ( DiscrD minD,      DiscrD maxD )
+               DiscrP _ -> ( DiscrP algMinBound, DiscrP algMaxBound )
+               NoDiscr -> panic "mkMultiBranch NoDiscr"
 
          (algMinBound, algMaxBound)
             = case maybe_ncons of
@@ -1566,9 +1561,9 @@ getBreakArray = BcM $ \st -> return (st, breakArray st)
 
 newUnique :: BcM Unique
 newUnique = BcM $
-   \st -> case splitUniqSupply (uniqSupply st) of
-             (us1, us2) -> let newState = st { uniqSupply = us2 } 
-                           in  return (newState, uniqFromSupply us1) 
+   \st -> case takeUniqFromSupply (uniqSupply st) of
+             (uniq, us) -> let newState = st { uniqSupply = us }
+                           in  return (newState, uniq)
 
 newId :: Type -> BcM Id
 newId ty = do