From: sewardj <unknown>
Date: Mon, 5 Feb 2001 17:29:41 +0000 (+0000)
Subject: [project @ 2001-02-05 17:29:41 by sewardj]
X-Git-Tag: Approximately_9120_patches~2747
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e9137ce0b07f4426290e008a9121b308045703ef;p=ghc-hetmet.git

[project @ 2001-02-05 17:29:41 by sewardj]
Enable (& fix) peephole optimisation.  Also a couple of unhandled cases
left over from running the Galois raytracer, I think.
---

diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index 14f0ed4..e0359d7 100644
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -169,12 +169,12 @@ ppBCEnv p
 -- Create a BCO and do a spot of peephole optimisation on the insns
 -- at the same time.
 mkProtoBCO nm instrs_ordlist origin
-   = ProtoBCO nm (id {-peep-} (fromOL instrs_ordlist)) origin
+   = ProtoBCO nm (peep (fromOL instrs_ordlist)) origin
      where
         peep (PUSH_L off1 : PUSH_L off2 : PUSH_L off3 : rest)
            = PUSH_LLL off1 (off2-1) (off3-2) : peep rest
         peep (PUSH_L off1 : PUSH_L off2 : rest)
-           = PUSH_LL off1 off2 : peep rest
+           = PUSH_LL off1 (off2-1) : peep rest
         peep (i:rest)
            = i : peep rest
         peep []
@@ -474,6 +474,7 @@ atomRep (AnnVar v)    = typePrimRep (idType v)
 atomRep (AnnLit l)    = literalPrimRep l
 atomRep (AnnNote n b) = atomRep (snd b)
 atomRep (AnnApp f (_, AnnType _)) = atomRep (snd f)
+atomRep (AnnLam x e) | isTyVar x = atomRep (snd e)
 atomRep other = pprPanic "atomRep" (ppr (deAnnotate (undefined,other)))
 
 
@@ -669,6 +670,10 @@ pushAtom tagged d p (AnnApp f (_, AnnType _))
 pushAtom tagged d p (AnnNote note e)
    = pushAtom tagged d p (snd e)
 
+pushAtom tagged d p (AnnLam x e) 
+   | isTyVar x 
+   = pushAtom tagged d p (snd e)
+
 pushAtom tagged d p other
    = pprPanic "ByteCodeGen.pushAtom" 
               (pprCoreExpr (deAnnotate (undefined, other)))