compiler: de-lhs basicTypes/
authorAustin Seipp <austin@well-typed.com>
Wed, 3 Dec 2014 18:44:39 +0000 (12:44 -0600)
committerAustin Seipp <austin@well-typed.com>
Wed, 3 Dec 2014 19:52:27 +0000 (13:52 -0600)
Signed-off-by: Austin Seipp <austin@well-typed.com>
28 files changed:
compiler/basicTypes/BasicTypes.hs [moved from compiler/basicTypes/BasicTypes.lhs with 80% similarity]
compiler/basicTypes/ConLike.hs [moved from compiler/basicTypes/ConLike.lhs with 68% similarity]
compiler/basicTypes/DataCon.hs [moved from compiler/basicTypes/DataCon.lhs with 95% similarity]
compiler/basicTypes/DataCon.hs-boot [moved from compiler/basicTypes/DataCon.lhs-boot with 95% similarity]
compiler/basicTypes/Demand.hs [moved from compiler/basicTypes/Demand.lhs with 91% similarity]
compiler/basicTypes/Id.hs [moved from compiler/basicTypes/Id.lhs with 92% similarity]
compiler/basicTypes/IdInfo.hs [moved from compiler/basicTypes/IdInfo.lhs with 84% similarity]
compiler/basicTypes/IdInfo.hs-boot [moved from compiler/basicTypes/IdInfo.lhs-boot with 86% similarity]
compiler/basicTypes/Literal.hs [moved from compiler/basicTypes/Literal.lhs with 94% similarity]
compiler/basicTypes/MkId.hs [moved from compiler/basicTypes/MkId.lhs with 94% similarity]
compiler/basicTypes/MkId.hs-boot [moved from compiler/basicTypes/MkId.lhs-boot with 90% similarity]
compiler/basicTypes/Module.hs [moved from compiler/basicTypes/Module.lhs with 90% similarity]
compiler/basicTypes/Module.hs-boot [moved from compiler/basicTypes/Module.lhs-boot with 88% similarity]
compiler/basicTypes/Name.hs [moved from compiler/basicTypes/Name.lhs with 87% similarity]
compiler/basicTypes/Name.hs-boot [moved from compiler/basicTypes/Name.lhs-boot with 78% similarity]
compiler/basicTypes/NameEnv.hs [moved from compiler/basicTypes/NameEnv.lhs with 83% similarity]
compiler/basicTypes/NameSet.hs [moved from compiler/basicTypes/NameSet.lhs with 83% similarity]
compiler/basicTypes/OccName.hs [moved from compiler/basicTypes/OccName.lhs with 88% similarity]
compiler/basicTypes/OccName.hs-boot [moved from compiler/basicTypes/OccName.lhs-boot with 59% similarity]
compiler/basicTypes/PatSyn.hs [moved from compiler/basicTypes/PatSyn.lhs with 90% similarity]
compiler/basicTypes/PatSyn.hs-boot [moved from compiler/basicTypes/PatSyn.lhs-boot with 94% similarity]
compiler/basicTypes/RdrName.hs [moved from compiler/basicTypes/RdrName.lhs with 93% similarity]
compiler/basicTypes/SrcLoc.hs [moved from compiler/basicTypes/SrcLoc.lhs with 85% similarity]
compiler/basicTypes/UniqSupply.hs [moved from compiler/basicTypes/UniqSupply.lhs with 87% similarity]
compiler/basicTypes/Unique.hs [moved from compiler/basicTypes/Unique.lhs with 85% similarity]
compiler/basicTypes/Var.hs [moved from compiler/basicTypes/Var.lhs with 88% similarity]
compiler/basicTypes/VarEnv.hs [moved from compiler/basicTypes/VarEnv.lhs with 91% similarity]
compiler/basicTypes/VarSet.hs [moved from compiler/basicTypes/VarSet.lhs with 88% similarity]

similarity index 80%
rename from compiler/basicTypes/BasicTypes.lhs
rename to compiler/basicTypes/BasicTypes.hs
index d8c6519..d2207d4 100644 (file)
@@ -1,7 +1,7 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1997-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1997-1998
+
 \section[BasicTypes]{Miscellanous types}
 
 This module defines a miscellaneously collection of very simple
@@ -12,8 +12,8 @@ types that
 \item don't depend on any other complicated types
 \item are used in more than one "part" of the compiler
 \end{itemize}
+-}
 
-\begin{code}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module BasicTypes(
@@ -94,15 +94,15 @@ import SrcLoc ( Located,unLoc )
 import Data.Data hiding (Fixity)
 import Data.Function (on)
 import GHC.Exts (Any)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Arity]{Arity}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | The number of value arguments that can be applied to a value before it does
 -- "real work". So:
 --  fib 100     has arity 0
@@ -115,40 +115,40 @@ type Arity = Int
 --  \x -> fib x                has representation arity 1
 --  \(# x, y #) -> fib (x + y) has representation arity 2
 type RepArity = Int
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
               Constructor tags
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Type of the tags associated with each constructor possibility
 type ConTag = Int
 
 fIRST_TAG :: ConTag
 -- ^ Tags are allocated from here for real constructors
 fIRST_TAG =  1
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Alignment]{Alignment}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
          One-shot information
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
 -- variable info. Sometimes we know whether the lambda binding this variable
 -- is a \"one-shot\" lambda; that is, whether it is applied at most once.
@@ -191,16 +191,15 @@ pprOneShotInfo OneShotLam    = ptext (sLit "OneShot")
 
 instance Outputable OneShotInfo where
     ppr = pprOneShotInfo
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
            Swap flag
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data SwapFlag
   = NotSwapped  -- Args are: actual,   expected
   | IsSwapped   -- Args are: expected, actual
@@ -220,32 +219,30 @@ isSwapped NotSwapped = False
 unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
 unSwap NotSwapped f a b = f a b
 unSwap IsSwapped  f a b = f b a
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[FunctionOrData]{FunctionOrData}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data FunctionOrData = IsFunction | IsData
     deriving (Eq, Ord, Data, Typeable)
 
 instance Outputable FunctionOrData where
     ppr IsFunction = text "(function)"
     ppr IsData     = text "(data)"
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Version]{Module and identifier version numbers}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type Version = Int
 
 bumpVersion :: Version -> Version
@@ -253,16 +250,15 @@ bumpVersion v = v+1
 
 initialVersion :: Version
 initialVersion = 1
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Deprecations
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-
-\begin{code}
 -- reason/explanation from a WARNING or DEPRECATED pragma
 data WarningTxt = WarningTxt [Located FastString]
                 | DeprecatedTxt [Located FastString]
@@ -272,25 +268,25 @@ instance Outputable WarningTxt where
     ppr (WarningTxt    ws) = doubleQuotes (vcat (map (ftext . unLoc) ws))
     ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
                              doubleQuotes (vcat (map (ftext . unLoc) ds))
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Rules
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type RuleName = FastString
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Fixity]{Fixity info}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 ------------------------
 data Fixity = Fixity Int FixityDirection
   deriving (Data, Typeable)
@@ -322,8 +318,8 @@ 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}
@@ -331,8 +327,8 @@ Consider
 \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)
@@ -348,16 +344,15 @@ compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
     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
@@ -373,16 +368,15 @@ isTopLevel NotTopLevel  = False
 instance Outputable TopLevelFlag where
   ppr TopLevel    = ptext (sLit "<TopLevel>")
   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Boxity flag
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data Boxity
   = Boxed
   | Unboxed
@@ -391,16 +385,15 @@ data Boxity
 isBoxed :: Boxity -> Bool
 isBoxed Boxed   = True
 isBoxed Unboxed = False
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Recursive/Non-Recursive flag
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data RecFlag = Recursive
              | NonRecursive
              deriving( Eq, Data, Typeable )
@@ -420,14 +413,15 @@ boolToRecFlag False = NonRecursive
 instance Outputable RecFlag where
   ppr Recursive    = ptext (sLit "Recursive")
   ppr NonRecursive = ptext (sLit "NonRecursive")
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Code origin
-%*                                                                      *
-%************************************************************************
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
+
 data Origin = FromSource
             | Generated
             deriving( Eq, Data, Typeable )
@@ -439,15 +433,15 @@ isGenerated FromSource = False
 instance Outputable Origin where
   ppr FromSource  = ptext (sLit "FromSource")
   ppr Generated   = ptext (sLit "Generated")
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Instance overlap flag
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | The semantics allowed for overlapping instances for a particular
 -- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.lhs`) for a
 -- explanation of the `isSafeOverlap` field.
@@ -541,15 +535,15 @@ instance Outputable OverlapMode where
 pprSafeOverlap :: Bool -> SDoc
 pprSafeOverlap True  = ptext $ sLit "[safe]"
 pprSafeOverlap False = empty
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Tuples
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data TupleSort
   = BoxedTuple
   | UnboxedTuple
@@ -570,13 +564,13 @@ tupleParens BoxedTuple      p = parens p
 tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples
                                          -- directly, we overload the (,,) syntax
 tupleParens UnboxedTuple 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)
@@ -593,12 +587,12 @@ And we should have
 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
@@ -609,18 +603,18 @@ 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}
 -- | Identifier occurrence information
 data OccInfo
   = NoOccInfo           -- ^ There are many occurrences, or unknown occurrences
@@ -639,8 +633,8 @@ data OccInfo
         !RulesOnly
 
 type RulesOnly = Bool
-\end{code}
 
+{-
 Note [LoopBreaker OccInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
    IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
@@ -650,9 +644,8 @@ Note [LoopBreaker OccInfo]
                              Do not inline at all
 
 See OccurAnal Note [Weak loop breakers]
+-}
 
-
-\begin{code}
 isNoOcc :: OccInfo -> Bool
 isNoOcc NoOccInfo = True
 isNoOcc _         = False
@@ -703,9 +696,7 @@ isOneOcc _           = False
 zapFragileOcc :: OccInfo -> OccInfo
 zapFragileOcc (OneOcc {}) = NoOccInfo
 zapFragileOcc occ         = occ
-\end{code}
 
-\begin{code}
 instance Outputable OccInfo where
   -- only used for debugging; never parsed.  KSW 1999-07
   ppr NoOccInfo            = empty
@@ -720,20 +711,20 @@ instance Outputable OccInfo where
                  | otherwise  = char '*'
           pp_args | int_cxt   = char '!'
                   | otherwise = empty
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Default method specfication
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 The DefMethSpec enumeration just indicates what sort of default method
 is used for a class. It is generated from source code, and present in
 interface files; it is converted to Class.DefMeth before begin put in a
 Class object.
+-}
 
-\begin{code}
 data DefMethSpec = NoDM        -- No default method
                  | VanillaDM   -- Default method given with polymorphic code
                  | GenericDM   -- Default method given with generic code
@@ -743,15 +734,15 @@ instance Outputable DefMethSpec where
   ppr NoDM      = empty
   ppr VanillaDM = ptext (sLit "{- Has default method -}")
   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Success flag}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data SuccessFlag = Succeeded | Failed
 
 instance Outputable SuccessFlag where
@@ -768,18 +759,17 @@ succeeded Failed    = False
 
 failed Succeeded = False
 failed Failed    = True
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Activation}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 When a rule or inlining is active
+-}
 
-\begin{code}
 type PhaseNum = Int  -- Compilation phase
                      -- Phases decrease towards zero
                      -- Zero is the last phase
@@ -827,8 +817,8 @@ data InlineSpec   -- What the user's INLINE pragma looked like
                      -- where there isn't any real inline pragma at all
   deriving( Eq, Data, Typeable, Show )
         -- Show needed for Lexer.x
-\end{code}
 
+{-
 Note [InlinePragma]
 ~~~~~~~~~~~~~~~~~~~
 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
@@ -879,8 +869,8 @@ The main effects of CONLIKE are:
 
     - The rule matcher consults this field.  See
       Note [Expanding variables] in Rules.lhs.
+-}
 
-\begin{code}
 isConLike :: RuleMatchInfo -> Bool
 isConLike ConLike = True
 isConLike _            = False
@@ -1003,11 +993,7 @@ isAlwaysActive _            = False
 isEarlyActive AlwaysActive      = True
 isEarlyActive (ActiveBefore {}) = True
 isEarlyActive _                 = False
-\end{code}
-
 
-
-\begin{code}
 -- Used (instead of Rational) to represent exactly the floating point literal that we
 -- encountered in the user's source program. This allows us to pretty-print exactly what
 -- the user wrote, which is important e.g. for floating point numbers that can't represented
@@ -1037,10 +1023,5 @@ instance Ord FractionalLit where
 
 instance Outputable FractionalLit where
   ppr = text . fl_text
-\end{code}
-
-\begin{code}
 
 newtype HValue = HValue Any
-
-\end{code}
similarity index 68%
rename from compiler/basicTypes/ConLike.lhs
rename to compiler/basicTypes/ConLike.hs
index 3414aa4..7b8f70d 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+
 \section[ConLike]{@ConLike@: Constructor-like things}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module ConLike (
@@ -23,29 +23,28 @@ import Name
 import Data.Function (on)
 import qualified Data.Data as Data
 import qualified Data.Typeable
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Constructor-like things}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A constructor-like thing
 data ConLike = RealDataCon DataCon
              | PatSynCon PatSyn
   deriving Data.Typeable.Typeable
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Instances}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Eq ConLike where
     (==) = (==) `on` getUnique
     (/=) = (/=) `on` getUnique
@@ -80,4 +79,3 @@ instance Data.Data ConLike where
     toConstr _   = abstractConstr "ConLike"
     gunfold _ _  = error "gunfold"
     dataTypeOf _ = mkNoRepType "ConLike"
-\end{code}
similarity index 95%
rename from compiler/basicTypes/DataCon.lhs
rename to compiler/basicTypes/DataCon.hs
index e57439d..09196fb 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+
 \section[DataCon]{@DataCon@: Data Constructors}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module DataCon (
@@ -71,9 +71,8 @@ import qualified Data.Typeable
 import Data.Maybe
 import Data.Char
 import Data.Word
-\end{code}
-
 
+{-
 Data constructor representation
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following Haskell data type declaration
@@ -238,13 +237,13 @@ Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
 
 Note that (Foo a) might not be an instance of Ord.
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Data constructors}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A data constructor
 --
 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
@@ -460,8 +459,8 @@ data HsBang
 -- StrictnessMark is internal only, used to indicate strictness
 -- of the DataCon *worker* fields
 data StrictnessMark = MarkedStrict | NotMarkedStrict
-\end{code}
 
+{-
 Note [Data con representation]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The dcRepType field contains the type of the representation of a contructor
@@ -502,13 +501,13 @@ For imported data types, the dcArgBangs field is just the same as the
 dcr_bangs field; we don't know what the user originally said.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Instances}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Eq DataCon where
     a == b = getUnique a == getUnique b
     a /= b = getUnique a /= getUnique b
@@ -572,16 +571,15 @@ isBanged _                         = True
 isMarkedStrict :: StrictnessMark -> Bool
 isMarkedStrict NotMarkedStrict = False
 isMarkedStrict _               = True   -- All others are strict
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Construction}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Build a new data constructor
 mkDataCon :: Name
           -> Bool               -- ^ Is the constructor declared infix?
@@ -659,8 +657,8 @@ mkDataCon name declared_infix
 
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv) ty | (tv,ty) <- spec ]
-\end{code}
 
+{-
 Note [Unpack equality predicates]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we have a GADT with a contructor C :: (a~[b]) => b -> T a
@@ -669,8 +667,8 @@ takes no space at all.  This is easily done: just give it
 an UNPACK pragma. The rest of the unpack/repack code does the
 heavy lifting.  This one line makes every GADT take a word less
 space for each equality predicate, so it's pretty important!
+-}
 
-\begin{code}
 -- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
 dataConName :: DataCon -> Name
 dataConName = dcName
@@ -911,9 +909,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
     map (substTyWith tyvars inst_tys) arg_tys
   where
     tyvars = univ_tvs ++ ex_tvs
-\end{code}
 
-\begin{code}
 -- | Returns the argument types of the wrapper, excluding all dictionary arguments
 -- and without substituting for any type variables
 dataConOrigArgTys :: DataCon -> [Type]
@@ -929,9 +925,7 @@ dataConRepArgTys (MkData { dcRep = rep
   = case rep of
       NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys
       DCR { dcr_arg_tys = arg_tys } -> arg_tys
-\end{code}
 
-\begin{code}
 -- | The string @package:module.name@ identifying a constructor, which is attached
 -- to its info table and used by the GHCi debugger and the heap profiler
 dataConIdentity :: DataCon -> [Word8]
@@ -941,9 +935,7 @@ dataConIdentity dc = bytesFS (packageKeyFS (modulePackageKey mod)) ++
                   fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
   where name = dataConName dc
         mod  = ASSERT( isExternalName name ) nameModule name
-\end{code}
 
-\begin{code}
 isTupleDataCon :: DataCon -> Bool
 isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
 
@@ -953,16 +945,12 @@ isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
 -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
 isVanillaDataCon :: DataCon -> Bool
 isVanillaDataCon dc = dcVanilla dc
-\end{code}
 
-\begin{code}
 classDataCon :: Class -> DataCon
 classDataCon clas = case tyConDataCons (classTyCon clas) of
                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
                       [] -> panic "classDataCon"
-\end{code}
 
-\begin{code}
 dataConCannotMatch :: [Type] -> DataCon -> Bool
 -- Returns True iff the data con *definitely cannot* match a
 --                  scrutinee of type (T tys)
@@ -986,18 +974,18 @@ dataConCannotMatch tys con
                      EqPred ty1 ty2 -> [(ty1, ty2)]
                      TuplePred ts   -> concatMap predEqs ts
                      _              -> []
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
               Building an algebraic data type
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 buildAlgTyCon is here because it is called from TysWiredIn, which in turn
 depends on DataCon, but not on BuildTyCl.
+-}
 
-\begin{code}
 buildAlgTyCon :: Name
               -> [TyVar]               -- ^ Kind variables and type variables
               -> [Role]
@@ -1024,28 +1012,27 @@ buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
     mb_promoted_tc
       | is_promotable = Just (mkPromotedTyCon tc (promoteKind kind))
       | otherwise     = Nothing
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
         Promoting of data types to the kind level
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 These two 'promoted..' functions are here because
  * They belong together
  * 'promoteDataCon' depends on DataCon stuff
+-}
 
-\begin{code}
 promoteDataCon :: DataCon -> TyCon
 promoteDataCon (MkData { dcPromoted = Just tc }) = tc
 promoteDataCon dc = pprPanic "promoteDataCon" (ppr dc)
 
 promoteDataCon_maybe :: DataCon -> Maybe TyCon
 promoteDataCon_maybe (MkData { dcPromoted = mb_tc }) = mb_tc
-\end{code}
 
+{-
 Note [Promoting a Type to a Kind]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Suppsoe we have a data constructor D
@@ -1062,8 +1049,8 @@ The transformation from type to kind is done by promoteType
   * Ensure that all type constructors mentioned (Maybe and T
     in the example) are promotable; that is, they have kind
           * -> ... -> * -> *
+-}
 
-\begin{code}
 -- | Promotes a type to a kind.
 -- Assumes the argument satisfies 'isPromotableType'
 promoteType :: Type -> Kind
@@ -1088,15 +1075,15 @@ promoteKind (TyConApp tc [])
   | tc `hasKey` liftedTypeKindTyConKey = superKind
 promoteKind (FunTy arg res) = FunTy (promoteKind arg) (promoteKind res)
 promoteKind k = pprPanic "promoteKind" (ppr k)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Splitting products}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Extract the type constructor, type argument, data constructor and it's
 -- /representation/ argument types from a type if it is a product type.
 --
@@ -1126,4 +1113,3 @@ splitDataProductType_maybe ty
   = Just (tycon, ty_args, con, dataConInstArgTys con ty_args)
   | otherwise
   = Nothing
-\end{code}
similarity index 95%
rename from compiler/basicTypes/DataCon.lhs-boot
rename to compiler/basicTypes/DataCon.hs-boot
index 08920cc..5370a87 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module DataCon where
 import Name( Name, NamedThing )
 import {-# SOURCE #-} TyCon( TyCon )
@@ -17,4 +16,3 @@ instance Uniquable DataCon
 instance NamedThing DataCon
 instance Outputable DataCon
 instance OutputableBndr DataCon
-\end{code}
similarity index 91%
rename from compiler/basicTypes/Demand.lhs
rename to compiler/basicTypes/Demand.hs
index f553fc2..ecf22bc 100644 (file)
@@ -1,22 +1,22 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
 \section[Demand]{@Demand@: A decoupled implementation of a demand domain}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
 
 module Demand (
-        StrDmd, UseDmd(..), Count(..), 
+        StrDmd, UseDmd(..), Count(..),
         countOnce, countMany,   -- cardinality
 
-        Demand, CleanDemand, 
+        Demand, CleanDemand,
         mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd,
-        getUsage, toCleanDmd, 
+        getUsage, toCleanDmd,
         absDmd, topDmd, botDmd, seqDmd,
-        lubDmd, bothDmd, apply1Dmd, apply2Dmd, 
-        isTopDmd, isBotDmd, isAbsDmd, isSeqDmd, 
+        lubDmd, bothDmd, apply1Dmd, apply2Dmd,
+        isTopDmd, isBotDmd, isAbsDmd, isSeqDmd,
         peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,
 
         DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
@@ -30,14 +30,14 @@ module Demand (
         DmdResult, CPRResult,
         isBotRes, isTopRes,
         topRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes,
-        appIsBottom, isBottomingSig, pprIfaceStrictSig, 
+        appIsBottom, isBottomingSig, pprIfaceStrictSig,
         trimCPRInfo, returnsCPR_maybe,
         StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig,
         isNopSig, splitStrictSig, increaseStrictSigArity,
 
-        seqDemand, seqDemandList, seqDmdType, seqStrictSig, 
+        seqDemand, seqDemandList, seqDmdType, seqStrictSig,
 
-        evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd, 
+        evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd,
         splitDmdTy, splitFVs,
         deferAfterIO,
         postProcessUnsat, postProcessDmdTypeM,
@@ -70,13 +70,13 @@ import Type            ( Type, isUnLiftedType )
 import TyCon           ( isNewTyCon, isClassTyCon )
 import DataCon         ( splitDataProductType_maybe )
 import FastString
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Strictness domain}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
         Lazy
          |
@@ -85,12 +85,11 @@ import FastString
   SCall      SProd
       \      /
       HyperStr
-
-\begin{code}
+-}
 
 -- Vanilla strictness domain
 data StrDmd
-  = HyperStr             -- Hyper-strict 
+  = HyperStr             -- Hyper-strict
                          -- Bottom of the lattice
                          -- Note [HyperStr and Use demands]
 
@@ -168,7 +167,7 @@ lubStr HeadStr   _             = HeadStr
 
 bothMaybeStr :: MaybeStr -> MaybeStr -> MaybeStr
 bothMaybeStr Lazy     s           = s
-bothMaybeStr s        Lazy        = s 
+bothMaybeStr s        Lazy        = s
 bothMaybeStr (Str s1) (Str s2) = Str (s1 `bothStr` s2)
 
 bothStr :: StrDmd -> StrDmd -> StrDmd
@@ -181,7 +180,7 @@ bothStr (SCall _)  (SProd _)   = HyperStr  -- Weird
 
 bothStr (SProd _)  HyperStr    = HyperStr
 bothStr (SProd s1) HeadStr     = SProd s1
-bothStr (SProd s1) (SProd s2) 
+bothStr (SProd s1) (SProd s2)
     | length s1 == length s2   = mkSProd (zipWith bothMaybeStr s1 s2)
     | otherwise                = HyperStr  -- Weird
 bothStr (SProd _) (SCall _)    = HyperStr
@@ -189,7 +188,7 @@ bothStr (SProd _) (SCall _)    = HyperStr
 -- utility functions to deal with memory leaks
 seqStrDmd :: StrDmd -> ()
 seqStrDmd (SProd ds)   = seqStrDmdList ds
-seqStrDmd (SCall s)     = s `seq` () 
+seqStrDmd (SCall s)     = s `seq` ()
 seqStrDmd _            = ()
 
 seqStrDmdList :: [MaybeStr] -> ()
@@ -208,13 +207,13 @@ splitStrProdDmd n (SProd ds) = ASSERT( ds `lengthIs` n) Just ds
 splitStrProdDmd _ (SCall {}) = Nothing
       -- This can happen when the programmer uses unsafeCoerce,
       -- and we don't then want to crash the compiler (Trac #9208)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Absence domain}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
       Used
       /   \
@@ -223,21 +222,20 @@ splitStrProdDmd _ (SCall {}) = Nothing
       UHead
        |
       Abs
-
-\begin{code}
+-}
 
 -- Domain for genuine usage
 data UseDmd
   = UCall Count UseDmd   -- Call demand for absence
                          -- Used only for values of function type
 
-  | UProd [MaybeUsed]     -- Product 
+  | UProd [MaybeUsed]     -- Product
                          -- Used only for values of product type
                          -- See Note [Don't optimise UProd(Used) to Used]
                          -- [Invariant] Not all components are Abs
                          --             (in that case, use UHead)
 
-  | UHead                -- May be used; but its sub-components are 
+  | UHead                -- May be used; but its sub-components are
                          -- definitely *not* used.  Roughly U(AAA)
                          -- Eg the usage of x in x `seq` e
                          -- A polymorphic demand: used for values of all types,
@@ -254,17 +252,17 @@ data MaybeUsed
   = Abs                  -- Definitely unused
                          -- Bottom of the lattice
 
-  | Use Count UseDmd     -- May be used with some cardinality 
+  | Use Count UseDmd     -- May be used with some cardinality
   deriving ( Eq, Show )
 
 -- Abstract counting of usages
 data Count = One | Many
-  deriving ( Eq, Show )     
+  deriving ( Eq, Show )
 
 -- Pretty-printing
 instance Outputable MaybeUsed where
   ppr Abs           = char 'A'
-  ppr (Use Many a)   = ppr a 
+  ppr (Use Many a)   = ppr a
   ppr (Use One  a)   = char '1' <> char '*' <> ppr a
 
 instance Outputable UseDmd where
@@ -287,18 +285,18 @@ useBot     = Abs
 useTop     = Use Many Used
 
 mkUCall :: Count -> UseDmd -> UseDmd
---mkUCall c Used = Used c 
+--mkUCall c Used = Used c
 mkUCall c a  = UCall c a
 
 mkUProd :: [MaybeUsed] -> UseDmd
-mkUProd ux 
+mkUProd ux
   | all (== Abs) ux    = UHead
   | otherwise          = UProd ux
 
 lubCount :: Count -> Count -> Count
 lubCount _ Many = Many
 lubCount Many _ = Many
-lubCount x _    = x 
+lubCount x _    = x
 
 lubMaybeUsed :: MaybeUsed -> MaybeUsed -> MaybeUsed
 lubMaybeUsed Abs x                   = x
@@ -310,7 +308,7 @@ lubUse UHead       u               = u
 lubUse (UCall c u) UHead           = UCall c u
 lubUse (UCall c1 u1) (UCall c2 u2) = UCall (lubCount c1 c2) (lubUse u1 u2)
 lubUse (UCall _ _) _               = Used
-lubUse (UProd ux) UHead            = UProd ux 
+lubUse (UProd ux) UHead            = UProd ux
 lubUse (UProd ux1) (UProd ux2)
      | length ux1 == length ux2    = UProd $ zipWith lubMaybeUsed ux1 ux2
      | otherwise                   = Used
@@ -322,7 +320,7 @@ lubUse Used _                      = Used  -- Note [Used should win]
 
 -- `both` is different from `lub` in its treatment of counting; if
 -- `both` is computed for two used, the result always has
---  cardinality `Many` (except for the inner demands of UCall demand -- [TODO] explain).  
+--  cardinality `Many` (except for the inner demands of UCall demand -- [TODO] explain).
 --  Also,  x `bothUse` x /= x (for anything but Abs).
 
 bothMaybeUsed :: MaybeUsed -> MaybeUsed -> MaybeUsed
@@ -335,12 +333,12 @@ bothUse :: UseDmd -> UseDmd -> UseDmd
 bothUse UHead       u               = u
 bothUse (UCall c u) UHead           = UCall c u
 
--- Exciting special treatment of inner demand for call demands: 
+-- Exciting special treatment of inner demand for call demands:
 --    use `lubUse` instead of `bothUse`!
 bothUse (UCall _ u1) (UCall _ u2)   = UCall Many (u1 `lubUse` u2)
 
 bothUse (UCall {}) _                = Used
-bothUse (UProd ux) UHead            = UProd ux 
+bothUse (UProd ux) UHead            = UProd ux
 bothUse (UProd ux1) (UProd ux2)
       | length ux1 == length ux2    = UProd $ zipWith bothMaybeUsed ux1 ux2
       | otherwise                   = Used
@@ -353,8 +351,8 @@ bothUse Used _                      = Used  -- Note [Used should win]
 peelUseCall :: UseDmd -> Maybe (Count, UseDmd)
 peelUseCall (UCall c u)   = Just (c,u)
 peelUseCall _             = Nothing
-\end{code}
 
+{-
 Note [Don't optimise UProd(Used) to Used]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 These two UseDmds:
@@ -363,7 +361,7 @@ are semantically equivalent, but we do not turn the former into
 the latter, for a regrettable-subtle reason.  Suppose we did.
 then
   f (x,y) = (y,x)
-would get 
+would get
   StrDmd = Str  = SProd [Lazy, Lazy]
   UseDmd = Used = UProd [Used, Used]
 But with the joint demand of <Str, Used> doesn't convey any clue
@@ -383,7 +381,7 @@ Note [Used should win]
 Both in lubUse and bothUse we want (Used `both` UProd us) to be Used.
 Why?  Because Used carries the implication the whole thing is used,
 box and all, so we don't want to w/w it.  If we use it both boxed and
-unboxed, then we are definitely using the box, and so we are quite 
+unboxed, then we are definitely using the box, and so we are quite
 likely to pay a reboxing cost.  So we make Used win here.
 
 Example is in the Buffer argument of GHC.IO.Handle.Internals.writeCharBuffer
@@ -401,9 +399,8 @@ Compare with: (C) making Used win for both, but UProd win for lub
             Min          -0.1%     -0.3%     -7.9%     -8.0%     -6.5%
             Max          +0.1%     +1.0%    +21.0%    +21.0%     +0.5%
  Geometric Mean          +0.0%     +0.0%     -0.0%     -0.1%     -0.1%
+-}
 
-
-\begin{code}
 -- If a demand is used multiple times (i.e. reused), than any use-once
 -- mentioned there, that is not protected by a UCall, can happen many times.
 markReusedDmd :: MaybeUsed -> MaybeUsed
@@ -447,21 +444,21 @@ seqMaybeUsed _          = ()
 splitUseProdDmd :: Int -> UseDmd -> Maybe [MaybeUsed]
 splitUseProdDmd n Used        = Just (replicate n useTop)
 splitUseProdDmd n UHead       = Just (replicate n Abs)
-splitUseProdDmd n (UProd ds)  = ASSERT2( ds `lengthIs` n, text "splitUseProdDmd" $$ ppr n $$ ppr ds ) 
+splitUseProdDmd n (UProd ds)  = ASSERT2( ds `lengthIs` n, text "splitUseProdDmd" $$ ppr n $$ ppr ds )
                                 Just ds
 splitUseProdDmd _ (UCall _ _) = Nothing
       -- This can happen when the programmer uses unsafeCoerce,
       -- and we don't then want to crash the compiler (Trac #9208)
-\end{code}
-%************************************************************************
-%*                                                                      *
-\subsection{Joint domain for Strictness and Absence}
-%*                                                                      *
-%************************************************************************
 
-\begin{code}
+{-
+************************************************************************
+*                                                                      *
+\subsection{Joint domain for Strictness and Absence}
+*                                                                      *
+************************************************************************
+-}
 
-data JointDmd = JD { strd :: MaybeStr, absd :: MaybeUsed } 
+data JointDmd = JD { strd :: MaybeStr, absd :: MaybeUsed }
   deriving ( Eq, Show )
 
 -- Pretty-printing
@@ -474,7 +471,7 @@ mkJointDmd s a = JD { strd = s, absd = a }
 
 mkJointDmds :: [MaybeStr] -> [MaybeUsed] -> [JointDmd]
 mkJointDmds ss as = zipWithEqual "mkJointDmds" mkJointDmd ss as
-     
+
 absDmd :: JointDmd
 absDmd = mkJointDmd Lazy Abs
 
@@ -493,23 +490,23 @@ botDmd :: JointDmd
 botDmd = mkJointDmd strBot useBot
 
 lubDmd :: JointDmd -> JointDmd -> JointDmd
-lubDmd (JD {strd = s1, absd = a1}) 
+lubDmd (JD {strd = s1, absd = a1})
        (JD {strd = s2, absd = a2}) = mkJointDmd (s1 `lubMaybeStr` s2) (a1 `lubMaybeUsed` a2)
 
 bothDmd :: JointDmd -> JointDmd -> JointDmd
-bothDmd (JD {strd = s1, absd = a1}) 
+bothDmd (JD {strd = s1, absd = a1})
         (JD {strd = s2, absd = a2}) = mkJointDmd (s1 `bothMaybeStr` s2) (a1 `bothMaybeUsed` a2)
 
 isTopDmd :: JointDmd -> Bool
 isTopDmd (JD {strd = Lazy, absd = Use Many Used}) = True
-isTopDmd _                                        = False 
+isTopDmd _                                        = False
 
 isBotDmd :: JointDmd -> Bool
 isBotDmd (JD {strd = Str HyperStr, absd = Abs}) = True
-isBotDmd _                                      = False 
-  
+isBotDmd _                                      = False
+
 isAbsDmd :: JointDmd -> Bool
-isAbsDmd (JD {absd = Abs})  = True   -- The strictness part can be HyperStr 
+isAbsDmd (JD {absd = Abs})  = True   -- The strictness part can be HyperStr
 isAbsDmd _                  = False  -- for a bottom demand
 
 isSeqDmd :: JointDmd -> Bool
@@ -547,20 +544,20 @@ splitFVs is_thunk rhs_fvs
       | Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)
       | otherwise = ( addToUFM_Directly lazy_fv uniq (JD { strd = Lazy, absd = u })
                     , addToUFM_Directly sig_fv  uniq (JD { strd = s,    absd = Abs }) )
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Clean demand for Strictness and Usage}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 This domain differst from JointDemand in the sence that pure absence
 is taken away, i.e., we deal *only* with non-absent demands.
 
 Note [Strict demands]
 ~~~~~~~~~~~~~~~~~~~~~
-isStrictDmd returns true only of demands that are 
+isStrictDmd returns true only of demands that are
    both strict
    and  used
 In particular, it is False for <HyperStr, Abs>, which can and does
@@ -587,11 +584,9 @@ f :: (Int -> (Int, Int)) -> (Int, Bool)
 f g = (snd (g 3), True)
 
 should be: <L,C(U(AU))>m
+-}
 
-
-\begin{code}
-
-data CleanDemand = CD { sd :: StrDmd, ud :: UseDmd } 
+data CleanDemand = CD { sd :: StrDmd, ud :: UseDmd }
   deriving ( Eq, Show )
 
 instance Outputable CleanDemand where
@@ -601,7 +596,7 @@ mkCleanDmd :: StrDmd -> UseDmd -> CleanDemand
 mkCleanDmd s a = CD { sd = s, ud = a }
 
 bothCleanDmd :: CleanDemand -> CleanDemand -> CleanDemand
-bothCleanDmd (CD { sd = s1, ud = a1}) (CD { sd = s2, ud = a2}) 
+bothCleanDmd (CD { sd = s1, ud = a1}) (CD { sd = s2, ud = a2})
   = CD { sd = s1 `bothStr` s2, ud = a1 `bothUse` a2 }
 
 mkHeadStrict :: CleanDemand -> CleanDemand
@@ -623,14 +618,14 @@ evalDmd :: JointDmd
 evalDmd = mkJointDmd (Str HeadStr) useTop
 
 mkProdDmd :: [JointDmd] -> CleanDemand
-mkProdDmd dx 
-  = mkCleanDmd sp up 
+mkProdDmd dx
+  = mkCleanDmd sp up
   where
     sp = mkSProd $ map strd dx
-    up = mkUProd $ map absd dx   
+    up = mkUProd $ map absd dx
 
 mkCallDmd :: CleanDemand -> CleanDemand
-mkCallDmd (CD {sd = d, ud = u}) 
+mkCallDmd (CD {sd = d, ud = u})
   = mkCleanDmd (mkSCall d) (mkUCall One u)
 
 cleanEvalDmd :: CleanDemand
@@ -682,8 +677,8 @@ trimToType (JD ms mu) ts
     go_u (UProd mus) (TsProd tss)
       | equalLength mus tss      = UProd (zipWith go_mu mus tss)
     go_u _           _           = Used
-\end{code}
 
+{-
 Note [Trimming a demand to a type]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this:
@@ -720,10 +715,9 @@ Head-stricts demands. For instance,
 S ~ S(L, ..., L)
 
 Also, when top or bottom is occurred as a result demand, it in fact
-can be expanded to saturate a callee's arity. 
-
+can be expanded to saturate a callee's arity.
+-}
 
-\begin{code}
 splitProdDmd_maybe :: JointDmd -> Maybe [JointDmd]
 -- Split a product into its components, iff there is any
 -- useful information to be extracted thereby
@@ -736,13 +730,13 @@ splitProdDmd_maybe (JD {strd = s, absd = u})
                                          -> Just (mkJointDmds sx ux)
       (Lazy,           Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)
       _ -> Nothing
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                    Demand results
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 
 DmdResult:     Dunno CPRResult
@@ -758,11 +752,10 @@ CPRResult:         NoCPR
 Product contructors return (Dunno (RetProd rs))
 In a fixpoint iteration, start from Diverges
 We have lubs, but not glbs; but that is ok.
+-}
 
-
-\begin{code}
 ------------------------------------------------------------------------
--- Constructed Product Result                                             
+-- Constructed Product Result
 ------------------------------------------------------------------------
 
 data Termination r = Diverges    -- Definitely diverges
@@ -777,7 +770,7 @@ data CPRResult = NoCPR          -- Top of the lattice
                deriving( Eq, Show )
 
 lubCPR :: CPRResult -> CPRResult -> CPRResult
-lubCPR (RetSum t1) (RetSum t2) 
+lubCPR (RetSum t1) (RetSum t2)
   | t1 == t2                       = RetSum t1
 lubCPR RetProd     RetProd     = RetProd
 lubCPR _ _                     = NoCPR
@@ -885,8 +878,8 @@ resTypeArgDmd :: DmdResult -> JointDmd
 -- Also see Note [defaultDmd vs. resTypeArgDmd]
 resTypeArgDmd r | isBotRes r = botDmd
 resTypeArgDmd _              = topDmd
-\end{code}
 
+{-
 Note [defaultDmd and resTypeArgDmd]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -973,24 +966,24 @@ Imagine that it had millions of fields. This actually happened
 in GHC itself where the tuple was DynFlags
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Demand environments and types}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type Demand = JointDmd
 
 type DmdEnv = VarEnv Demand   -- See Note [Default demand on free variables]
 
-data DmdType = DmdType 
-                  DmdEnv        -- Demand on explicitly-mentioned 
+data DmdType = DmdType
+                  DmdEnv        -- Demand on explicitly-mentioned
                                 --      free variables
                   [Demand]      -- Demand on arguments
                   DmdResult     -- See [Nature of result demand]
-\end{code}
 
+{-
 Note [Nature of result demand]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 A DmdResult contains information about termination (currently distinguishing
@@ -1036,7 +1029,7 @@ Note [Asymmetry of 'both' for DmdType and DmdResult]
 'both' for DmdTypes is *assymetrical*, because there is only one
 result!  For example, given (e1 e2), we get a DmdType dt1 for e1, use
 its arg demand to analyse e2 giving dt2, and then do (dt1 `bothType` dt2).
-Similarly with 
+Similarly with
   case e of { p -> rhs }
 we get dt_scrut from the scrutinee and dt_rhs from the RHS, and then
 compute (dt_rhs `bothType` dt_scrut).
@@ -1048,9 +1041,8 @@ We
  4. take CPR info from the first argument.
 
 3 and 4 are implementd in bothDmdResult.
+-}
 
-
-\begin{code}
 -- Equality needed for fixpoints in DmdAnal
 instance Eq DmdType where
   (==) (DmdType fv1 ds1 res1)
@@ -1068,8 +1060,8 @@ lubDmdType d1 d2
     lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultDmd r1) fv2 (defaultDmd r2)
     lub_ds  = zipWithEqual "lubDmdType" lubDmd ds1 ds2
     lub_res = lubDmdResult r1 r2
-\end{code}
 
+{-
 Note [The need for BothDmdArg]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Previously, the right argument to bothDmdType, as well as the return value of
@@ -1077,9 +1069,8 @@ dmdAnalStar via postProcessDmdTypeM, was a DmdType. But bothDmdType only needs
 to know about the free variables and termination information, but nothing about
 the demand put on arguments, nor cpr information. So we make that explicit by
 only passing the relevant information.
+-}
 
-
-\begin{code}
 type BothDmdArg = (DmdEnv, Termination ())
 
 mkBothDmdArg :: DmdEnv -> BothDmdArg
@@ -1100,7 +1091,7 @@ bothDmdType (DmdType fv1 ds1 r1) (fv2, t2)
   where both_fv = plusVarEnv_CD bothDmd fv1 (defaultDmd r1) fv2 (defaultDmd t2)
 
 instance Outputable DmdType where
-  ppr (DmdType fv ds res) 
+  ppr (DmdType fv ds res)
     = hsep [text "DmdType",
             hcat (map ppr ds) <> ppr res,
             if null fv_elts then empty
@@ -1193,11 +1184,9 @@ strictenDmd (JD {strd = s, absd = u})
     poke_s (Str s)   = s
     poke_u Abs       = UHead
     poke_u (Use _ u) = u
-\end{code}
 
-Deferring and peeeling
+-- Deferring and peeeling
 
-\begin{code}
 type DeferAndUse   -- Describes how to degrade a result type
    =( Bool        -- Lazify (defer) the type
     , Count)      -- Many => manify the type
@@ -1298,8 +1287,8 @@ peelManyCalls n (CD { sd = str, ud = abs })
     go_abs 0 _              = One    --          one UCall Many in the demand
     go_abs n (UCall One d') = go_abs (n-1) d'
     go_abs _ _              = Many
-\end{code}
 
+{-
 Note [Demands from unsaturated function calls]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -1337,8 +1326,8 @@ cases, and then call postProcessUnsat to reduce the demand appropriately.
 Similarly, dmdTransformDictSelSig and dmdAnal, when analyzing a Lambda, use
 peelCallDmd, which peels only one level, but also returns the demand put on the
 body of the function.
+-}
 
-\begin{code}
 peelFV :: DmdType -> Var -> (DmdType, Demand)
 peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
                                (DmdType fv' ds res, dmd)
@@ -1349,8 +1338,8 @@ peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
 
 addDemand :: Demand -> DmdType -> DmdType
 addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res
-\end{code}
 
+{-
 Note [Default demand on free variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If the variable is not mentioned in the environment of a demand type,
@@ -1369,14 +1358,14 @@ Tricky point: make sure that we analyse in the 'virgin' pass. Consider
    rec { f acc x True  = f (...rec { g y = ...g... }...)
          f acc x False = acc }
 In the virgin pass for 'f' we'll give 'f' a very strict (bottom) type.
-That might mean that we analyse the sub-expression containing the 
+That might mean that we analyse the sub-expression containing the
 E = "...rec g..." stuff in a bottom demand.  Suppose we *didn't analyse*
-E, but just retuned botType.  
+E, but just retuned botType.
 
 Then in the *next* (non-virgin) iteration for 'f', we might analyse E
 in a weaker demand, and that will trigger doing a fixpoint iteration
 for g.  But *because it's not the virgin pass* we won't start g's
-iteration at bottom.  Disaster.  (This happened in $sfibToList' of 
+iteration at bottom.  Disaster.  (This happened in $sfibToList' of
 nofib/spectral/fibheaps.)
 
 So in the virgin pass we make sure that we do analyse the expression
@@ -1446,18 +1435,18 @@ There are several wrinkles:
   'f' above.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                      Demand signatures
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
-In a let-bound Id we record its strictness info.  
+In a let-bound Id we record its strictness info.
 In principle, this strictness info is a demand transformer, mapping
 a demand on the Id into a DmdType, which gives
         a) the free vars of the Id's value
         b) the Id's arguments
-        c) an indication of the result of applying 
+        c) an indication of the result of applying
            the Id to its arguments
 
 However, in fact we store in the Id an extremely emascuated demand
@@ -1485,8 +1474,8 @@ and <L,U(U,U)> on the second, then returning a constructor.
 
 If this same function is applied to one arg, all we can say is that it
 uses x with <L,U>, and its arg with demand <L,U>.
+-}
 
-\begin{code}
 newtype StrictSig = StrictSig DmdType
                   deriving( Eq )
 
@@ -1537,9 +1526,9 @@ dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _)) cd
     -- see Note [Demands from unsaturated function calls]
 
 dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType
--- Same as dmdTransformSig but for a data constructor (worker), 
+-- Same as dmdTransformSig but for a data constructor (worker),
 -- which has a special kind of demand transformer.
--- If the constructor is saturated, we feed the demand on 
+-- If the constructor is saturated, we feed the demand on
 -- the result into the constructor arguments.
 dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))
                              (CD { sd = str, ud = abs })
@@ -1577,8 +1566,8 @@ dmdTransformDictSelSig (StrictSig (DmdType _ [dict_dmd] _)) cd
                    | otherwise    = mkOnceUsedDmd cd  -- This is the one!
 
 dmdTransformDictSelSig _ _ = panic "dmdTransformDictSelSig: no args"
-\end{code}
 
+{-
 Note [Demand transformer for a dictionary selector]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we evaluate (op dict-expr) under demand 'd', then we can push the demand 'd'
@@ -1586,7 +1575,7 @@ into the appropriate field of the dictionary. What *is* the appropriate field?
 We just look at the strictness signature of the class op, which will be
 something like: U(AAASAAAAA).  Then replace the 'S' by the demand 'd'.
 
-For single-method classes, which are represented by newtypes the signature 
+For single-method classes, which are represented by newtypes the signature
 of 'op' won't look like U(...), so the splitProdDmd_maybe will fail.
 That's fine: if we are doing strictness analysis we are also doing inling,
 so we'll have inlined 'op' into a cast.  So we can bale out in a conservative
@@ -1600,8 +1589,8 @@ ops.   Now if a subsequent module in the --make sweep has a local -O flag
 you might do strictness analysis, but there is no inlining for the class op.
 This is weird, so I'm not worried about whether this optimises brilliantly; but
 it should not fall over.
+-}
 
-\begin{code}
 argsOneShots :: StrictSig -> Arity -> [[OneShotInfo]]
 -- See Note [Computing one-shot info, and ProbOneShot]
 argsOneShots (StrictSig (DmdType _ arg_ds _)) n_val_args
@@ -1628,8 +1617,8 @@ argOneShots one_shot_info (JD { absd = usg })
     go (UCall One  u) = one_shot_info : go u
     go (UCall Many u) = NoOneShotInfo : go u
     go _              = []
-\end{code}
 
+{-
 Note [Computing one-shot info, and ProbOneShot]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider a call
@@ -1654,17 +1643,16 @@ How is it used?  Well, it's quite likely that the partial application
 of f is not shared, so the float-out pass (in SetLevels.lvlLamBndrs)
 does not float MFEs out of a ProbOneShot lambda.  That currently is
 the only way that ProbOneShot is used.
+-}
 
-
-\begin{code}
 -- appIsBottom returns true if an application to n args would diverge
 -- See Note [Unsaturated applications]
 appIsBottom :: StrictSig -> Int -> Bool
 appIsBottom (StrictSig (DmdType _ ds res)) n
-            | isBotRes res                      = not $ lengthExceeds ds n 
+            | isBotRes res                      = not $ lengthExceeds ds n
 appIsBottom _                                 _ = False
-\end{code}
 
+{-
 Note [Unsaturated applications]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If a function having bottom as its demand result is applied to a less
@@ -1675,33 +1663,33 @@ of arguments, says conservatively if the function is going to diverge
 or not.
 
 Zap absence or one-shot information, under control of flags
+-}
 
-\begin{code}
 zapDemand :: DynFlags -> Demand -> Demand
-zapDemand dflags dmd 
+zapDemand dflags dmd
   | Just kfs <- killFlags dflags = zap_dmd kfs dmd
   | otherwise                    = dmd
 
 zapStrictSig :: DynFlags -> StrictSig -> StrictSig
-zapStrictSig dflags sig@(StrictSig (DmdType env ds r)) 
+zapStrictSig dflags sig@(StrictSig (DmdType env ds r))
   | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (zap_dmd kfs) ds) r)
   | otherwise                    = sig
 
 type KillFlags = (Bool, Bool)
 
 killFlags :: DynFlags -> Maybe KillFlags
-killFlags dflags 
+killFlags dflags
   | not kill_abs && not kill_one_shot = Nothing
   | otherwise                         = Just (kill_abs, kill_one_shot)
   where
     kill_abs      = gopt Opt_KillAbsence dflags
     kill_one_shot = gopt Opt_KillOneShot dflags
-      
+
 zap_dmd :: KillFlags -> Demand -> Demand
 zap_dmd kfs (JD {strd = s, absd = u}) = JD {strd = s, absd = zap_musg kfs u}
 
 zap_musg :: KillFlags -> MaybeUsed -> MaybeUsed
-zap_musg (kill_abs, _) Abs 
+zap_musg (kill_abs, _) Abs
   | kill_abs  = useTop
   | otherwise = Abs
 zap_musg kfs (Use c u) = Use (zap_count kfs c) (zap_usg kfs u)
@@ -1715,9 +1703,7 @@ zap_usg :: KillFlags -> UseDmd -> UseDmd
 zap_usg kfs (UCall c u) = UCall (zap_count kfs c) (zap_usg kfs u)
 zap_usg kfs (UProd us)  = UProd (map (zap_musg kfs) us)
 zap_usg _   u           = u
-\end{code}
 
-\begin{code}
 -- If the argument is a used non-newtype dictionary, give it strict
 -- demand. Also split the product type & demand and recur in order to
 -- similarly strictify the argument's contained used non-newtype
@@ -1746,8 +1732,8 @@ strictifyDictDmd ty dmd = case absd dmd of
              -- TODO could optimize with an aborting variant of zipWith since
              -- the superclass dicts are always a prefix
   _ -> dmd -- unused or not a dictionary
-\end{code}
 
+{-
 Note [HyperStr and Use demands]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -1762,22 +1748,21 @@ distinguishing the uses on x and y in the True case, we could either not figure
 out how deeply we can unpack x, or that we do not have to pass y.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                      Serialisation
-%*                                                                      *
-%************************************************************************
-
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Binary StrDmd where
   put_ bh HyperStr     = do putByte bh 0
   put_ bh HeadStr      = do putByte bh 1
   put_ bh (SCall s)    = do putByte bh 2
                             put_ bh s
   put_ bh (SProd sx)   = do putByte bh 3
-                            put_ bh sx  
-  get bh = do 
+                            put_ bh sx
+  get bh = do
          h <- getByte bh
          case h of
            0 -> do return HyperStr
@@ -1788,15 +1773,15 @@ instance Binary StrDmd where
                    return (SProd sx)
 
 instance Binary MaybeStr where
-    put_ bh Lazy         = do 
+    put_ bh Lazy         = do
             putByte bh 0
-    put_ bh (Str s)    = do 
+    put_ bh (Str s)    = do
             putByte bh 1
             put_ bh s
 
     get  bh = do
             h <- getByte bh
-            case h of 
+            case h of
               0 -> return Lazy
               _ -> do s  <- get bh
                       return $ Str s
@@ -1804,32 +1789,32 @@ instance Binary MaybeStr where
 instance Binary Count where
     put_ bh One  = do putByte bh 0
     put_ bh Many = do putByte bh 1
-    
+
     get  bh = do h <- getByte bh
                  case h of
                    0 -> return One
-                   _ -> return Many   
+                   _ -> return Many
 
 instance Binary MaybeUsed where
-    put_ bh Abs          = do 
+    put_ bh Abs          = do
             putByte bh 0
-    put_ bh (Use c u)    = do 
+    put_ bh (Use c u)    = do
             putByte bh 1
             put_ bh c
             put_ bh u
 
     get  bh = do
             h <- getByte bh
-            case h of 
-              0 -> return Abs       
+            case h of
+              0 -> return Abs
               _ -> do c  <- get bh
                       u  <- get bh
                       return $ Use c u
 
 instance Binary UseDmd where
-    put_ bh Used         = do 
+    put_ bh Used         = do
             putByte bh 0
-    put_ bh UHead        = do 
+    put_ bh UHead        = do
             putByte bh 1
     put_ bh (UCall c u)    = do
             putByte bh 2
@@ -1841,7 +1826,7 @@ instance Binary UseDmd where
 
     get  bh = do
             h <- getByte bh
-            case h of 
+            case h of
               0 -> return $ Used
               1 -> return $ UHead
               2 -> do c <- get bh
@@ -1852,7 +1837,7 @@ instance Binary UseDmd where
 
 instance Binary JointDmd where
     put_ bh (JD {strd = x, absd = y}) = do put_ bh x; put_ bh y
-    get  bh = do 
+    get  bh = do
               x <- get bh
               y <- get bh
               return $ mkJointDmd x y
@@ -1866,12 +1851,12 @@ instance Binary StrictSig where
 
 instance Binary DmdType where
   -- Ignore DmdEnv when spitting out the DmdType
-  put_ bh (DmdType _ ds dr) 
-       = do put_ bh ds 
+  put_ bh (DmdType _ ds dr)
+       = do put_ bh ds
             put_ bh dr
-  get bh 
-      = do ds <- get bh 
-           dr <- get bh 
+  get bh
+      = do ds <- get bh
+           dr <- get bh
            return (DmdType emptyDmdEnv ds dr)
 
 instance Binary DmdResult where
@@ -1890,8 +1875,7 @@ instance Binary CPRResult where
 
     get  bh = do
             h <- getByte bh
-            case h of 
+            case h of
               0 -> do { n <- get bh; return (RetSum n) }
               1 -> return RetProd
               _ -> return NoCPR
-\end{code}
similarity index 92%
rename from compiler/basicTypes/Id.lhs
rename to compiler/basicTypes/Id.hs
index 85e9b30..fa34a4f 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
 \section[Id]{@Ids@: Value and constructor identifiers}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 -- |
@@ -41,15 +41,15 @@ module Id (
         recordSelectorFieldLabel,
 
         -- ** Modifying an Id
-        setIdName, setIdUnique, Id.setIdType, 
-        setIdExported, setIdNotExported, 
-        globaliseId, localiseId, 
+        setIdName, setIdUnique, Id.setIdType,
+        setIdExported, setIdNotExported,
+        globaliseId, localiseId,
         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
         zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,
         zapIdStrictness,
 
         -- ** Predicates on Ids
-        isImplicitId, isDeadBinder, 
+        isImplicitId, isDeadBinder,
         isStrictId,
         isExportedId, isLocalId, isGlobalId,
         isRecordSelector, isNaughtyRecordSelector,
@@ -69,7 +69,7 @@ module Id (
 
         -- ** One-shot lambdas
         isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
-        setOneShotLambda, clearOneShotLambda, 
+        setOneShotLambda, clearOneShotLambda,
         updOneShotInfo, setIdOneShotInfo,
         isStateHackType, stateHackOneShot, typeOneShot,
 
@@ -92,10 +92,10 @@ module Id (
         setIdCafInfo,
         setIdOccInfo, zapIdOccInfo,
 
-        setIdDemandInfo, 
-        setIdStrictness, 
+        setIdDemandInfo,
+        setIdStrictness,
 
-        idDemandInfo, 
+        idDemandInfo,
         idStrictness,
 
     ) where
@@ -147,15 +147,15 @@ infixl  1 `setIdUnfoldingLazily`,
 
           `setIdDemandInfo`,
           `setIdStrictness`
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Basic Id manipulation}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 idName   :: Id -> Name
 idName    = Var.varName
 
@@ -207,13 +207,13 @@ modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
 maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
 maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
 maybeModifyIdInfo Nothing         id = id
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Simple Id construction}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Absolutely all Ids are made by mkId.  It is just like Var.mkId,
 but in addition it pins free-tyvar-info onto the Id's type,
@@ -228,8 +228,8 @@ the compiler overall. I don't quite know why; perhaps finding free
 type variables of an Id isn't all that common whereas applying a
 substitution (which changes the free type variables) is more common.
 Anyway, we removed it in March 2008.
+-}
 
-\begin{code}
 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
 mkGlobalId = Var.mkGlobalVar
@@ -283,13 +283,13 @@ mkDerivedLocalM deriv_name id ty
 mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
 mkWiredInIdName mod fs uniq id
  = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
-\end{code}
 
+{-
 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 @Uniques@, but that's OK because the templates are supposed to be
 instantiated before use.
+-}
 
-\begin{code}
 -- | Workers get local names. "CoreTidy" will externalise these if necessary
 mkWorkerId :: Unique -> Id -> Type -> Id
 mkWorkerId uniq unwrkr ty
@@ -306,8 +306,8 @@ mkTemplateLocals = mkTemplateLocalsNum 1
 -- | Create a template local for a series of type, but start from a specified template local
 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
-\end{code}
 
+{-
 Note [Exported LocalIds]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 We use mkExportedLocalId for things like
@@ -343,13 +343,13 @@ In CoreTidy we must make all these LocalIds into GlobalIds, so that in
 importing modules (in --make mode) we treat them as properly global.
 That is what is happening in, say tidy_insts in TidyPgm.
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Special Ids}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 recordSelectorFieldLabel id
@@ -459,8 +459,8 @@ isImplicitId id
 
 idIsFrom :: Module -> Id -> Bool
 idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
-\end{code}
 
+{-
 Note [Primop wrappers]
 ~~~~~~~~~~~~~~~~~~~~~~
 Currently hasNoBinding claims that PrimOpIds don't have a curried
@@ -473,36 +473,34 @@ applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
 
 Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
 used by GHCi, which does not implement primops direct at all.
+-}
 
-
-
-\begin{code}
 isDeadBinder :: Id -> Bool
 isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
                   | otherwise = False   -- TyVars count as not dead
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
               Evidence variables
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 isEvVar :: Var -> Bool
 isEvVar var = isPredTy (varType var)
 
 isDictId :: Id -> Bool
 isDictId id = isDictTy (idType id)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{IdInfo stuff}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
         ---------------------------------
         -- ARITY
 idArity :: Id -> Arity
@@ -543,7 +541,7 @@ isStrictId :: Id -> Bool
 isStrictId id
   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
            (isStrictType (idType id)) ||
-           -- Take the best of both strictnesses - old and new               
+           -- Take the best of both strictnesses - old and new
            (isStrictDmd (idDemandInfo id))
 
         ---------------------------------
@@ -607,15 +605,14 @@ setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 
 zapIdOccInfo :: Id -> Id
 zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
-\end{code}
-
 
+{-
         ---------------------------------
         -- INLINING
 The inline pragma tells us to be very keen to inline this Id, but it's still
 OK not to if optimisation is switched off.
+-}
 
-\begin{code}
 idInlinePragma :: Id -> InlinePragma
 idInlinePragma id = inlinePragInfo (idInfo id)
 
@@ -636,12 +633,12 @@ idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
 
 isConLikeId :: Id -> Bool
 isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
-\end{code}
-
 
+{-
         ---------------------------------
         -- ONE-SHOT LAMBDAS
-\begin{code}
+-}
+
 idOneShotInfo :: Id -> OneShotInfo
 idOneShotInfo id = oneShotInfo (idInfo id)
 
@@ -728,9 +725,7 @@ updOneShotInfo id one_shot
 -- But watch out: this may change the type of something else
 --      f = \x -> e
 -- If we change the one-shot-ness of x, f's type changes
-\end{code}
 
-\begin{code}
 zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
 zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
 
@@ -738,12 +733,12 @@ zapLamIdInfo :: Id -> Id
 zapLamIdInfo = zapInfo zapLamInfo
 
 zapFragileIdInfo :: Id -> Id
-zapFragileIdInfo = zapInfo zapFragileInfo 
+zapFragileIdInfo = zapInfo zapFragileInfo
 
 zapDemandIdInfo :: Id -> Id
 zapDemandIdInfo = zapInfo zapDemandInfo
-\end{code}
 
+{-
 Note [transferPolyIdInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 This transfer is used in two places:
@@ -791,8 +786,8 @@ arity and strictness info before transferring it.  E.g.
       g' = \y. \x. e
       + substitute (g' y) for g
 Notice that g' has an arity one more than the original g
+-}
 
-\begin{code}
 transferPolyIdInfo :: Id        -- Original Id
                    -> [Var]     -- Abstract wrt these variables
                    -> Id        -- New Id
@@ -816,4 +811,3 @@ transferPolyIdInfo old_id abstract_wrt new_id
                                  `setInlinePragInfo` old_inline_prag
                                  `setOccInfo` old_occ_info
                                  `setStrictnessInfo` new_strictness
-\end{code}
similarity index 84%
rename from compiler/basicTypes/IdInfo.lhs
rename to compiler/basicTypes/IdInfo.hs
index 685d79e..d2179dc 100644 (file)
@@ -1,13 +1,13 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
+
 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
 
 (And a pretty good illustration of quite a few things wrong with
 Haskell. [WDP 94/11])
+-}
 
-\begin{code}
 module IdInfo (
         -- * The IdDetails type
         IdDetails(..), pprIdDetails, coVarDetails,
@@ -93,15 +93,15 @@ infixl  1 `setSpecInfo`,
           `setCafInfo`,
           `setStrictnessInfo`,
           `setDemandInfo`
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                      IdDetails
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | The 'IdDetails' of an 'Id' give stable, and necessary,
 -- information about the Id.
 data IdDetails
@@ -165,16 +165,15 @@ pprIdDetails other     = brackets (pp other)
    pp (RecSelId { sel_naughty = is_naughty })
                          = brackets $ ptext (sLit "RecSel")
                             <> ppWhen is_naughty (ptext (sLit "(naughty)"))
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{The main IdInfo type}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | An 'IdInfo' gives /optional/ information about an 'Id'.  If
 -- present it never lies, but it may not be present, in which case there
 -- is always a conservative assumption which can be made.
@@ -232,11 +231,9 @@ seqStrictnessInfo ty = seqStrictSig ty
 
 seqDemandInfo :: Demand -> ()
 seqDemandInfo dmd = seqDemand dmd
-\end{code}
 
-Setters
+-- Setters
 
-\begin{code}
 setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
 setSpecInfo       info sp = sp `seq` info { specInfo = sp }
 setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
@@ -273,10 +270,7 @@ setDemandInfo info dd = dd `seq` info { demandInfo = dd }
 
 setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
 setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
-\end{code}
-
 
-\begin{code}
 -- | Basic 'IdInfo' that carries no useful information whatsoever
 vanillaIdInfo :: IdInfo
 vanillaIdInfo
@@ -297,20 +291,19 @@ vanillaIdInfo
 noCafIdInfo :: IdInfo
 noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
         -- Used for built-in type Ids in MkId.
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[arity-IdInfo]{Arity info about an @Id@}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 For locally-defined Ids, the code generator maintains its own notion
 of their arities; so it should not be asking...  (but other things
 besides the code-generator need arity info!)
+-}
 
-\begin{code}
 -- | An 'ArityInfo' of @n@ tells us that partial application of this
 -- 'Id' to up to @n-1@ value arguments does essentially no work.
 --
@@ -328,15 +321,15 @@ unknownArity = 0 :: Arity
 ppArityInfo :: Int -> SDoc
 ppArityInfo 0 = empty
 ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Inline-pragma information}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Tells when the inlining is active.
 -- When it is active the thing may be inlined, depending on how
 -- big it is.
@@ -347,26 +340,24 @@ ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
 -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
 -- entirely as a way to inhibit inlining until we want it
 type InlinePragInfo = InlinePragma
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                Strictness
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 pprStrictness :: StrictSig -> SDoc
 pprStrictness sig = ppr sig
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
         SpecInfo
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Note [Specialisations and RULES in IdInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -386,8 +377,8 @@ differently because:
 
 In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off
 and put in the global list.
+-}
 
-\begin{code}
 -- | Records the specializations of this 'Id' that we know about
 -- in the form of rewrite 'CoreRule's that target them
 data SpecInfo
@@ -420,15 +411,15 @@ setSpecInfoHead fn (SpecInfo rules fvs)
 
 seqSpecInfo :: SpecInfo -> ()
 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[CG-IdInfo]{Code generator-related information}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 
 -- | Records whether an 'Id' makes Constant Applicative Form references
@@ -461,15 +452,15 @@ instance Outputable CafInfo where
 ppCafInfo :: CafInfo -> SDoc
 ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
 ppCafInfo MayHaveCafRefs = empty
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Bulk operations on IdInfo}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | This is used to remove information on lambda binders that we have
 -- setup as part of a lambda group, assuming they will be applied all at once,
 -- but turn out to be part of an unsaturated lambda as in e.g:
@@ -492,15 +483,11 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
                  _other                -> occ
 
     is_safe_dmd dmd = not (isStrictDmd dmd)
-\end{code}
 
-\begin{code}
 -- | Remove demand info on the 'IdInfo' if it is present, otherwise return @Nothing@
 zapDemandInfo :: IdInfo -> Maybe IdInfo
 zapDemandInfo info = Just (info {demandInfo = topDmd})
-\end{code}
 
-\begin{code}
 zapFragileInfo :: IdInfo -> Maybe IdInfo
 -- ^ Zap info that depends on free variables
 zapFragileInfo info
@@ -509,15 +496,15 @@ zapFragileInfo info
                `setOccInfo` zapFragileOcc occ)
   where
     occ = occInfo info
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{TickBoxOp}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type TickBoxId = Int
 
 -- | Tick box for Hpc-style coverage
@@ -526,4 +513,3 @@ data TickBoxOp
 
 instance Outputable TickBoxOp where
     ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)
-\end{code}
similarity index 86%
rename from compiler/basicTypes/IdInfo.lhs-boot
rename to compiler/basicTypes/IdInfo.hs-boot
index 257e1c6..2e98629 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module IdInfo where
 import Outputable
 data IdInfo
@@ -7,4 +6,3 @@ data IdDetails
 vanillaIdInfo :: IdInfo
 coVarDetails :: IdDetails
 pprIdDetails :: IdDetails -> SDoc
-\end{code}
\ No newline at end of file
similarity index 94%
rename from compiler/basicTypes/Literal.lhs
rename to compiler/basicTypes/Literal.hs
index 13fbb4d..cb0be03 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+
 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module Literal
@@ -63,16 +63,15 @@ import Data.Word
 import Data.Char
 import Data.Data ( Data, Typeable )
 import Numeric ( fromRat )
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Literals}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | So-called 'Literal's are one of:
 --
 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
@@ -118,8 +117,8 @@ data Literal
   | LitInteger Integer Type --  ^ Integer literals
                             -- See Note [Integer literals]
   deriving (Data, Typeable)
-\end{code}
 
+{-
 Note [Integer literals]
 ~~~~~~~~~~~~~~~~~~~~~~~
 An Integer literal is represented using, well, an Integer, to make it
@@ -139,8 +138,8 @@ in TcIface.
 
 
 Binary instance
+-}
 
-\begin{code}
 instance Binary Literal where
     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
@@ -195,9 +194,7 @@ instance Binary Literal where
                     i <- get bh
                     -- See Note [Integer literals]
                     return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
-\end{code}
 
-\begin{code}
 instance Outputable Literal where
     ppr lit = pprLiteral (\d -> d) lit
 
@@ -211,12 +208,12 @@ instance Ord Literal where
     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
     compare a b = cmpLit a b
-\end{code}
-
 
+{-
         Construction
         ~~~~~~~~~~~~
-\begin{code}
+-}
+
 -- | Creates a 'Literal' of type @Int#@
 mkMachInt :: DynFlags -> Integer -> Literal
 mkMachInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
@@ -272,11 +269,12 @@ isZeroLit (MachWord64 0) = True
 isZeroLit (MachFloat  0) = True
 isZeroLit (MachDouble 0) = True
 isZeroLit _              = False
-\end{code}
 
+{-
         Coercions
         ~~~~~~~~~
-\begin{code}
+-}
+
 narrow8IntLit, narrow16IntLit, narrow32IntLit,
   narrow8WordLit, narrow16WordLit, narrow32WordLit,
   char2IntLit, int2CharLit,
@@ -330,11 +328,12 @@ double2FloatLit l              = pprPanic "double2FloatLit" (ppr l)
 
 nullAddrLit :: Literal
 nullAddrLit = MachNullAddr
-\end{code}
 
+{-
         Predicates
         ~~~~~~~~~~
-\begin{code}
+-}
+
 -- | True if there is absolutely no penalty to duplicating the literal.
 -- False principally of strings
 litIsTrivial :: Literal -> Bool
@@ -359,11 +358,12 @@ litFitsInChar _           = False
 litIsLifted :: Literal -> Bool
 litIsLifted (LitInteger {}) = True
 litIsLifted _               = False
-\end{code}
 
+{-
         Types
         ~~~~~
-\begin{code}
+-}
+
 -- | Find the Haskell 'Type' the literal occupies
 literalType :: Literal -> Type
 literalType MachNullAddr    = addrPrimTy
@@ -392,12 +392,12 @@ absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
                         , (doublePrimTyConKey,  MachDouble 0)
                         , (wordPrimTyConKey,    MachWord 0)
                         , (word64PrimTyConKey,  MachWord64 0) ]
-\end{code}
-
 
+{-
         Comparison
         ~~~~~~~~~~
-\begin{code}
+-}
+
 cmpLit :: Literal -> Literal -> Ordering
 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
@@ -425,14 +425,14 @@ litTag (MachFloat     _)   = _ILIT(8)
 litTag (MachDouble    _)   = _ILIT(9)
 litTag (MachLabel _ _ _)   = _ILIT(10)
 litTag (LitInteger  {})    = _ILIT(11)
-\end{code}
 
+{-
         Printing
         ~~~~~~~~
 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
   exceptions: MachFloat gets an initial keyword prefix.
+-}
 
-\begin{code}
 pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
 -- The function is used on non-atomic literals
 -- to wrap parens around literals that occur in
@@ -456,19 +456,18 @@ pprIntVal :: Integer -> SDoc
 -- ^ Print negative integers with parens to be sure it's unambiguous
 pprIntVal i | i < 0     = parens (integer i)
             | otherwise = integer i
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Hashing}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Hash values should be zero or a positive integer.  No negatives please.
 (They mess up the UniqFM for some reason.)
+-}
 
-\begin{code}
 hashLiteral :: Literal -> Int
 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
 hashLiteral (MachStr s)         = hashByteString s
@@ -492,4 +491,3 @@ hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 
 hashFS :: FastString -> Int
 hashFS s = iBox (uniqueOfFS s)
-\end{code}
similarity index 94%
rename from compiler/basicTypes/MkId.lhs
rename to compiler/basicTypes/MkId.hs
index 2f76fc2..14ed9b6 100644 (file)
@@ -1,7 +1,7 @@
-%
-(c) The University of Glasgow 2006
-(c) The AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The AQUA Project, Glasgow University, 1998
+
 
 This module contains definitions for the IdInfo for things that
 have a standard form, namely:
@@ -10,8 +10,8 @@ have a standard form, namely:
 - record selectors
 - method and superclass selectors
 - primitive operations
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module MkId (
@@ -76,13 +76,13 @@ import FastString
 import ListSetOps
 
 import Data.Maybe       ( maybeToList )
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Wired in Ids}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Note [Wired-in Ids]
 ~~~~~~~~~~~~~~~~~~~
@@ -115,8 +115,8 @@ In cases (2-4), the function has a definition in a library module, and
 can be called; but the wired-in version means that the details are
 never read from that module's interface file; instead, the full definition
 is right here.
+-}
 
-\begin{code}
 wiredInIds :: [Id]
 wiredInIds
   =  [lazyId, dollarId, oneShotId]
@@ -137,13 +137,13 @@ ghcPrimIds
     coerceId,
     proxyHashId
     ]
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Data constructors}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 The wrapper for a constructor is an ordinary top-level binding that evaluates
 any strict args, unboxes any args that are going to be flattened, and calls
@@ -241,11 +241,11 @@ predicate (C a).  But now we treat that as an ordinary argument, not
 part of the theta-type, so all is well.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Dictionary selectors}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Selecting a field for a dictionary.  If there is just one field, then
 there's nothing to do.
@@ -264,8 +264,8 @@ Then the top-level type for op is
 This is unlike ordinary record selectors, which have all the for-alls
 at the outside.  When dealing with classes it's very convenient to
 recover the original type signature from the class op selector.
+-}
 
-\begin{code}
 mkDictSelId :: Name          -- Name of one of the *value* selectors
                              -- (dictionary superclass or method)
             -> Class -> Id
@@ -355,17 +355,15 @@ dictSelRule val_index n_ty_args _ id_unf _ args
   = Just (getNth con_args val_index)
   | otherwise
   = Nothing
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
         Data constructors
-%*                                                                      *
-%************************************************************************
-
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 mkDataConWorkId :: Name -> DataCon -> Id
 mkDataConWorkId wkr_name data_con
   | isNewTyCon tycon
@@ -445,8 +443,8 @@ dataConCPR con
     --         on the stack, and are often then allocated in the heap
     --         by the caller.  So doing CPR for them may in fact make
     --         things worse.
-\end{code}
 
+{-
 -------------------------------------------------
 --         Data constructor representation
 --
@@ -454,9 +452,8 @@ dataConCPR con
 -- constructor fields
 --
 --------------------------------------------------
+-}
 
-
-\begin{code}
 type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)
   -- Unbox: bind rep vars by decomposing src var
 
@@ -728,8 +725,8 @@ isUnpackableType fam_envs ty
     attempt_unpack (HsUserBang Nothing bang)     = bang  -- Be conservative
     attempt_unpack HsStrict                      = False
     attempt_unpack HsNoBang                      = False
-\end{code}
 
+{-
 Note [Unpack one-wide fields]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The flag UnboxSmallStrictFields ensures that any field that can
@@ -790,22 +787,21 @@ takes no space at all.  This is easily done: just give it
 an UNPACK pragma. The rest of the unpack/repack code does the
 heavy lifting.  This one line makes every GADT take a word less
 space for each equality predicate, so it's pretty important!
+-}
 
-
-\begin{code}
 mk_pred_strict_mark :: PredType -> HsBang
 mk_pred_strict_mark pred
   | isEqPred pred = HsUnpack Nothing    -- Note [Unpack equality predicates]
   | otherwise     = HsNoBang
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
         Wrapping and unwrapping newtypes and type families
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 -- The wrapper for the data constructor for a newtype looks like this:
 --      newtype T a = MkT (a,Int)
@@ -878,16 +874,15 @@ unwrapTypeFamInstScrut axiom ind args scrut
 unwrapTypeUnbranchedFamInstScrut :: CoAxiom Unbranched -> [Type] -> CoreExpr -> CoreExpr
 unwrapTypeUnbranchedFamInstScrut axiom
   = unwrapTypeFamInstScrut axiom 0
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Primitive operations}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 mkPrimOpId :: PrimOp -> Id
 mkPrimOpId prim_op
   = id
@@ -939,14 +934,13 @@ mkFCallId dflags uniq fcall ty
     (arg_tys, _)    = tcSplitFunTys tau
     arity           = length arg_tys
     strict_sig      = mkClosedStrictSig (replicate arity evalDmd) topRes
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{DictFuns and default methods}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Note [Dict funs and default methods]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -955,8 +949,8 @@ involves user-written code, so we can't figure out their strictness etc
 based on fixed info, as we can for constructors and record selectors (say).
 
 NB: See also Note [Exported LocalIds] in Id
+-}
 
-\begin{code}
 mkDictFunId :: Name      -- Name to use for the dict fun;
             -> [TyVar]
             -> ThetaType
@@ -989,14 +983,13 @@ mkDictFunTy tvs theta clas tys
                    -- See Note [Silent Superclass Arguments]
     discard pred = any (`eqPred` pred) theta
                  -- See the DFun Superclass Invariant in TcInstDcls
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Un-definable}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 These Ids can't be defined in Haskell.  They could be defined in
 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
@@ -1012,8 +1005,8 @@ add it as a built-in Id with an unfolding here.
 The type variables we use here are "open" type variables: this means
 they can unify with both unlifted and lifted types.  Hence we provide
 another gun with which to shoot yourself in the foot.
+-}
 
-\begin{code}
 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
    realWorldName, voidPrimIdName, coercionTokenName,
    magicDictName, coerceName, proxyName, dollarName, oneShotName :: Name
@@ -1029,9 +1022,7 @@ coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey
 proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId
 dollarName        = mkWiredInIdName gHC_BASE  (fsLit "$")              dollarIdKey        dollarId
 oneShotName       = mkWiredInIdName gHC_MAGIC (fsLit "oneShot")        oneShotKey         oneShotId
-\end{code}
 
-\begin{code}
 dollarId :: Id  -- Note [dollarId magic]
 dollarId = pcMiscPrelId dollarName ty
              (noCafIdInfo `setUnfoldingInfo` unf)
@@ -1155,8 +1146,8 @@ coerceId = pcMiscPrelId coerceName ty info
     rhs = mkLams [alphaTyVar, betaTyVar, eqR, x] $
           mkWildCase (Var eqR) eqRTy betaTy $
           [(DataAlt coercibleDataCon, [eq], Cast (Var x) (CoVarCo eq))]
-\end{code}
 
+{-
 Note [dollarId magic]
 ~~~~~~~~~~~~~~~~~~~~~
 The only reason that ($) is wired in is so that its type can be
@@ -1351,9 +1342,8 @@ The evaldUnfolding makes it look that some primitive value is
 evaluated, which in turn makes Simplify.interestingArg return True,
 which in turn makes INLINE things applied to said value likely to be
 inlined.
+-}
 
-
-\begin{code}
 realWorldPrimId :: Id   -- :: State# RealWorld
 realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
                      (noCafIdInfo `setUnfoldingInfo` evaldUnfolding    -- Note [evaldUnfoldings]
@@ -1371,10 +1361,7 @@ coercionTokenId -- Used to replace Coercion terms when we go to STG
   = pcMiscPrelId coercionTokenName
                  (mkTyConApp eqPrimTyCon [liftedTypeKind, unitTy, unitTy])
                  noCafIdInfo
-\end{code}
-
 
-\begin{code}
 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
 pcMiscPrelId name ty info
   = mkVanillaGlobalWithInfo name ty info
@@ -1383,4 +1370,3 @@ pcMiscPrelId name ty info
     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
     -- being compiled, then it's just a matter of luck if the definition
     -- will be in "the right place" to be in scope.
-\end{code}
similarity index 90%
rename from compiler/basicTypes/MkId.lhs-boot
rename to compiler/basicTypes/MkId.hs-boot
index d7adedb..69a694b 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module MkId where
 import Name( Name )
 import Var( Id )
@@ -11,6 +10,3 @@ mkDataConWorkId :: Name -> DataCon -> Id
 mkPrimOpId      :: PrimOp -> Id
 
 magicDictId :: Id
-\end{code}
-
-
similarity index 90%
rename from compiler/basicTypes/Module.lhs
rename to compiler/basicTypes/Module.hs
index 44279e5..ac5efd4 100644 (file)
@@ -1,14 +1,14 @@
-%
-(c) The University of Glasgow, 2004-2006
-%
+{-
+(c) The University of Glasgow, 2004-2006
+
 
 Module
 ~~~~~~~~~~
 Simply the name of a module, represented as a FastString.
 These are Uniquable, hence we can build Maps with Modules as
 the keys.
+-}
 
-\begin{code}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module Module
@@ -72,7 +72,7 @@ module Module
         ModuleNameEnv,
 
         -- * Sets of Modules
-        ModuleSet, 
+        ModuleSet,
         emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
     ) where
 
@@ -91,15 +91,15 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified FiniteMap as Map
 import System.FilePath
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Module locations}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Where a module lives on the file system: the actual locations
 -- of the .hs, .hi and .o files, if we have them
 data ModLocation
@@ -122,8 +122,8 @@ data ModLocation
 
 instance Outputable ModLocation where
    ppr = text . show
-\end{code}
 
+{-
 For a module in another package, the hs_file and obj_file
 components of ModLocation are undefined.
 
@@ -131,8 +131,8 @@ The locations specified by a ModLocation may or may not
 correspond to actual files yet: for example, even if the object
 file doesn't exist, the ModLocation still contains the path to
 where the object file will reside if/when it is created.
+-}
 
-\begin{code}
 addBootSuffix :: FilePath -> FilePath
 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
 addBootSuffix path = path ++ "-boot"
@@ -149,16 +149,15 @@ addBootSuffixLocn locn
   = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
          , ml_hi_file  = addBootSuffix (ml_hi_file locn)
          , ml_obj_file = addBootSuffix (ml_obj_file locn) }
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{The name of a module}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
 newtype ModuleName = ModuleName FastString
     deriving Typeable
@@ -226,15 +225,15 @@ moduleNameSlashes = dots_to_slashes . moduleNameString
 moduleNameColons :: ModuleName -> String
 moduleNameColons = dots_to_colons . moduleNameString
   where dots_to_colons = map (\c -> if c == '.' then ':' else c)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{A fully qualified module}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A Module is a pair of a 'PackageKey' and a 'ModuleName'.
 data Module = Module {
    modulePackageKey :: !PackageKey,  -- pkg-1.0
@@ -291,15 +290,15 @@ class ContainsModule t where
 
 class HasModule m where
     getModule :: m Module
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{PackageKey}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A string which uniquely identifies a package.  For wired-in packages,
 -- it is just the package name, but for user compiled packages, it is a hash.
 -- ToDo: when the key is a hash, we can do more clever things than store
@@ -411,15 +410,15 @@ wiredInPackageKeys = [ primPackageKey,
                        thisGhcPackageKey,
                        dphSeqPackageKey,
                        dphParPackageKey ]
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{@ModuleEnv@s}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A map keyed off of 'Module's
 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
 
@@ -486,9 +485,7 @@ isEmptyModuleEnv (ModuleEnv e) = Map.null e
 
 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
-\end{code}
 
-\begin{code}
 -- | A set of 'Module's
 type ModuleSet = Map Module ()
 
@@ -503,13 +500,11 @@ mkModuleSet ms    = Map.fromList [(m,()) | m <- ms ]
 extendModuleSet s m = Map.insert m () s
 moduleSetElts     = Map.keys
 elemModuleSet     = Map.member
-\end{code}
 
+{-
 A ModuleName has a Unique, so we can build mappings of these using
 UniqFM.
+-}
 
-\begin{code}
 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 type ModuleNameEnv elt = UniqFM elt
-\end{code}
-
similarity index 88%
rename from compiler/basicTypes/Module.lhs-boot
rename to compiler/basicTypes/Module.hs-boot
index 6d194d6..8a73d38 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module Module where
 
 data Module
@@ -7,4 +6,3 @@ data PackageKey
 moduleName :: Module -> ModuleName
 modulePackageKey :: Module -> PackageKey
 packageKeyString :: PackageKey -> String
-\end{code}
similarity index 87%
rename from compiler/basicTypes/Name.lhs
rename to compiler/basicTypes/Name.hs
index d7c18fc..ffdd1a1 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
+-}
 
-\begin{code}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 -- |
@@ -89,15 +89,15 @@ import FastString
 import Outputable
 
 import Data.Data
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Name-datatype]{The @Name@ datatype, and name construction}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A unique, unambigious name for something, containing information about where
 -- that thing originated.
 data Name = Name {
@@ -129,15 +129,15 @@ data NameSort
 -- which have special syntactic forms.  They aren't in scope
 -- as such.
 data BuiltInSyntax = BuiltInSyntax | UserSyntax
-\end{code}
 
+{-
 Notes about the NameSorts:
 
 1.  Initially, top-level Ids (including locally-defined ones) get External names,
     and all other local Ids get Internal names
 
 2.  In any invocation of GHC, an External Name for "M.x" has one and only one
-    unique.  This unique association is ensured via the Name Cache; 
+    unique.  This unique association is ensured via the Name Cache;
     see Note [The Name Cache] in IfaceEnv.
 
 3.  Things with a External name are given C static labels, so they finally
@@ -165,8 +165,8 @@ Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler,
                    E.g. Bool, True, Int, Float, and many others
 
 All built-in syntax is for wired-in things.
+-}
 
-\begin{code}
 instance HasOccName Name where
   occName = nameOccName
 
@@ -180,15 +180,15 @@ nameUnique  name = mkUniqueGrimily (iBox (n_uniq name))
 nameOccName name = n_occ  name
 nameSrcLoc  name = srcSpanStart (n_loc name)
 nameSrcSpan name = n_loc  name
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Predicates on names}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName    :: Name -> Bool
 isExternalName    :: Name -> Bool
@@ -239,16 +239,15 @@ isVarName = isVarOcc . nameOccName
 
 isSystemName (Name {n_sort = System}) = True
 isSystemName _                        = False
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Making names}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Create a name which is (for now at least) local to the current module and hence
 -- does not need a 'Module' to disambiguate it from other 'Name's
 mkInternalName :: Unique -> OccName -> SrcSpan -> Name
@@ -309,9 +308,7 @@ mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
 mkFCallName :: Unique -> String -> Name
 mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan
    -- The encoded string completely describes the ccall
-\end{code}
 
-\begin{code}
 -- When we renumber/rename things, we need to be
 -- able to change a Name's Unique to match the cached
 -- one in the thing it's the name of.  If you know what I mean.
@@ -333,9 +330,7 @@ tidyNameOcc name                            occ = name { n_occ = occ }
 -- | Make the 'Name' into an internal name, regardless of what it was to begin with
 localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
-\end{code}
 
-\begin{code}
 -- |Create a localised variant of a name.
 --
 -- If the name is external, encode the original's module name to disambiguate.
@@ -346,15 +341,14 @@ mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
     origin
       | nameIsLocalOrFrom this_mod name = Nothing
       | otherwise                       = Just (moduleNameColons . moduleName . nameModule $ name)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Hashing and comparison}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 cmpName :: Name -> Name -> Ordering
 cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
@@ -378,15 +372,15 @@ stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
     sort_cmp Internal         System           = LT
     sort_cmp System           System           = EQ
     sort_cmp System           _                = GT
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Name-instances]{Instance declarations}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Eq Name where
     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
@@ -409,15 +403,15 @@ instance Data Name where
   toConstr _   = abstractConstr "Name"
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "Name"
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Binary}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Binary Name where
    put_ bh name =
       case getUserData bh of
@@ -426,15 +420,15 @@ instance Binary Name where
    get bh =
       case getUserData bh of
         UserData { ud_get_name = get_name } -> get_name bh
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Pretty printing}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Outputable Name where
     ppr name = pprName name
 
@@ -546,24 +540,22 @@ pprNameDefnLoc name
          -> ptext (sLit "at") <+> ftext s
          | otherwise
          -> ptext (sLit "in") <+> quotes (ppr (nameModule name))
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Overloaded functions related to Names}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A class allowing convenient access to the 'Name' of various datatypes
 class NamedThing a where
     getOccName :: a -> OccName
     getName    :: a -> Name
 
     getOccName n = nameOccName (getName n)      -- Default method
-\end{code}
 
-\begin{code}
 getSrcLoc           :: NamedThing a => a -> SrcLoc
 getSrcSpan          :: NamedThing a => a -> SrcSpan
 getOccString        :: NamedThing a => a -> String
@@ -577,15 +569,15 @@ pprInfixName, pprPrefixName :: (Outputable a, NamedThing a) => a -> SDoc
 -- add parens or back-quotes as appropriate
 pprInfixName  n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)
 
-pprPrefixName thing 
- |  name `hasKey` liftedTypeKindTyConKey 
+pprPrefixName thing
+ |  name `hasKey` liftedTypeKindTyConKey
  = ppr name   -- See Note [Special treatment for kind *]
  | otherwise
  = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)
  where
    name = getName thing
-\end{code}
 
+{-
 Note [Special treatment for kind *]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Do not put parens around the kind '*'.  Even though it looks like
@@ -597,4 +589,4 @@ the overloaded function pprPrefixOcc.  It's easier where we know the
 type being pretty printed; eg the pretty-printing code in TypeRep.
 
 See Trac #7645, which led to this.
-
+-}
similarity index 78%
rename from compiler/basicTypes/Name.lhs-boot
rename to compiler/basicTypes/Name.hs-boot
index 27b71d9..313db26 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module Name where
 
 import {-# SOURCE #-} Module
@@ -6,4 +5,3 @@ import {-# SOURCE #-} Module
 data Name
 
 nameModule :: Name -> Module
-\end{code}
similarity index 83%
rename from compiler/basicTypes/NameEnv.lhs
rename to compiler/basicTypes/NameEnv.hs
index f86e174..9018bc4 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
 \section[NameEnv]{@NameEnv@: name environments}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 module NameEnv (
         -- * Var, Id and TyVar environments (maps)
@@ -31,15 +31,15 @@ import Name
 import Unique
 import UniqFM
 import Maybes
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Name environment}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 depAnal :: (node -> [Name])      -- Defs
         -> (node -> [Name])      -- Uses
         -> [node]
@@ -56,16 +56,15 @@ depAnal get_defs get_uses nodes
 
     key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
     key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Name environment}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type NameEnv a = UniqFM a       -- Domain is Name
 
 emptyNameEnv       :: NameEnv a
@@ -116,4 +115,3 @@ anyNameEnv f x          = foldUFM ((||) . f) False x
 disjointNameEnv x y     = isNullUFM (intersectUFM x y)
 
 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
-\end{code}
similarity index 83%
rename from compiler/basicTypes/NameSet.lhs
rename to compiler/basicTypes/NameSet.hs
index 0710dfa..7bca479 100644 (file)
@@ -1,9 +1,8 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 module NameSet (
         -- * Names set type
@@ -34,15 +33,15 @@ module NameSet (
 
 import Name
 import UniqSet
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Sets of names}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type NameSet = UniqSet Name
 
 emptyNameSet       :: NameSet
@@ -84,18 +83,17 @@ intersectNameSet  = intersectUniqSets
 delListFromNameSet set ns = foldl delFromNameSet set ns
 
 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Free variables}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 These synonyms are useful when we are thinking of free variables
+-}
 
-\begin{code}
 type FreeVars   = NameSet
 
 plusFV   :: FreeVars -> FreeVars -> FreeVars
@@ -117,16 +115,15 @@ addOneFV    = extendNameSet
 unitFV      = unitNameSet
 delFV n s   = delFromNameSet s n
 delFVs ns s = delListFromNameSet s ns
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Defs and uses
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A set of names that are defined somewhere
 type Defs = NameSet
 
@@ -196,4 +193,3 @@ findUses dus uses
         = rhs_uses `unionNameSet` uses
         | otherwise     -- No def is used
         = uses
-\end{code}
similarity index 88%
rename from compiler/basicTypes/OccName.lhs
rename to compiler/basicTypes/OccName.hs
index fdc7c95..b7da021 100644 (file)
@@ -1,9 +1,8 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
 
-\begin{code}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 -- |
@@ -109,17 +108,17 @@ import Lexeme
 import Binary
 import Data.Char
 import Data.Data
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
               FastStringEnv
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 FastStringEnv can't be in FastString because the env depends on UniqFM
+-}
 
-\begin{code}
 type FastStringEnv a = UniqFM a         -- Keyed by FastString
 
 
@@ -132,15 +131,15 @@ emptyFsEnv  = emptyUFM
 lookupFsEnv = lookupUFM
 extendFsEnv = addToUFM
 mkFsEnv     = listToUFM
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Name space}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data NameSpace = VarName        -- Variables, including "real" data constructors
                | DataName       -- "Source" data constructors
                | TvName         -- Type variables
@@ -231,25 +230,21 @@ demoteNameSpace VarName = Nothing
 demoteNameSpace DataName = Nothing
 demoteNameSpace TvName = Nothing
 demoteNameSpace TcClsName = Just DataName
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data OccName = OccName
     { occNameSpace  :: !NameSpace
     , occNameFS     :: !FastString
     }
     deriving Typeable
-\end{code}
-
 
-\begin{code}
 instance Eq OccName where
     (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
 
@@ -266,16 +261,15 @@ instance Data OccName where
 
 instance HasOccName OccName where
   occName = id
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Printing}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Outputable OccName where
     ppr = pprOccName
 
@@ -303,21 +297,21 @@ pprOccName (OccName sp occ)
     strip_th_unique ('[' : c : _) | isAlphaNum c = []
     strip_th_unique (c : cs) = c : strip_th_unique cs
     strip_th_unique []       = []
-\end{code}
 
+{-
 Note [Suppressing uniques in OccNames]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 This is a hack to de-wobblify the OccNames that contain uniques from
 Template Haskell that have been turned into a string in the OccName.
 See Note [Unique OccNames from Template Haskell] in Convert.hs
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Construction}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 mkOccName :: NameSpace -> String -> OccName
 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
 
@@ -378,14 +372,13 @@ otherNameSpace TcClsName = TvName
 This class provides a consistent way to access the underlying OccName. -}
 class HasOccName name where
   occName :: name -> OccName
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Environments
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 OccEnvs are used mainly for the envts in ModIfaces.
 
@@ -399,8 +392,8 @@ So we can make a Unique using
         mkUnique ns key  :: Unique
 where 'ns' is a Char representing the name space.  This in turn makes it
 easy to build an OccEnv.
+-}
 
-\begin{code}
 instance Uniquable OccName where
       -- See Note [The Unique of an OccName]
   getUnique (OccName VarName   fs) = mkVarOccUnique  fs
@@ -487,16 +480,15 @@ foldOccSet        = foldUniqSet
 isEmptyOccSet     = isEmptyUniqSet
 intersectOccSet   = intersectUniqSets
 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Predicates and taking them apart}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 occNameString :: OccName -> String
 occNameString (OccName _ s) = unpackFS s
 
@@ -544,24 +536,20 @@ parenSymOcc :: OccName -> SDoc -> SDoc
 -- ^ Wrap parens around an operator
 parenSymOcc occ doc | isSymOcc occ = parens doc
                     | otherwise    = doc
-\end{code}
-
 
-\begin{code}
 startsWithUnderscore :: OccName -> Bool
 -- ^ Haskell 98 encourages compilers to suppress warnings about unsed
 -- names in a pattern if they start with @_@: this implements that test
 startsWithUnderscore occ = case occNameString occ of
                              ('_' : _) -> True
                              _other    -> False
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Making system names}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Here's our convention for splitting up the interface file name space:
 
@@ -591,8 +579,8 @@ This knowledge is encoded in the following functions.
 
 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 NB: The string must already be encoded!
+-}
 
-\begin{code}
 mk_deriv :: NameSpace
          -> String              -- Distinguishes one sort of derived name from another
          -> String
@@ -606,9 +594,7 @@ isDerivedOccName occ =
      '$':c:_ | isAlphaNum c -> True
      ':':c:_ | isAlphaNum c -> True
      _other                 -> False
-\end{code}
 
-\begin{code}
 mkDataConWrapperOcc, mkWorkerOcc, mkMatcherOcc, mkDefaultMethodOcc,
         mkGenDefMethodOcc, mkDerivedTyConOcc, mkClassDataConOcc, mkDictOcc,
         mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, mkGenOcc1, mkGenOcc2,
@@ -694,9 +680,7 @@ mk_simple_deriv_with sp px (Just with) occ = mk_deriv sp (px ++ with ++ "_") (oc
 -- of the data constructor OccName (which should be a DataName)
 -- to VarName
 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
-\end{code}
 
-\begin{code}
 mkSuperDictSelOcc :: Int        -- ^ Index of superclass, e.g. 3
                   -> OccName    -- ^ Class, e.g. @Ord@
                   -> OccName    -- ^ Derived 'Occname', e.g. @$p3Ord@
@@ -710,9 +694,7 @@ mkLocalOcc uniq occ
    = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
         -- The Unique might print with characters
         -- that need encoding (e.g. 'z'!)
-\end{code}
 
-\begin{code}
 -- | Derive a name for the representation type constructor of a
 -- @data@\/@newtype@ instance.
 mkInstTyTcOcc :: String                 -- ^ Family name, e.g. @Map@
@@ -720,9 +702,7 @@ mkInstTyTcOcc :: String                 -- ^ Family name, e.g. @Map@
               -> OccName                -- ^ @R:Map@
 mkInstTyTcOcc str set =
   chooseUniqueOcc tcName ('R' : ':' : str) set
-\end{code}
 
-\begin{code}
 mkDFunOcc :: String             -- ^ Typically the class and type glommed together e.g. @OrdMaybe@.
                                 -- Only used in debug mode, for extra clarity
           -> Bool               -- ^ Is this a hs-boot instance DFun?
@@ -738,20 +718,20 @@ mkDFunOcc info_str is_boot set
   where
     prefix | is_boot   = "$fx"
            | otherwise = "$f"
-\end{code}
 
+{-
 Sometimes we need to pick an OccName that has not already been used,
 given a set of in-use OccNames.
+-}
 
-\begin{code}
 chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
 chooseUniqueOcc ns str set = loop (mkOccName ns str) (0::Int)
   where
   loop occ n
    | occ `elemOccSet` set = loop (mkOccName ns (str ++ show n)) (n+1)
    | otherwise            = occ
-\end{code}
 
+{-
 We used to add a '$m' to indicate a method, but that gives rise to bad
 error messages from the type checker when we print the function name or pattern
 of an instance-decl binding.  Why? Because the binding is zapped
@@ -770,19 +750,18 @@ e.g. a call to constructor MkFoo where
 
 If this is necessary, we do it by prefixing '$m'.  These
 guys never show up in error messages.  What a hack.
+-}
 
-\begin{code}
 mkMethodOcc :: OccName -> OccName
 mkMethodOcc occ@(OccName VarName _) = occ
 mkMethodOcc occ                     = mk_simple_deriv varName "$m" occ
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Tidying them up}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Before we print chunks of code we like to rename it so that
 we don't have to print lots of silly uniques in it.  But we mustn't
@@ -809,8 +788,8 @@ type TidyOccEnv = UniqFM Int
 
 * When looking for a renaming for "foo2" we strip off the "2" and start
   with "foo".  Otherwise if we tidy twice we get silly names like foo23.
+-}
 
-\begin{code}
 type TidyOccEnv = UniqFM Int    -- The in-scope OccNames
   -- See Note [TidyOccEnv]
 
@@ -843,16 +822,16 @@ tidyOccName env occ@(OccName occ_sp fs)
        where
          n1 = n+1
          new_fs = mkFastString (base ++ show n)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Binary instance
     Here rather than BinIface because OccName is abstract
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Binary NameSpace where
     put_ bh VarName = do
             putByte bh 0
@@ -878,4 +857,3 @@ instance Binary OccName where
           aa <- get bh
           ab <- get bh
           return (OccName aa ab)
-\end{code}
similarity index 59%
rename from compiler/basicTypes/OccName.lhs-boot
rename to compiler/basicTypes/OccName.hs-boot
index d9c7fcd..c6fa885 100644 (file)
@@ -1,5 +1,3 @@
-\begin{code}
 module OccName where
 
 data OccName
-\end{code}
similarity index 90%
rename from compiler/basicTypes/PatSyn.lhs
rename to compiler/basicTypes/PatSyn.hs
index 9fc4f98..f2cef7b 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+
 \section[PatSyn]{@PatSyn@: Pattern synonyms}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module PatSyn (
@@ -36,16 +36,15 @@ import HsBinds( HsPatSynDetails(..) )
 import qualified Data.Data as Data
 import qualified Data.Typeable
 import Data.Function
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Pattern synonyms}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A pattern synonym
 -- See Note [Pattern synonym representation]
 data PatSyn
@@ -90,8 +89,8 @@ data PatSyn
              -- See Note [Builder for pattern synonyms with unboxed type]
   }
   deriving Data.Typeable.Typeable
-\end{code}
 
+{-
 Note [Pattern synonym representation]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following pattern synonym declaration
@@ -143,7 +142,7 @@ For the above example, the matcher function has type:
 
 with the following implementation:
 
-        $mP @r @t $dEq $dNum scrut cont fail 
+        $mP @r @t $dEq $dNum scrut cont fail
           = case scrut of
               MkT @b $dShow $dOrd [x] (Just 42) -> cont @b $dShow $dOrd x
               _                                 -> fail Void#
@@ -153,7 +152,7 @@ be instantiated by an unboxed type; for example where we see
      f (P x) = 3#
 
 The extra Void# argument for the failure continuation is needed so that
-it is lazy even when the result type is unboxed. 
+it is lazy even when the result type is unboxed.
 
 For the same reason, if the pattern has no arguments, an extra Void#
 argument is added to the success continuation as well.
@@ -190,13 +189,13 @@ we must remember that the builder has this void argument. This is
 done by TcPatSyn.patSynBuilderOcc.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Instances}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Eq PatSyn where
     (==) = (==) `on` getUnique
     (/=) = (/=) `on` getUnique
@@ -226,16 +225,15 @@ instance Data.Data PatSyn where
     toConstr _   = abstractConstr "PatSyn"
     gunfold _ _  = error "gunfold"
     dataTypeOf _ = mkNoRepType "PatSyn"
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Construction}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Build a new pattern synonym
 mkPatSyn :: Name
          -> Bool                 -- ^ Is the pattern synonym declared infix?
@@ -263,9 +261,7 @@ mkPatSyn name declared_infix
                 psOrigResTy = orig_res_ty,
                 psMatcher = matcher,
                 psBuilder = builder }
-\end{code}
 
-\begin{code}
 -- | The 'Name' of the 'PatSyn', giving it a unique, rooted identification
 patSynName :: PatSyn -> Name
 patSynName = psName
@@ -347,4 +343,3 @@ patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
   = ASSERT2( length univ_tvs == length inst_tys
            , ptext (sLit "patSynInstResTy") <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
     substTyWith univ_tvs inst_tys res_ty
-\end{code}
similarity index 94%
rename from compiler/basicTypes/PatSyn.lhs-boot
rename to compiler/basicTypes/PatSyn.hs-boot
index 0bb85e9..733c51b 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module PatSyn where
 import Name( NamedThing )
 import Data.Typeable ( Typeable )
@@ -16,4 +15,3 @@ instance OutputableBndr PatSyn
 instance Uniquable PatSyn
 instance Typeable PatSyn
 instance Data PatSyn
-\end{code}
similarity index 93%
rename from compiler/basicTypes/RdrName.lhs
rename to compiler/basicTypes/RdrName.hs
index 22893f3..71135d0 100644 (file)
@@ -1,9 +1,8 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 -- |
@@ -45,7 +44,7 @@ module RdrName (
 
         -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
-        lookupGlobalRdrEnv, extendGlobalRdrEnv, 
+        lookupGlobalRdrEnv, extendGlobalRdrEnv,
         pprGlobalRdrEnv, globalRdrEnvElts,
         lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
         transformGREs, findLocalDupsRdrEnv, pickGREs,
@@ -76,15 +75,15 @@ import Util
 import StaticFlags( opt_PprStyle_Debug )
 
 import Data.Data
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{The main data type}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Do not use the data constructors of RdrName directly: prefer the family
 -- of functions that creates them, such as 'mkRdrUnqual'
 data RdrName
@@ -117,16 +116,14 @@ data RdrName
         --
         -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
   deriving (Data, Typeable)
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Simple functions}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 instance HasOccName RdrName where
   occName = rdrNameOcc
@@ -173,9 +170,7 @@ demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
 demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
 demoteRdrName (Orig _ _) = panic "demoteRdrName"
 demoteRdrName (Exact _) = panic "demoteRdrName"
-\end{code}
 
-\begin{code}
         -- These two are the basic constructors
 mkRdrUnqual :: OccName -> RdrName
 mkRdrUnqual occ = Unqual occ
@@ -213,9 +208,7 @@ nukeExact :: Name -> RdrName
 nukeExact n
   | isExternalName n = Orig (nameModule n) (nameOccName n)
   | otherwise        = Unqual (nameOccName n)
-\end{code}
 
-\begin{code}
 isRdrDataCon :: RdrName -> Bool
 isRdrTyVar   :: RdrName -> Bool
 isRdrTc      :: RdrName -> Bool
@@ -256,16 +249,15 @@ isExact _         = False
 isExact_maybe :: RdrName -> Maybe Name
 isExact_maybe (Exact n) = Just n
 isExact_maybe _         = Nothing
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Instances}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 instance Outputable RdrName where
     ppr (Exact name)   = ppr name
     ppr (Unqual occ)   = ppr occ
@@ -323,15 +315,15 @@ instance Ord RdrName where
 
     compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
     compare (Orig _ _)   _            = GT
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                         LocalRdrEnv
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | This environment is used to store local bindings (@let@, @where@, lambda, @case@).
 -- It is keyed by OccName, because we never use it for qualified names
 -- We keep the current mapping, *and* the set of all Names in scope
@@ -388,11 +380,11 @@ inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
 inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
 
 delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
-delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs 
+delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs
   = LRE { lre_env = delListFromOccEnv env occs
         , lre_in_scope = ns }
-\end{code}
 
+{-
 Note [Local bindings with Exact Names]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 With Template Haskell we can make local bindings that have Exact Names.
@@ -401,13 +393,13 @@ does so in RnTpes.bindHsTyVars), so for an Exact Name we must consult
 the in-scope-name-set.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                         GlobalRdrEnv
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type GlobalRdrEnv = OccEnv [GlobalRdrElt]
 -- ^ Keyed by 'OccName'; when looking up a qualified name
 -- we look up the 'OccName' part, and then check the 'Provenance'
@@ -455,8 +447,8 @@ hasParent n (ParentIs n')
   | n /= n' = pprPanic "hasParent" (ppr n <+> ppr n')  -- Parents should agree
 #endif
 hasParent n _  = ParentIs n
-\end{code}
 
+{-
 Note [Parents]
 ~~~~~~~~~~~~~~~~~
   Parent           Children
@@ -496,9 +488,8 @@ those.  For T that will mean we have
   one GRE with Parent C
   one GRE with NoParent
 That's why plusParent picks the "best" case.
+-}
 
-
-\begin{code}
 -- | make a 'GlobalRdrEnv' where all the elements point to the same
 -- Provenance (useful for "hiding" imports, or imports with
 -- no details).
@@ -531,9 +522,9 @@ instance Outputable GlobalRdrElt where
 
 pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
 pprGlobalRdrEnv locals_only env
-  = vcat [ ptext (sLit "GlobalRdrEnv") <+> ppWhen locals_only (ptext (sLit "(locals only)")) 
+  = vcat [ ptext (sLit "GlobalRdrEnv") <+> ppWhen locals_only (ptext (sLit "(locals only)"))
              <+> lbrace
-         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ] 
+         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]
              <+> rbrace) ]
   where
     remove_locals gres | locals_only = filter isLocalGRE gres
@@ -642,11 +633,9 @@ pickGREs rdr_name gres
                       = filter ((== mod) . is_as . is_decl) is
                       | otherwise
                       = []
-\end{code}
 
-Building GlobalRdrEnvs
+-- Building GlobalRdrEnvs
 
-\begin{code}
 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
 
@@ -755,16 +744,16 @@ shadow_name env name
        = Nothing   -- Shadow both qualified and unqualified
        | otherwise -- Shadow unqualified only
        = Just (is { is_decl = id_spec { is_qual = True } })
-\end{code}
 
+{-
 Note [Template Haskell binders in the GlobalRdrEnv]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For reasons described in Note [Top-level Names in Template Haskell decl quotes]
 in RnNames, a GRE with an Internal gre_name (i.e. one generated by a TH decl
 quote) should *shadow* a GRE with an External gre_name.  Hence some faffing
 around in pickGREs and findLocalDupsRdrEnv
+-}
 
-\begin{code}
 findLocalDupsRdrEnv :: GlobalRdrEnv -> [Name] -> [[GlobalRdrElt]]
 -- ^ For each 'OccName', see if there are multiple local definitions
 -- for it; return a list of all such
@@ -791,15 +780,15 @@ findLocalDupsRdrEnv rdr_env occs
       | isInternalName name = isInternalName n
       | otherwise           = True
     pick _ _ = False
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                         Provenance
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | The 'Provenance' of something says how it came to be in scope.
 -- It's quite elaborate so that we can give accurate unused-name warnings.
 data Provenance
@@ -890,9 +879,7 @@ instance Ord ImpDeclSpec where
 
 instance Ord ImpItemSpec where
    compare is1 is2 = is_iloc is1 `compare` is_iloc is2
-\end{code}
 
-\begin{code}
 plusProv :: Provenance -> Provenance -> Provenance
 -- Choose LocalDef over Imported
 -- There is an obscure bug lurking here; in the presence
@@ -946,4 +933,3 @@ instance Outputable ImportSpec where
 pprLoc :: SrcSpan -> SDoc
 pprLoc (RealSrcSpan s)    = ptext (sLit "at") <+> ppr s
 pprLoc (UnhelpfulSpan {}) = empty
-\end{code}
similarity index 85%
rename from compiler/basicTypes/SrcLoc.lhs
rename to compiler/basicTypes/SrcLoc.hs
index c7e1fbe..8e17561 100644 (file)
@@ -1,8 +1,5 @@
-%
-% (c) The University of Glasgow, 1992-2006
-%
+-- (c) The University of Glasgow, 1992-2006
 
-\begin{code}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
    -- Workaround for Trac #5252 crashes the bootstrap compiler without -O
@@ -83,17 +80,18 @@ import Data.Bits
 import Data.Data
 import Data.List
 import Data.Ord
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcLoc-SrcLocations]{Source-location information}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 We keep information about the {\em definition} point for each entity;
 this is the obvious stuff:
-\begin{code}
+-}
+
 -- | Represents a single point within a file
 data RealSrcLoc
   = SrcLoc      FastString              -- A precise location (file name)
@@ -104,15 +102,15 @@ data SrcLoc
   = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
   | UnhelpfulLoc FastString     -- Just a general indication
   deriving Show
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcLoc-access-fns]{Access functions}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
 mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
 
@@ -149,15 +147,15 @@ advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1
 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (((((c - 1) `shiftR` 3) + 1)
                                                   `shiftL` 3) + 1)
 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcLoc-instances]{Instance declarations for various names}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 instance Eq SrcLoc where
   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
@@ -219,15 +217,15 @@ instance Data SrcSpan where
   toConstr _   = abstractConstr "SrcSpan"
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "SrcSpan"
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcSpan]{Source Spans}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 {- |
 A SrcSpan delimits a portion of a text file.  It could be represented
 by a pair of (line,column) coordinates, but in fact we optimise
@@ -330,15 +328,15 @@ combineRealSrcSpans span1 span2
     (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)
                                   (srcSpanEndLine span2, srcSpanEndCol span2)
     file = srcSpanFile span1
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcSpan-predicates]{Predicates}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
 isGoodSrcSpan :: SrcSpan -> Bool
 isGoodSrcSpan (RealSrcSpan _) = True
@@ -350,15 +348,13 @@ isOneLineSpan :: SrcSpan -> Bool
 isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
 isOneLineSpan (UnhelpfulSpan _) = False
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 srcSpanStartLine :: RealSrcSpan -> Int
 srcSpanEndLine :: RealSrcSpan -> Int
@@ -381,15 +377,13 @@ srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcSpan-access-fns]{Access functions}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
 srcSpanStart :: SrcSpan -> SrcLoc
@@ -416,15 +410,13 @@ srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
 srcSpanFileName_maybe (RealSrcSpan s)   = Just (srcSpanFile s)
 srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[SrcSpan-instances]{Instances}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 -- We want to order SrcSpans first by the start point, then by the end point.
 instance Ord SrcSpan where
@@ -499,15 +491,15 @@ pprUserRealSpan show_path (SrcSpanPoint src_path line col)
   = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
          , int line <> colon
          , int col ]
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Located]{Attaching SrcSpans to things}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 data GenLocated l e = L l e
   deriving (Eq, Ord, Typeable, Data)
@@ -556,15 +548,15 @@ instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
                 -- ifPprDebug (braces (pprUserSpan False l))
                 ifPprDebug (braces (ppr l))
              $$ ppr e
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Ordering SrcSpans for InteractiveUI}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Alternative strategies for ordering 'SrcSpan's
 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
 rightmost            = flip compare
@@ -587,5 +579,3 @@ isSubspanOf src parent
     | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
     | otherwise = srcSpanStart parent <= srcSpanStart src &&
                   srcSpanEnd parent   >= srcSpanEnd src
-
-\end{code}
similarity index 87%
rename from compiler/basicTypes/UniqSupply.lhs
rename to compiler/basicTypes/UniqSupply.hs
index d1a1efd..3d0573d 100644 (file)
@@ -1,9 +1,8 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
 
-\begin{code}
 {-# LANGUAGE UnboxedTuples #-}
 
 module UniqSupply (
@@ -33,15 +32,14 @@ import GHC.IO
 import MonadUtils
 import Control.Monad
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Splittable Unique supply: @UniqSupply@}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A value of type 'UniqSupply' is unique, and it can
 -- supply /one/ distinct 'Unique'.  Also, from the supply, one can
 -- also manufacture an arbitrary number of further 'UniqueSupply' values,
@@ -50,9 +48,7 @@ data UniqSupply
   = MkSplitUniqSupply FastInt   -- make the Unique with this
                    UniqSupply UniqSupply
                                 -- when split => these two supplies
-\end{code}
 
-\begin{code}
 mkSplitUniqSupply :: Char -> IO UniqSupply
 -- ^ Create a unique supply out of thin air. The character given must
 -- be distinct from those of all calls to this function in the compiler
@@ -69,9 +65,7 @@ uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite
 -- ^ Obtain an infinite list of 'Unique' that can be generated by constant splitting of the supply
 takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
 -- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply
-\end{code}
 
-\begin{code}
 mkSplitUniqSupply c
   = case fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24) of
      mask -> let
@@ -93,21 +87,19 @@ foreign import ccall unsafe "genSym" genSym :: IO Int
 
 splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
 listSplitUniqSupply  (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2
-\end{code}
 
-\begin{code}
 uniqFromSupply  (MkSplitUniqSupply n _ _)  = mkUniqueGrimily (iBox n)
 uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily (iBox n) : uniqsFromSupply s2
 takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily (iBox n), s1)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A monad which just gives the ability to obtain 'Unique's
 newtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) }
 
@@ -139,10 +131,9 @@ initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r }
 {-# INLINE lazyThenUs #-}
 {-# INLINE returnUs #-}
 {-# INLINE splitUniqSupply #-}
-\end{code}
 
-@thenUs@ is where we split the @UniqSupply@.
-\begin{code}
+-- @thenUs@ is where we split the @UniqSupply@.
+
 liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)
 liftUSM (USM m) us = case m us of (# a, us' #) -> (a, us')
 
@@ -196,9 +187,7 @@ getUniqueUs = USM (\us -> case takeUniqFromSupply us of
 getUniquesUs :: UniqSM [Unique]
 getUniquesUs = USM (\us -> case splitUniqSupply us of
                            (us1,us2) -> (# uniqsFromSupply us1, us2 #))
-\end{code}
 
-\begin{code}
 -- {-# SPECIALIZE mapM          :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-}
 -- {-# SPECIALIZE mapAndUnzipM  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c]) #-}
 -- {-# SPECIALIZE mapAndUnzip3M :: (a -> UniqSM (b,c,d)) -> [a] -> UniqSM ([b],[c],[d]) #-}
@@ -209,4 +198,3 @@ lazyMapUs f (x:xs)
   = f x             `lazyThenUs` \ r  ->
     lazyMapUs f xs  `lazyThenUs` \ rs ->
     returnUs (r:rs)
-\end{code}
similarity index 85%
rename from compiler/basicTypes/Unique.lhs
rename to compiler/basicTypes/Unique.hs
index 8191db6..ecff80f 100644 (file)
@@ -1,7 +1,7 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
 
 @Uniques@ are used to distinguish entities in the compiler (@Ids@,
 @Classes@, etc.) from each other.  Thus, @Uniques@ are the basic
@@ -14,8 +14,8 @@ directed to that end.
 Some of the other hair in this code is to be able to use a
 ``splittable @UniqueSupply@'' if requested/possible (not standard
 Haskell).
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, BangPatterns, MagicHash #-}
 
 module Unique (
@@ -70,30 +70,30 @@ import Util
 import GHC.Exts (indexCharOffAddr#, Char(..))
 
 import Data.Char        ( chr, ord )
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Unique-type]{@Unique@ type and operations}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
 Fast comparison is everything on @Uniques@:
+-}
 
-\begin{code}
 --why not newtype Int?
 
 -- | The type of unique identifiers that are used in many places in GHC
 -- for fast ordering and equality tests. You should generate these with
 -- the functions from the 'UniqSupply' module
 data Unique = MkUnique FastInt
-\end{code}
 
+{-
 Now come the functions which construct uniques from their pieces, and vice versa.
 The stuff about unique *supplies* is handled further down this module.
+-}
 
-\begin{code}
 unpkUnique      :: Unique -> (Char, Int)        -- The reverse
 
 mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
@@ -103,10 +103,7 @@ getKeyFastInt   :: Unique -> FastInt            -- for Var
 incrUnique      :: Unique -> Unique
 deriveUnique    :: Unique -> Int -> Unique
 newTagUnique    :: Unique -> Char -> Unique
-\end{code}
-
 
-\begin{code}
 mkUniqueGrimily x = MkUnique (iUnbox x)
 
 {-# INLINE getKey #-}
@@ -146,17 +143,15 @@ unpkUnique (MkUnique u)
         i   = iBox (u `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-})
     in
     (tag, i)
-\end{code}
-
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Uniquable-class]{The @Uniquable@ class}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Class of things that we can obtain a 'Unique' from
 class Uniquable a where
     getUnique :: a -> Unique
@@ -169,20 +164,19 @@ instance Uniquable FastString where
 
 instance Uniquable Int where
  getUnique i = mkUniqueGrimily i
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Unique-instances]{Instance declarations for @Unique@}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 And the whole point (besides uniqueness) is fast equality.  We don't
 use `deriving' because we want {\em precise} control of ordering
 (equality on @Uniques@ is v common).
+-}
 
-\begin{code}
 eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
 ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
@@ -206,10 +200,9 @@ instance Ord Unique where
 -----------------
 instance Uniquable Unique where
     getUnique u = u
-\end{code}
 
-We do sometimes make strings with @Uniques@ in them:
-\begin{code}
+-- We do sometimes make strings with @Uniques@ in them:
+
 showUnique :: Unique -> String
 showUnique uniq
   = case unpkUnique uniq of
@@ -230,19 +223,19 @@ instance Outputable Unique where
 
 instance Show Unique where
     show uniq = showUnique uniq
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Utils-base62]{Base-62 numbers}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 A character-stingy way to read/write numbers (notably Uniques).
 The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
 Code stolen from Lennart.
+-}
 
-\begin{code}
 iToBase62 :: Int -> String
 iToBase62 n_
   = ASSERT(n_ >= 0) go (iUnbox n_) ""
@@ -259,13 +252,13 @@ iToBase62 n_
     {-# INLINE chooseChar62 #-}
     chooseChar62 n = C# (indexCharOffAddr# chars62 n)
     !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Allocation of unique supply characters:
         v,t,u : for renumbering value-, type- and usage- vars.
@@ -285,8 +278,8 @@ Allocation of unique supply characters:
         n       Native codegen
         r       Hsc name cache
         s       simplifier
+-}
 
-\begin{code}
 mkAlphaTyVarUnique     :: Int -> Unique
 mkPreludeClassUnique   :: Int -> Unique
 mkPreludeTyConUnique   :: Int -> Unique
@@ -356,5 +349,3 @@ mkVarOccUnique  fs = mkUnique 'i' (iBox (uniqueOfFS fs))
 mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs))
 mkTvOccUnique   fs = mkUnique 'v' (iBox (uniqueOfFS fs))
 mkTcOccUnique   fs = mkUnique 'c' (iBox (uniqueOfFS fs))
-\end{code}
-
similarity index 88%
rename from compiler/basicTypes/Var.lhs
rename to compiler/basicTypes/Var.hs
index 62253c8..925ffe3 100644 (file)
@@ -1,10 +1,10 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
 \section{@Vars@: Variables}
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 -- |
 -- #name_types#
@@ -80,18 +80,17 @@ import FastString
 import Outputable
 
 import Data.Data
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                      Synonyms
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 -- These synonyms are here and not in Id because otherwise we need a very
 -- large number of SOURCE imports of Id.hs :-(
+-}
 
-\begin{code}
 type Id    = Var       -- A term-level identifier
 
 type TyVar   = Var     -- Type *or* kind variable (historical)
@@ -110,8 +109,8 @@ type IpId   = EvId      -- A term-level implicit parameter
 type EqVar  = EvId      -- Boxed equality evidence
 
 type CoVar = Id         -- See Note [Evidence: EvIds and CoVars]
-\end{code}
 
+{-
 Note [Evidence: EvIds and CoVars]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * An EvId (evidence Id) is a *boxed*, term-level evidence variable
@@ -136,19 +135,19 @@ go over the whole compiler code to use:
    - KindVar to mean kind         variables
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{The main data type declarations}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 
 Every @Var@ has a @Unique@, to uniquify it and for fast comparison, a
 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
 strictness).  The essential info about different kinds of @Vars@ is
 in its @VarDetails@.
+-}
 
-\begin{code}
 -- | Essentially a typed 'Name', that may also contain some additional information
 -- about the 'Var' and it's use sites.
 data Var
@@ -185,8 +184,8 @@ data IdScope    -- See Note [GlobalId/LocalId]
 data ExportFlag
   = NotExported -- ^ Not exported: may be discarded as dead code.
   | Exported    -- ^ Exported: kept alive
-\end{code}
 
+{-
 Note [GlobalId/LocalId]
 ~~~~~~~~~~~~~~~~~~~~~~~
 A GlobalId is
@@ -203,13 +202,13 @@ A LocalId is
   * always treated as a candidate by the free-variable finder
 
 After CoreTidy, top-level LocalIds are turned into GlobalIds
+-}
 
-\begin{code}
 instance Outputable Var where
   ppr var = ppr (varName var) <> getPprStyle (ppr_debug var)
 
 ppr_debug :: Var -> PprStyle -> SDoc
-ppr_debug (TyVar {}) sty 
+ppr_debug (TyVar {}) sty
   | debugStyle sty = brackets (ptext (sLit "tv"))
 ppr_debug (TcTyVar {tc_tv_details = d}) sty
   | dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)
@@ -243,10 +242,7 @@ instance Data Var where
   toConstr _   = abstractConstr "Var"
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "Var"
-\end{code}
-
 
-\begin{code}
 varUnique :: Var -> Unique
 varUnique var = mkUniqueGrimily (iBox (realUnique var))
 
@@ -262,16 +258,15 @@ setVarName var new_name
 
 setVarType :: Id -> Type -> Id
 setVarType id ty = id { varType = ty }
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Type and kind variables}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 tyVarName :: TyVar -> Name
 tyVarName = varName
 
@@ -294,9 +289,7 @@ updateTyVarKindM :: (Monad m) => (Kind -> m Kind) -> TyVar -> m TyVar
 updateTyVarKindM update tv
   = do { k' <- update (tyVarKind tv)
        ; return $ tv {varType = k'} }
-\end{code}
 
-\begin{code}
 mkTyVar :: Name -> Kind -> TyVar
 mkTyVar name kind = TyVar { varName    = name
                           , realUnique = getKeyFastInt (nameUnique name)
@@ -327,15 +320,14 @@ mkKindVar name kind = TyVar
   , realUnique = getKeyFastInt (nameUnique name)
   , varType    = kind }
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Ids}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 idInfo :: Id -> IdInfo
 idInfo (Id { id_info = info }) = info
 idInfo other                   = pprPanic "idInfo" (ppr other)
@@ -394,15 +386,15 @@ setIdNotExported :: Id -> Id
 -- ^ We can only do this to LocalIds
 setIdNotExported id = ASSERT( isLocalId id )
                       id { idScope = LocalId NotExported }
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Predicates over variables}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 isTyVar :: Var -> Bool
 isTyVar = isTKVar     -- Historical
 
@@ -446,4 +438,3 @@ isExportedId :: Var -> Bool
 isExportedId (Id { idScope = GlobalId })        = True
 isExportedId (Id { idScope = LocalId Exported}) = True
 isExportedId _ = False
-\end{code}
similarity index 91%
rename from compiler/basicTypes/VarEnv.lhs
rename to compiler/basicTypes/VarEnv.hs
index 30d40c8..1d1c060 100644 (file)
@@ -1,9 +1,8 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
 
-\begin{code}
 module VarEnv (
         -- * Var, Id and TyVar environments (maps)
         VarEnv, IdEnv, TyVarEnv, CoVarEnv,
@@ -60,16 +59,15 @@ import Outputable
 import FastTypes
 import StaticFlags
 import FastString
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 In-scope sets
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | A set of variables that are in scope at some point
 data InScopeSet = InScope (VarEnv Var) FastInt
         -- The (VarEnv Var) is just a VarSet.  But we write it like
@@ -129,9 +127,7 @@ lookupInScope_Directly (InScope in_scope _) uniq
 unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
 unionInScope (InScope s1 _) (InScope s2 n2)
   = InScope (s1 `plusVarEnv` s2) n2
-\end{code}
 
-\begin{code}
 -- | @uniqAway in_scope v@ finds a unique that is not used in the
 -- in-scope set, and gives that to v.
 uniqAway :: InScopeSet -> Var -> Var
@@ -158,15 +154,15 @@ uniqAway' (InScope set n) var
           | otherwise = setVarUnique var uniq
           where
             uniq = deriveUnique orig_unique (iBox (n *# k))
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Dual renaming
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | When we are comparing (or matching) types or terms, we are faced with
 -- \"going under\" corresponding binders.  E.g. when comparing:
 --
@@ -320,8 +316,8 @@ nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
 -- ^ Wipe the left or right side renaming
 nukeRnEnvL env = env { envL = emptyVarEnv }
 nukeRnEnvR env = env { envR = emptyVarEnv }
-\end{code}
 
+{-
 Note [Eta expansion]
 ~~~~~~~~~~~~~~~~~~~~
 When matching
@@ -337,29 +333,28 @@ For example, if we don't do this, we can get silly matches like
 succeeding with [a -> v y], which is bogus of course.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                 Tidying
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | When tidying up print names, we keep a mapping of in-scope occ-names
 -- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
 type TidyEnv = (TidyOccEnv, VarEnv Var)
 
 emptyTidyEnv :: TidyEnv
 emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{@VarEnv@s}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type VarEnv elt   = UniqFM elt
 type IdEnv elt    = VarEnv elt
 type TyVarEnv elt = VarEnv elt
@@ -399,9 +394,7 @@ lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
 elemVarEnv        :: Var -> VarEnv a -> Bool
 elemVarEnvByKey   :: Unique -> VarEnv a -> Bool
 foldVarEnv        :: (a -> b -> b) -> b -> VarEnv a -> b
-\end{code}
 
-\begin{code}
 elemVarEnv       = elemUFM
 elemVarEnvByKey  = elemUFM_Directly
 alterVarEnv      = alterUFM
@@ -439,12 +432,12 @@ zipVarEnv tyvars tys   = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 lookupVarEnv_NF env id = case lookupVarEnv env id of
                          Just xx -> xx
                          Nothing -> panic "lookupVarEnv_NF: Nothing"
-\end{code}
 
+{-
 @modifyVarEnv@: Look up a thing in the VarEnv,
 then mash it with the modify function, and put it back.
+-}
 
-\begin{code}
 modifyVarEnv mangle_fn env key
   = case (lookupVarEnv env key) of
       Nothing -> env
@@ -455,4 +448,3 @@ modifyVarEnv_Directly mangle_fn env key
   = case (lookupUFM_Directly env key) of
       Nothing -> env
       Just xx -> addToUFM_Directly env key (mangle_fn xx)
-\end{code}
similarity index 88%
rename from compiler/basicTypes/VarSet.lhs
rename to compiler/basicTypes/VarSet.hs
index 362f408..c134124 100644 (file)
@@ -1,9 +1,8 @@
-%
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module VarSet (
@@ -27,15 +26,15 @@ module VarSet (
 import Var      ( Var, TyVar, CoVar, Id )
 import Unique
 import UniqSet
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{@VarSet@s}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 type VarSet       = UniqSet Var
 type IdSet        = UniqSet Id
 type TyVarSet     = UniqSet TyVar
@@ -103,9 +102,7 @@ extendVarSet_C = addOneToUniqSet_C
 delVarSetByKey  = delOneFromUniqSet_Directly
 elemVarSetByKey = elemUniqSet_Directly
 partitionVarSet = partitionUniqSet
-\end{code}
 
-\begin{code}
 mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
 
 -- See comments with type signatures
@@ -118,10 +115,6 @@ fixVarSet f s | new_s `subVarSet` s = s
               | otherwise           = fixVarSet f new_s
               where
                 new_s = f s
-\end{code}
 
-\begin{code}
 seqVarSet :: VarSet -> ()
 seqVarSet s = sizeVarSet s `seq` ()
-\end{code}
-