Commit 74a395c2 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-09-14 15:49:56 by simonpj]

-----------------
	Make seq built in
	-----------------

	DO NOT merge with stable

Until this commit 'seq' used a cunning hack so that it
seems to be *non-strict* in its second argument:

  seq x y = case seq# x of { 0 -> y; other -> error "urk" }

The reason for this is to make sure that x is evaluated before y,
which is what you want in a parallel setting.

But in a *sequential* settting, this simply destroys strictness
information about y.  Now that people are starting to use seq more,
this is becoming painful.  People sometimes use seq to make their
function strict, and are surprised when it becomes non-strict in other
arguments!

So this commit changes seq so that it does what you would naively
expect:

	seq x y = case x of { any -> y }

This is done by making seq built-in, defined along with
	unsafeCoerce
	getTag

in MkId.lhs.  (I considered giving their unfoldings in
PrelGHC.hi-boot.pp, but then there is the matter of making sure they
are unfolded, since these fns don't have top-level curried defns,
so I held off and did seq the same way as the other two.)

I renamed PrelConc.seq as PrelConc.pseq; maybe its name will change
to `then` or `before` or something else.  That's up to the GPH
folk.
parent fd4b0e84
......@@ -32,11 +32,11 @@ module MkId (
import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, betaTyVar, betaTy,
intPrimTy, realWorldStatePrimTy, addrPrimTy
)
import TysWiredIn ( charTy, mkListTy )
import PrelRules ( primOpRule )
import PrelRules ( primOpRules )
import Rules ( addRule )
import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
mkTyVarTys, mkClassPred, tcEqPred,
......@@ -125,6 +125,7 @@ wiredInIds
, realWorldPrimId
, unsafeCoerceId
, getTagId
, seqId
]
\end{code}
......@@ -146,8 +147,24 @@ mkDataConId work_name data_con
`setArityInfo` arity
`setNewStrictnessInfo` Just strict_sig
arity = dataConRepArity data_con
arity = dataConRepArity data_con
strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
-- Notice that we do *not* say the worker is strict
-- even if the data constructor is declared strict
-- e.g. data T = MkT !(Int,Int)
-- Why? Because the *wrapper* is strict (and its unfolding has case
-- expresssions that do the evals) but the *worker* itself is not.
-- If we pretend it is strict then when we see
-- case x of y -> $wMkT y
-- the simplifier thinks that y is "sure to be evaluated" (because
-- $wMkT is strict) and drops the case. No, $wMkT is not strict.
--
-- When the simplifer sees a pattern
-- case e of MkT x -> ...
-- it uses the dataConRepStrictness of MkT to mark x as evaluated;
-- but that's fine... dataConRepStrictness comes from the data con
-- not from the worker Id.
tycon = dataConTyCon data_con
cpr_info | isProductTyCon tycon &&
......@@ -222,9 +239,7 @@ mkDataConWrapId data_con
-- applications are treated as values
`setNewStrictnessInfo` Just wrap_sig
wrap_ty = mkForAllTys all_tyvars $
mkFunTys all_arg_tys
result_ty
wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
res_info = strictSigResInfo (idNewStrictness work_id)
wrap_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) res_info)
......@@ -619,8 +634,7 @@ mkPrimOpId prim_op
`setNewStrictnessInfo` Just (mkNewStrictnessInfo id arity strict_info NoCPRInfo)
-- Until we modify the primop generation code
rules = maybe emptyCoreRules (addRule emptyCoreRules id)
(primOpRule prim_op)
rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
-- For each ccall we manufacture a separate CCallOpId, giving it
......@@ -740,7 +754,12 @@ mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
%* *
%************************************************************************
These two can't be defined in Haskell.
These Ids can't be defined in Haskell. They could be defined in
unfoldings in PrelGHC.hi-boot, but we'd have to ensure that they
were definitely, definitely inlined, because there is no curried
identifier for them. Thats what mkCompulsoryUnfolding does.
If we had a way to get a compulsory unfolding from an interface file,
we could do that, but we don't right now.
unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
just gets expanded into a type coercion wherever it occurs. Hence we
......@@ -762,8 +781,18 @@ unsafeCoerceId
[x] = mkTemplateLocals [openAlphaTy]
rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
Note (Coerce openBetaTy openAlphaTy) (Var x)
\end{code}
seqId
= pcMiscPrelId seqIdKey pREL_GHC SLIT("seq") ty info
where
info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
ty = mkForAllTys [alphaTyVar,betaTyVar]
(mkFunTy alphaTy (mkFunTy betaTy betaTy))
[x,y] = mkTemplateLocals [alphaTy, betaTy]
rhs = mkLams [alphaTyVar,betaTyVar,x] (Case (Var x) x [(DEFAULT, [], Var y)])
\end{code}
@getTag#@ is another function which can't be defined in Haskell. It needs to
evaluate its argument and call the dataToTag# primitive.
......
......@@ -812,6 +812,7 @@ integerPlusOneIdKey = mkPreludeMiscIdUnique 10
integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
integerZeroIdKey = mkPreludeMiscIdUnique 12
int2IntegerIdKey = mkPreludeMiscIdUnique 13
seqIdKey = mkPreludeMiscIdUnique 14
irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
eqStringIdKey = mkPreludeMiscIdUnique 16
noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
......
% -----------------------------------------------------------------------------
% $Id: PrelConc.lhs,v 1.24 2001/05/18 16:54:05 simonmar Exp $
% $Id: PrelConc.lhs,v 1.25 2001/09/14 15:49:56 simonpj Exp $
%
% (c) The University of Glasgow, 1994-2000
%
......@@ -19,7 +19,7 @@ module PrelConc
, killThread -- :: ThreadId -> IO ()
, throwTo -- :: ThreadId -> Exception -> IO ()
, par -- :: a -> b -> b
, seq -- :: a -> b -> b
, pseq -- :: a -> b -> b
, yield -- :: IO ()
-- Waiting
......@@ -47,7 +47,7 @@ import PrelIOBase ( IO(..), MVar(..) )
import PrelBase ( Int(..) )
import PrelException ( Exception(..), AsyncException(..) )
infixr 0 `par`, `seq`
infixr 0 `par`, `pseq`
\end{code}
%************************************************************************
......@@ -80,7 +80,10 @@ yield :: IO ()
yield = IO $ \s ->
case (yield# s) of s1 -> (# s1, () #)
-- "seq" is defined a bit weirdly (see below)
-- Nota Bene: 'pseq' used to be 'seq'
-- but 'seq' is now defined in PrelGHC
--
-- "pseq" is defined a bit weirdly (see below)
--
-- The reason for the strange "0# -> parError" case is that
-- it fools the compiler into thinking that seq is non-strict in
......@@ -91,9 +94,9 @@ yield = IO $ \s ->
-- Just before converting from Core to STG there's a bit of magic
-- that recognises the seq# and eliminates the duff case.
{-# INLINE seq #-}
seq :: a -> b -> b
seq x y = case (seq# x) of { 0# -> seqError; _ -> y }
{-# INLINE pseq #-}
pseq :: a -> b -> b
pseq x y = case (seq# x) of { 0# -> seqError; _ -> y }
{-# INLINE par #-}
par :: a -> b -> b
......
......@@ -51,6 +51,9 @@ __export PrelGHC
tryPutMVarzh
isEmptyMVarzh
-- Seq
seq
-- Parallel
seqzh
parzh
......@@ -463,3 +466,4 @@ instance __forall s => {CCallable (StablePtrzh s)} = zdfCCallableStablePtrzh;
1 zdfCCallableMutableByteArrayzh :: __forall s => {CCallable (MutableByteArrayzh s)} ;
1 zdfCCallableForeignObjzh :: {CCallable ForeignObjzh} ;
1 zdfCCallableStablePtrzh :: __forall a => {CCallable (StablePtrzh a)} ;
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment