X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=f34ac9c1726f47a3c77e10458f5a135b4397f707;hb=8287e2325f56a6ce7f855f4aeb1e975f64717720;hp=7d6bc234f7057647fed86568c6830362fc46d89a;hpb=76349636abcb764e8ed3b9ae548730ad2d85abb2;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 7d6bc23..f34ac9c 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -298,7 +298,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 +640,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 +923,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 +1092,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) @@ -1564,9 +1565,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