X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FBasicTypes.lhs;h=14c9893befceea90ba6f5dccda01e7823f58afc1;hb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;hp=5ddc45204a7317e3e5c9629a7b044e15465877f9;hpb=b5c71bff716366ae888bf120776d3e163c86c60a;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs index 5ddc452..14c9893 100644 --- a/ghc/compiler/basicTypes/BasicTypes.lhs +++ b/ghc/compiler/basicTypes/BasicTypes.lhs @@ -14,7 +14,7 @@ types that \begin{code} module BasicTypes( - Version, + Version, bumpVersion, initialVersion, bogusVersion, Arity, @@ -29,7 +29,10 @@ module BasicTypes( TopLevelFlag(..), isTopLevel, isNotTopLevel, + Boxity(..), isBoxed, tupleParens, + OccInfo(..), seqOccInfo, isFragileOccInfo, isLoopBreaker, + InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch @@ -75,6 +78,15 @@ type Arity = Int \begin{code} type Version = Int + +bogusVersion :: Version -- Shouldn't look at these +bogusVersion = error "bogusVersion" + +bumpVersion :: Version -> Version +bumpVersion v = v+1 + +initialVersion :: Version +initialVersion = 1 \end{code} @@ -146,6 +158,28 @@ isTopLevel NotTopLevel = False %************************************************************************ %* * +\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 + +tupleParens :: Boxity -> SDoc -> SDoc +tupleParens Boxed p = parens p +tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)") +\end{code} + + +%************************************************************************ +%* * \subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag} %* * %************************************************************************