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))
= 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
= 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
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
= 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
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}