\begin{code}
module BasicTypes(
- Version, bumpVersion, initialVersion, bogusVersion,
+ Version, bumpVersion, initialVersion,
Arity,
+
+ DeprecTxt,
- Unused, unused,
-
- FixitySig(..), Fixity(..), FixityDirection(..),
+ Fixity(..), FixityDirection(..),
defaultFixity, maxPrecedence,
- arrowFixity, negateFixity, negatePrecedence,
+ negateFixity,
compareFixity,
IPName(..), ipNameName, mapIPName,
- NewOrData(..),
-
- RecFlag(..), isRec, isNonRec,
+ RecFlag(..), isRec, isNonRec, boolToRecFlag,
TopLevelFlag(..), isTopLevel, isNotTopLevel,
- Boxity(..), isBoxed, tupleParens,
+ Boxity(..), isBoxed,
+
+ TupCon(..), tupleParens,
OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
isDeadOcc, isLoopBreaker,
#include "HsVersions.h"
+import FastString( FastString )
import Outputable
-import SrcLoc
\end{code}
%************************************************************************
%* *
-\subsection[Unused]{Unused}
-%* *
-%************************************************************************
-
-Used as a placeholder in types.
-
-\begin{code}
-type Unused = ()
-
-unused :: Unused
-unused = error "Unused is used!"
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection[Arity]{Arity}
%* *
%************************************************************************
\begin{code}
type Version = Int
-bogusVersion :: Version -- Shouldn't look at these
-bogusVersion = error "bogusVersion"
-
-bumpVersion :: Bool -> Version -> Version
--- Bump if the predicate (typically equality between old and new) is false
-bumpVersion False v = v+1
-bumpVersion True v = v
+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}
%************************************************************************
%* *
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 FixitySig name = FixitySig name Fixity SrcLoc
-
-instance Eq name => Eq (FixitySig name) where
- (FixitySig n1 f1 _) == (FixitySig n2 f2 _) = n1==n2 && f1==f2
-
-instance Outputable name => Outputable (FixitySig name) where
- ppr (FixitySig name fixity loc) = sep [ppr fixity, ppr name]
-
-------------------------
data Fixity = Fixity Int FixityDirection
instance Outputable Fixity where
negateFixity :: Fixity
negateFixity = Fixity negatePrecedence InfixL -- Precedence of unary negate is wired in as infixl 6!
-arrowFixity :: Fixity -- Fixity of '->' in types
-arrowFixity = Fixity 0 InfixR
-
negatePrecedence :: Int
negatePrecedence = 6
\end{code}
%************************************************************************
%* *
-\subsection[NewType/DataType]{NewType/DataType flag}
-%* *
-%************************************************************************
-
-\begin{code}
-data NewOrData
- = NewType -- "newtype Blah ..."
- | DataType -- "data Blah ..."
- deriving( Eq ) -- Needed because Demand derives Eq
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection[Top-level/local]{Top-level/not-top level flag}
%* *
%************************************************************************
isTopLevel TopLevel = True
isTopLevel NotTopLevel = False
+
+instance Outputable TopLevelFlag where
+ ppr TopLevel = ptext SLIT("<TopLevel>")
+ ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
\end{code}
+
%************************************************************************
%* *
\subsection[Top-level/local]{Top-level/not-top level flag}
isBoxed :: Boxity -> Bool
isBoxed Boxed = True
isBoxed Unboxed = False
-
-tupleParens :: Boxity -> SDoc -> SDoc
-tupleParens Boxed p = parens p
-tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
\end{code}
\begin{code}
data RecFlag = Recursive
| NonRecursive
+ deriving( Eq )
isRec :: RecFlag -> Bool
isRec Recursive = True
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}
%************************************************************************
%************************************************************************
This is the "Embedding-Projection pair" datatype, it contains
-two pieces of code (normally either RenamedHsExpr's or Id's)
+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
instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07
ppr NoOccInfo = empty
- ppr IAmALoopBreaker = ptext SLIT("_Kx")
- ppr IAmDead = ptext SLIT("_Kd")
- ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl")
- | one_branch = ptext SLIT("_Ks")
- | otherwise = ptext SLIT("_Ks*")
+ ppr IAmALoopBreaker = ptext SLIT("LoopBreaker")
+ ppr IAmDead = ptext SLIT("Dead")
+ ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("OnceInLam")
+ | one_branch = ptext SLIT("Once")
+ | otherwise = ptext SLIT("OnceEachBranch")
instance Show OccInfo where
showsPrec p occ = showsPrecSDoc p (ppr occ)
e.g. data T = MkT !Int !(Bool,Bool)
\begin{code}
-data StrictnessMark
- = MarkedUserStrict -- "!" in a source decl
- | MarkedStrict -- "!" in an interface decl: strict but not unboxed
- | MarkedUnboxed -- "!!" in an interface decl: unboxed
- | NotMarkedStrict -- No annotation at all
+data StrictnessMark -- Used in interface decls only
+ = MarkedStrict
+ | MarkedUnboxed
+ | NotMarkedStrict
deriving( Eq )
isMarkedUnboxed MarkedUnboxed = True
isMarkedStrict other = True -- All others are strict
instance Outputable StrictnessMark where
- ppr MarkedUserStrict = ptext SLIT("!u")
ppr MarkedStrict = ptext SLIT("!")
- ppr MarkedUnboxed = ptext SLIT("! !")
- ppr NotMarkedStrict = empty
+ ppr MarkedUnboxed = ptext SLIT("!!")
+ ppr NotMarkedStrict = ptext SLIT("_")
\end{code}
projects / ghc-hetmet.git / blobdiff