compiler: de-lhs deSugar/
authorAustin Seipp <austin@well-typed.com>
Wed, 3 Dec 2014 18:46:28 +0000 (12:46 -0600)
committerAustin Seipp <austin@well-typed.com>
Wed, 3 Dec 2014 19:52:28 +0000 (13:52 -0600)
Signed-off-by: Austin Seipp <austin@well-typed.com>
18 files changed:
compiler/deSugar/Check.hs [moved from compiler/deSugar/Check.lhs with 97% similarity]
compiler/deSugar/Coverage.hs [moved from compiler/deSugar/Coverage.lhs with 97% similarity]
compiler/deSugar/Desugar.hs [moved from compiler/deSugar/Desugar.lhs with 91% similarity]
compiler/deSugar/DsArrows.hs [moved from compiler/deSugar/DsArrows.lhs with 98% similarity]
compiler/deSugar/DsBinds.hs [moved from compiler/deSugar/DsBinds.lhs with 96% similarity]
compiler/deSugar/DsCCall.hs [moved from compiler/deSugar/DsCCall.lhs with 98% similarity]
compiler/deSugar/DsExpr.hs [moved from compiler/deSugar/DsExpr.lhs with 92% similarity]
compiler/deSugar/DsExpr.hs-boot [moved from compiler/deSugar/DsExpr.lhs-boot with 92% similarity]
compiler/deSugar/DsForeign.hs [moved from compiler/deSugar/DsForeign.lhs with 95% similarity]
compiler/deSugar/DsGRHSs.hs [moved from compiler/deSugar/DsGRHSs.lhs with 88% similarity]
compiler/deSugar/DsListComp.hs [moved from compiler/deSugar/DsListComp.lhs with 95% similarity]
compiler/deSugar/DsMonad.hs [moved from compiler/deSugar/DsMonad.lhs with 91% similarity]
compiler/deSugar/DsMonad.hs-boot [moved from compiler/deSugar/DsMonad.lhs-boot with 97% similarity]
compiler/deSugar/DsUtils.hs [moved from compiler/deSugar/DsUtils.lhs with 93% similarity]
compiler/deSugar/Match.hs [moved from compiler/deSugar/Match.lhs with 94% similarity]
compiler/deSugar/Match.hs-boot [moved from compiler/deSugar/Match.lhs-boot with 96% similarity]
compiler/deSugar/MatchCon.hs [moved from compiler/deSugar/MatchCon.lhs with 98% similarity]
compiler/deSugar/MatchLit.hs [moved from compiler/deSugar/MatchLit.lhs with 89% similarity]

similarity index 97%
rename from compiler/deSugar/Check.lhs
rename to compiler/deSugar/Check.hs
index b5b9544..7284db3 100644 (file)
@@ -1,10 +1,10 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
-%
-% Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1997-1998
+
+Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module Check ( check , ExhaustivePat ) where
@@ -29,8 +29,8 @@ import Util
 import BasicTypes
 import Outputable
 import FastString
-\end{code}
 
+{-
 This module performs checks about if one list of equations are:
 \begin{itemize}
 \item Overlapped
@@ -95,8 +95,8 @@ Then we need to use InPats.
      Juan Quintela 5 JUL 1998\\
           User-friendliness and compiler writers are no friends.
 \end{quotation}
+-}
 
-\begin{code}
 type WarningPat = InPat Name
 type ExhaustivePat = ([WarningPat], [(Name, [HsLit])])
 type EqnNo  = Int
@@ -122,11 +122,8 @@ untidy_exhaustive (pats, messages) =
 
 untidy_message :: (Name, [HsLit]) -> (Name, [HsLit])
 untidy_message (string, lits) = (string, map untidy_lit lits)
-\end{code}
-
-The function @untidy@ does the reverse work of the @tidy_pat@ function.
 
-\begin{code}
+-- The function @untidy@ does the reverse work of the @tidy_pat@ function.
 
 type NeedPars = Bool
 
@@ -144,9 +141,9 @@ untidy b (L loc p) = L loc (untidy' b p)
     untidy' _ (LitPat lit)           = LitPat (untidy_lit lit)
     untidy' _ p@(ConPatIn _ (PrefixCon [])) = p
     untidy' b (ConPatIn name ps)     = pars b (L loc (ConPatIn name (untidy_con ps)))
-    untidy' _ (ListPat pats ty Nothing)     = ListPat (map untidy_no_pars pats) ty Nothing   
+    untidy' _ (ListPat pats ty Nothing)     = ListPat (map untidy_no_pars pats) ty Nothing
     untidy' _ (TuplePat pats box tys) = TuplePat (map untidy_no_pars pats) box tys
-    untidy' _ (ListPat _ _ (Just _)) = panic "Check.untidy: Overloaded ListPat"    
+    untidy' _ (ListPat _ _ (Just _)) = panic "Check.untidy: Overloaded ListPat"
     untidy' _ (PArrPat _ _)          = panic "Check.untidy: Shouldn't get a parallel array here!"
     untidy' _ (SigPatIn _ _)         = panic "Check.untidy: SigPat"
     untidy' _ (LazyPat {})           = panic "Check.untidy: LazyPat"
@@ -177,8 +174,8 @@ pars _    p = unLoc p
 untidy_lit :: HsLit -> HsLit
 untidy_lit (HsCharPrim src c) = HsChar src c
 untidy_lit lit                = lit
-\end{code}
 
+{-
 This equation is the same that check, the only difference is that the
 boring work is done, that work needs to be done only once, this is
 the reason top have two functions, check is the external interface,
@@ -203,9 +200,7 @@ There are several cases:
       vars in the first column, we actuate in consequence.
 
 \end{itemize}
-
-
-\begin{code}
+-}
 
 check' :: [(EqnNo, EquationInfo)]
         -> ([ExhaustivePat],    -- Pattern scheme that might not be matched at all
@@ -213,7 +208,7 @@ check' :: [(EqnNo, EquationInfo)]
 
 check' [] = ([],emptyUniqSet)
   -- Was    ([([],[])], emptyUniqSet)
-  -- But that (a) seems weird, and (b) triggered Trac #7669 
+  -- But that (a) seems weird, and (b) triggered Trac #7669
   -- So now I'm just doing the simple obvious thing
 
 check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
@@ -242,36 +237,34 @@ check' qs
     some_constructors = any is_con first_pats
     some_literals     = any is_lit first_pats
     only_vars         = all is_var first_pats
-\end{code}
 
+{-
 Here begins the code to deal with literals, we need to split the matrix
 in different matrix beginning by each literal and a last matrix with the
 rest of values.
+-}
 
-\begin{code}
 split_by_literals :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
 split_by_literals qs = process_literals used_lits qs
            where
              used_lits = get_used_lits qs
-\end{code}
 
+{-
 @process_explicit_literals@ is a function that process each literal that appears
 in the column of the matrix.
+-}
 
-\begin{code}
 process_explicit_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
 process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs)
     where
       pats_indexs   = map (\x -> construct_literal_matrix x qs) lits
       (pats,indexs) = unzip pats_indexs
-\end{code}
-
 
+{-
 @process_literals@ calls @process_explicit_literals@ to deal with the literals
 that appears in the matrix and deal also with the rest of the cases. It
 must be one Variable to be complete.
-
-\begin{code}
+-}
 
 process_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
 process_literals used_lits qs
@@ -285,12 +278,12 @@ process_literals used_lits qs
        pats_default    = [(nlWildPatName:ps,constraints) |
                                         (ps,constraints) <- (pats')] ++ pats
        indexs_default  = unionUniqSets indexs' indexs
-\end{code}
 
+{-
 Here we have selected the literal and we will select all the equations that
 begins for that literal and create a new matrix.
+-}
 
-\begin{code}
 construct_literal_matrix :: HsLit -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
 construct_literal_matrix lit qs =
     (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs)
@@ -307,12 +300,12 @@ remove_first_column_lit lit qs
   where
      shift_pat eqn@(EqnInfo { eqn_pats = _:ps}) = eqn { eqn_pats = ps }
      shift_pat _                                = panic "Check.shift_var: no patterns"
-\end{code}
 
+{-
 This function splits the equations @qs@ in groups that deal with the
 same constructor.
+-}
 
-\begin{code}
 split_by_constructor :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
 split_by_constructor qs
   | null used_cons      = ([], mkUniqSet $ map fst qs)
@@ -321,19 +314,19 @@ split_by_constructor qs
                        where
                           used_cons   = get_used_cons qs
                           unused_cons = get_unused_cons used_cons
-\end{code}
 
+{-
 The first column of the patterns matrix only have vars, then there is
 nothing to do.
+-}
 
-\begin{code}
 first_column_only_vars :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
 first_column_only_vars qs
   = (map (\ (xs,ys) -> (nlWildPatName:xs,ys)) pats,indexs)
   where
     (pats, indexs) = check' (map remove_var qs)
-\end{code}
 
+{-
 This equation takes a matrix of patterns and split the equations by
 constructor, using all the constructors that appears in the first column
 of the pattern matching.
@@ -341,8 +334,8 @@ of the pattern matching.
 We can need a default clause or not ...., it depends if we used all the
 constructors or not explicitly. The reasoning is similar to @process_literals@,
 the difference is that here the default case is not always needed.
+-}
 
-\begin{code}
 no_need_default_case :: [Pat Id] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
 no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs)
     where
@@ -369,8 +362,8 @@ construct_matrix con qs =
     (map (make_con con) pats,indexs)
   where
     (pats,indexs) = (check' (remove_first_column con qs))
-\end{code}
 
+{-
 Here remove first column is more difficult that with literals due to the fact
 that constructors can have arguments.
 
@@ -384,8 +377,8 @@ is transformed in:
  x xs y
  _ _  y
 \end{verbatim}
+-}
 
-\begin{code}
 remove_first_column :: Pat Id                -- Constructor
                     -> [(EqnNo, EquationInfo)]
                     -> [(EqnNo, EquationInfo)]
@@ -536,8 +529,8 @@ is_var_lit _   (WildPat _)   = True
 is_var_lit lit pat
   | Just lit' <- get_lit pat = lit == lit'
   | otherwise                = False
-\end{code}
 
+{-
 The difference beteewn @make_con@ and @make_whole_con@ is that
 @make_wole_con@ creates a new constructor with all their arguments, and
 @make_con@ takes a list of argumntes, creates the contructor getting their
@@ -570,12 +563,12 @@ In particular:
 \\      @((:) x xs)@  & returns to be & @(x:xs)@
 \\      @(x:(...:[])@ & returns to be & @[x,...]@
 \end{tabular}
-%
+
 The difficult case is the third one becouse we need to follow all the
 contructors until the @[]@ to know that we need to use the second case,
 not the second. \fbox{\ ???\ }
-%
-\begin{code}
+-}
+
 isInfixCon :: DataCon -> Bool
 isInfixCon con = isDataSymOcc (getOccName con)
 
@@ -629,8 +622,8 @@ make_whole_con con | isInfixCon con = nlInfixConPat name
                 where
                   name   = getName con
                   pats   = [nlWildPatName | _ <- dataConOrigArgTys con]
-\end{code}
 
+{-
 ------------------------------------------------------------------------
                    Tidying equations
 ------------------------------------------------------------------------
@@ -640,8 +633,8 @@ that is, it removes syntactic sugar, reducing the number of cases that
 must be handled by the main checking algorithm.  One difference is
 that here we can do *all* the tidying at once (recursively), rather
 than doing it incrementally.
+-}
 
-\begin{code}
 tidy_eqn :: EquationInfo -> EquationInfo
 tidy_eqn eqn = eqn { eqn_pats = map tidy_pat (eqn_pats eqn),
                      eqn_rhs  = tidy_rhs (eqn_rhs eqn) }
@@ -778,4 +771,3 @@ tidy_con con (RecCon (HsRecFields fs _))
     insertNm nm p (x@(n,_):xs)
       | nm == n    = (nm,p):xs
       | otherwise  = x : insertNm nm p xs
-\end{code}
similarity index 97%
rename from compiler/deSugar/Coverage.lhs
rename to compiler/deSugar/Coverage.hs
index 1c64b1a..8ae8933 100644 (file)
@@ -1,8 +1,8 @@
-%
-(c) Galois, 2006
-(c) University of Glasgow, 2007
-%
-\begin{code}
+{-
+(c) Galois, 2006
+(c) University of Glasgow, 2007
+-}
+
 {-# LANGUAGE NondecreasingIndentation #-}
 
 module Coverage (addTicksToBinds, hpcInitCode) where
@@ -43,16 +43,15 @@ import Trace.Hpc.Util
 import BreakArray
 import Data.Map (Map)
 import qualified Data.Map as Map
-\end{code}
 
+{-
+************************************************************************
+*                                                                      *
+*              The main function: addTicksToBinds
+*                                                                      *
+************************************************************************
+-}
 
-%************************************************************************
-%*                                                                      *
-%*              The main function: addTicksToBinds
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
 addTicksToBinds
         :: DynFlags
         -> Module
@@ -526,7 +525,7 @@ addTickHsExpr (ExplicitList ty wit es) =
         liftM3 ExplicitList
                 (return ty)
                 (addTickWit wit)
-                (mapM (addTickLHsExpr) es) 
+                (mapM (addTickLHsExpr) es)
              where addTickWit Nothing = return Nothing
                    addTickWit (Just fln) = do fln' <- addTickHsExpr fln
                                               return (Just fln')
@@ -808,7 +807,7 @@ addTickHsCmd (HsCmdArrForm e fix cmdtop) =
                (return fix)
                (mapM (liftL (addTickHsCmdTop)) cmdtop)
 
-addTickHsCmd (HsCmdCast co cmd) 
+addTickHsCmd (HsCmdCast co cmd)
   = liftM2 HsCmdCast (return co) (addTickHsCmd cmd)
 
 -- Others should never happen in a command context.
@@ -918,9 +917,7 @@ liftL :: (Monad m) => (a -> m a) -> Located a -> m (Located a)
 liftL f (L loc a) = do
   a' <- f a
   return $ L loc a'
-\end{code}
 
-\begin{code}
 data TickTransState = TT { tickBoxCount:: Int
                          , mixEntries  :: [MixEntry_]
                          }
@@ -1164,18 +1161,12 @@ mkHpcPos _ = panic "bad source span; expected such spans to be filtered out"
 
 hpcSrcSpan :: SrcSpan
 hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
-\end{code}
-
 
-\begin{code}
 matchesOneOfMany :: [LMatch Id body] -> Bool
 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
   where
         matchCount (L _ (Match _pats _ty (GRHSs grhss _binds))) = length grhss
-\end{code}
-
 
-\begin{code}
 type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
 
 -- For the hash value, we hash everything: the file name,
@@ -1187,13 +1178,13 @@ type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
 mixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int
 mixHash file tm tabstop entries = fromIntegral $ hashString
         (show $ Mix file tm 0 tabstop entries)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
-%*              initialisation
-%*                                                                      *
-%************************************************************************
+{-
+************************************************************************
+*                                                                      *
+*              initialisation
+*                                                                      *
+************************************************************************
 
 Each module compiled with -fhpc declares an initialisation function of
 the form `hpc_init_<module>()`, which is emitted into the _stub.c file
@@ -1207,8 +1198,8 @@ static void hpc_init_Main(void) __attribute__((constructor));
 static void hpc_init_Main(void)
 {extern StgWord64 _hpc_tickboxes_Main_hpc[];
  hs_hpc_module("Main",8,1150288664,_hpc_tickboxes_Main_hpc);}
+-}
 
-\begin{code}
 hpcInitCode :: Module -> HpcInfo -> SDoc
 hpcInitCode _ (NoHpcInfo {}) = Outputable.empty
 hpcInitCode this_mod (HpcInfo tickCount hashNo)
@@ -1240,4 +1231,3 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
        = module_name
        | otherwise
        = package_name <> char '/' <> module_name
-\end{code}
similarity index 91%
rename from compiler/deSugar/Desugar.lhs
rename to compiler/deSugar/Desugar.hs
index 500c411..ac4bdb2 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 The Desugarer: turning HsSyn into Core.
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module Desugar ( deSugar, deSugarExpr ) where
@@ -52,15 +52,15 @@ import OrdList
 import Data.List
 import Data.IORef
 import Control.Monad( when )
-\end{code}
 
-%************************************************************************
-%*                                                                      *
-%*              The main function: deSugar
-%*                                                                      *
-%************************************************************************
+{-
+************************************************************************
+*                                                                      *
+*              The main function: deSugar
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- | Main entry point to the desugarer.
 deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts)
 -- Can modify PCS by faulting in more declarations
@@ -212,8 +212,8 @@ combineEvBinds (NonRec b r : bs) val_prs
   | otherwise = NonRec b r : combineEvBinds bs val_prs
 combineEvBinds (Rec prs : bs) val_prs
   = combineEvBinds bs (prs ++ val_prs)
-\end{code}
 
+{-
 Note [Top-level evidence]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 Top-level evidence bindings may be mutually recursive with the top-level value
@@ -223,9 +223,8 @@ when computing dependencies.
 
 So we pull out the type/coercion variables (which are in dependency order),
 and Rec the rest.
+-}
 
-
-\begin{code}
 deSugarExpr :: HscEnv -> LHsExpr Id -> IO (Messages, Maybe CoreExpr)
 
 deSugarExpr hsc_env tc_expr
@@ -249,15 +248,15 @@ deSugarExpr hsc_env tc_expr
             Just expr -> dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr expr)
 
        ; return (msgs, mb_core_expr) }
-\end{code}
 
-%************************************************************************
-%*                                                                      *
-%*              Add rules and export flags to binders
-%*                                                                      *
-%************************************************************************
+{-
+************************************************************************
+*                                                                      *
+*              Add rules and export flags to binders
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 addExportFlagsAndRules
     :: HscTarget -> NameSet -> NameSet -> [CoreRule]
     -> [(Id, t)] -> [(Id, t)]
@@ -299,9 +298,8 @@ addExportFlagsAndRules target exports keep_alive rules prs
     is_exported :: Name -> Bool
     is_exported | targetRetainsAllBindings target = isExternalName
                 | otherwise                       = (`elemNameSet` exports)
-\end{code}
-
 
+{-
 Note [Adding export flags]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 Set the no-discard flag if either
@@ -338,13 +336,12 @@ Reason
     thereby get dropped
 
 
-%************************************************************************
-%*                                                                      *
-%*              Desugaring transformation rules
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+************************************************************************
+*                                                                      *
+*              Desugaring transformation rules
+*                                                                      *
+************************************************************************
+-}
 
 dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule)
 dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
@@ -378,7 +375,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
 
               inline_shadows_rule   -- Function can be inlined before rule fires
                 | wopt Opt_WarnInlineRuleShadowing dflags
-                , isLocalId fn_id || hasSomeUnfolding (idUnfolding fn_id)   
+                , isLocalId fn_id || hasSomeUnfolding (idUnfolding fn_id)
                        -- If imported with no unfolding, no worries
                 = case (idInlineActivation fn_id, act) of
                     (NeverActive, _)    -> False
@@ -422,8 +419,7 @@ unfold_coerce bndrs lhs rhs = do
             (bndrs,wrap) <- go vs
             return (v:bndrs, wrap)
 
-\end{code}
-
+{-
 Note [Desugaring RULE left hand sides]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For the LHS of a RULE we do *not* want to desugar
@@ -455,13 +451,13 @@ corresponding `co :: a ~#R b` and wrap the LHS and the RHS in
 `let c = MkCoercible co in ...`. This is later simplified to the desired form
 by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS).
 
-%************************************************************************
-%*                                                                      *
-%*              Desugaring vectorisation declarations
-%*                                                                      *
-%************************************************************************
+************************************************************************
+*                                                                      *
+*              Desugaring vectorisation declarations
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 dsVect :: LVectDecl Id -> DsM CoreVect
 dsVect (L loc (HsVect (L _ v) rhs))
   = putSrcSpanDs loc $
@@ -486,4 +482,3 @@ dsVect (L _loc (HsVectInstOut inst))
   = return $ VectInst (instanceDFunId inst)
 dsVect vi@(L _ (HsVectInstIn _))
   = pprPanic "Desugar.dsVect: unexpected 'HsVectInstIn'" (ppr vi)
-\end{code}
similarity index 98%
rename from compiler/deSugar/DsArrows.lhs
rename to compiler/deSugar/DsArrows.hs
index 8f8e2d9..1a73210 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Desugaring arrow commands
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module DsArrows ( dsProcExpr ) where
@@ -48,9 +48,7 @@ import SrcLoc
 import ListSetOps( assocDefault )
 import FastString
 import Data.List
-\end{code}
 
-\begin{code}
 data DsCmdEnv = DsCmdEnv {
         arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr
     }
@@ -137,12 +135,12 @@ mkSndExpr a_ty b_ty = do
     pair_var <- newSysLocalDs (mkCorePairTy a_ty b_ty)
     return (Lam pair_var
                (coreCasePair pair_var a_var b_var (Var b_var)))
-\end{code}
 
+{-
 Build case analysis of a tuple.  This cannot be done in the DsM monad,
 because the list of variables is typically not yet defined.
+-}
 
-\begin{code}
 -- coreCaseTuple [u1..] v [x1..xn] body
 --      = case v of v { (x1, .., xn) -> body }
 -- But the matching may be nested if the tuple is very big
@@ -155,9 +153,7 @@ coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr
 coreCasePair scrut_var var1 var2 body
   = Case (Var scrut_var) scrut_var (exprType body)
          [(DataAlt (tupleCon BoxedTuple 2), [var1, var2], body)]
-\end{code}
 
-\begin{code}
 mkCorePairTy :: Type -> Type -> Type
 mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]
 
@@ -166,8 +162,8 @@ mkCorePairExpr e1 e2 = mkCoreTup [e1, e2]
 
 mkCoreUnitExpr :: CoreExpr
 mkCoreUnitExpr = mkCoreTup []
-\end{code}
 
+{-
 The input is divided into a local environment, which is a flat tuple
 (unless it's too big), and a stack, which is a right-nested pair.
 In general, the input has the form
@@ -176,8 +172,8 @@ In general, the input has the form
 
 where xi are the environment values, and si the ones on the stack,
 with s1 being the "top", the first one to be matched with a lambda.
+-}
 
-\begin{code}
 envStackType :: [Id] -> Type -> Type
 envStackType ids stack_ty = mkCorePairTy (mkBigCoreVarTupTy ids) stack_ty
 
@@ -250,17 +246,12 @@ matchVarStack (param_id:param_ids) stack_id body = do
     (tail_id, tail_code) <- matchVarStack param_ids stack_id body
     pair_id <- newSysLocalDs (mkCorePairTy (idType param_id) (idType tail_id))
     return (pair_id, coreCasePair pair_id param_id tail_id tail_code)
-\end{code}
 
-\begin{code}
 mkHsEnvStackExpr :: [Id] -> Id -> LHsExpr Id
 mkHsEnvStackExpr env_ids stack_id
   = mkLHsTupleExpr [mkLHsVarTuple env_ids, nlHsVar stack_id]
-\end{code}
-
-Translation of arrow abstraction
 
-\begin{code}
+-- Translation of arrow abstraction
 
 -- D; xs |-a c : () --> t'      ---> c'
 -- --------------------------
@@ -287,8 +278,8 @@ dsProcExpr pat (L _ (HsCmdTop cmd _unitTy cmd_ty ids)) = do
                     (Lam var match_code)
                     core_cmd
     return (mkLets meth_binds proc_code)
-\end{code}
 
+{-
 Translation of a command judgement of the form
 
         D; xs |-a c : stk --> t
@@ -296,8 +287,8 @@ Translation of a command judgement of the form
 to an expression e such that
 
         D |- e :: a (xs, stk) t
+-}
 
-\begin{code}
 dsLCmd :: DsCmdEnv -> IdSet -> Type -> Type -> LHsCmd Id -> [Id]
        -> DsM (CoreExpr, IdSet)
 dsLCmd ids local_vars stk_ty res_ty cmd env_ids
@@ -483,8 +474,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
                 core_if
                 (do_choice ids then_ty else_ty res_ty core_then core_else),
         fvs_cond `unionVarSet` fvs_then `unionVarSet` fvs_else)
-\end{code}
 
+{-
 Case commands are treated in much the same way as if commands
 (see above) except that there are more alternatives.  For example
 
@@ -509,8 +500,8 @@ case bodies, containing the following fields:
    input type of the arrow
  * a CoreExpr for an arrow built by combining the translated command
    bodies with |||.
+-}
 
-\begin{code}
 dsCmd ids local_vars stack_ty res_ty
       (HsCmdCase exp (MG { mg_alts = matches, mg_arg_tys = arg_tys, mg_origin = origin }))
       env_ids = do
@@ -678,13 +669,11 @@ trimInput build_arrow
         (core_cmd, free_vars) <- build_arrow env_ids
         return (core_cmd, free_vars, varSetElems free_vars))
 
-\end{code}
-
+{-
 Translation of command judgements of the form
 
         D |-a do { ss } : t
-
-\begin{code}
+-}
 
 dsCmdDo :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this statement
@@ -731,11 +720,12 @@ dsCmdDo ids local_vars res_ty (stmt:stmts) env_ids = do
                 core_stmts,
               fv_stmt)
 
-\end{code}
+{-
 A statement maps one local environment to another, and is represented
 as an arrow from one tuple type to another.  A statement sequence is
 translated to a composition of such arrows.
-\begin{code}
+-}
+
 dsCmdLStmt :: DsCmdEnv -> IdSet -> [Id] -> CmdLStmt Id -> [Id]
            -> DsM (CoreExpr, IdSet)
 dsCmdLStmt ids local_vars out_ids cmd env_ids
@@ -994,10 +984,10 @@ dsRecCmd ids local_vars stmts later_ids later_rets rec_ids rec_rets = do
 
     return (core_loop, env1_id_set, env1_ids)
 
-\end{code}
+{-
 A sequence of statements (as in a rec) is desugared to an arrow between
 two environments (no stack)
-\begin{code}
+-}
 
 dsfixCmdStmts
         :: DsCmdEnv             -- arrow combinators
@@ -1038,11 +1028,9 @@ dsCmdStmts ids local_vars out_ids (stmt:stmts) env_ids = do
               fv_stmt)
 
 dsCmdStmts _ _ _ [] _ = panic "dsCmdStmts []"
-\end{code}
 
-Match a list of expressions against a list of patterns, left-to-right.
+-- Match a list of expressions against a list of patterns, left-to-right.
 
-\begin{code}
 matchSimplys :: [CoreExpr]              -- Scrutinees
              -> HsMatchContext Name     -- Match kind
              -> [LPat Id]               -- Patterns they should match
@@ -1054,11 +1042,9 @@ matchSimplys (exp:exps) ctxt (pat:pats) result_expr fail_expr = do
     match_code <- matchSimplys exps ctxt pats result_expr fail_expr
     matchSimply exp ctxt pat match_code fail_expr
 matchSimplys _ _ _ _ _ = panic "matchSimplys"
-\end{code}
 
-List of leaf expressions, with set of variables bound in each
+-- List of leaf expressions, with set of variables bound in each
 
-\begin{code}
 leavesMatch :: LMatch Id (Located (body Id)) -> [(Located (body Id), IdSet)]
 leavesMatch (L _ (Match pats _ (GRHSs grhss binds)))
   = let
@@ -1070,11 +1056,9 @@ leavesMatch (L _ (Match pats _ (GRHSs grhss binds)))
       mkVarSet (collectLStmtsBinders stmts)
         `unionVarSet` defined_vars)
     | L _ (GRHS stmts body) <- grhss]
-\end{code}
 
-Replace the leaf commands in a match
+-- Replace the leaf commands in a match
 
-\begin{code}
 replaceLeavesMatch
         :: Type                                 -- new result type
         -> [Located (body' Id)]                 -- replacement leaf expressions of that type
@@ -1095,11 +1079,9 @@ replaceLeavesGRHS
 replaceLeavesGRHS (leaf:leaves) (L loc (GRHS stmts _))
   = (leaves, L loc (GRHS stmts leaf))
 replaceLeavesGRHS [] _ = panic "replaceLeavesGRHS []"
-\end{code}
 
-Balanced fold of a non-empty list.
+-- Balanced fold of a non-empty list.
 
-\begin{code}
 foldb :: (a -> a -> a) -> [a] -> a
 foldb _ [] = error "foldb of empty list"
 foldb _ [x] = x
@@ -1108,8 +1090,8 @@ foldb f xs = foldb f (fold_pairs xs)
     fold_pairs [] = []
     fold_pairs [x] = [x]
     fold_pairs (x1:x2:xs) = f x1 x2:fold_pairs xs
-\end{code}
 
+{-
 Note [Dictionary binders in ConPatOut] See also same Note in HsUtils
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The following functions to collect value variables from patterns are
@@ -1129,8 +1111,8 @@ Here p77 is a local binding for the (+) operation.
 
 See comments in HsUtils for why the other version does not include
 these bindings.
+-}
 
-\begin{code}
 collectPatBinders :: LPat Id -> [Id]
 collectPatBinders pat = collectl pat []
 
@@ -1193,5 +1175,3 @@ collectStmtBinders (ParStmt xs _ _)     = collectLStmtsBinders
                                         $ [ s | ParStmtBlock ss _ _ <- xs, s <- ss]
 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
 collectStmtBinders (RecStmt { recS_later_ids = later_ids }) = later_ids
-
-\end{code}
similarity index 96%
rename from compiler/deSugar/DsBinds.lhs
rename to compiler/deSugar/DsBinds.hs
index bc1b352..b2ca4dc 100644 (file)
@@ -1,15 +1,15 @@
-%
-(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
+
 
 Pattern-matching bindings (HsBinds and MonoBinds)
 
 Handles @HsBinds@; those at the top level require different handling,
 in that the @Rec@/@NonRec@/etc structure is thrown away (whereas at
 lower levels it is preserved with @let@/@letrec@s).
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
@@ -70,15 +70,15 @@ import Util
 import Control.Monad( when )
 import MonadUtils
 import Control.Monad(liftM)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[dsMonoBinds]{Desugaring a @MonoBinds@}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 dsTopLHsBinds :: LHsBinds Id -> DsM (OrdList (Id,CoreExpr))
 dsTopLHsBinds binds = ds_lhs_binds binds
 
@@ -244,7 +244,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
                 -- See Note [ClassOp/DFun selection] in TcInstDcls
                 -- See Note [Single-method classes]  in TcInstDcls
     mk_dfun_w_stuff is_newtype
-       | is_newtype 
+       | is_newtype
        = gbl_id `setIdUnfolding`  mkInlineUnfolding (Just 0) rhs
                 `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }
        | otherwise
@@ -261,8 +261,8 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
 dictArity :: [Var] -> Arity
 -- Don't count coercion variables in arity
 dictArity dicts = count isId dicts
-\end{code}
 
+{-
 [Desugaring AbsBinds]
 ~~~~~~~~~~~~~~~~~~~~~
 In the general AbsBinds case we desugar the binding to this:
@@ -425,8 +425,8 @@ Note that
 
   * The RHS of f_spec, <poly_rhs> has a *copy* of 'binds', so that it
     can fully specialise it.
+-}
 
-\begin{code}
 ------------------------
 dsSpecs :: CoreExpr     -- Its rhs
         -> TcSpecPrags
@@ -538,9 +538,8 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
 specOnInline :: Name -> MsgDoc
 specOnInline f = ptext (sLit "SPECIALISE pragma on INLINE function probably won't fire:")
                  <+> quotes (ppr f)
-\end{code}
-
 
+{-
 Note [Activation pragmas for SPECIALISE]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 From a user SPECIALISE pragma for f, we generate
@@ -582,13 +581,13 @@ NOINLINE [k] f
 SPEC f :: ty                [n]   INLINE [k]
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsection{Adding inline pragmas}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 decomposeRuleLhs :: [Var] -> CoreExpr -> Either SDoc ([Var], Id, [CoreExpr])
 -- (decomposeRuleLhs bndrs lhs) takes apart the LHS of a RULE,
 -- The 'bndrs' are the quantified binders of the rules, but decomposeRuleLhs
@@ -673,8 +672,8 @@ decomposeRuleLhs orig_bndrs orig_lhs
      where
        rhs_fvs = exprFreeVars r
        needed' = (needed `minusVarSet` rhs_fvs) `extendVarSet` d
-\end{code}
 
+{-
 Note [Decomposing the left-hand side of a RULE]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 There are several things going on here.
@@ -731,7 +730,7 @@ The drop_dicts algorithm is based on these observations:
 
   * The "needed variables" are simply the orig_bndrs.  Consider
        f :: (Eq a, Show b) => a -> b -> String
-       {-# SPECIALISE f :: (Show b) => Int -> b -> String
+       ... SPECIALISE f :: (Show b) => Int -> b -> String ...
     Then orig_bndrs includes the *quantified* dictionaries of the type
     namely (dsb::Show b), but not the one for Eq Int
 
@@ -770,7 +769,7 @@ Note [Unused spec binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
         f :: a -> a
-        {-# SPECIALISE f :: Eq a => a -> a #-}
+        ... SPECIALISE f :: Eq a => a -> a ...
 It's true that this *is* a more specialised type, but the rule
 we get is something like this:
         f_spec d = f
@@ -790,7 +789,7 @@ over it too.  *Any* dict with that type will do.
 So for example when you have
         f :: Eq a => a -> a
         f = <rhs>
-        {-# SPECIALISE f :: Int -> Int #-}
+        ... SPECIALISE f :: Int -> Int ...
 
 Then we get the SpecPrag
         SpecPrag (f Int dInt)
@@ -807,14 +806,14 @@ utterly bogus. So we really make a fresh Id, with the same unique and type
 as the old one, but with an Internal name and no IdInfo.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                 Desugaring evidence
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
+-}
 
-\begin{code}
 dsHsWrapper :: HsWrapper -> CoreExpr -> DsM CoreExpr
 dsHsWrapper WpHole            e = return e
 dsHsWrapper (WpTyApp ty)      e = return $ App e (Type ty)
@@ -990,8 +989,8 @@ ds_tc_coercion subst tc_co
     ds_ev_id subst v
      | Just co <- Coercion.lookupCoVar subst v = co
      | otherwise  = pprPanic "ds_tc_coercion" (ppr v $$ ppr tc_co)
-\end{code}
 
+{-
 Note [Simple coercions]
 ~~~~~~~~~~~~~~~~~~~~~~~
 We have a special case for coercions that are simple variables.
@@ -1016,5 +1015,4 @@ which simpleOpt (currently) doesn't remove. So the rule never matches.
 
 Maybe simpleOpt should be smarter.  But it seems like a good plan
 to simply never generate the redundant box/unbox in the first place.
-
-
+-}
similarity index 98%
rename from compiler/deSugar/DsCCall.lhs
rename to compiler/deSugar/DsCCall.hs
index deb3106..5c5fde0 100644 (file)
@@ -1,11 +1,11 @@
-%
-(c) The University of Glasgow 2006
-(c) The AQUA Project, Glasgow University, 1994-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The AQUA Project, Glasgow University, 1994-1998
+
 
 Desugaring foreign calls
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 module DsCCall
         ( dsCCall
@@ -45,8 +45,8 @@ import Outputable
 import Util
 
 import Data.Maybe
-\end{code}
 
+{-
 Desugaring of @ccall@s consists of adding some state manipulation,
 unboxing any boxed primitive arguments and boxing the result if
 desired.
@@ -81,8 +81,8 @@ follows:
    \ s# -> case (ccall# foo [ r, t1#, ... tm# ] s# e1# ... em#) of
           (StateAnd<r># result# state#) -> (R# result#, realWorld#)
 \end{verbatim}
+-}
 
-\begin{code}
 dsCCall :: CLabelString -- C routine to invoke
         -> [CoreExpr]   -- Arguments (desugared)
         -> Safety       -- Safety of the call
@@ -121,9 +121,7 @@ mkFCall dflags uniq the_fcall val_args res_ty
     tyvars  = varSetElems (tyVarsOfType body_ty)
     ty      = mkForAllTys tyvars body_ty
     the_fcall_id = mkFCallId dflags uniq the_fcall ty
-\end{code}
 
-\begin{code}
 unboxArg :: CoreExpr                    -- The supplied argument
          -> DsM (CoreExpr,              -- To pass as the actual argument
                  CoreExpr -> CoreExpr   -- Wrapper to unbox the arg
@@ -195,10 +193,7 @@ unboxArg arg
     (_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys
     maybe_arg3_tycon               = tyConAppTyCon_maybe data_con_arg_ty3
     Just arg3_tycon                = maybe_arg3_tycon
-\end{code}
-
 
-\begin{code}
 boxResult :: Type
           -> DsM (Type, CoreExpr -> CoreExpr)
 
@@ -385,4 +380,3 @@ maybeNarrow dflags tycon
   | tycon `hasKey` word32TyConKey
          && wORD_SIZE dflags > 4         = \e -> App (Var (mkPrimOpId Narrow32WordOp)) e
   | otherwise                     = id
-\end{code}
similarity index 92%
rename from compiler/deSugar/DsExpr.lhs
rename to compiler/deSugar/DsExpr.hs
index c9134c9..e94936d 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Desugaring exporessions.
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module DsExpr ( dsExpr, dsLExpr, dsLocalBinds, dsValBinds, dsLit ) where
@@ -61,16 +61,15 @@ import Outputable
 import FastString
 
 import Control.Monad
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 dsLocalBinds, dsValBinds
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 dsLocalBinds :: HsLocalBinds Id -> CoreExpr -> DsM CoreExpr
 dsLocalBinds EmptyLocalBinds    body = return body
 dsLocalBinds (HsValBinds binds) body = dsValBinds binds body
@@ -86,7 +85,7 @@ dsIPBinds :: HsIPBinds Id -> CoreExpr -> DsM CoreExpr
 dsIPBinds (IPBinds ip_binds ev_binds) body
   = do  { ds_binds <- dsTcEvBinds ev_binds
         ; let inner = mkCoreLets ds_binds body
-                -- The dict bindings may not be in 
+                -- The dict bindings may not be in
                 -- dependency order; hence Rec
         ; foldrM ds_ip_bind inner ip_binds }
   where
@@ -116,7 +115,7 @@ ds_val_bind (_is_rec, binds) body
           case prs of
             [] -> return body
             _  -> return (Let (Rec prs) body) }
-        -- Use a Rec regardless of is_rec. 
+        -- Use a Rec regardless of is_rec.
         -- Why? Because it allows the binds to be all
         -- mixed up, which is what happens in one rare case
         -- Namely, for an AbsBind with no tyvars and no dicts,
@@ -136,11 +135,11 @@ dsStrictBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
   = do { let body1 = foldr bind_export body exports
              bind_export export b = bindNonRec (abe_poly export) (Var (abe_mono export)) b
        ; body2 <- foldlBagM (\body lbind -> dsStrictBind (unLoc lbind) body)
-                            body1 lbinds 
+                            body1 lbinds
        ; ds_binds <- dsTcEvBinds ev_binds
        ; return (mkCoreLets ds_binds body2) }
 
-dsStrictBind (FunBind { fun_id = L _ fun, fun_matches = matches, fun_co_fn = co_fn 
+dsStrictBind (FunBind { fun_id = L _ fun, fun_matches = matches, fun_co_fn = co_fn
                       , fun_tick = tick, fun_infix = inf }) body
                 -- Can't be a bang pattern (that looks like a PatBind)
                 -- so must be simply unboxed
@@ -155,7 +154,7 @@ dsStrictBind (PatBind {pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty }) body
         -- ==> case rhs of C x# y# -> body
     do { rhs <- dsGuarded grhss ty
        ; let upat = unLoc pat
-             eqn = EqnInfo { eqn_pats = [upat], 
+             eqn = EqnInfo { eqn_pats = [upat],
                              eqn_rhs = cantFailMatchResult body }
        ; var    <- selectMatchVar upat
        ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
@@ -175,15 +174,14 @@ strictMatchOnly (FunBind { fun_id = L _ id })
   = isUnLiftedType (idType id)
 strictMatchOnly _ = False -- I hope!  Checked immediately by caller in fact
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[DsExpr-vars-and-cons]{Variables, constructors, literals}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 dsLExpr :: LHsExpr Id -> DsM CoreExpr
 
 dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
@@ -203,7 +201,7 @@ dsExpr (HsWrap co_fn e)
        ; warnAboutIdentities dflags e' (exprType wrapped_e)
        ; return wrapped_e }
 
-dsExpr (NegApp expr neg_expr) 
+dsExpr (NegApp expr neg_expr)
   = App <$> dsExpr neg_expr <*> dsLExpr expr
 
 dsExpr (HsLam a_Match)
@@ -218,8 +216,8 @@ dsExpr (HsApp fun arg)
   = mkCoreAppDs <$> dsLExpr fun <*>  dsLExpr arg
 
 dsExpr (HsUnboundVar _) = panic "dsExpr: HsUnboundVar"
-\end{code}
 
+{-
 Note [Desugaring vars]
 ~~~~~~~~~~~~~~~~~~~~~~
 In one situation we can get a *coercion* variable in a HsVar, namely
@@ -235,7 +233,7 @@ Then we get
 
 That 'g' in the 'in' part is an evidence variable, and when
 converting to core it must become a CO.
-   
+
 Operator sections.  At first it looks as if we can convert
 \begin{verbatim}
         (expr op)
@@ -256,12 +254,12 @@ for example.  So we convert instead to
 \end{verbatim}
 If \tr{expr} is actually just a variable, say, then the simplifier
 will sort it out.
+-}
 
-\begin{code}
 dsExpr (OpApp e1 op _ e2)
   = -- for the type of y, we need the type of op's 2nd argument
     mkCoreAppsDs <$> dsLExpr op <*> mapM dsLExpr [e1, e2]
-    
+
 dsExpr (SectionL expr op)       -- Desugar (e !) to ((!) e)
   = mkCoreAppDs <$> dsLExpr op <*> dsLExpr expr
 
@@ -321,9 +319,9 @@ dsExpr (HsLet binds body) = do
 --
 dsExpr (HsDo ListComp     stmts res_ty) = dsListComp stmts res_ty
 dsExpr (HsDo PArrComp     stmts _)      = dsPArrComp (map unLoc stmts)
-dsExpr (HsDo DoExpr       stmts _)      = dsDo stmts 
-dsExpr (HsDo GhciStmtCtxt stmts _)      = dsDo stmts 
-dsExpr (HsDo MDoExpr      stmts _)      = dsDo stmts 
+dsExpr (HsDo DoExpr       stmts _)      = dsDo stmts
+dsExpr (HsDo GhciStmtCtxt stmts _)      = dsDo stmts
+dsExpr (HsDo MDoExpr      stmts _)      = dsDo stmts
 dsExpr (HsDo MonadComp    stmts _)      = dsMonadComp stmts
 
 dsExpr (HsIf mb_fun guard_expr then_expr else_expr)
@@ -347,14 +345,14 @@ dsExpr (HsMultiIf res_ty alts)
   where
     mkErrorExpr = mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID res_ty
                                (ptext (sLit "multi-way if"))
-\end{code}
-
 
+{-
 \noindent
 \underline{\bf Various data construction things}
-%              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-\begin{code}
-dsExpr (ExplicitList elt_ty wit xs) 
+             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-}
+
+dsExpr (ExplicitList elt_ty wit xs)
   = dsExplicitList elt_ty wit xs
 
 -- We desugar [:x1, ..., xn:] as
@@ -375,7 +373,7 @@ dsExpr (ExplicitPArr ty xs) = do
 dsExpr (ArithSeq expr witness seq)
   = case witness of
      Nothing -> dsArithSeq expr seq
-     Just fl -> do { 
+     Just fl -> do {
        ; fl' <- dsExpr fl
        ; newArithSeq <- dsArithSeq expr seq
        ; return (App fl' newArithSeq)}
@@ -390,18 +388,18 @@ dsExpr (PArrSeq _ _)
   = panic "DsExpr.dsExpr: Infinite parallel array!"
     -- the parser shouldn't have generated it and the renamer and typechecker
     -- shouldn't have let it through
-\end{code}
 
+{-
 \noindent
 \underline{\bf Record construction and update}
-             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For record construction we do this (assuming T has three arguments)
 \begin{verbatim}
         T { op2 = e }
 ==>
-        let err = /\a -> recConErr a 
-        T (recConErr t1 "M.lhs/230/op1") 
-          e 
+        let err = /\a -> recConErr a
+        T (recConErr t1 "M.lhs/230/op1")
+          e
           (recConErr t1 "M.lhs/230/op3")
 \end{verbatim}
 @recConErr@ then converts its arugment string into a proper message
@@ -412,13 +410,13 @@ before printing it as
 
 We also handle @C{}@ as valid construction syntax for an unlabelled
 constructor @C@, setting all of @C@'s fields to bottom.
+-}
 
-\begin{code}
 dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do
     con_expr' <- dsExpr con_expr
     let
         (arg_tys, _) = tcSplitFunTys (exprType con_expr')
-        -- A newtype in the corner should be opaque; 
+        -- A newtype in the corner should be opaque;
         -- hence TcType.tcSplitFunTys
 
         mk_arg (arg_ty, lbl)    -- Selector id has the field label as its name
@@ -430,14 +428,14 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do
 
         labels = dataConFieldLabels (idDataCon data_con_id)
         -- The data_con_id is guaranteed to be the wrapper id of the constructor
-    
+
     con_args <- if null labels
                 then mapM unlabelled_bottom arg_tys
                 else mapM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels)
-    
+
     return (mkCoreApps con_expr' con_args)
-\end{code}
 
+{-
 Record update is a little harder. Suppose we have the decl:
 \begin{verbatim}
         data T = T1 {op1, op2, op3 :: Int}
@@ -461,17 +459,17 @@ dictionaries.
 
 Note [Update for GADTs]
 ~~~~~~~~~~~~~~~~~~~~~~~
-Consider 
+Consider
    data T a b where
      T1 { f1 :: a } :: T a Int
 
-Then the wrapper function for T1 has type 
+Then the wrapper function for T1 has type
    $WT1 :: a -> T a Int
 But if x::T a b, then
    x { f1 = v } :: T a b   (not T a Int!)
 So we need to cast (T a Int) to (T a b).  Sigh.
+-}
 
-\begin{code}
 dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
                        cons_to_upd in_inst_tys out_inst_tys)
   | null fields
@@ -511,14 +509,14 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
     add_field_binds [] expr = expr
     add_field_binds ((_,b,r):bs) expr = bindNonRec b r (add_field_binds bs expr)
 
-        -- Awkwardly, for families, the match goes 
+        -- Awkwardly, for families, the match goes
         -- from instance type to family type
     tycon     = dataConTyCon (head cons_to_upd)
     in_ty     = mkTyConApp tycon in_inst_tys
     out_ty    = mkFamilyTyConApp tycon out_inst_tys
 
     mk_alt upd_fld_env con
-      = do { let (univ_tvs, ex_tvs, eq_spec, 
+      = do { let (univ_tvs, ex_tvs, eq_spec,
                   theta, arg_tys, _) = dataConFullSig con
                  subst = mkTopTvSubst (univ_tvs `zip` in_inst_tys)
 
@@ -528,7 +526,7 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
            ; arg_ids    <- newSysLocalsDs (substTys subst arg_tys)
            ; let val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg
                                          (dataConFieldLabels con) arg_ids
-                 mk_val_arg field_name pat_arg_id 
+                 mk_val_arg field_name pat_arg_id
                      = nlHsVar (lookupNameEnv upd_fld_env field_name `orElse` pat_arg_id)
                  inst_con = noLoc $ HsWrap wrap (HsVar (dataConWrapId con))
                         -- Reconstruct with the WrapId so that unpacking happens
@@ -559,11 +557,8 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
                              | otherwise    = mkLHsWrap (mkWpCast (mkTcSubCo wrap_co)) rhs
            ; return (mkSimpleMatch [pat] wrapped_rhs) }
 
-\end{code}
-
-Here is where we desugar the Template Haskell brackets and escapes
+-- Here is where we desugar the Template Haskell brackets and escapes
 
-\begin{code}
 -- Template Haskell stuff
 
 dsExpr (HsRnBracketOut _ _) = panic "dsExpr HsRnBracketOut"
@@ -576,11 +571,9 @@ dsExpr (HsSpliceE _ s)      = pprPanic "dsExpr:splice" (ppr s)
 
 -- Arrow notation extension
 dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
-\end{code}
 
-Hpc Support 
+-- Hpc Support
 
-\begin{code}
 dsExpr (HsTick tickish e) = do
   e' <- dsLExpr e
   return (Tick tickish e')
@@ -597,9 +590,6 @@ dsExpr (HsBinTick ixT ixF e) = do
   do { ASSERT(exprType e2 `eqType` boolTy)
        mkBinaryTickBox ixT ixF e2
      }
-\end{code}
-
-\begin{code}
 
 -- HsSyn constructs that just shouldn't be here:
 dsExpr (ExprWithTySig {})  = panic "dsExpr:ExprWithTySig"
@@ -617,11 +607,11 @@ dsExpr (HsDo          {})  = panic "dsExpr:HsDo"
 
 
 findField :: [LHsRecField Id arg] -> Name -> [arg]
-findField rbinds lbl 
+findField rbinds lbl
   = [rhs | L _ (HsRecField { hsRecFieldId = id, hsRecFieldArg = rhs }) <- rbinds
          , lbl == idName (unLoc id) ]
-\end{code}
 
+{-
 %--------------------------------------------------------------------
 
 Note [Desugaring explicit lists]
@@ -640,10 +630,10 @@ fruitless allocations.  Essentially, whenever we see a list literal
    say [x_1, ..., x_(k-1)], we turn it into an expression involving
    build so that if we find any foldrs over it it will fuse away
    entirely!
-   
+
    So in this example we will desugar to:
    build (\c n -> x_1 `c` x_2 `c` .... `c` foldr c n [x_k, ..., x_n]
-   
+
    If fusion fails to occur then build will get inlined and (since we
    defined a RULE for foldr (:) []) we will get back exactly the
    normal desugaring for an explicit list.
@@ -662,11 +652,11 @@ point doing this fancy stuff, and it may even be harmful.
 =======>  Note by SLPJ Dec 08.
 
 I'm unconvinced that we should *ever* generate a build for an explicit
-list.  See the comments in GHC.Base about the foldr/cons rule, which 
+list.  See the comments in GHC.Base about the foldr/cons rule, which
 points out that (foldr k z [a,b,c]) may generate *much* less code than
 (a `k` b `k` c `k` z).
 
-Furthermore generating builds messes up the LHS of RULES. 
+Furthermore generating builds messes up the LHS of RULES.
 Example: the foldr/single rule in GHC.Base
    foldr k z [x] = ...
 We do not want to generate a build invocation on the LHS of this RULE!
@@ -675,10 +665,9 @@ We fix this by disabling rules in rule LHSs, and testing that
 flag here; see Note [Desugaring RULE left hand sides] in Desugar
 
 To test this I've added a (static) flag -fsimple-list-literals, which
-makes all list literals be generated via the simple route.  
+makes all list literals be generated via the simple route.
+-}
 
-
-\begin{code}
 dsExplicitList :: PostTc Id Type -> Maybe (SyntaxExpr Id) -> [LHsExpr Id]
                -> DsM CoreExpr
 -- See Note [Desugaring explicit lists]
@@ -698,7 +687,7 @@ dsExplicitList elt_ty Nothing xs
     is_static e = all is_static_var (varSetElems (exprFreeVars e))
 
     is_static_var :: Var -> Bool
-    is_static_var v 
+    is_static_var v
       | isId v = isExternalName (idName v)  -- Top-level things are given external names
       | otherwise = False                   -- Type variables
 
@@ -712,11 +701,11 @@ dsExplicitList elt_ty (Just fln) xs
        ; list <- dsExplicitList elt_ty Nothing xs
        ; dflags <- getDynFlags
        ; return (App (App fln' (mkIntExprInt dflags (length xs))) list) }
-       
+
 spanTail :: (a -> Bool) -> [a] -> ([a], [a])
 spanTail f xs = (reverse rejected, reverse satisfying)
     where (satisfying, rejected) = span f $ reverse xs
-    
+
 dsArithSeq :: PostTcExpr -> (ArithSeqInfo Id) -> DsM CoreExpr
 dsArithSeq expr (From from)
   = App <$> dsExpr expr <*> dsLExpr from
@@ -737,31 +726,31 @@ dsArithSeq expr (FromThenTo from thn to)
        thn'  <- dsLExpr thn
        to'   <- dsLExpr to
        return $ mkApps expr' [from', thn', to']
-\end{code}
 
+{-
 Desugar 'do' and 'mdo' expressions (NOT list comprehensions, they're
 handled in DsListComp).  Basically does the translation given in the
 Haskell 98 report:
+-}
 
-\begin{code}
 dsDo :: [ExprLStmt Id] -> DsM CoreExpr
 dsDo stmts
   = goL stmts
   where
     goL [] = panic "dsDo"
     goL (L loc stmt:lstmts) = putSrcSpanDs loc (go loc stmt lstmts)
-  
+
     go _ (LastStmt body _) stmts
       = ASSERT( null stmts ) dsLExpr body
         -- The 'return' op isn't used for 'do' expressions
 
     go _ (BodyStmt rhs then_expr _ _) stmts
       = do { rhs2 <- dsLExpr rhs
-           ; warnDiscardedDoBindings rhs (exprType rhs2) 
+           ; warnDiscardedDoBindings rhs (exprType rhs2)
            ; then_expr2 <- dsExpr then_expr
            ; rest <- goL stmts
            ; return (mkApps then_expr2 [rhs2, rest]) }
-    
+
     go _ (LetStmt binds) stmts
       = do { rest <- goL stmts
            ; dsLocalBinds binds rest }
@@ -777,7 +766,7 @@ dsDo stmts
                                       res1_ty (cantFailMatchResult body)
             ; match_code <- handle_failure pat match fail_op
             ; return (mkApps bind_op' [rhs', Lam var match_code]) }
-    
+
     go loc (RecStmt { recS_stmts = rec_stmts, recS_later_ids = later_ids
                     , recS_rec_ids = rec_ids, recS_ret_fn = return_op
                     , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op
@@ -785,7 +774,7 @@ dsDo stmts
       = goL (new_bind_stmt : stmts)  -- rec_ids can be empty; eg  rec { print 'x' }
       where
         new_bind_stmt = L loc $ BindStmt (mkBigLHsPatTup later_pats)
-                                         mfix_app bind_op 
+                                         mfix_app bind_op
                                          noSyntaxExpr  -- Tuple cannot fail
 
         tup_ids      = rec_ids ++ filterOut (`elem` rec_ids) later_ids
@@ -801,9 +790,9 @@ dsDo stmts
         body         = noLoc $ HsDo DoExpr (rec_stmts ++ [ret_stmt]) body_ty
         ret_app      = nlHsApp (noLoc return_op) (mkBigLHsTup rets)
         ret_stmt     = noLoc $ mkLastStmt ret_app
-                     -- This LastStmt will be desugared with dsDo, 
+                     -- This LastStmt will be desugared with dsDo,
                      -- which ignores the return_op in the LastStmt,
-                     -- so we must apply the return_op explicitly 
+                     -- so we must apply the return_op explicitly
 
     go _ (ParStmt   {}) _ = panic "dsDo ParStmt"
     go _ (TransStmt {}) _ = panic "dsDo TransStmt"
@@ -821,18 +810,17 @@ handle_failure pat match fail_op
   = extractMatchResult match (error "It can't fail")
 
 mk_fail_msg :: DynFlags -> Located e -> String
-mk_fail_msg dflags pat = "Pattern match failure in do expression at " ++ 
+mk_fail_msg dflags pat = "Pattern match failure in do expression at " ++
                          showPpr dflags (getLoc pat)
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Errors and contexts}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 -- Warn about certain types of values discarded in monadic bindings (#3263)
 warnDiscardedDoBindings :: LHsExpr Id -> Type -> DsM ()
 warnDiscardedDoBindings rhs rhs_ty
@@ -869,4 +857,3 @@ badMonadBind rhs elt_ty flag_doc
          , hang (ptext (sLit "Suppress this warning by saying"))
               2 (quotes $ ptext (sLit "_ <-") <+> ppr rhs)
          , ptext (sLit "or by using the flag") <+>  flag_doc ]
-\end{code}
similarity index 92%
rename from compiler/deSugar/DsExpr.lhs-boot
rename to compiler/deSugar/DsExpr.hs-boot
index 03a47ed..129185d 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module DsExpr where
 import HsSyn    ( HsExpr, LHsExpr, HsLocalBinds )
 import Var      ( Id )
@@ -8,4 +7,3 @@ import CoreSyn  ( CoreExpr )
 dsExpr  :: HsExpr  Id -> DsM CoreExpr
 dsLExpr :: LHsExpr Id -> DsM CoreExpr
 dsLocalBinds :: HsLocalBinds Id -> CoreExpr -> DsM CoreExpr
-\end{code}
similarity index 95%
rename from compiler/deSugar/DsForeign.lhs
rename to compiler/deSugar/DsForeign.hs
index 660cbf0..0ae14f8 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Desugaring foreign declarations (see also DsCCall).
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module DsForeign ( dsForeigns
@@ -60,8 +60,8 @@ import Hooks
 
 import Data.Maybe
 import Data.List
-\end{code}
 
+{-
 Desugaring of @foreign@ declarations is naturally split up into
 parts, an @import@ and an @export@  part. A @foreign import@
 declaration
@@ -74,8 +74,8 @@ is the same as
   f a1 ... an = _ccall_ nm cc a1 ... an
 \end{verbatim}
 so we reuse the desugaring code in @DsCCall@ to deal with these.
+-}
 
-\begin{code}
 type Binding = (Id, CoreExpr)   -- No rec/nonrec structure;
                                 -- the occurrence analyser will sort it all out
 
@@ -111,14 +111,13 @@ dsForeigns' fos = do
                           (CExport (L _ (CExportStatic ext_nm cconv)) _)) = do
       (h, c, _, _) <- dsFExport id co ext_nm cconv False
       return (h, c, [id], [])
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Foreign import}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Desugaring foreign imports is just the matter of creating a binding
 that on its RHS unboxes its arguments, performs the external call
@@ -137,8 +136,8 @@ However, we create a worker/wrapper pair, thus:
 The strictness/CPR analyser won't do this automatically because it doesn't look
 inside returned tuples; but inlining this wrapper is a Really Good Idea
 because it exposes the boxing to the call site.
+-}
 
-\begin{code}
 dsFImport :: Id
           -> Coercion
           -> ForeignImport
@@ -191,16 +190,15 @@ fun_type_arg_stdcall_info dflags StdCallConv ty
     in Just $ sum (map (widthInBytes . typeWidth . typeCmmType dflags . getPrimTyOf) fe_arg_tys)
 fun_type_arg_stdcall_info _ _other_conv _
   = Nothing
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Foreign calls}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header
         -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)
 dsFCall fn_id co fcall mDeclHeader = do
@@ -280,14 +278,13 @@ dsFCall fn_id co fcall mDeclHeader = do
         fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs'
 
     return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], empty, cDoc)
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Primitive calls}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 This is for `@foreign import prim@' declarations.
 
@@ -295,8 +292,8 @@ Currently, at the core level we pretend that these primitive calls are
 foreign calls. It may make more sense in future to have them as a distinct
 kind of Id, or perhaps to bundle them with PrimOps since semantically and
 for calling convention they are really prim ops.
+-}
 
-\begin{code}
 dsPrimCall :: Id -> Coercion -> ForeignCall
            -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)
 dsPrimCall fn_id co fcall = do
@@ -317,13 +314,12 @@ dsPrimCall fn_id co fcall = do
         rhs'     = Cast rhs co
     return ([(fn_id, rhs')], empty, empty)
 
-\end{code}
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Foreign export}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 The function that does most of the work for `@foreign export@' declarations.
 (see below for the boilerplate code a `@foreign export@' declaration expands
@@ -335,8 +331,8 @@ For each `@foreign export foo@' in a module M we generate:
 \item a Haskell stub `@M.\$ffoo@', which calls
 \end{itemize}
 the user-written Haskell function `@M.foo@'.
+-}
 
-\begin{code}
 dsFExport :: Id                 -- Either the exported Id,
                                 -- or the foreign-export-dynamic constructor
           -> Coercion           -- Coercion between the Haskell type callable
@@ -376,8 +372,8 @@ dsFExport fn_id co ext_name cconv isDyn = do
       mkFExportCBits dflags ext_name
                      (if isDyn then Nothing else Just fn_id)
                      fe_arg_tys res_ty is_IO_res_ty cconv
-\end{code}
 
+{-
 @foreign import "wrapper"@ (previously "foreign export dynamic") lets
 you dress up Haskell IO actions of some fixed type behind an
 externally callable interface (i.e., as a C function pointer). Useful
@@ -411,8 +407,8 @@ f_helper(StablePtr s, HsBool b, HsInt i)
         rts_unlock(cap);
 }
 \end{verbatim}
+-}
 
-\begin{code}
 dsFExportDynamic :: Id
                  -> Coercion
                  -> CCallConv
@@ -488,19 +484,19 @@ dsFExportDynamic id co0 cconv = do
 
 toCName :: DynFlags -> Id -> String
 toCName dflags i = showSDoc dflags (pprCode CStyle (ppr (idName i)))
-\end{code}
 
-%*
-%
+{-
+*
+
 \subsection{Generating @foreign export@ stubs}
-%
-%*
+
+*
 
 For each @foreign export@ function, a C stub function is generated.
 The C stub constructs the application of the exported Haskell function
 using the hugs/ghc rts invocation API.
+-}
 
-\begin{code}
 mkFExportCBits :: DynFlags
                -> FastString
                -> Maybe Id      -- Just==static, Nothing==dynamic
@@ -814,4 +810,3 @@ primTyDescChar dflags ty
        | wORD_SIZE dflags == 4  = ('W','w')
        | wORD_SIZE dflags == 8  = ('L','l')
        | otherwise              = panic "primTyDescChar"
-\end{code}
similarity index 88%
rename from compiler/deSugar/DsGRHSs.lhs
rename to compiler/deSugar/DsGRHSs.hs
index a571e80..1346f8a 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Matching guarded right-hand-sides (GRHSs)
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module DsGRHSs ( dsGuarded, dsGRHSs, dsGRHS ) where
@@ -30,8 +30,8 @@ import Name
 import Util
 import SrcLoc
 import Outputable
-\end{code}
 
+{-
 @dsGuarded@ is used for both @case@ expressions and pattern bindings.
 It desugars:
 \begin{verbatim}
@@ -42,24 +42,22 @@ It desugars:
 \end{verbatim}
 producing an expression with a runtime error in the corner if
 necessary.  The type argument gives the type of the @ei@.
+-}
 
-\begin{code}
 dsGuarded :: GRHSs Id (LHsExpr Id) -> Type -> DsM CoreExpr
 
 dsGuarded grhss rhs_ty = do
     match_result <- dsGRHSs PatBindRhs [] grhss rhs_ty
     error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty
     extractMatchResult match_result error_expr
-\end{code}
 
-In contrast, @dsGRHSs@ produces a @MatchResult@.
+-- In contrast, @dsGRHSs@ produces a @MatchResult@.
 
-\begin{code}
 dsGRHSs :: HsMatchContext Name -> [Pat Id]      -- These are to build a MatchContext from
         -> GRHSs Id (LHsExpr Id)                -- Guarded RHSs
         -> Type                                 -- Type of RHS
         -> DsM MatchResult
-dsGRHSs hs_ctx _ (GRHSs grhss binds) rhs_ty 
+dsGRHSs hs_ctx _ (GRHSs grhss binds) rhs_ty
   = ASSERT( notNull grhss )
     do { match_results <- mapM (dsGRHS hs_ctx rhs_ty) grhss
        ; let match_result1 = foldr1 combineMatchResults match_results
@@ -70,16 +68,15 @@ dsGRHSs hs_ctx _ (GRHSs grhss binds) rhs_ty
 dsGRHS :: HsMatchContext Name -> Type -> LGRHS Id (LHsExpr Id) -> DsM MatchResult
 dsGRHS hs_ctx rhs_ty (L _ (GRHS guards rhs))
   = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
-%*  matchGuard : make a MatchResult from a guarded RHS                  *
-%*                                                                      *
-%************************************************************************
+{-
+************************************************************************
+*                                                                      *
+*  matchGuard : make a MatchResult from a guarded RHS                  *
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 matchGuards :: [GuardStmt Id]       -- Guard
             -> HsStmtContext Name   -- Context
             -> LHsExpr Id           -- RHS
@@ -152,10 +149,11 @@ isTrueLHsExpr (L _ (HsBinTick ixT _ e))
 
 isTrueLHsExpr (L _ (HsPar e))         = isTrueLHsExpr e
 isTrueLHsExpr _                       = Nothing
-\end{code}
 
+{-
 Should {\em fail} if @e@ returns @D@
 \begin{verbatim}
 f x | p <- e', let C y# = e, f y# = r1
     | otherwise          = r2
 \end{verbatim}
+-}
similarity index 95%
rename from compiler/deSugar/DsListComp.lhs
rename to compiler/deSugar/DsListComp.hs
index 2111c95..79d6f47 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Desugaring list comprehensions, monad comprehensions and array comprehensions
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, NamedFieldPuns #-}
 
 module DsListComp ( dsListComp, dsPArrComp, dsMonadComp ) where
@@ -35,15 +35,15 @@ import FastString
 import TcType
 import ListSetOps( getNth )
 import Util
-\end{code}
 
+{-
 List comprehensions may be desugared in one of two ways: ``ordinary''
 (as you would expect if you read SLPJ's book) and ``with foldr/build
 turned on'' (if you read Gill {\em et al.}'s paper on the subject).
 
 There will be at least one ``qualifier'' in the input.
+-}
 
-\begin{code}
 dsListComp :: [ExprLStmt Id]
            -> Type              -- Type of entire list
            -> DsM CoreExpr
@@ -137,13 +137,13 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM
     return (bound_unzipped_inner_list_expr, pat)
 
 dsTransStmt _ = panic "dsTransStmt: Not given a TransStmt"
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[DsListComp-ordinary]{Ordinary desugaring of list comprehensions}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Just as in Phil's chapter~7 in SLPJ, using the rules for
 optimally-compiled list comprehensions.  This is what Kevin followed
@@ -202,8 +202,7 @@ don't have to deal with arbitrary limits on the number of zip functions in the
 prelude, nor which library the zip function came from.
 The introduced tuples are Boxed, but only because I couldn't get it to work
 with the Unboxed variety.
-
-\begin{code}
+-}
 
 deListComp :: [ExprStmt Id] -> CoreExpr -> DsM CoreExpr
 
@@ -251,10 +250,7 @@ deListComp (ParStmt stmtss_w_bndrs _ _ : quals) list
         pats = map mkBigLHsVarPatTup bndrs_s
 
 deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt"
-\end{code}
-
 
-\begin{code}
 deBindComp :: OutPat Id
            -> CoreExpr
            -> [ExprStmt Id]
@@ -288,13 +284,13 @@ deBindComp pat core_list1 quals core_list2 = do
                         -- Increasing order of tag
 
     return (Let (Rec [(h, rhs)]) letrec_body)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[DsListComp-foldr-build]{Foldr/Build desugaring of list comprehensions}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 @dfListComp@ are the rules used with foldr/build turned on:
 
@@ -308,8 +304,8 @@ TE[ e | p <- l , q ] c n = let
                            in
                            foldr f n l
 \end{verbatim}
+-}
 
-\begin{code}
 dfListComp :: Id -> Id      -- 'c' and 'n'
         -> [ExprStmt Id]    -- the rest of the qual's
         -> DsM CoreExpr
@@ -368,15 +364,14 @@ dfBindComp c_id n_id (pat, core_list1) quals = do
 
     -- now build the outermost foldr, and return
     mkFoldrExpr x_ty b_ty (mkLams [x, b] core_expr) (Var n_id) core_list1
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[DsFunGeneration]{Generation of zip/unzip functions for use in desugaring}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 mkZipBind :: [Type] -> DsM (Id, CoreExpr)
 -- mkZipBind [t1, t2]
@@ -456,15 +451,14 @@ mkUnzipBind _ elt_tys
     unzip_fn_ty        = elt_tuple_list_ty `mkFunTy` elt_list_tuple_ty
 
     mkConcatExpression (list_element_ty, head, tail) = mkConsExpr list_element_ty head tail
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[DsPArrComp]{Desugaring of array comprehensions}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
+*                                                                      *
+************************************************************************
+-}
 
 -- entry point for desugaring a parallel array comprehension
 --
@@ -658,11 +652,9 @@ parrElemType e  =
     Just (tycon, [ty]) | tycon == parrTyCon -> ty
     _                                                     -> panic
       "DsListComp.parrElemType: not a parallel array type"
-\end{code}
 
-Translation for monad comprehensions
+-- Translation for monad comprehensions
 
-\begin{code}
 -- Entry point for monad comprehension desugaring
 dsMonadComp :: [ExprLStmt Id] -> DsM CoreExpr
 dsMonadComp stmts = dsMcStmts stmts
@@ -780,7 +772,7 @@ dsMcStmt (ParStmt blocks mzip_op bind_op) stmts_rest
 
        ; dsMcBindStmt pat rhs bind_op noSyntaxExpr stmts_rest }
   where
-    ds_inner (ParStmtBlock stmts bndrs return_op) 
+    ds_inner (ParStmtBlock stmts bndrs return_op)
        = do { exp <- dsInnerMonadComp stmts bndrs return_op
             ; return (exp, mkBigCoreVarTupTy bndrs) }
 
@@ -877,4 +869,3 @@ mkMcUnzipM _ fmap_op ys elt_tys
                         mkTupleSelector xs (getNth xs n) tup_xs (Var tup_xs)
 
        ; return (mkBigCoreTup (map mk_elt [0..length elt_tys - 1])) }
-\end{code}
similarity index 91%
rename from compiler/deSugar/DsMonad.lhs
rename to compiler/deSugar/DsMonad.hs
index 1c707c4..9c987a2 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 @DsMonad@: monadery used in desugaring
+-}
 
-\begin{code}
 {-# LANGUAGE FlexibleInstances #-}
 
 module DsMonad (
@@ -19,12 +19,12 @@ module DsMonad (
         newFailLocalDs, newPredVarDs,
         getSrcSpanDs, putSrcSpanDs,
         mkPrintUnqualifiedDs,
-        newUnique, 
+        newUnique,
         UniqSupply, newUniqueSupply,
         getGhcModeDs, dsGetFamInstEnvs,
         dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon,
-        
-        PArrBuiltin(..), 
+
+        PArrBuiltin(..),
         dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
         dsInitPArrBuiltin,
 
@@ -67,15 +67,15 @@ import Maybes
 
 import Data.IORef
 import Control.Monad
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Data types for the desugarer
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data DsMatchContext
   = DsMatchContext (HsMatchContext Name) SrcSpan
   deriving ()
@@ -110,20 +110,19 @@ data CanItFail = CanFail | CantFail
 orFail :: CanItFail -> CanItFail -> CanItFail
 orFail CantFail CantFail = CantFail
 orFail _        _        = CanFail
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Monad stuff
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around
 a @UniqueSupply@ and some annotations, which
 presumably include source-file location information:
+-}
 
-\begin{code}
 type DsM result = TcRnIf DsGblEnv DsLclEnv result
 
 -- Compatibility functions
@@ -131,7 +130,7 @@ fixDs :: (a -> DsM a) -> DsM a
 fixDs    = fixM
 
 type DsWarning = (SrcSpan, SDoc)
-        -- Not quite the same as a WarnMsg, we have an SDoc here 
+        -- Not quite the same as a WarnMsg, we have an SDoc here
         -- and we'll do the print_unqual stuff later on to turn it
         -- into a Doc.
 
@@ -154,13 +153,13 @@ data PArrBuiltin
         , enumFromThenToPVar :: Var     -- ^ enumFromThenToP
         }
 
-data DsGblEnv 
+data DsGblEnv
         = DsGblEnv
         { ds_mod          :: Module             -- For SCC profiling
         , ds_fam_inst_env :: FamInstEnv         -- Like tcg_fam_inst_env
         , ds_unqual  :: PrintUnqualified
         , ds_msgs    :: IORef Messages          -- Warning messages
-        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global, 
+        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,
                                                 -- possibly-imported things
         , ds_dph_env :: GlobalRdrEnv            -- exported entities of 'Data.Array.Parallel.Prim'
                                                 -- iff '-fvectorise' flag was given as well as
@@ -177,12 +176,12 @@ data DsLclEnv = DsLclEnv {
         ds_loc     :: SrcSpan           -- to put in pattern-matching error msgs
      }
 
--- Inside [| |] brackets, the desugarer looks 
+-- Inside [| |] brackets, the desugarer looks
 -- up variables in the DsMetaEnv
 type DsMetaEnv = NameEnv DsMetaVal
 
 data DsMetaVal
-   = Bound Id           -- Bound by a pattern inside the [| |]. 
+   = Bound Id           -- Bound by a pattern inside the [| |].
                         -- Will be dynamically alpha renamed.
                         -- The Id has type THSyntax.Var
 
@@ -205,7 +204,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
                             initDPHBuiltins $
                               tryM thing_inside     -- Catch exceptions (= errors during desugaring)
 
-        -- Display any errors and warnings 
+        -- Display any errors and warnings
         -- Note: if -Werror is used, we don't signal an error here.
         ; msgs <- readIORef msg_var
 
@@ -217,7 +216,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
                 -- a UserError exception.  Then it should have put an error
                 -- message in msg_var, so we just discard the exception
 
-        ; return (msgs, final_res) 
+        ; return (msgs, final_res)
         }
   where
     -- Extend the global environment with a 'GlobalRdrEnv' containing the exported entities of
@@ -235,7 +234,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
                       -> DsM GlobalRdrEnv     -- empty if condition 'False'
         loadOneModule modname check err
           = do { doLoad <- check
-               ; if not doLoad 
+               ; if not doLoad
                  then return emptyGlobalRdrEnv
                  else do {
                ; result <- liftIO $ findImportedModule hsc_env modname Nothing
@@ -260,7 +259,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
 
     checkLoadDAP = do { paEnabled <- xoptM Opt_ParallelArrays
                       ; return $ paEnabled &&
-                                 mod /= gHC_PARR' && 
+                                 mod /= gHC_PARR' &&
                                  moduleName mod /= dATA_ARRAY_PARALLEL_NAME
                       }
                       -- do not load 'Data.Array.Parallel' iff compiling 'base:GHC.PArr' or a
@@ -313,46 +312,45 @@ loadModule doc mod
     imp_spec = ImpDeclSpec { is_mod = name, is_qual = True,
                              is_dloc = wiredInSrcSpan, is_as = name }
     name = moduleName mod
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Operations in the monad
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 And all this mysterious stuff is so we can occasionally reach out and
 grab one or more names.  @newLocalDs@ isn't exported---exported
 functions are defined with it.  The difference in name-strings makes
 it easier to read debugging output.
+-}
 
-\begin{code}
 -- Make a new Id with the same print name, but different type, and new unique
 newUniqueId :: Id -> Type -> DsM Id
 newUniqueId id = mkSysLocalM (occNameFS (nameOccName (idName id)))
 
 duplicateLocalDs :: Id -> DsM Id
-duplicateLocalDs old_local 
+duplicateLocalDs old_local
   = do  { uniq <- newUnique
         ; return (setIdUnique old_local uniq) }
 
 newPredVarDs :: PredType -> DsM Var
 newPredVarDs pred
  = newSysLocalDs pred
+
 newSysLocalDs, newFailLocalDs :: Type -> DsM Id
 newSysLocalDs  = mkSysLocalM (fsLit "ds")
 newFailLocalDs = mkSysLocalM (fsLit "fail")
 
 newSysLocalsDs :: [Type] -> DsM [Id]
 newSysLocalsDs tys = mapM newSysLocalDs tys
-\end{code}
 
+{-
 We can also reach out and either set/grab location information from
 the @SrcSpan@ being carried around.
+-}
 
-\begin{code}
 getGhcModeDs :: DsM GhcMode
 getGhcModeDs =  getDynFlags >>= return . ghcMode
 
@@ -363,15 +361,15 @@ putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
 putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc}) thing_inside
 
 warnDs :: SDoc -> DsM ()
-warnDs warn = do { env <- getGblEnv 
+warnDs warn = do { env <- getGblEnv
                  ; loc <- getSrcSpanDs
                  ; dflags <- getDynFlags
                  ; let msg = mkWarnMsg dflags loc (ds_unqual env)  warn
                  ; updMutVar (ds_msgs env) (\ (w,e) -> (w `snocBag` msg, e)) }
 
 failWithDs :: SDoc -> DsM a
-failWithDs err 
-  = do  { env <- getGblEnv 
+failWithDs err
+  = do  { env <- getGblEnv
         ; loc <- getSrcSpanDs
         ; dflags <- getDynFlags
         ; let msg = mkErrMsg dflags loc (ds_unqual env) err
@@ -380,21 +378,19 @@ failWithDs err
 
 mkPrintUnqualifiedDs :: DsM PrintUnqualified
 mkPrintUnqualifiedDs = ds_unqual <$> getGblEnv
-\end{code}
 
-\begin{code}
 instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
     lookupThing = dsLookupGlobal
 
 dsLookupGlobal :: Name -> DsM TyThing
 -- Very like TcEnv.tcLookupGlobal
-dsLookupGlobal name 
+dsLookupGlobal name
   = do  { env <- getGblEnv
         ; setEnvs (ds_if_env env)
                   (tcIfaceGlobal name) }
 
 dsLookupGlobalId :: Name -> DsM Id
-dsLookupGlobalId name 
+dsLookupGlobalId name
   = tyThingId <$> dsLookupGlobal name
 
 -- |Get a name from "Data.Array.Parallel" for the desugarer, from the 'ds_parr_bi' component of the
@@ -410,10 +406,6 @@ dsLookupTyCon name
 dsLookupDataCon :: Name -> DsM DataCon
 dsLookupDataCon name
   = tyThingDataCon <$> dsLookupGlobal name
-\end{code}
-
-\begin{code}
-
 
 -- |Lookup a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
 --  Panic if there isn't one, or if it is defined multiple times.
@@ -477,9 +469,7 @@ dsInitPArrBuiltin thing_inside
     externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
 
     arithErr = panic "Arithmetic sequences have to wait until we support type classes"
-\end{code}
 
-\begin{code}
 dsGetFamInstEnvs :: DsM FamInstEnvs
 -- Gets both the external-package inst-env
 -- and the home-pkg inst env (includes module being compiled)
@@ -496,9 +486,7 @@ dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (ds_meta env
 dsExtendMetaEnv :: DsMetaEnv -> DsM a -> DsM a
 dsExtendMetaEnv menv thing_inside
   = updLclEnv (\env -> env { ds_meta = ds_meta env `plusNameEnv` menv }) thing_inside
-\end{code}
 
-\begin{code}
 discardWarningsDs :: DsM a -> DsM a
 -- Ignore warnings inside the thing inside;
 -- used to ignore inaccessable cases etc. inside generated code
@@ -512,4 +500,3 @@ discardWarningsDs thing_inside
         ; writeTcRef (ds_msgs env) old_msgs
 
         ; return result }
-\end{code}
similarity index 97%
rename from compiler/deSugar/DsMonad.lhs-boot
rename to compiler/deSugar/DsMonad.hs-boot
index 081b048..12bc5eb 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module DsMonad (DsM) where
 
 import TcRnTypes
@@ -7,8 +6,7 @@ data DsGblEnv
 data DsLclEnv
 type DsM result = TcRnIf DsGblEnv DsLclEnv result
 
-\end{code}
-
+{-
 Some notes about this boot file (from Edsko):
 
 
@@ -31,3 +29,4 @@ for the dsForeignsHook.)
 I'm sure this cycle can be broken somehow, but I'm not familiar enough
 with this part of the compiler to see if there is a natural point to
 do it.
+-}
similarity index 93%
rename from compiler/deSugar/DsUtils.lhs
rename to compiler/deSugar/DsUtils.hs
index bd99b90..1a7985f 100644 (file)
@@ -1,13 +1,13 @@
-%
-(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
+
 
 Utilities for desugaring
 
 This module exports some utility functions of no great interest.
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 -- | Utility functions for constructing Core syntax, principally for desugaring
@@ -75,21 +75,20 @@ import FastString
 import TcEvidence
 
 import Control.Monad    ( zipWithM )
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{ Selecting match variables}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 We're about to match against some patterns.  We want to make some
 @Ids@ to use as match variables.  If a pattern has an @Id@ readily at
 hand, which should indeed be bound to the pattern as a whole, then use it;
 otherwise, make one up.
+-}
 
-\begin{code}
 selectSimpleMatchVarL :: LPat Id -> DsM Id
 selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
 
@@ -120,8 +119,8 @@ selectMatchVar (VarPat var)  = return (localiseId var)  -- Note [Localise patter
 selectMatchVar (AsPat var _) = return (unLoc var)
 selectMatchVar other_pat     = newSysLocalDs (hsPatType other_pat)
                                   -- OK, better make up one...
-\end{code}
 
+{-
 Note [Localise pattern binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider     module M where
@@ -160,28 +159,26 @@ runs on the output of the desugarer, so all is well by the end of
 the desugaring pass.
 
 
-%************************************************************************
-%*                                                                      *
-%* type synonym EquationInfo and access functions for its pieces        *
-%*                                                                      *
-%************************************************************************
+************************************************************************
+*                                                                      *
+* type synonym EquationInfo and access functions for its pieces        *
+*                                                                      *
+************************************************************************
 \subsection[EquationInfo-synonym]{@EquationInfo@: a useful synonym}
 
 The ``equation info'' used by @match@ is relatively complicated and
 worthy of a type synonym and a few handy functions.
+-}
 
-\begin{code}
 firstPat :: EquationInfo -> Pat Id
 firstPat eqn = ASSERT( notNull (eqn_pats eqn) ) head (eqn_pats eqn)
 
 shiftEqns :: [EquationInfo] -> [EquationInfo]
 -- Drop the first pattern in each equation
 shiftEqns eqns = [ eqn { eqn_pats = tail (eqn_pats eqn) } | eqn <- eqns ]
-\end{code}
 
-Functions on MatchResults
+-- Functions on MatchResults
 
-\begin{code}
 matchCanFail :: MatchResult -> Bool
 matchCanFail (MatchResult CanFail _)  = True
 matchCanFail (MatchResult CantFail _) = False
@@ -337,9 +334,6 @@ mkCoAlgCaseMatchResult dflags var ty match_alts
 mkCoSynCaseMatchResult :: Id -> Type -> CaseAlt PatSyn -> MatchResult
 mkCoSynCaseMatchResult var ty alt = MatchResult CanFail $ mkPatSynCase var ty alt
 
-\end{code}
-
-\begin{code}
 sort_alts :: [CaseAlt DataCon] -> [CaseAlt DataCon]
 sort_alts = sortWith (dataConTag . alt_pat)
 
@@ -450,15 +444,15 @@ mkPArrCase dflags var ty sorted_alts fail = do
         binds = [NonRec arg (indexExpr i) | (i, arg) <- zip [1..] (alt_bndrs alt)]
         --
         indexExpr i = mkApps (Var indexP) [Type elemTy, Var var, mkIntExpr dflags i]
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection{Desugarer's versions of some Core functions}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 mkErrorAppDs :: Id              -- The error function
              -> Type            -- Type to which it should be applied
              -> SDoc            -- The error message string to pass
@@ -472,8 +466,8 @@ mkErrorAppDs err_id ty msg = do
         core_msg = Lit (mkMachString full_msg)
         -- mkMachString returns a result of type String#
     return (mkApps (Var err_id) [Type ty, core_msg])
-\end{code}
 
+{-
 'mkCoreAppDs' and 'mkCoreAppsDs' hand the special-case desugaring of 'seq'.
 
 Note [Desugaring seq (1)]  cf Trac #1031
@@ -539,8 +533,8 @@ The isLocalId ensures that we don't turn
 into
         case True of True { ... }
 which stupidly tries to bind the datacon 'True'.
+-}
 
-\begin{code}
 mkCoreAppDs  :: CoreExpr -> CoreExpr -> CoreExpr
 mkCoreAppDs (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2
   | f `hasKey` seqIdKey            -- Note [Desugaring seq (1), (2)]
@@ -554,14 +548,13 @@ mkCoreAppDs fun arg = mkCoreApp fun arg  -- The rest is done in MkCore
 
 mkCoreAppsDs :: CoreExpr -> [CoreExpr] -> CoreExpr
 mkCoreAppsDs fun args = foldl mkCoreAppDs fun args
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[mkSelectorBind]{Make a selector bind}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 This is used in various places to do with lazy patterns.
 For each binder $b$ in the pattern, we create a binding:
@@ -604,8 +597,8 @@ Otherwise we do (B).  Really (A) is just an optimisation for very common
 cases like
      Just x = e
      (p,q) = e
+-}
 
-\begin{code}
 mkSelectorBinds :: [Maybe (Tickish Id)]  -- ticks to add, possibly
                 -> LPat Id      -- The pattern
                 -> CoreExpr     -- Expression to which the pattern is bound
@@ -690,13 +683,13 @@ mkSelectorBinds ticks pat val_expr
     is_triv_pat (WildPat _) = True
     is_triv_pat (ParPat p)  = is_triv_lpat p
     is_triv_pat _           = False
-\end{code}
 
+{-
 Creating big tuples and their types for full Haskell expressions.
 They work over *Ids*, and create tuples replete with their types,
 which is whey they are not in HsUtils.
+-}
 
-\begin{code}
 mkLHsPatTup :: [LPat Id] -> LPat Id
 mkLHsPatTup []     = noLoc $ mkVanillaTuplePat [] Boxed
 mkLHsPatTup [lpat] = lpat
@@ -723,13 +716,13 @@ mkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs)
 
 mkBigLHsPatTup :: [LPat Id] -> LPat Id
 mkBigLHsPatTup = mkChunkified mkLHsPatTup
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[mkFailurePair]{Code for pattern-matching and other failures}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Generally, we handle pattern matching failure like this: let-bind a
 fail-variable, and use that variable if the thing fails:
@@ -778,8 +771,8 @@ for the primitive case:
 \end{verbatim}
 
 Now @fail.33@ is a function, so it can be let-bound.
+-}
 
-\begin{code}
 mkFailurePair :: CoreExpr       -- Result type of the whole case expression
               -> DsM (CoreBind, -- Binds the newly-created fail variable
                                 -- to \ _ -> expression
@@ -793,8 +786,8 @@ mkFailurePair expr
                  App (Var fail_fun_var) (Var voidPrimId)) }
   where
     ty = exprType expr
-\end{code}
 
+{-
 Note [Failure thunks and CPR]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When we make a failure point we ensure that it
@@ -812,8 +805,8 @@ entered at most once.  Adding a dummy 'realWorld' token argument makes
 it clear that sharing is not an issue.  And that in turn makes it more
 CPR-friendly.  This matters a lot: if you don't get it right, you lose
 the tail call property.  For example, see Trac #3403.
+-}
 
-\begin{code}
 mkOptTickBox :: Maybe (Tickish Id) -> CoreExpr -> CoreExpr
 mkOptTickBox Nothing e        = e
 mkOptTickBox (Just tickish) e = Tick tickish e
@@ -831,4 +824,3 @@ mkBinaryTickBox ixT ixF e = do
                        [ (DataAlt falseDataCon, [], falseBox)
                        , (DataAlt trueDataCon,  [], trueBox)
                        ]
-\end{code}
similarity index 94%
rename from compiler/deSugar/Match.lhs
rename to compiler/deSugar/Match.hs
index 753c8fd..5089f86 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 The @match@ function
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
@@ -48,16 +48,16 @@ import FastString
 
 import Control.Monad( when )
 import qualified Data.Map as Map
-\end{code}
 
+{-
 This function is a wrapper of @match@, it must be called from all the parts where
 it was called match, but only substitutes the first call, ....
 if the associated flags are declared, warnings will be issued.
 It can not be called matchWrapper because this name already exists :-(
 
 JJCQ 30-Nov-1997
+-}
 
-\begin{code}
 matchCheck ::  DsMatchContext
             -> [Id]             -- Vars rep'ing the exprs we're matching with
             -> Type             -- Type of the case expression
@@ -102,21 +102,19 @@ matchCheck_really dflags ctx@(DsMatchContext hs_ctx _) vars ty qs
                                            -- in list comprehensions, pattern guards
                                            -- etc.  They are often *supposed* to be
                                            -- incomplete
-\end{code}
 
+{-
 This variable shows the maximum number of lines of output generated for warnings.
 It will limit the number of patterns/equations displayed to@ maximum_output@.
 
 (ToDo: add command-line option?)
+-}
 
-\begin{code}
 maximum_output :: Int
 maximum_output = 4
-\end{code}
 
-The next two functions create the warning message.
+-- The next two functions create the warning message.
 
-\begin{code}
 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
 dsShadowWarn ctx@(DsMatchContext kind loc) qs
   = putSrcSpanDs loc (warnDs warn)
@@ -171,14 +169,13 @@ ppr_constraint (var,pats) = sep [ppr var, ptext (sLit "`notElem`"), ppr pats]
 
 ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> EquationInfo -> SDoc
 ppr_eqn prefixF kind eqn = prefixF (ppr_shadow_pats kind (eqn_pats eqn))
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 The main matching function
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 The function @match@ is basically the same as in the Wadler chapter,
 except it is monadised, to carry around the name supply, info about
@@ -276,8 +273,8 @@ constructors, or all variables (or similar beasts), etc.
 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
 corresponds roughly to @matchVarCon@.
+-}
 
-\begin{code}
 match :: [Id]             -- Variables rep\'ing the exprs we\'re matching with
       -> Type             -- Type of the case expression
       -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
@@ -420,8 +417,8 @@ getViewPat (ViewPat _ pat _) = unLoc pat
 getViewPat _                 = panic "getViewPat"
 getOLPat (ListPat pats ty (Just _)) = ListPat pats ty Nothing
 getOLPat _                   = panic "getOLPat"
-\end{code}
 
+{-
 Note [Empty case alternatives]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The list of EquationInfo can be empty, arising from
@@ -440,11 +437,11 @@ case we want to see that "hello" exception, not (error "empty case").
 See also Note [Case elimination: lifted case] in Simplify.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                 Tidying patterns
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 which will be scrutinised.  This means:
@@ -480,8 +477,8 @@ Float,  Double, at least) are converted to unboxed form; e.g.,
 (ConPat I# _ _ [LitPat (HsIntPrim i)])
 \end{verbatim}
 \end{description}
+-}
 
-\begin{code}
 tidyEqnInfo :: Id -> EquationInfo
             -> DsM (DsWrapper, EquationInfo)
         -- DsM'd because of internal call to dsLHsBinds
@@ -633,7 +630,7 @@ push_bang_into_newtype_arg :: SrcSpan -> HsConPatDetails Id -> HsConPatDetails I
 -- See Note [Bang patterns and newtypes]
 -- We are transforming   !(N p)   into   (N !p)
 push_bang_into_newtype_arg l (PrefixCon (arg:args))
-  = ASSERT( null args) 
+  = ASSERT( null args)
     PrefixCon [L l (BangPat arg)]
 push_bang_into_newtype_arg l (RecCon rf)
   | HsRecFields { rec_flds = L lf fld : flds } <- rf
@@ -642,8 +639,8 @@ push_bang_into_newtype_arg l (RecCon rf)
     RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg = L l (BangPat arg) })] })
 push_bang_into_newtype_arg _ cd
   = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
-\end{code}
 
+{-
 Note [Bang patterns and newtypes]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For the pattern  !(Just pat)  we can discard the bang, because
@@ -681,11 +678,11 @@ evaluation of \tr{e}.  An alternative translation (No.~2):
 ]
 \end{verbatim}
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 We might be able to optimise unmixing when confronted by
 only-one-constructor-possible, of which tuples are the most notable
@@ -721,11 +718,11 @@ Need to make sure the right names get bound for the variable patterns.
 Presumably just a variant on the constructor case (as it is now).
 \end{description}
 
-%************************************************************************
-%*                                                                      *
-%*  matchWrapper: a convenient way to call @match@                      *
-%*                                                                      *
-%************************************************************************
+************************************************************************
+*                                                                      *
+*  matchWrapper: a convenient way to call @match@                      *
+*                                                                      *
+************************************************************************
 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 
 Calls to @match@ often involve similar (non-trivial) work; that work
@@ -764,13 +761,13 @@ by examining one of the RHS expressions in one of the @EquationInfo@s.
 \item
 Call @match@ with all of this information!
 \end{enumerate}
+-}
 
-\begin{code}
 matchWrapper :: HsMatchContext Name         -- For shadowing warning messages
              -> MatchGroup Id (LHsExpr Id)  -- Matches being desugared
              -> DsM ([Id], CoreExpr)        -- Results
-\end{code}
 
+{-
  There is one small problem with the Lambda Patterns, when somebody
  writes something similar to:
 \begin{verbatim}
@@ -792,8 +789,8 @@ due to the fact that lambda patterns can have more than
 one pattern, and match simply only accepts one pattern.
 
 JJQC 30-Nov-1997
+-}
 
-\begin{code}
 matchWrapper ctxt (MG { mg_alts = matches
                       , mg_arg_tys = arg_tys
                       , mg_res_ty = rhs_ty
@@ -828,19 +825,19 @@ matchEquations ctxt vars eqns_info rhs_ty
 
         ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc
         ; extractMatchResult match_result fail_expr }
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
 situation where we want to match a single expression against a single
 pattern. It returns an expression.
+-}
 
-\begin{code}
 matchSimply :: CoreExpr                 -- Scrutinee
             -> HsMatchContext Name      -- Match kind
             -> LPat Id                  -- Pattern it should match
@@ -871,16 +868,15 @@ matchSinglePat scrut hs_ctx pat ty match_result
   = do { var <- selectSimpleMatchVarL pat
        ; match_result' <- matchSinglePat (Var var) hs_ctx pat ty match_result
        ; return (adjustMatchResult (bindNonRec var scrut) match_result') }
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Pattern classification
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 data PatGroup
   = PgAny               -- Immediate match: variables, wildcards,
                         --                  lazy patterns
@@ -923,17 +919,16 @@ subGroup group
 
     -- pg_map :: Map a [EquationInfo]
     -- Equations seen so far in reverse order of appearance
-\end{code}
 
+{-
 Note [Take care with pattern order]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In the subGroup function we must be very careful about pattern re-ordering,
 Consider the patterns [ (True, Nothing), (False, x), (True, y) ]
 Then in bringing together the patterns for True, we must not
 swap the Nothing and y!
+-}
 
-
-\begin{code}
 sameGroup :: PatGroup -> PatGroup -> Bool
 -- Same group means that a single case expression
 -- or test will suffice to match both, *and* the order
@@ -1073,8 +1068,8 @@ patGroup _      (CoPat _ p _)                 = PgCo  (hsPatType p) -- Type of i
 patGroup _      (ViewPat expr p _)            = PgView expr (hsPatType (unLoc p))
 patGroup _      (ListPat _ _ (Just _))        = PgOverloadedList
 patGroup _      pat                           = pprPanic "patGroup" (ppr pat)
-\end{code}
 
+{-
 Note [Grouping overloaded literal patterns]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 WATCH OUT!  Consider
@@ -1092,4 +1087,4 @@ If the first arg matches '1' but the second does not match 'True', we
 cannot jump to the third equation!  Because the same argument might
 match '2'!
 Hence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group.
-
+-}
similarity index 96%
rename from compiler/deSugar/Match.lhs-boot
rename to compiler/deSugar/Match.hs-boot
index 66ecc8a..826f635 100644 (file)
@@ -1,4 +1,3 @@
-\begin{code}
 module Match where
 import Var      ( Id )
 import TcType   ( Type )
@@ -32,4 +31,3 @@ matchSinglePat
         -> Type
         -> MatchResult
         -> DsM MatchResult
-\end{code}
similarity index 98%
rename from compiler/deSugar/MatchCon.lhs
rename to compiler/deSugar/MatchCon.hs
index 8377e2a..b42522c 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Pattern-matching constructors
+-}
 
-\begin{code}
 {-# LANGUAGE CPP #-}
 
 module MatchCon ( matchConFamily, matchPatSyn ) where
@@ -31,8 +31,8 @@ import SrcLoc
 import DynFlags
 import Outputable
 import Control.Monad(liftM)
-\end{code}
 
+{-
 We are confronted with the first column of patterns in a set of
 equations, all beginning with constructors from one ``family'' (e.g.,
 @[]@ and @:@ make up the @List@ ``family'').  We want to generate the
@@ -83,7 +83,8 @@ returned is the number of constructors in the family.
 The function @matchConFamily@ is concerned with this
 have-we-used-all-the-constructors? question; the local function
 @match_cons_used@ does all the real work.
-\begin{code}
+-}
+
 matchConFamily :: [Id]
                -> Type
                -> [[EquationInfo]]
@@ -226,8 +227,8 @@ conArgPats  arg_tys (RecCon (HsRecFields { rec_flds = rpats }))
         -- Important special case for C {}, which can be used for a
         -- datacon that isn't declared to have fields at all
   | otherwise  = map (unLoc . hsRecFieldArg . unLoc) rpats
-\end{code}
 
+{-
 Note [Record patterns]
 ~~~~~~~~~~~~~~~~~~~~~~
 Consider
@@ -286,4 +287,4 @@ Originally I tried to use
         (\b -> let e = d in expr2) a
 to do this substitution.  While this is "correct" in a way, it fails
 Lint, because e::Ord b but d::Ord a.
-
+-}
similarity index 89%
rename from compiler/deSugar/MatchLit.lhs
rename to compiler/deSugar/MatchLit.hs
index acf0b77..1f54780 100644 (file)
@@ -1,11 +1,11 @@
-%
-(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
+
 
 Pattern-matching literal patterns
+-}
 
-\begin{code}
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
 
 module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey
@@ -50,15 +50,15 @@ import Data.Int
 import Data.Traversable (traverse)
 #endif
 import Data.Word
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Desugaring literals
         [used to be in DsExpr, but DsMeta needs it,
          and it's nice to avoid a loop]
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 We give int/float literals type @Integer@ and @Rational@, respectively.
 The typechecker will (presumably) have put \tr{from{Integer,Rational}s}
@@ -72,8 +72,8 @@ For numeric literals, we try to detect there use at a standard type
 [NB: down with the @App@ conversion.]
 
 See also below where we look for @DictApps@ for \tr{plusInt}, etc.
+-}
 
-\begin{code}
 dsLit :: HsLit -> DsM CoreExpr
 dsLit (HsStringPrim _ s) = return (Lit (MachStr s))
 dsLit (HsCharPrim   _ c) = return (Lit (MachChar c))
@@ -114,8 +114,8 @@ dsOverLit' dflags (OverLit { ol_val = val, ol_rebindable = rebindable
   | not rebindable
   , Just expr <- shortCutLit dflags val ty = dsExpr expr        -- Note [Literal short cut]
   | otherwise                              = dsExpr witness
-\end{code}
 
+{-
 Note [Literal short cut]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 The type checker tries to do this short-cutting as early as possible, but
@@ -124,17 +124,17 @@ And where it's possible to generate the correct literal right away, it's
 much better to do so.
 
 
-%************************************************************************
-%*                                                                      *
+************************************************************************
+*                                                                      *
                  Warnings about overflowed literals
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 Warn about functions like toInteger, fromIntegral, that convert
 between one type and another when the to- and from- types are the
 same.  Then it's probably (albeit not definitely) the identity
+-}
 
-\begin{code}
 warnAboutIdentities :: DynFlags -> CoreExpr -> Type -> DsM ()
 warnAboutIdentities dflags (Var conv_fn) type_of_conv
   | wopt Opt_WarnIdentities dflags
@@ -153,9 +153,7 @@ conversionNames
     , fromIntegralName, realToFracName ]
  -- We can't easily add fromIntegerName, fromRationalName,
  -- because they are generated by literals
-\end{code}
 
-\begin{code}
 warnAboutOverflowedLiterals :: DynFlags -> HsOverLit Id -> DsM ()
 warnAboutOverflowedLiterals dflags lit
  | wopt Opt_WarnOverflowedLiterals dflags
@@ -189,8 +187,8 @@ warnAboutOverflowedLiterals dflags lit
             , not (xopt Opt_NegativeLiterals dflags)
             = ptext (sLit "If you are trying to write a large negative literal, use NegativeLiterals")
             | otherwise = Outputable.empty
-\end{code}
 
+{-
 Note [Suggest NegativeLiterals]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If you write
@@ -200,8 +198,8 @@ it'll parse as (negate 128), and overflow.  In this case, suggest NegativeLitera
 We get an erroneous suggestion for
   x = 128
 but perhaps that does not matter too much.
+-}
 
-\begin{code}
 warnAboutEmptyEnumerations :: DynFlags -> LHsExpr Id -> Maybe (LHsExpr Id) -> LHsExpr Id -> DsM ()
 -- Warns about [2,3 .. 1] which returns the empty list
 -- Only works for integral types, not floating point
@@ -248,16 +246,15 @@ getIntegralLit (OverLit { ol_val = HsIntegral _ i, ol_type = ty })
   | Just tc <- tyConAppTyCon_maybe ty
   = Just (i, tyConName tc)
 getIntegralLit _ = Nothing
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
         Tidying lit pats
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 tidyLitPat :: HsLit -> Pat Id
 -- Result has only the following HsLits:
 --      HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim
@@ -328,16 +325,15 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
 
 tidyNPat _ over_lit mb_neg eq
   = NPat over_lit mb_neg eq
-\end{code}
-
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Pattern matching on LitPat
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 matchLiterals :: [Id]
               -> Type                   -- Type of the whole case expression
               -> [[EquationInfo]]       -- All PgLits
@@ -410,15 +406,15 @@ litValKey (HsFractional r) False = MachFloat (fl_value r)
 litValKey (HsFractional r) True  = MachFloat (negate (fl_value r))
 litValKey (HsIsString _ s) neg   = ASSERT( not neg) MachStr
                                                       (fastStringToByteString s)
-\end{code}
 
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Pattern matching on NPat
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
+-}
 
-\begin{code}
 matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
   = do  { let NPat lit mb_neg eq_chk = firstPat eqn1
@@ -432,14 +428,13 @@ matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
         ; match_result <- match vars ty (shiftEqns (eqn1:eqns))
         ; return (mkGuardedMatchResult pred_expr match_result) }
 matchNPats vars _ eqns = pprPanic "matchOneNPat" (ppr (vars, eqns))
-\end{code}
 
-
-%************************************************************************
-%*                                                                      *
+{-
+************************************************************************
+*                                                                      *
                 Pattern matching on n+k patterns
-%*                                                                      *
-%************************************************************************
+*                                                                      *
+************************************************************************
 
 For an n+k pattern, we use the various magic expressions we've been given.
 We generate:
@@ -450,9 +445,8 @@ We generate:
     else
         <try-next-pattern-or-whatever>
 \end{verbatim}
+-}
 
-
-\begin{code}
 matchNPlusKPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 -- All NPlusKPats, for the *same* literal k
 matchNPlusKPats (var:vars) ty (eqn1:eqns)
@@ -475,4 +469,3 @@ matchNPlusKPats (var:vars) ty (eqn1:eqns)
     shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e)
 
 matchNPlusKPats vars _ eqns = pprPanic "matchNPlusKPats" (ppr (vars, eqns))
-\end{code}