-\begin{code}
-stateAndArrayPrimTyCon
- = pcDataTyCon stateAndArrayPrimTyConKey aRR_BASE SLIT("StateAndArray#")
- alpha_beta_tyvars [stateAndArrayPrimDataCon]
-stateAndArrayPrimDataCon
- = pcDataCon stateAndArrayPrimDataConKey aRR_BASE SLIT("StateAndArray#")
- alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
- stateAndArrayPrimTyCon nullSpecEnv
-
-stateAndMutableArrayPrimTyCon
- = pcDataTyCon stateAndMutableArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableArray#")
- alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
-stateAndMutableArrayPrimDataCon
- = pcDataCon stateAndMutableArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableArray#")
- alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
- stateAndMutableArrayPrimTyCon nullSpecEnv
-
-stateAndByteArrayPrimTyCon
- = pcDataTyCon stateAndByteArrayPrimTyConKey aRR_BASE SLIT("StateAndByteArray#")
- alpha_tyvar [stateAndByteArrayPrimDataCon]
-stateAndByteArrayPrimDataCon
- = pcDataCon stateAndByteArrayPrimDataConKey aRR_BASE SLIT("StateAndByteArray#")
- alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
- stateAndByteArrayPrimTyCon nullSpecEnv
-
-stateAndMutableByteArrayPrimTyCon
- = pcDataTyCon stateAndMutableByteArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableByteArray#")
- alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
-stateAndMutableByteArrayPrimDataCon
- = pcDataCon stateAndMutableByteArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableByteArray#")
- alpha_tyvar [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon alpha_ty]
- stateAndMutableByteArrayPrimTyCon nullSpecEnv
-
-stateAndSynchVarPrimTyCon
- = pcDataTyCon stateAndSynchVarPrimTyConKey cONC_BASE SLIT("StateAndSynchVar#")
- alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
-stateAndSynchVarPrimDataCon
- = pcDataCon stateAndSynchVarPrimDataConKey cONC_BASE SLIT("StateAndSynchVar#")
- alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
- stateAndSynchVarPrimTyCon nullSpecEnv
-\end{code}
-
-The ccall-desugaring mechanism uses this function to figure out how to
-rebox the result. It's really a HACK, especially the part about
-how many types to drop from \tr{tys_applied}.
-
-\begin{code}
-getStatePairingConInfo
- :: Type -- primitive type
- -> (Id, -- state pair constructor for prim type
- Type) -- type of state pair
-
-getStatePairingConInfo prim_ty
- = case (maybeAppTyCon prim_ty) of
- Nothing -> panic "getStatePairingConInfo:1"
- Just (prim_tycon, tys_applied) ->
- let
- (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
- pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
- in
- (pair_con, pair_ty)
- where
- tbl = [
- (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
- (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
- (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
- (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
- (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
- (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
- (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
- (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
- (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
- (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
- (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
- (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
- (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
- -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
- ]
-\end{code}