- ret_conv = case alt_type of
- AlgAlt tc -> ctrlReturnConvAlg tc
- PolyAlt -> UnvectoredReturn 0
-
-
--- Alternatives for a semi-tagging case expression
-cgEvalAltsSemiTag cc_slot bndr srt tycon alts
- = do -- Bind the default binder
- bindNewToReg bndr nodeReg (mkLFArgument bndr)
-
- blks <- getCgStmts $ cgEvalAltsSemiTag' cc_slot tycon alts
- lbl <- emitDirectReturnTarget (idName bndr) blks srt
- return (CaseAlts lbl Nothing bndr False)
-
-cgEvalAltsSemiTag' cc_slot tycon alts
- = do
- (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot (AlgAlt tycon) alts
-
- iptr <- newTemp wordRep
- stmtC (CmmAssign iptr (closureInfoPtr (CmmReg nodeReg)))
- -- share the iptr between ctype and tag, below
-
- -- we don't have a 1-indexed tag field, we have to use the type
- -- field first to find out whether the closure is a constructor
- not_constr <- newLabelC
-
- let highCons = CmmLit (CmmInt CONSTR_NOCAF_STATIC halfWordRep)
- stmtC (CmmCondBranch (CmmMachOp (MO_U_Gt halfWordRep)
- [infoTableClosureType (infoTable (CmmReg iptr)),
- highCons])
- not_constr)
-
- let tag_expr = CmmMachOp (MO_U_Conv halfWordRep wordRep)
- [infoTableConstrTag (infoTable (CmmReg iptr))]
-
- let family_size = tyConFamilySize tycon
- emitSwitch tag_expr alts mb_deflt 0 (family_size - 1)
-
- labelC not_constr
- stmtC (CmmJump (entryCode (CmmReg iptr)) [])