X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Fgenprimopcode%2FMain.hs;h=e486403a80e8c57bc122614227c2b4e07ee489a8;hb=591c4e1d694b163367e74bbd2d21415773f420d6;hp=49d3921a35a1d5369919e2385164bc6af4c9112e;hpb=5824647099a9d75e8c1b9e0f67abc8757456b624;p=ghc-hetmet.git

diff --git a/ghc/utils/genprimopcode/Main.hs b/ghc/utils/genprimopcode/Main.hs
index 49d3921..e486403 100644
--- a/ghc/utils/genprimopcode/Main.hs
+++ b/ghc/utils/genprimopcode/Main.hs
@@ -290,10 +290,12 @@ gen_primop_list (Info defaults entries)
      ) where (first:rest) = filter is_primop entries
 
 gen_primop_tag (Info defaults entries)
-   = unlines (zipWith f (filter is_primop entries) [1..])
+   = unlines (max_def : zipWith f primop_entries [1..])
      where
+	primop_entries = filter is_primop entries
         f i n = "tagOf_PrimOp " ++ cons i 
                 ++ " = _ILIT(" ++ show n ++ ") :: FastInt"
+	max_def = "maxPrimOpTag = " ++ show (length primop_entries) ++ " :: Int"
 
 gen_data_decl (Info defaults entries)
    = let conss = map cons (filter is_primop entries)
@@ -383,7 +385,7 @@ ppType (TyApp "RealWorld"   []) = "realWorldTy"
 ppType (TyApp "ThreadId#"   []) = "threadIdPrimTy"
 ppType (TyApp "ForeignObj#" []) = "foreignObjPrimTy"
 ppType (TyApp "BCO#"        []) = "bcoPrimTy"
-ppType (TyApp "Unit"        []) = "unitTy"   -- dodgy
+ppType (TyApp "()"          []) = "unitTy" 	-- unitTy is TysWiredIn's name for ()
 
 
 ppType (TyVar "a")               = "alphaTy"
@@ -647,7 +649,7 @@ ppT = alts [apply TyVar pTyvar,
            ]
 
 pTyvar       = sat (`notElem` ["section","primop","with"]) pName
-pTycon       = pConstructor
+pTycon       = alts [pConstructor, lexeme (string "()")]
 pName        = lexeme (then2 (:) lower (many isIdChar))
 pConstructor = lexeme (then2 (:) upper (many isIdChar))