X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FBasicTypes.lhs;fp=ghc%2Fcompiler%2FbasicTypes%2FBasicTypes.lhs;h=0000000000000000000000000000000000000000;hb=0065d5ab628975892cea1ec7303f968c3338cbe1;hp=6b662bd6a64c18c590d9dc541187fe88e13d1c79;hpb=28a464a75e14cece5db40f2765a29348273ff2d2;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs deleted file mode 100644 index 6b662bd..0000000 --- a/ghc/compiler/basicTypes/BasicTypes.lhs +++ /dev/null @@ -1,508 +0,0 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998 -% -\section[BasicTypes]{Miscellanous types} - -This module defines a miscellaneously collection of very simple -types that - -\begin{itemize} -\item have no other obvious home -\item don't depend on any other complicated types -\item are used in more than one "part" of the compiler -\end{itemize} - -\begin{code} -module BasicTypes( - Version, bumpVersion, initialVersion, - - Arity, - - DeprecTxt, - - Fixity(..), FixityDirection(..), - defaultFixity, maxPrecedence, - negateFixity, funTyFixity, - compareFixity, - - IPName(..), ipNameName, mapIPName, - - RecFlag(..), isRec, isNonRec, boolToRecFlag, - - TopLevelFlag(..), isTopLevel, isNotTopLevel, - - Boxity(..), isBoxed, - - TupCon(..), tupleParens, - - OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, - isDeadOcc, isLoopBreaker, isNoOcc, - - InsideLam, insideLam, notInsideLam, - OneBranch, oneBranch, notOneBranch, - InterestingCxt, - - EP(..), - - StrictnessMark(..), isMarkedUnboxed, isMarkedStrict, - - CompilerPhase, - Activation(..), isActive, isNeverActive, isAlwaysActive, - InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec, - - SuccessFlag(..), succeeded, failed, successIf - ) where - -#include "HsVersions.h" - -import FastString( FastString ) -import Outputable -\end{code} - -%************************************************************************ -%* * -\subsection[Arity]{Arity} -%* * -%************************************************************************ - -\begin{code} -type Arity = Int -\end{code} - - -%************************************************************************ -%* * -\subsection[Version]{Module and identifier version numbers} -%* * -%************************************************************************ - -\begin{code} -type Version = Int - -bumpVersion :: Version -> Version -bumpVersion v = v+1 - -initialVersion :: Version -initialVersion = 1 -\end{code} - -%************************************************************************ -%* * - Deprecations -%* * -%************************************************************************ - - -\begin{code} -type DeprecTxt = FastString -- reason/explanation for deprecation -\end{code} - -%************************************************************************ -%* * -\subsection{Implicit parameter identity} -%* * -%************************************************************************ - -The @IPName@ type is here because it is used in TypeRep (i.e. very -early in the hierarchy), but also in HsSyn. - -\begin{code} -data IPName name - = Dupable name -- ?x: you can freely duplicate this implicit parameter - | Linear name -- %x: you must use the splitting function to duplicate it - deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map - -- (used in HscTypes.OrigIParamCache) - - -ipNameName :: IPName name -> name -ipNameName (Dupable n) = n -ipNameName (Linear n) = n - -mapIPName :: (a->b) -> IPName a -> IPName b -mapIPName f (Dupable n) = Dupable (f n) -mapIPName f (Linear n) = Linear (f n) - -instance Outputable name => Outputable (IPName name) where - ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters - ppr (Linear n) = char '%' <> ppr n -- Splittable implicit parameters -\end{code} - - -%************************************************************************ -%* * -\subsection[Fixity]{Fixity info} -%* * -%************************************************************************ - -\begin{code} ------------------------- -data Fixity = Fixity Int FixityDirection - -instance Outputable Fixity where - ppr (Fixity prec dir) = hcat [ppr dir, space, int prec] - -instance Eq Fixity where -- Used to determine if two fixities conflict - (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2 - ------------------------- -data FixityDirection = InfixL | InfixR | InfixN - deriving(Eq) - -instance Outputable FixityDirection where - ppr InfixL = ptext SLIT("infixl") - ppr InfixR = ptext SLIT("infixr") - ppr InfixN = ptext SLIT("infix") - ------------------------- -maxPrecedence = (9::Int) -defaultFixity = Fixity maxPrecedence InfixL - -negateFixity, funTyFixity :: Fixity --- Wired-in fixities -negateFixity = Fixity 6 InfixL -- Fixity of unary negate -funTyFixity = Fixity 0 InfixR -- Fixity of '->' -\end{code} - -Consider - -\begin{verbatim} - a `op1` b `op2` c -\end{verbatim} -@(compareFixity op1 op2)@ tells which way to arrange appication, or -whether there's an error. - -\begin{code} -compareFixity :: Fixity -> Fixity - -> (Bool, -- Error please - Bool) -- Associate to the right: a op1 (b op2 c) -compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2) - = case prec1 `compare` prec2 of - GT -> left - LT -> right - EQ -> case (dir1, dir2) of - (InfixR, InfixR) -> right - (InfixL, InfixL) -> left - _ -> error_please - where - right = (False, True) - left = (False, False) - error_please = (True, False) -\end{code} - - -%************************************************************************ -%* * -\subsection[Top-level/local]{Top-level/not-top level flag} -%* * -%************************************************************************ - -\begin{code} -data TopLevelFlag - = TopLevel - | NotTopLevel - -isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool - -isNotTopLevel NotTopLevel = True -isNotTopLevel TopLevel = False - -isTopLevel TopLevel = True -isTopLevel NotTopLevel = False - -instance Outputable TopLevelFlag where - ppr TopLevel = ptext SLIT("") - ppr NotTopLevel = ptext SLIT("") -\end{code} - - -%************************************************************************ -%* * -\subsection[Top-level/local]{Top-level/not-top level flag} -%* * -%************************************************************************ - -\begin{code} -data Boxity - = Boxed - | Unboxed - deriving( Eq ) - -isBoxed :: Boxity -> Bool -isBoxed Boxed = True -isBoxed Unboxed = False -\end{code} - - -%************************************************************************ -%* * -\subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag} -%* * -%************************************************************************ - -\begin{code} -data RecFlag = Recursive - | NonRecursive - deriving( Eq ) - -isRec :: RecFlag -> Bool -isRec Recursive = True -isRec NonRecursive = False - -isNonRec :: RecFlag -> Bool -isNonRec Recursive = False -isNonRec NonRecursive = True - -boolToRecFlag :: Bool -> RecFlag -boolToRecFlag True = Recursive -boolToRecFlag False = NonRecursive - -instance Outputable RecFlag where - ppr Recursive = ptext SLIT("Recursive") - ppr NonRecursive = ptext SLIT("NonRecursive") -\end{code} - -%************************************************************************ -%* * - Tuples -%* * -%************************************************************************ - -\begin{code} -data TupCon = TupCon Boxity Arity - -instance Eq TupCon where - (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2 - -tupleParens :: Boxity -> SDoc -> SDoc -tupleParens Boxed p = parens p -tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)") -\end{code} - -%************************************************************************ -%* * -\subsection[Generic]{Generic flag} -%* * -%************************************************************************ - -This is the "Embedding-Projection pair" datatype, it contains -two pieces of code (normally either RenamedExpr's or Id's) -If we have a such a pair (EP from to), the idea is that 'from' and 'to' -represents functions of type - - from :: T -> Tring - to :: Tring -> T - -And we should have - - to (from x) = x - -T and Tring are arbitrary, but typically T is the 'main' type while -Tring is the 'representation' type. (This just helps us remember -whether to use 'from' or 'to'. - -\begin{code} -data EP a = EP { fromEP :: a, -- :: T -> Tring - toEP :: a } -- :: Tring -> T -\end{code} - -Embedding-projection pairs are used in several places: - -First of all, each type constructor has an EP associated with it, the -code in EP converts (datatype T) from T to Tring and back again. - -Secondly, when we are filling in Generic methods (in the typechecker, -tcMethodBinds), we are constructing bimaps by induction on the structure -of the type of the method signature. - - -%************************************************************************ -%* * -\subsection{Occurrence information} -%* * -%************************************************************************ - -This data type is used exclusively by the simplifier, but it appears in a -SubstResult, which is currently defined in VarEnv, which is pretty near -the base of the module hierarchy. So it seemed simpler to put the -defn of OccInfo here, safely at the bottom - -\begin{code} -data OccInfo - = NoOccInfo - - | IAmDead -- Marks unused variables. Sometimes useful for - -- lambda and case-bound variables. - - | OneOcc !InsideLam - !OneBranch - !InterestingCxt - - | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers - -- in a group of recursive definitions - -isNoOcc :: OccInfo -> Bool -isNoOcc NoOccInfo = True -isNoOcc other = False - -seqOccInfo :: OccInfo -> () -seqOccInfo occ = occ `seq` () - ------------------ -type InterestingCxt = Bool -- True <=> Function: is applied - -- Data value: scrutinised by a case with - -- at least one non-DEFAULT branch - ------------------ -type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda - -- Substituting a redex for this occurrence is - -- dangerous because it might duplicate work. -insideLam = True -notInsideLam = False - ------------------ -type OneBranch = Bool -- True <=> Occurs in only one case branch - -- so no code-duplication issue to worry about -oneBranch = True -notOneBranch = False - -isLoopBreaker :: OccInfo -> Bool -isLoopBreaker IAmALoopBreaker = True -isLoopBreaker other = False - -isDeadOcc :: OccInfo -> Bool -isDeadOcc IAmDead = True -isDeadOcc other = False - -isOneOcc (OneOcc _ _ _) = True -isOneOcc other = False - -isFragileOcc :: OccInfo -> Bool -isFragileOcc (OneOcc _ _ _) = True -isFragileOcc other = False -\end{code} - -\begin{code} -instance Outputable OccInfo where - -- only used for debugging; never parsed. KSW 1999-07 - ppr NoOccInfo = empty - ppr IAmALoopBreaker = ptext SLIT("LoopBreaker") - ppr IAmDead = ptext SLIT("Dead") - ppr (OneOcc inside_lam one_branch int_cxt) - = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args - where - pp_lam | inside_lam = char 'L' - | otherwise = empty - pp_br | one_branch = empty - | otherwise = char '*' - pp_args | int_cxt = char '!' - | otherwise = empty - -instance Show OccInfo where - showsPrec p occ = showsPrecSDoc p (ppr occ) -\end{code} - -%************************************************************************ -%* * -\subsection{Strictness indication} -%* * -%************************************************************************ - -The strictness annotations on types in data type declarations -e.g. data T = MkT !Int !(Bool,Bool) - -\begin{code} -data StrictnessMark -- Used in interface decls only - = MarkedStrict - | MarkedUnboxed - | NotMarkedStrict - deriving( Eq ) - -isMarkedUnboxed MarkedUnboxed = True -isMarkedUnboxed other = False - -isMarkedStrict NotMarkedStrict = False -isMarkedStrict other = True -- All others are strict - -instance Outputable StrictnessMark where - ppr MarkedStrict = ptext SLIT("!") - ppr MarkedUnboxed = ptext SLIT("!!") - ppr NotMarkedStrict = ptext SLIT("_") -\end{code} - - -%************************************************************************ -%* * -\subsection{Success flag} -%* * -%************************************************************************ - -\begin{code} -data SuccessFlag = Succeeded | Failed - -successIf :: Bool -> SuccessFlag -successIf True = Succeeded -successIf False = Failed - -succeeded, failed :: SuccessFlag -> Bool -succeeded Succeeded = True -succeeded Failed = False - -failed Succeeded = False -failed Failed = True -\end{code} - - -%************************************************************************ -%* * -\subsection{Activation} -%* * -%************************************************************************ - -When a rule or inlining is active - -\begin{code} -type CompilerPhase = Int -- Compilation phase - -- Phases decrease towards zero - -- Zero is the last phase - -data Activation = NeverActive - | AlwaysActive - | ActiveBefore CompilerPhase -- Active only *before* this phase - | ActiveAfter CompilerPhase -- Active in this phase and later - deriving( Eq ) -- Eq used in comparing rules in HsDecls - -data InlineSpec - = Inline - Activation -- Says during which phases inlining is allowed - Bool -- True <=> make the RHS look small, so that when inlining - -- is enabled, it will definitely actually happen - deriving( Eq ) - -defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced -alwaysInlineSpec = Inline AlwaysActive True -- INLINE always -neverInlineSpec = Inline NeverActive False -- NOINLINE - -instance Outputable Activation where - ppr AlwaysActive = empty -- The default - ppr (ActiveBefore n) = brackets (char '~' <> int n) - ppr (ActiveAfter n) = brackets (int n) - ppr NeverActive = ptext SLIT("NEVER") - -instance Outputable InlineSpec where - ppr (Inline act True) = ptext SLIT("INLINE") <> ppr act - ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act - -isActive :: CompilerPhase -> Activation -> Bool -isActive p NeverActive = False -isActive p AlwaysActive = True -isActive p (ActiveAfter n) = p <= n -isActive p (ActiveBefore n) = p > n - -isNeverActive, isAlwaysActive :: Activation -> Bool -isNeverActive NeverActive = True -isNeverActive act = False - -isAlwaysActive AlwaysActive = True -isAlwaysActive other = False -\end{code} -