-integerZeroId
- = pcMiscPrelId integerZeroIdKey pREL_NUM SLIT("integer_0") integerTy noIdInfo
-integerPlusOneId
- = pcMiscPrelId integerPlusOneIdKey pREL_NUM SLIT("integer_1") integerTy noIdInfo
-integerPlusTwoId
- = pcMiscPrelId integerPlusTwoIdKey pREL_NUM SLIT("integer_2") integerTy noIdInfo
-integerMinusOneId
- = pcMiscPrelId integerMinusOneIdKey pREL_NUM SLIT("integer_m1") integerTy noIdInfo
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[PrelVals-parallel]{@seq@ and @par@: for parallel operation (only)}
-%* *
-%************************************************************************
-
-\begin{code}
-{- OUT:
---------------------------------------------------------------------
--- seqId :: "seq", used w/ GRIP, etc., is really quite similar to
--- dangerousEval
-{-
- OLDER:
- seq = /\ a b -> \ x y -> case x of { _ -> y }
-
- OLD:
- seq = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
-
- NEW (95/05):
- seq = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
-
--}
-
-seqId = pcMiscPrelId seqIdKey pRELUDE SLIT("seq")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding seq_template))
- where
- [x, y, z]
- = mkTemplateLocals [
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- seq_template
- = mkLam [alphaTyVar, betaTyVar] [x, y] (
- Case (Prim SeqOp [TyArg alphaTy, VarArg x]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
-
---------------------------------------------------------------------
--- parId :: "par", also used w/ GRIP, etc.
-{-
- OLDER:
-
- par = /\ a b -> \ x y -> case (par# (case x of { _ -> () })) of { _ -> y }
-
- OLD:
-
- par = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
-
- NEW (95/05):
-
- par = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
-
--}
-parId = pcMiscPrelId parIdKey cONC_BASE SLIT("par")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding par_template))
- where
- [x, y, z]
- = mkTemplateLocals [
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- par_template
- = mkLam [alphaTyVar, betaTyVar] [x, y] (
- Case (Prim ParOp [TyArg alphaTy, VarArg x]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
-
--- forkId :: "fork", for *required* concurrent threads
-{-
- _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
--}
-forkId = pcMiscPrelId forkIdKey cONC_BASE SLIT("fork")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding fork_template))
- where
- [x, y, z]
- = mkTemplateLocals [
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- fork_template
- = mkLam [alphaTyVar, betaTyVar] [x, y] (
- Case (Prim ForkOp [TyArg alphaTy, VarArg x]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
--}
-\end{code}
-
-GranSim ones:
-\begin{code}
-{- OUT:
-parLocalId = pcMiscPrelId parLocalIdKey cONC_BASE SLIT("parLocal")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parLocal_template))
- where
- -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
- [w, g, s, p, x, y, z]
- = mkTemplateLocals [
- {-w-} intPrimTy,
- {-g-} intPrimTy,
- {-s-} intPrimTy,
- {-p-} intPrimTy,
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- parLocal_template
- = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, x, y] (
- Case (Prim ParLocalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
-
-parGlobalId = pcMiscPrelId parGlobalIdKey cONC_BASE SLIT("parGlobal")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parGlobal_template))
- where
- -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
- [w, g, s, p, x, y, z]
- = mkTemplateLocals [
- {-w-} intPrimTy,
- {-g-} intPrimTy,
- {-s-} intPrimTy,
- {-p-} intPrimTy,
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- parGlobal_template
- = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, x, y] (
- Case (Prim ParGlobalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
-
-
-parAtId = pcMiscPrelId parAtIdKey cONC_BASE SLIT("parAt")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
- alphaTy, betaTy, gammaTy] gammaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAt_template))
- where
- -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
- [w, g, s, p, v, x, y, z]
- = mkTemplateLocals [
- {-w-} intPrimTy,
- {-g-} intPrimTy,
- {-s-} intPrimTy,
- {-p-} intPrimTy,
- {-v-} alphaTy,
- {-x-} betaTy,
- {-y-} gammaTy,
- {-z-} intPrimTy
- ]
-
- parAt_template
- = mkLam [alphaTyVar, betaTyVar, gammaTyVar] [w, g, s, p, v, x, y] (
- Case (Prim ParAtOp [TyArg alphaTy, TyArg betaTy, TyArg gammaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [gammaTy])]
- (BindDefault z (Var y))))
-
-parAtAbsId = pcMiscPrelId parAtAbsIdKey cONC_BASE SLIT("parAtAbs")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAtAbs_template))
- where
- -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
- [w, g, s, p, v, x, y, z]
- = mkTemplateLocals [
- {-w-} intPrimTy,
- {-g-} intPrimTy,
- {-s-} intPrimTy,
- {-p-} intPrimTy,
- {-v-} intPrimTy,
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- parAtAbs_template
- = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, v, x, y] (
- Case (Prim ParAtAbsOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
-
-parAtRelId = pcMiscPrelId parAtRelIdKey cONC_BASE SLIT("parAtRel")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAtRel_template))
- where
- -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
- [w, g, s, p, v, x, y, z]
- = mkTemplateLocals [
- {-w-} intPrimTy,
- {-g-} intPrimTy,
- {-s-} intPrimTy,
- {-p-} intPrimTy,
- {-v-} intPrimTy,
- {-x-} alphaTy,
- {-y-} betaTy,
- {-z-} intPrimTy
- ]
-
- parAtRel_template
- = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, v, x, y] (
- Case (Prim ParAtRelOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
- (BindDefault z (Var y))))
-
-parAtForNowId = pcMiscPrelId parAtForNowIdKey cONC_BASE SLIT("parAtForNow")
- (mkSigmaTy [alphaTyVar, betaTyVar] []
- (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
- alphaTy, betaTy, gammaTy] gammaTy))
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAtForNow_template))
- where
- -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
- [w, g, s, p, v, x, y, z]
- = mkTemplateLocals [
- {-w-} intPrimTy,
- {-g-} intPrimTy,
- {-s-} intPrimTy,
- {-p-} intPrimTy,
- {-v-} alphaTy,
- {-x-} betaTy,
- {-y-} gammaTy,
- {-z-} intPrimTy
- ]
-
- parAtForNow_template
- = mkLam [alphaTyVar, betaTyVar, gammaTyVar] [w, g, s, p, v, x, y] (
- Case (Prim ParAtForNowOp [TyArg alphaTy, TyArg betaTy, TyArg gammaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
- PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [gammaTy])]
- (BindDefault z (Var y))))
-
--- copyable and noFollow are currently merely hooks: they are translated into
--- calls to the macros COPYABLE and NOFOLLOW -- HWL
-
-copyableId = pcMiscPrelId copyableIdKey cONC_BASE SLIT("copyable")
- (mkSigmaTy [alphaTyVar] []
- alphaTy)
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding copyable_template))
- where
- -- Annotations: x: closure that's tagged to by copyable
- [x, z]
- = mkTemplateLocals [
- {-x-} alphaTy,
- {-z-} alphaTy
- ]
-
- copyable_template
- = mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )
-
-noFollowId = pcMiscPrelId noFollowIdKey cONC_BASE SLIT("noFollow")
- (mkSigmaTy [alphaTyVar] []
- alphaTy)
- (noIdInfo `addUnfoldInfo` (mk_inline_unfolding noFollow_template))
- where
- -- Annotations: x: closure that's tagged to not follow
- [x, z]
- = mkTemplateLocals [
- {-x-} alphaTy,
- {-z-} alphaTy
- ]
-
- noFollow_template
- = mkLam [alphaTyVar] [x] ( Prim NoFollowOp [TyArg alphaTy, VarArg x] )
--}
-\end{code}