Change a use of xargs to "$(XARGS)" $(XARGS_OPTS)

[ghc-hetmet.git] / utils / ext-core / Language / Core / Core.hs

diff --git a/utils/ext-core/Language/Core/Core.hs b/utils/ext-core/Language/Core/Core.hs
index 74442bd..f538ff2 100644 (file)
--- a/utils/ext-core/Language/Core/Core.hs
+++ b/utils/ext-core/Language/Core/Core.hs
@@ -5,6 +5,7 @@ import Language.Core.Encoding
 
 import Data.Generics
 import Data.List (elemIndex)
+import Data.Char
 
 data Module 
  = Module AnMname [Tdef] [Vdefg]
@@ -102,7 +103,7 @@ data CoercionKind =
 -- either type constructors or coercion names onto either
 -- kinds or coercion kinds.
 data KindOrCoercion = Kind Kind | Coercion CoercionKind
-  
+
 data Lit = Literal CoreLit Ty
   deriving (Data, Typeable, Eq)
 
@@ -209,7 +210,7 @@ mainPkg = P "main"
 primPkg = P $ zEncodeString "ghc-prim"
 ghcPrefix = ["GHC"]
 mainPrefix = []
-baseMname = mkBaseMname "Base"
+baseMname = error "Somebody called baseMname!" -- mkBaseMname "Base"
 boolMname = mkPrimMname "Bool"
 mainVar = qual mainMname "main"
 wrapperMainVar = qual wrapperMainMname "main"
@@ -251,7 +252,15 @@ tUtuple ts = foldl Tapp (Tcon (tcUtuple (length ts))) ts
 
 isUtupleTy :: Ty -> Bool
 isUtupleTy (Tapp t _) = isUtupleTy t
-isUtupleTy (Tcon tc) = tc `elem` [tcUtuple n | n <- [1..maxUtuple]]
+isUtupleTy (Tcon tc) = 
+  case tc of
+    (Just pm, 'Z':rest) | pm == primMname && last rest == 'H' -> 
+       let mid = take ((length rest) - 1) rest in
+         all isDigit mid && (let num = read mid in
+                               1 <= num && num <= maxUtuple)
+    _ -> False
+-- The above is ugly, but less ugly than this:
+--tc `elem` [tcUtuple n | n <- [1..maxUtuple]]
 isUtupleTy _ = False
 
 dcUtuple :: Int -> Qual Dcon
@@ -278,3 +287,6 @@ flattenBinds :: [Vdefg] -> [Vdef]   -- Get all the lhs/rhs pairs
 flattenBinds (Nonrec vd : binds) = vd : flattenBinds binds
 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 flattenBinds []                          = []
+
+unitMname :: AnMname
+unitMname = mkPrimMname "Unit"