Commit b9b1fab3 authored by Austin Seipp's avatar Austin Seipp

compiler: de-lhs hsSyn/

Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent a56fe4a1
%
% (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
This module converts Template Haskell syntax into HsSyn
-}
\begin{code}
{-# LANGUAGE CPP #-}
module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
......@@ -1140,7 +1140,7 @@ okOcc ns str
| OccName.isVarNameSpace ns = okVarOcc str
| OccName.isDataConNameSpace ns = okConOcc str
| otherwise = okTcOcc str
-- Determine the name space of a name in a type
--
isVarName :: TH.Name -> Bool
......@@ -1216,8 +1216,8 @@ mk_pkg pkg = stringToPackageKey (TH.pkgString pkg)
mk_uniq :: Int -> Unique
mk_uniq u = mkUniqueGrimily u
\end{code}
{-
Note [Binders in Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this TH term construction:
......@@ -1270,3 +1270,4 @@ the way System Names are printed.
There's a small complication of course; see Note [Looking up Exact
RdrNames] in RnEnv.
-}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\section[HsBinds]{Abstract syntax: top-level bindings and signatures}
Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
-}
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
......@@ -50,17 +50,17 @@ import Control.Applicative hiding (empty)
#else
import Control.Applicative ((<$>))
#endif
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Bindings: @BindGroup@}
%* *
%************************************************************************
* *
************************************************************************
Global bindings (where clauses)
-}
\begin{code}
-- During renaming, we need bindings where the left-hand sides
-- have been renamed but the the right-hand sides have not.
-- the ...LR datatypes are parametrized by two id types,
......@@ -234,8 +234,7 @@ data PatSynBind idL idR
deriving instance (DataId idL, DataId idR )
=> Data (PatSynBind idL idR)
\end{code}
{-
Note [AbsBinds]
~~~~~~~~~~~~~~~
The AbsBinds constructor is used in the output of the type checker, to record
......@@ -333,8 +332,8 @@ Specifically,
* Before renaming, and after typechecking, the field is unused;
it's just an error thunk
-}
\begin{code}
instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsLocalBindsLR idL idR) where
ppr (HsValBinds bs) = ppr bs
ppr (HsIPBinds bs) = ppr bs
......@@ -427,8 +426,8 @@ getTypeSigNames (ValBindsOut _ sigs)
= mkNameSet [unLoc n | L _ (TypeSig names _ _) <- sigs, n <- names]
getTypeSigNames _
= panic "HsBinds.getTypeSigNames"
\end{code}
{-
What AbsBinds means
~~~~~~~~~~~~~~~~~~~
AbsBinds tvs
......@@ -452,8 +451,8 @@ So the desugarer tries to do a better job:
tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND
in (fm,gm)
-}
\begin{code}
instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsBindLR idL idR) where
ppr mbind = ppr_monobind mbind
......@@ -507,10 +506,7 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (PatSynBind idL
ImplicitBidirectional -> ppr_simple equals
ExplicitBidirectional mg -> ppr_simple (ptext (sLit "<-")) <+> ptext (sLit "where") $$
(nest 2 $ pprFunBind psyn is_infix mg)
\end{code}
\begin{code}
pprTicks :: SDoc -> SDoc -> SDoc
-- Print stuff about ticks only when -dppr-debug is on, to avoid
-- them appearing in error messages (from the desugarer); see Trac # 3263
......@@ -520,15 +516,15 @@ pprTicks pp_no_debug pp_when_debug
= getPprStyle (\ sty -> if debugStyle sty || dumpStyle sty
then pp_when_debug
else pp_no_debug)
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Implicit parameter bindings
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
data HsIPBinds id
= IPBinds
[LIPBind id]
......@@ -565,21 +561,20 @@ instance (OutputableBndr id) => Outputable (IPBind id) where
where name = case lr of
Left ip -> pprBndr LetBind ip
Right id -> pprBndr LetBind id
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{@Sig@: type signatures and value-modifying user pragmas}
%* *
%************************************************************************
* *
************************************************************************
It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
``specialise this function to these four types...'') in with type
signatures. Then all the machinery to move them into place, etc.,
serves for both.
-}
\begin{code}
type LSig name = Located (Sig name)
-- | Signatures and pragmas
......@@ -769,13 +764,13 @@ hsSigDoc (InlineSig _ prag) = ppr (inlinePragmaSpec prag) <+> ptext (sLit "p
hsSigDoc (SpecInstSig {}) = ptext (sLit "SPECIALISE instance pragma")
hsSigDoc (FixSig {}) = ptext (sLit "fixity declaration")
hsSigDoc (MinimalSig {}) = ptext (sLit "MINIMAL pragma")
\end{code}
{-
Check if signatures overlap; this is used when checking for duplicate
signatures. Since some of the signatures contain a list of names, testing for
equality is not enough -- we have to check if they overlap.
-}
\begin{code}
instance (OutputableBndr name) => Outputable (Sig name) where
ppr sig = ppr_sig sig
......@@ -835,15 +830,15 @@ instance Outputable TcSpecPrag where
pprMinimalSig :: OutputableBndr name => BooleanFormula (Located name) -> SDoc
pprMinimalSig bf = ptext (sLit "MINIMAL") <+> ppr (fmap unLoc bf)
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection[PatSynBind]{A pattern synonym definition}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
data HsPatSynDetails a
= InfixPatSyn a a
| PrefixPatSyn [a]
......@@ -885,4 +880,3 @@ data HsPatSynDir id
| ExplicitBidirectional (MatchGroup id (LHsExpr id))
deriving (Typeable)
deriving instance (DataId id) => Data (HsPatSynDir id)
\end{code}
\begin{code}
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
......@@ -54,18 +53,17 @@ instance OutputableBndr id => Outputable (HsCmd id)
type LHsExpr a = Located (HsExpr a)
type SyntaxExpr a = HsExpr a
pprLExpr :: (OutputableBndr i) =>
pprLExpr :: (OutputableBndr i) =>
LHsExpr i -> SDoc
pprExpr :: (OutputableBndr i) =>
pprExpr :: (OutputableBndr i) =>
HsExpr i -> SDoc
pprUntypedSplice :: (OutputableBndr i) =>
pprUntypedSplice :: (OutputableBndr i) =>
HsSplice i -> SDoc
pprPatBind :: (OutputableBndr bndr, OutputableBndr id, Outputable body)
=> LPat bndr -> GRHSs id body -> SDoc
pprFunBind :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
pprFunBind :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
=> idL -> Bool -> MatchGroup idR body -> SDoc
\end{code}
%
% (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
HsImpExp: Abstract syntax: imports, exports, interfaces
-}
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
module HsImpExp where
......@@ -19,16 +19,17 @@ import FastString
import SrcLoc
import Data.Data
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Import and export declaration lists}
%* *
%************************************************************************
* *
************************************************************************
One per \tr{import} declaration in a module.
\begin{code}
-}
type LImportDecl name = Located (ImportDecl name)
-- ^ When in a list this may have
--
......@@ -76,9 +77,7 @@ simpleImportDecl mn = ImportDecl {
ideclAs = Nothing,
ideclHiding = Nothing
}
\end{code}
\begin{code}
instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name) where
ppr (ImportDecl { ideclName = mod', ideclPkgQual = pkg
, ideclSource = from, ideclSafe = safe
......@@ -112,15 +111,15 @@ instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name)
ppr_ies [] = ptext (sLit "()")
ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Imported and exported entities}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
type LIE name = Located (IE name)
-- ^ When in a list this may have
--
......@@ -154,9 +153,7 @@ data IE name
| IEDoc HsDocString -- ^ Some documentation
| IEDocNamed String -- ^ Reference to named doc
deriving (Eq, Data, Typeable)
\end{code}
\begin{code}
ieName :: IE name -> name
ieName (IEVar (L _ n)) = n
ieName (IEThingAbs n) = n
......@@ -173,9 +170,6 @@ ieNames (IEModuleContents _ ) = []
ieNames (IEGroup _ _ ) = []
ieNames (IEDoc _ ) = []
ieNames (IEDocNamed _ ) = []
\end{code}
\begin{code}
pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
pprImpExp name = type_pref <+> pprPrefixOcc name
......@@ -196,4 +190,3 @@ instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
ppr (IEGroup n _) = text ("<IEGroup: " ++ (show n) ++ ">")
ppr (IEDoc doc) = ppr doc
ppr (IEDocNamed string) = text ("<IEDocNamed: " ++ string ++ ">")
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\section[HsLit]{Abstract syntax: source-language literals}
-}
\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
......@@ -28,20 +28,15 @@ import Lexer ( SourceText )
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection[HsLit]{Literals}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- Note [literal source text] for SourceText fields in the following
data HsLit
= HsChar SourceText Char -- Character
......@@ -98,8 +93,8 @@ data OverLitVal
overLitType :: HsOverLit a -> PostTc a Type
overLitType = ol_type
\end{code}
{-
Note [literal source text]
~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -157,8 +152,8 @@ calls, which wouldn't be possible if the desguarar made the application.
The PostTcType in each branch records the type the overload literal is
found to have.
-}
\begin{code}
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit)
instance Eq (HsOverLit id) where
......@@ -183,9 +178,7 @@ instance Ord OverLitVal where
compare (HsIsString _ s1) (HsIsString _ s2) = s1 `compare` s2
compare (HsIsString _ _) (HsIntegral _ _) = GT
compare (HsIsString _ _) (HsFractional _) = GT
\end{code}
\begin{code}
instance Outputable HsLit where
-- Use "show" because it puts in appropriate escapes
ppr (HsChar _ c) = pprHsChar c
......@@ -211,4 +204,3 @@ instance Outputable OverLitVal where
ppr (HsIntegral _ i) = integer i
ppr (HsFractional f) = ppr f
ppr (HsIsString _ s) = pprHsString s
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\section[PatSyntax]{Abstract Haskell syntax---patterns}
-}
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
......@@ -52,10 +52,7 @@ import FastString
-- libraries:
import Data.Data hiding (TyCon,Fixity)
import Data.Maybe
\end{code}
\begin{code}
type InPat id = LPat id -- No 'Out' constructors
type OutPat id = LPat id -- No 'In' constructors
......@@ -114,7 +111,7 @@ data Pat id
pat_con :: Located ConLike,
pat_arg_tys :: [Type], -- The univeral arg types, 1-1 with the universal
-- tyvars of the constructor/pattern synonym
-- Use (conLikeResTy pat_con pat_arg_tys) to get
-- Use (conLikeResTy pat_con pat_arg_tys) to get
-- the type of the pattern
pat_tvs :: [TyVar], -- Existentially bound type variables (tyvars only)
......@@ -173,11 +170,9 @@ data Pat id
-- the scrutinee, followed by a match on 'pat'
deriving (Typeable)
deriving instance (DataId id) => Data (Pat id)
\end{code}
HsConDetails is use for patterns/expressions *and* for data type declarations
-- HsConDetails is use for patterns/expressions *and* for data type declarations
\begin{code}
data HsConDetails arg rec
= PrefixCon [arg] -- C p1 p2 p3
| RecCon rec -- C { x = p1, y = p2 }
......@@ -190,12 +185,12 @@ hsConPatArgs :: HsConPatDetails id -> [LPat id]
hsConPatArgs (PrefixCon ps) = ps
hsConPatArgs (RecCon fs) = map (hsRecFieldArg . unLoc) (rec_flds fs)
hsConPatArgs (InfixCon p1 p2) = [p1,p2]
\end{code}
{-
However HsRecFields is used only for patterns and expressions
(not data type declarations)
-}
\begin{code}
data HsRecFields id arg -- A bunch of record fields
-- { x = 3, y = True }
-- Used for both expressions and patterns
......@@ -239,15 +234,15 @@ data HsRecField id arg = HsRecField {
hsRecFields :: HsRecFields id arg -> [id]
hsRecFields rbinds = map (unLoc . hsRecFieldId . unLoc) (rec_flds rbinds)
\end{code}
%************************************************************************
%* *
%* Printing patterns
%* *
%************************************************************************
{-
************************************************************************
* *
* Printing patterns
* *
************************************************************************
-}
\begin{code}
instance (OutputableBndr name) => Outputable (Pat name) where
ppr = pprPat
......@@ -324,16 +319,15 @@ instance (OutputableBndr id, Outputable arg)
ppr (HsRecField { hsRecFieldId = f, hsRecFieldArg = arg,
hsRecPun = pun })
= ppr f <+> (ppUnless pun $ equals <+> ppr arg)
\end{code}
%************************************************************************
%* *
%* Building patterns
%* *
%************************************************************************
{-
************************************************************************
* *
* Building patterns
* *
************************************************************************
-}
\begin{code}
mkPrefixConPat :: DataCon -> [OutPat id] -> [Type] -> OutPat id
-- Make a vanilla Prefix constructor pattern
mkPrefixConPat dc pats tys
......@@ -347,14 +341,13 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
mkCharLitPat :: String -> Char -> OutPat id
mkCharLitPat src c = mkPrefixConPat charDataCon
[noLoc $ LitPat (HsCharPrim src c)] []
\end{code}
%************************************************************************
%* *
%* Predicates for checking things about pattern-lists in EquationInfo *
%* *
%************************************************************************
{-
************************************************************************
* *
* Predicates for checking things about pattern-lists in EquationInfo *
* *
************************************************************************
\subsection[Pat-list-predicates]{Look for interesting things in patterns}
......@@ -379,7 +372,8 @@ A pattern is in {\em exactly one} of the above three categories; `as'
patterns are treated specially, of course.
The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
\begin{code}
-}
isStrictLPat :: LPat id -> Bool
isStrictLPat (L _ (ParPat p)) = isStrictLPat p
isStrictLPat (L _ (BangPat {})) = True
......@@ -394,7 +388,7 @@ isStrictHsBind _ = False
looksLazyPatBind :: HsBind id -> Bool
-- Returns True of anything *except*
-- a StrictHsBind (as above) or
-- a StrictHsBind (as above) or
-- a VarPat
-- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
looksLazyPatBind (PatBind { pat_lhs = p }) = looksLazyLPat p
......@@ -452,7 +446,7 @@ isIrrefutableHsPat pat
-- Both should be gotten rid of by renamer before
-- isIrrefutablePat is called
go1 (SplicePat {}) = urk pat
go1 (SplicePat {}) = urk pat
go1 (QuasiQuotePat {}) = urk pat
urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
......@@ -483,4 +477,3 @@ conPatNeedsParens :: HsConDetails a b -> Bool
conPatNeedsParens (PrefixCon args) = not (null args)
conPatNeedsParens (InfixCon {}) = True
conPatNeedsParens (RecCon {}) = True
\end{code}
\begin{code}
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
......@@ -29,4 +28,3 @@ instance Typeable1 Pat
instance (DataId id) => Data (Pat id)
instance (OutputableBndr name) => Outputable (Pat name)
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\section{Haskell abstract syntax definition}
This module glues together the pieces of the Haskell abstract syntax,
which is declared in the various \tr{Hs*} modules. This module,
therefore, is almost nothing but re-exporting.
-}
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
......@@ -54,9 +54,7 @@ import FastString
-- libraries:
import Data.Data hiding ( Fixity )
\end{code}
\begin{code}
-- | All we actually declare here is the top-level structure for a module.
data HsModule name
= HsModule {
......@@ -105,10 +103,7 @@ data HsModule name
--
deriving (Typeable)
deriving instance (DataId name) => Data (HsModule name)
\end{code}
\begin{code}
instance (OutputableBndr name, HasOccName name)
=> Outputable (HsModule name) where
......@@ -143,4 +138,3 @@ pp_mb Nothing = empty
pp_nonnull :: Outputable t => [t] -> SDoc
pp_nonnull [] = empty
pp_nonnull xs = vcat (map ppr xs)
\end{code}
{-
(c) The University of Glasgow, 1992-2006
%
% (c) The University of Glasgow, 1992-2006
%
Here we collect a variety of helper functions that construct or
analyse HsSyn. All these functions deal with generic HsSyn; functions
......@@ -12,8 +11,8 @@ which deal with the instantiated versions are located elsewhere:
RdrName parser/RdrHsSyn
Name rename/RnHsSyn
Id typecheck/TcHsSyn
-}
\begin{code}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
......@@ -103,20 +102,19 @@ import Outputable
import Data.Either
import Data.Function
import Data.List
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Some useful helpers for constructing syntax
%* *
%************************************************************************
* *
************************************************************************
These functions attempt to construct a not-completely-useless SrcSpan
from their components, compared with the nl* functions below which
just attach noSrcSpan to everything.
-}
\begin{code}
mkHsPar :: LHsExpr id -> LHsExpr id
mkHsPar e = L (getLoc e) (HsPar e)
......@@ -312,16 +310,15 @@ mkHsString s = HsString s (mkFastString s)
userHsTyVarBndrs :: SrcSpan -> [name] -> [Located (HsTyVarBndr name)]
-- Caller sets location
userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar v) | v <- bndrs ]
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Constructing syntax with no location info
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
nlHsVar :: id -> LHsExpr id
nlHsVar n = noLoc (HsVar n)
......@@ -407,12 +404,12 @@ nlHsFunTy a b = noLoc (HsFunTy a b)
nlHsTyConApp :: name -> [LHsType name] -> LHsType name
nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys
\end{code}
{-
Tuples. All these functions are *pre-typechecker* because they lack
types on the tuple.
-}
\begin{code}
mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
-- Makes a pre-typechecker boxed tuple, deals with 1 case
mkLHsTupleExpr [e] = e
......@@ -426,18 +423,17 @@ nlTuplePat pats box = noLoc (TuplePat pats box [])
missingTupArg :: HsTupArg RdrName
missingTupArg = Missing placeHolderType
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Converting a Type to an HsType RdrName
%* *
%************************************************************************
* *
************************************************************************
This is needed to implement GeneralizedNewtypeDeriving.
-}
\begin{code}
toHsType :: Type -> LHsType RdrName
toHsType ty
| [] <- tvs_only
......@@ -471,9 +467,6 @@ toHsType ty
toHsKind :: Kind -> LHsKind RdrName
toHsKind = toHsType
\end{code}