X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Fprelude%2FPrelRules.lhs;h=2c2a2e40abc7772249070269316d5384216a8577;hb=b8598510c6f7138eeadfc749ec237d9b15df9696;hp=ba530898d646534e97a23ce2f0ba04aa8dc4aa26;hpb=711e4d7a4d65472a3a1fb35bcad8e1c9a109c728;p=ghc-hetmet.git

diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs
index ba53089..2c2a2e4 100644
--- a/ghc/compiler/prelude/PrelRules.lhs
+++ b/ghc/compiler/prelude/PrelRules.lhs
@@ -33,22 +33,24 @@ import Literal		( Literal(..), isLitLitLit, mkMachInt, mkMachWord
 import PrimOp		( PrimOp(..), primOpOcc )
 import TysWiredIn	( trueDataConId, falseDataConId )
 import TyCon		( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
-import DataCon		( dataConTag, dataConTyCon, dataConId, fIRST_TAG )
-import CoreUtils	( exprIsValue, cheapEqExpr, exprIsConApp_maybe )
+import DataCon		( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
+import CoreUtils	( cheapEqExpr, exprIsConApp_maybe )
 import Type		( tyConAppTyCon, eqType )
 import OccName		( occNameUserString)
 import PrelNames	( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
 			  eqStringName, unpackCStringIdKey )
 import Maybes		( orElse )
 import Name		( Name )
-import Bits		( Bits(..) )
+import Outputable
+import FastString
+import CmdLineOpts      ( opt_SimplExcessPrecision )
+
+import DATA_BITS	( Bits(..) )
 #if __GLASGOW_HASKELL__ >= 500
-import Word		( Word )
+import DATA_WORD	( Word )
 #else
-import Word		( Word64 )
+import DATA_WORD	( Word64 )
 #endif
-import Outputable
-import CmdLineOpts      ( opt_SimplExcessPrecision )
 \end{code}
 
 
@@ -56,8 +58,8 @@ import CmdLineOpts      ( opt_SimplExcessPrecision )
 primOpRules :: PrimOp -> [CoreRule]
 primOpRules op = primop_rule op
   where
-    op_name = _PK_ (occNameUserString (primOpOcc op))
-    op_name_case = op_name _APPEND_ SLIT("->case")
+    op_name = mkFastString (occNameUserString (primOpOcc op))
+    op_name_case = op_name `appendFS` FSLIT("->case")
 
 	-- A useful shorthand
     one_rule rule_fn = [BuiltinRule op_name rule_fn]
@@ -65,7 +67,6 @@ primOpRules op = primop_rule op
     -- ToDo:	something for integer-shift ops?
     --		NotOp
 
-    primop_rule SeqOp	    = one_rule seqRule
     primop_rule TagToEnumOp = one_rule tagToEnumRule
     primop_rule DataToTagOp = one_rule dataToTagRule
 
@@ -356,66 +357,6 @@ mkDoubleVal d = Lit (convFloating (MachDouble d))
 %*									*
 %************************************************************************
 
-In the parallel world, we use _seq_ to control the order in which
-certain expressions will be evaluated.  Operationally, the expression
-``_seq_ a b'' evaluates a and then evaluates b.  We have an inlining
-for _seq_ which translates _seq_ to:
-
-   _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y }
-
-Now, we know that the seq# primitive will never return 0#, but we
-don't let the simplifier know that.  We also use a special error
-value, parError#, which is *not* a bottoming Id, so as far as the
-simplifier is concerned, we have to evaluate seq# a before we know
-whether or not y will be evaluated.
-
-If we didn't have the extra case, then after inlining the compiler might
-see:
-	f p q = case seq# p of { _ -> p+q }
-
-If it sees that, it can see that f is strict in q, and hence it might
-evaluate q before p!  The "0# ->" case prevents this happening.
-By having the parError# branch we make sure that anything in the
-other branch stays there!
-
-This is fine, but we'd like to get rid of the extraneous code.  Hence,
-we *do* let the simplifier know that seq# is strict in its argument.
-As a result, we hope that `a' will be evaluated before seq# is called.
-At this point, we have a very special and magical simpification which
-says that ``seq# a'' can be immediately simplified to `1#' if we
-know that `a' is already evaluated.
-
-NB: If we ever do case-floating, we have an extra worry:
-
-    case a of
-      a' -> let b' = case seq# a of { True -> b; False -> parError# }
-	    in case b' of ...
-
-    =>
-
-    case a of
-      a' -> let b' = case True of { True -> b; False -> parError# }
-	    in case b' of ...
-
-    =>
-
-    case a of
-      a' -> let b' = b
-	    in case b' of ...
-
-    =>
-
-    case a of
-      a' -> case b of ...
-
-The second case must never be floated outside of the first!
-
-\begin{code}
-seqRule [Type ty, arg] | exprIsValue arg = Just (mkIntVal 1)
-seqRule other				 = Nothing
-\end{code}
-
-
 \begin{code}
 tagToEnumRule [Type ty, Lit (MachInt i)]
   = ASSERT( isEnumerationTyCon tycon ) 
@@ -424,7 +365,7 @@ tagToEnumRule [Type ty, Lit (MachInt i)]
 
 	[]	  -> Nothing	-- Abstract type
 	(dc:rest) -> ASSERT( null rest )
-		     Just (Var (dataConId dc))
+		     Just (Var (dataConWorkId dc))
   where 
     correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
     tag   = fromInteger i
@@ -459,8 +400,8 @@ dataToTagRule other = Nothing
 builtinRules :: [(Name, CoreRule)]
 -- Rules for non-primops that can't be expressed using a RULE pragma
 builtinRules
-  = [ (unpackCStringFoldrName, BuiltinRule SLIT("AppendLitString") match_append_lit),
-      (eqStringName,	       BuiltinRule SLIT("EqString") match_eq_string)
+  = [ (unpackCStringFoldrName, BuiltinRule FSLIT("AppendLitString") match_append_lit),
+      (eqStringName,	       BuiltinRule FSLIT("EqString") match_eq_string)
     ]
 
 
@@ -479,7 +420,7 @@ match_append_lit [Type ty1,
     c1 `cheapEqExpr` c2
   = ASSERT( ty1 `eqType` ty2 )
     Just (Var unpk `App` Type ty1
-		   `App` Lit (MachStr (s1 _APPEND_ s2))
+		   `App` Lit (MachStr (s1 `appendFS` s2))
 		   `App` c1
 		   `App` n)