[project @ 2003-12-10 14:15:16 by simonmar]

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

diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index 3a704a7..d7a477b 100644 (file)
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -19,8 +19,7 @@ import Name           ( Name, getName, mkSystemName )
 import Id
 import FiniteMap
 import ForeignCall     ( ForeignCall(..), CCallTarget(..), CCallSpec(..) )
-import HscTypes                ( ModGuts(..), ModGuts, 
-                         TypeEnv, typeEnvTyCons, typeEnvClasses )
+import HscTypes                ( TypeEnv, typeEnvTyCons, typeEnvClasses )
 import CoreUtils       ( exprType )
 import CoreSyn
 import PprCore         ( pprCoreExpr )
@@ -28,21 +27,19 @@ import Literal              ( Literal(..), literalPrimRep )
 import PrimRep
 import PrimOp          ( PrimOp(..) )
 import CoreFVs         ( freeVars )
-import Type            ( typePrimRep, isUnLiftedType, splitTyConApp_maybe, 
-                         isTyVarTy )
+import Type            ( typePrimRep, isUnLiftedType, splitTyConApp_maybe )
 import DataCon         ( DataCon, dataConTag, fIRST_TAG, dataConTyCon, 
                           isUnboxedTupleCon, isNullaryDataCon, dataConWorkId,
                          dataConRepArity )
 import TyCon           ( tyConFamilySize, isDataTyCon, tyConDataCons,
-                         isFunTyCon, isUnboxedTupleTyCon )
+                         isUnboxedTupleTyCon )
 import Class           ( Class, classTyCon )
-import Type            ( Type, repType, splitFunTys, dropForAlls )
+import Type            ( Type, repType, splitFunTys, dropForAlls, pprType )
 import Util
 import DataCon         ( dataConRepArity )
 import Var             ( isTyVar )
 import VarSet          ( VarSet, varSetElems )
-import TysPrim         ( foreignObjPrimTyCon, 
-                         arrayPrimTyCon, mutableArrayPrimTyCon,
+import TysPrim         ( arrayPrimTyCon, mutableArrayPrimTyCon,
                          byteArrayPrimTyCon, mutableByteArrayPrimTyCon
                        )
 import PrimRep         ( isFollowableRep )
@@ -51,12 +48,10 @@ import ErrUtils             ( showPass, dumpIfSet_dyn )
 import Unique          ( mkPseudoUnique3 )
 import FastString      ( FastString(..), unpackFS )
 import Panic           ( GhcException(..) )
-import PprType         ( pprType )
 import SMRep           ( arrWordsHdrSize, arrPtrsHdrSize, StgWord )
 import Bitmap          ( intsToReverseBitmap, mkBitmap )
 import OrdList
 import Constants       ( wORD_SIZE )
-import BasicTypes      ( TopLevelFlag(..), isTopLevel, isNotTopLevel )
 
 import Data.List       ( intersperse, sortBy, zip4, zip5, partition )
 import Foreign         ( Ptr, castPtr, mallocBytes, pokeByteOff, Word8 )
@@ -65,9 +60,8 @@ import Control.Exception      ( throwDyn )
 
 import GHC.Exts                ( Int(..), ByteArray# )
 
-import Control.Monad   ( when, mapAndUnzipM )
-import Data.Char       ( ord )
-import Data.Bits
+import Control.Monad   ( when )
+import Data.Char       ( ord, chr )
 
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module 
@@ -510,11 +504,14 @@ schemeT d s p app
       -- Detect and extract relevant info for the tagToEnum kludge.
       maybe_is_tagToEnum_call
          = let extract_constr_Names ty
-                  = case splitTyConApp_maybe (repType ty) of
-                       (Just (tyc, [])) |  isDataTyCon tyc
-                                        -> map getName (tyConDataCons tyc)
-                       other -> panic "maybe_is_tagToEnum_call.extract_constr_Ids"
-           in 
+                | 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"
+           in
            case app of
               (AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType t)) arg)
                  -> case isPrimOpId_maybe v of
@@ -717,7 +714,7 @@ doCase d s p (_,scrut)
            = case l of MachInt i     -> DiscrI (fromInteger i)
                        MachFloat r   -> DiscrF (fromRational r)
                        MachDouble r  -> DiscrD (fromRational r)
-                       MachChar i    -> DiscrI i
+                       MachChar i    -> DiscrI (ord i)
                        _ -> pprPanic "schemeE(AnnCase).my_discr" (ppr l)
 
         maybe_ncons 
@@ -889,8 +886,6 @@ generateCCall d0 s p ccall_spec@(CCallSpec target cconv safety) fn args_r_to_l
                  StaticTarget target
                     -> ioToBc (lookupStaticPtr target) `thenBc` \res ->
                        returnBc (True, res)
-                 CasmTarget _
-                    -> pprPanic "ByteCodeGen.generateCCall: casm" (ppr ccall_spec)
      in
          get_target_info       `thenBc` \ (is_static, static_target_addr) ->
      let
@@ -955,7 +950,7 @@ generateCCall d0 s p ccall_spec@(CCallSpec target cconv safety) fn args_r_to_l
 mkDummyLiteral :: PrimRep -> Literal
 mkDummyLiteral pr
    = case pr of
-        CharRep   -> MachChar 0
+        CharRep   -> MachChar (chr 0)
         IntRep    -> MachInt 0
         WordRep   -> MachWord 0
         DoubleRep -> MachDouble 0