[project @ 2001-01-16 12:42:18 by sewardj]
authorsewardj <unknown>
Tue, 16 Jan 2001 12:42:19 +0000 (12:42 +0000)
committersewardj <unknown>
Tue, 16 Jan 2001 12:42:19 +0000 (12:42 +0000)
Fill in some more missing cases.

ghc/compiler/ghci/ByteCodeGen.lhs
ghc/compiler/ghci/ByteCodeLink.lhs

index e85e20e..7afcb10 100644 (file)
@@ -210,10 +210,10 @@ collect xs not_lambda
 
 schemeR_wrk is_top original_body nm (args, body)
    | Just dcon <- maybe_toplevel_null_con_rhs
-   = trace ("nullary constructor! " ++ showSDocDebug (ppr nm)) (
+   = --trace ("nullary constructor! " ++ showSDocDebug (ppr nm)) (
      emitBc (mkProtoBCO (getName nm) (toOL [PACK dcon 0, ENTER])
                                      (Right original_body))
-     )
+     --)
 
    | otherwise
    = let fvs       = filter (not.isTyVar) (varSetElems (fst original_body))
@@ -354,6 +354,8 @@ schemeE d s p (fvs, AnnCase scrut bndr alts)
            = case l of MachInt i     -> DiscrI (fromInteger i)
                        MachFloat r   -> DiscrF (fromRational r)
                        MachDouble r  -> DiscrD (fromRational r)
+                       MachChar i    -> DiscrI i
+                       _ -> pprPanic "schemeE(AnnCase).my_discr" (ppr l)
 
         maybe_ncons 
            | not isAlgCase = Nothing
@@ -538,6 +540,7 @@ mkUnpackCode vars d p
            = case npr of
                 IntRep -> approved ; FloatRep -> approved
                 DoubleRep -> approved ; AddrRep -> approved
+                CharRep -> approved
                 _ -> pprPanic "ByteCodeGen.mkUnpackCode" (ppr npr)
              where
                 approved = UPK_TAG usizeW (off_h-usizeW) off_s   `consOL` theRest
index 549769b..0bb6906 100644 (file)
@@ -282,6 +282,7 @@ mkBits findLabel st proto_insns
                ret_itbl_addr = case pk of
                                   PtrRep    -> stg_ctoi_ret_R1p_info
                                   IntRep    -> stg_ctoi_ret_R1n_info
+                                  AddrRep   -> stg_ctoi_ret_R1n_info
                                   CharRep   -> stg_ctoi_ret_R1n_info
                                   FloatRep  -> stg_ctoi_ret_F1_info
                                   DoubleRep -> stg_ctoi_ret_D1_info
@@ -291,6 +292,7 @@ mkBits findLabel st proto_insns
           = addr st ret_itbl_addr
             where
                ret_itbl_addr = case pk of
+                                  CharRep   -> stg_gc_unbx_r1_info
                                   IntRep    -> stg_gc_unbx_r1_info
                                   FloatRep  -> stg_gc_f1_info
                                   DoubleRep -> stg_gc_d1_info
@@ -511,7 +513,7 @@ nameToCLabel n suffix
 primopToCLabel :: PrimOp -> String{-suffix-} -> String
 primopToCLabel primop suffix
    = let str = "PrelPrimopWrappers_" ++ occNameString (primOpOcc primop) ++ '_':suffix
-     in trace ("primopToCLabel: " ++ str)
+     in --trace ("primopToCLabel: " ++ str)
         str
 
 \end{code}