[project @ 1997-09-05 16:23:41 by simonpj]

[ghc-hetmet.git] / ghc / compiler / prelude / TysWiredIn.lhs

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 3e3a71b..c66d215 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -30,12 +30,18 @@ module TysWiredIn (
        floatTy,
        floatTyCon,
        getStatePairingConInfo,
+
        intDataCon,
        intTy,
        intTyCon,
+       isIntTy,
+       inIntRange,
+
        integerTy,
        integerTyCon,
        integerDataCon,
+       isIntegerTy,
+
        liftDataCon,
        liftTyCon,
        listTyCon,
@@ -94,8 +100,6 @@ IMPORT_DELOOPER(IdLoop)      ( SpecEnv, nullSpecEnv,
 #else
 import {-# SOURCE #-} Id ( Id, mkDataCon, mkTupleCon, StrictnessMark(..) )
 import {-# SOURCE #-} SpecEnv ( SpecEnv, nullSpecEnv )
-import {-# SOURCE #-} Type ( Type )
-import {-# SOURCE #-} TyVar ( TyVar )
 #endif
 
 -- friends:
@@ -103,16 +107,17 @@ import PrelMods
 import TysPrim
 
 -- others:
+import FieldLabel      ()      --
 import Kind            ( mkBoxedTypeKind, mkArrowKind )
-import Name            --( mkWiredInTyConName, mkWiredInIdName, mkTupNameStr )
+import Name            ( mkWiredInTyConName, mkWiredInIdName )
 import TyCon           ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
                          TyCon, SYN_IE(Arity)
                        )
-import BasicTypes      ( NewOrData(..) )
-import Type            ( mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys, 
-                         mkFunTy, mkFunTys, maybeAppTyCon,
+import BasicTypes      ( SYN_IE(Module), NewOrData(..) )
+import Type            ( SYN_IE(Type), mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys, 
+                         mkFunTy, mkFunTys, maybeAppTyCon, maybeAppDataTyCon,
                          GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
-import TyVar           ( tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
+import TyVar           ( GenTyVar, SYN_IE(TyVar), tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
 import Lex             ( mkTupNameStr )
 import Unique
 import Util            ( assoc, panic )
@@ -225,6 +230,19 @@ intTy = mkTyConTy intTyCon
 
 intTyCon = pcDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
 intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
+
+isIntTy :: GenType (GenTyVar flexi) uvar -> Bool
+isIntTy ty
+  = case (maybeAppDataTyCon ty) of
+       Just (tycon, [], _) -> uniqueOf tycon == intTyConKey
+       _                   -> False
+
+inIntRange :: Integer -> Bool  -- Tells if an integer lies in the legal range of Ints
+inIntRange i = (min_int <= i) && (i <= max_int)
+
+max_int, min_int :: Integer
+max_int = toInteger maxInt  
+min_int = toInteger minInt
 \end{code}
 
 \begin{code}
@@ -300,6 +318,12 @@ integerTyCon = pcDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integer
 
 integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
                [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
+
+isIntegerTy :: GenType (GenTyVar flexi) uvar -> Bool
+isIntegerTy ty
+  = case (maybeAppDataTyCon ty) of
+       Just (tycon, [], _) -> uniqueOf tycon == integerTyConKey
+       _                   -> False
 \end{code}
 
 And the other pairing types: