Commit f6ca98ca authored by partain's avatar partain
Browse files

[project @ 1996-03-22 09:28:55 by partain]

Removing more junk files
parent b52838bc
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
%
\section[AbsSyntax]{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.
The abstract syntax, used in the front end of the compiler, follows
that of a paper on the static semantics of Haskell by Simon Peyton
Jones and Phil Wadler.
The abstract syntax is parameterised with respect to variables
(abbrev: \tr{name}) and patterns (abbrev: \tr{pat}); here is a typical
example:
\begin{pseudocode}
type ProtoNameExpr = Expr ProtoName ProtoNamePat
type TypecheckedExpr = Expr Id TypecheckedPat
\end{pseudocode}
Some parts of the syntax are unparameterised, because there is no
need for them to be.
\begin{code}
#include "HsVersions.h"
module AbsSyn (
-- the mostly-parameterised data types
ArithSeqInfo(..),
Bind(..),
Binds(..),
ClassDecl(..),
ClassPragmas, -- abstract
ConDecl(..),
DefaultDecl(..),
Expr(..),
FixityDecl(..),
GRHSsAndBinds(..),
GRHS(..),
IE(..),
ImportedInterface(..),
IfaceImportDecl(..),
InPat(..),
InstDecl(..),
InstancePragmas, -- abstract
Interface(..),
Literal(..),
Match(..),
Module(..),
MonoBinds(..),
MonoType(..),
PolyType(..),
Qual(..),
Renaming(..),
Sig(..),
GenPragmas, -- abstract
ClassOpPragmas, -- abstract
TyDecl(..),
DataPragmas, -- abstract
TypePragmas, -- abstract
TypecheckedPat(..),
SpecialisedInstanceSig(..), -- a user pragma
DataTypeSig(..),
Context(..), -- synonyms
ClassAssertion(..),
-- synonyms for the (unparameterised) typechecker input
ProtoNameArithSeqInfo(..),
ProtoNameBind(..),
ProtoNameBinds(..),
ProtoNameClassDecl(..),
ProtoNameClassPragmas(..),
ProtoNameConDecl(..),
ProtoNameContext(..),
ProtoNameDefaultDecl(..),
ProtoNameExpr(..),
ProtoNameFixityDecl(..),
ProtoNameGRHSsAndBinds(..),
ProtoNameGRHS(..),
ProtoNameImportedInterface(..),
ProtoNameInstDecl(..),
ProtoNameInstancePragmas(..),
ProtoNameInterface(..),
ProtoNameMatch(..),
ProtoNameModule(..),
ProtoNameMonoBinds(..),
ProtoNameMonoType(..),
ProtoNamePat(..),
ProtoNamePolyType(..),
ProtoNameQual(..),
ProtoNameSig(..),
ProtoNameClassOpSig(..),
ProtoNameGenPragmas(..),
ProtoNameClassOpPragmas(..),
ProtoNameTyDecl(..),
ProtoNameDataPragmas(..),
ProtoNameSpecialisedInstanceSig(..),
ProtoNameDataTypeSig(..),
RenamedArithSeqInfo(..),
RenamedBind(..),
RenamedBinds(..),
RenamedClassDecl(..),
RenamedClassPragmas(..),
RenamedConDecl(..),
RenamedContext(..),
RenamedDefaultDecl(..),
RenamedExpr(..),
RenamedFixityDecl(..),
RenamedGRHSsAndBinds(..),
RenamedGRHS(..),
RenamedImportedInterface(..),
RenamedInstDecl(..),
RenamedInstancePragmas(..),
RenamedInterface(..),
RenamedMatch(..),
RenamedModule(..),
RenamedMonoBinds(..),
RenamedMonoType(..),
RenamedPat(..),
RenamedPolyType(..),
RenamedQual(..),
RenamedSig(..),
RenamedClassOpSig(..),
RenamedGenPragmas(..),
RenamedClassOpPragmas(..),
RenamedTyDecl(..),
RenamedDataPragmas(..),
RenamedSpecialisedInstanceSig(..),
RenamedDataTypeSig(..),
-- synonyms for the (unparameterised) typechecker output
TypecheckedArithSeqInfo(..),
TypecheckedBind(..),
TypecheckedBinds(..),
TypecheckedExpr(..),
TypecheckedGRHSsAndBinds(..),
TypecheckedGRHS(..),
TypecheckedMatch(..),
TypecheckedMonoBinds(..),
TypecheckedModule(..),
TypecheckedQual(..),
-- little help functions (AbsSynFuns)
collectTopLevelBinders,
collectBinders, collectTypedBinders,
collectMonoBinders,
collectMonoBindersAndLocs,
collectQualBinders,
collectPatBinders,
collectTypedPatBinders,
extractMonoTyNames,
cmpInstanceTypes, getNonPrelOuterTyCon,
getIEStrings, getRawIEStrings, ImExportListInfo(..),
--OLD: getMentionedVars,
mkDictApp,
mkDictLam,
mkTyApp,
mkTyLam,
nullBinds,
nullMonoBinds,
isLitPat, patsAreAllLits, isConPat, patsAreAllCons,
irrefutablePat,
#ifdef DPH
patsAreAllProcessor,
#endif
unfailablePat, unfailablePats,
pprContext,
typeOfPat,
negLiteral,
eqConDecls, eqMonoType, cmpPolyType,
-- imported things so we get a closed interface
Outputable(..), NamedThing(..),
ExportFlag, SrcLoc,
Pretty(..), PprStyle, PrettyRep,
OptIdInfo(..), -- I hate the instance virus!
IdInfo, SpecEnv, StrictnessInfo, UpdateInfo, ArityInfo,
DemandInfo, Demand, ArgUsageInfo, ArgUsage, DeforestInfo,
FBTypeInfo, FBType, FBConsum, FBProd,
Name(..), -- NB: goes out *WITH* constructors
Id, DictVar(..), Inst, ProtoName, TyVar, UniType, TauType(..),
Maybe, PreludeNameFun(..), Unique,
FullName, ShortName, Arity(..), TyCon, Class, ClassOp,
UnfoldingGuidance, BinderInfo, BasicLit, PrimOp, PrimKind,
IdEnv(..), UniqFM, FiniteMap,
CoreExpr, CoreAtom, UnfoldingCoreAtom, UnfoldingCoreExpr,
UnfoldingPrimOp, UfCostCentre, Bag
IF_ATTACK_PRAGMAS(COMMA cmpClass COMMA cmpTyCon COMMA cmpTyVar)
IF_ATTACK_PRAGMAS(COMMA cmpUniType COMMA pprPrimOp)
#ifndef __GLASGOW_HASKELL__
,TAG_
#endif
#ifdef DPH
,ParQuals(..), ProtoNameParQuals(..),
RenamedParQuals(..), TypecheckedParQuals(..),
collectParQualBinders
#endif {- Data Parallel Haskell -}
) where
import AbsSynFuns -- help functions
import HsBinds -- the main stuff to export
import HsCore
import HsDecls
import HsExpr
import HsImpExp
import HsLit
import HsMatches
import HsPat
import HsPragmas
import HsTypes
import AbsPrel ( PrimKind, PrimOp
IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
)
import AbsUniType ( TyVar, TyCon, Arity(..), Class, ClassOp, TauType(..)
IF_ATTACK_PRAGMAS(COMMA cmpTyVar)
IF_ATTACK_PRAGMAS(COMMA cmpClass)
IF_ATTACK_PRAGMAS(COMMA cmpTyCon)
IF_ATTACK_PRAGMAS(COMMA cmpUniType)
)
import BasicLit ( BasicLit )
import FiniteMap ( FiniteMap )
import Id ( Id, DictVar(..), DataCon(..) )
import IdInfo
import Inst ( Inst )
import Maybes ( Maybe )
import Name
import NameTypes ( ShortName, FullName ) -- .. for pragmas only
import Outputable
import Pretty
import ProtoName ( ProtoName(..) ) -- .. for pragmas only
import SrcLoc ( SrcLoc )
import Unique ( Unique )
import Util
\end{code}
All we actually declare here is the top-level structure for a module.
\begin{code}
data Module name pat
= Module
FAST_STRING -- module name
[IE] -- export list
[ImportedInterface name pat]
-- We snaffle interesting stuff out of the
-- imported interfaces early on, adding that
-- info to TyDecls/etc; so this list is
-- often empty, downstream.
[FixityDecl name]
[TyDecl name]
[DataTypeSig name] -- user pragmas that modify TyDecls;
-- (much like "Sigs" modify value "Binds")
[ClassDecl name pat]
[InstDecl name pat]
[SpecialisedInstanceSig name] -- user pragmas that modify InstDecls
[DefaultDecl name]
(Binds name pat) -- the main stuff!
[Sig name] -- "Sigs" are folded into the "Binds"
-- pretty early on, so this list is
-- often either empty or just the
-- interface signatures.
SrcLoc
\end{code}
\begin{code}
type ProtoNameModule = Module ProtoName ProtoNamePat
type RenamedModule = Module Name RenamedPat
type TypecheckedModule = Module Id TypecheckedPat
\end{code}
\begin{code}
instance (NamedThing name, Outputable name, NamedThing pat, Outputable pat) =>
Outputable (Module name pat) where
ppr sty (Module name exports imports fixities
typedecls typesigs classdecls instdecls instsigs
defdecls binds sigs src_loc)
= ppAboves [
ifPprShowAll sty (ppr sty src_loc),
if (null exports)
then (ppCat [ppPStr SLIT("module"), ppPStr name, ppPStr SLIT("where")])
else (ppAboves [
ppCat [ppPStr SLIT("module"), ppPStr name, ppLparen],
ppNest 8 (interpp'SP sty exports),
ppNest 4 (ppPStr SLIT(") where"))
]),
ppr sty imports, ppr sty fixities,
ppr sty typedecls, ppr sty typesigs,
ppr sty classdecls,
ppr sty instdecls, ppr sty instsigs,
ppr sty defdecls,
ppr sty binds, ppr sty sigs
]
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
%
\section[AbsSynFuns]{Abstract syntax: help functions}
\begin{code}
#include "HsVersions.h"
module AbsSynFuns (
collectTopLevelBinders,
collectBinders, collectTypedBinders,
collectMonoBinders,
collectMonoBindersAndLocs,
collectPatBinders,
collectQualBinders,
collectTypedPatBinders,
#ifdef DPH
collectParQualBinders,
#endif {- Data Parallel Haskell -}
cmpInstanceTypes,
extractMonoTyNames,
{-OLD:-}getMentionedVars, -- MENTIONED
getNonPrelOuterTyCon,
mkDictApp,
mkDictLam,
mkTyApp,
mkTyLam,
PreludeNameFun(..)
) where
IMPORT_Trace
import AbsSyn
import HsTypes ( cmpMonoType )
import Id ( Id, DictVar(..), DictFun(..) )
import Maybes ( Maybe(..) )
import ProtoName ( ProtoName(..), cmpProtoName )
import Rename ( PreludeNameFun(..) )
import Util
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-MonoBinds]{Bindings: @MonoBinds@}
%* *
%************************************************************************
Get all the binders in some @ProtoNameMonoBinds@, IN THE ORDER OF
APPEARANCE; e.g., in:
\begin{verbatim}
...
where
(x, y) = ...
f i j = ...
[a, b] = ...
\end{verbatim}
it should return @[x, y, f, a, b]@ (remember, order important).
\begin{code}
collectTopLevelBinders :: Binds name (InPat name) -> [name]
collectTopLevelBinders EmptyBinds = []
collectTopLevelBinders (SingleBind b) = collectBinders b
collectTopLevelBinders (BindWith b _) = collectBinders b
collectTopLevelBinders (ThenBinds b1 b2)
= (collectTopLevelBinders b1) ++ (collectTopLevelBinders b2)
collectBinders :: Bind name (InPat name) -> [name]
collectBinders EmptyBind = []
collectBinders (NonRecBind monobinds) = collectMonoBinders monobinds
collectBinders (RecBind monobinds) = collectMonoBinders monobinds
collectTypedBinders :: TypecheckedBind -> [Id]
collectTypedBinders EmptyBind = []
collectTypedBinders (NonRecBind monobinds) = collectTypedMonoBinders monobinds
collectTypedBinders (RecBind monobinds) = collectTypedMonoBinders monobinds
collectMonoBinders :: MonoBinds name (InPat name) -> [name]
collectMonoBinders EmptyMonoBinds = []
collectMonoBinders (PatMonoBind pat grhss_w_binds _) = collectPatBinders pat
collectMonoBinders (FunMonoBind f matches _) = [f]
collectMonoBinders (VarMonoBind v expr) = error "collectMonoBinders"
collectMonoBinders (AndMonoBinds bs1 bs2)
= (collectMonoBinders bs1) ++ (collectMonoBinders bs2)
collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id]
collectTypedMonoBinders EmptyMonoBinds = []
collectTypedMonoBinders (PatMonoBind pat grhss_w_binds _) = collectTypedPatBinders pat
collectTypedMonoBinders (FunMonoBind f matches _) = [f]
collectTypedMonoBinders (VarMonoBind v expr) = [v]
collectTypedMonoBinders (AndMonoBinds bs1 bs2)
= (collectTypedMonoBinders bs1) ++ (collectTypedMonoBinders bs2)
-- We'd like the binders -- and where they came from --
-- so we can make new ones with equally-useful origin info.
collectMonoBindersAndLocs
:: MonoBinds name (InPat name) -> [(name, SrcLoc)]
collectMonoBindersAndLocs EmptyMonoBinds = []
collectMonoBindersAndLocs (AndMonoBinds bs1 bs2)
= collectMonoBindersAndLocs bs1 ++ collectMonoBindersAndLocs bs2
collectMonoBindersAndLocs (PatMonoBind pat grhss_w_binds locn)
= collectPatBinders pat `zip` repeat locn
collectMonoBindersAndLocs (FunMonoBind f matches locn) = [(f, locn)]
collectMonoBindersAndLocs (VarMonoBind v expr)
= trace "collectMonoBindersAndLocs:VarMonoBind" []
-- ToDo: this is dubious, i.e., wrong, but harmless?
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-Expr]{Help functions: @Expr@}
%* *
%************************************************************************
And some little help functions that remove redundant redundancy:
\begin{code}
mkTyApp :: TypecheckedExpr -> [UniType] -> TypecheckedExpr
mkTyApp expr [] = expr
mkTyApp expr tys = TyApp expr tys
mkDictApp :: TypecheckedExpr -> [DictVar] -> TypecheckedExpr
mkDictApp expr [] = expr
mkDictApp expr dict_vars = DictApp expr dict_vars
mkTyLam :: [TyVar] -> TypecheckedExpr -> TypecheckedExpr
mkTyLam [] expr = expr
mkTyLam tyvars expr = TyLam tyvars expr
mkDictLam :: [DictVar] -> TypecheckedExpr -> TypecheckedExpr
mkDictLam [] expr = expr
mkDictLam dicts expr = DictLam dicts expr
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-Qual]{Help functions: @Quals@}
%* *
%************************************************************************
\begin{code}
#ifdef DPH
collectParQualBinders :: RenamedParQuals -> [Name]
collectParQualBinders (AndParQuals q1 q2)
= collectParQualBinders q1 ++ collectParQualBinders q2
collectParQualBinders (DrawnGenIn pats pat expr)
= concat ((map collectPatBinders pats)++[collectPatBinders pat])
collectParQualBinders (IndexGen exprs pat expr)
= (collectPatBinders pat)
collectParQualBinders (ParFilter expr) = []
#endif {- Data Parallel HAskell -}
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-ParQuals]{Help functions: @ParQuals@}
%* *
%************************************************************************
\begin{code}
collectQualBinders :: [RenamedQual] -> [Name]
collectQualBinders quals
= concat (map collect quals)
where
collect (GeneratorQual pat expr) = collectPatBinders pat
collect (FilterQual expr) = []
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-pats]{Help functions: patterns}
%* *
%************************************************************************
With un-parameterised patterns, we have to have ``duplicate'' copies
of one or two functions:
\begin{code}
collectPatBinders :: InPat a -> [a]
collectPatBinders (VarPatIn var) = [var]
collectPatBinders (LazyPatIn pat) = collectPatBinders pat
collectPatBinders (AsPatIn a pat) = a : (collectPatBinders pat)
collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
collectPatBinders (ConOpPatIn p1 c p2)= (collectPatBinders p1) ++ (collectPatBinders p2)
collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
collectPatBinders (NPlusKPatIn n _) = [n]
#ifdef DPH
collectPatBinders (ProcessorPatIn pats pat)
= concat (map collectPatBinders pats) ++ (collectPatBinders pat)
#endif
collectPatBinders any_other_pat = [ {-no binders-} ]
\end{code}
Nota bene: DsBinds relies on the fact that at least for simple
tuple patterns @collectTypedPatBinders@ returns the binders in
the same order as they appear in the tuple.
\begin{code}
collectTypedPatBinders :: TypecheckedPat -> [Id]
collectTypedPatBinders (VarPat var) = [var]
collectTypedPatBinders (LazyPat pat) = collectTypedPatBinders pat
collectTypedPatBinders (AsPat a pat) = a : (collectTypedPatBinders pat)
collectTypedPatBinders (ConPat _ _ pats) = concat (map collectTypedPatBinders pats)
collectTypedPatBinders (ConOpPat p1 _ p2 _) = (collectTypedPatBinders p1) ++ (collectTypedPatBinders p2)
collectTypedPatBinders (ListPat t pats) = concat (map collectTypedPatBinders pats)
collectTypedPatBinders (TuplePat pats) = concat (map collectTypedPatBinders pats)
collectTypedPatBinders (NPlusKPat n _ _ _ _ _) = [n]
#ifdef DPH
collectTypedPatBinders (ProcessorPat pats _ pat)
= (concat (map collectTypedPatBinders pats)) ++
(collectTypedPatBinders pat)
#endif {- Data Parallel Haskell -}
collectTypedPatBinders any_other_pat = [ {-no binders-} ]
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-MonoType]{Help functions: @MonoType@}
%* *
%************************************************************************
Get the type variable names from a @MonoType@. Don't use class @Eq@
because @ProtoNames@ aren't in it.
\begin{code}
extractMonoTyNames :: (name -> name -> Bool) -> MonoType name -> [name]
extractMonoTyNames eq monotype
= get monotype []
where
get (MonoTyVar name) acc | name `is_elem` acc = acc
| otherwise = name : acc
get (MonoTyCon con tys) acc = foldr get acc tys
get (ListMonoTy ty) acc = get ty acc
get (FunMonoTy ty1 ty2) acc = get ty1 (get ty2 acc)
get (TupleMonoTy tys) acc
= foldr get_poly acc tys
where
get_poly (UnoverloadedTy ty) acc = get ty acc
get_poly (ForAllTy _ ty) acc = get ty acc
get_poly (OverloadedTy ctxt ty) acc = panic "extractMonoTyNames"
get (MonoDict _ ty) acc = get ty acc
get (MonoTyVarTemplate _) acc = acc
#ifdef DPH
get (MonoTyProc tys ty) acc = foldr get (get ty acc) tys
get (MonoTyPod ty) acc = get ty acc
#endif {- Data Parallel Haskell -}
is_elem n [] = False
is_elem n (x:xs) = n `eq` x || n `is_elem` xs
\end{code}
@cmpInstanceTypes@ compares two @MonoType@s which are being used as
``instance types.'' This is used when comparing as-yet-unrenamed
instance decls to eliminate duplicates. We allow things (e.g.,
overlapping instances) which standard Haskell doesn't, so we must
cater for that. Generally speaking, the instance-type
``shape''-checker in @tcInstDecl@ will catch any mischief later on.
All we do is call @cmpMonoType@, passing it a tyvar-comparing function
that always claims that tyvars are ``equal;'' the result is that we
end up comparing the non-tyvar-ish structure of the two types.
\begin{code}
cmpInstanceTypes :: ProtoNameMonoType -> ProtoNameMonoType -> TAG_
cmpInstanceTypes ty1 ty2
= cmpMonoType funny_cmp ty1 ty2
where
funny_cmp :: ProtoName -> ProtoName -> TAG_
{- The only case we are really trying to catch
is when both types are tyvars: which are both
"Unk"s and names that start w/ a lower-case letter! (Whew.)
-}
funny_cmp (Unk u1) (Unk u2)
| isLower s1 && isLower s2 = EQ_
where
s1 = _HEAD_ u1
s2 = _HEAD_ u2
funny_cmp x y = cmpProtoName x y -- otherwise completely normal
\end{code}
@getNonPrelOuterTyCon@ is a yukky function required when deciding
whether to import an instance decl. If the class name or type
constructor are ``wanted'' then we should import it, otherwise not.
But the built-in core constructors for lists, tuples and arrows are
never ``wanted'' in this sense. @getNonPrelOuterTyCon@ catches just a
user-defined tycon and returns it.
\begin{code}
getNonPrelOuterTyCon :: ProtoNameMonoType -> Maybe ProtoName
getNonPrelOuterTyCon (MonoTyCon con _) = Just con
getNonPrelOuterTyCon _ = Nothing
\end{code}
%************************************************************************
%* *
\subsection[AbsSynFuns-mentioned-vars]{Collect mentioned variables}
%* *
%************************************************************************
This is just a {\em hack} whichs collects, from a module body, all the
variables that are ``mentioned,'' either as top-level binders or as
free variables. We can then use this list when walking over
interfaces, using it to avoid imported variables that are patently of
no interest.
We have to be careful to look out for \tr{M..} constructs in the
export list; if so, the game is up (and we must so report).
\begin{code}
{- OLD:MENTIONED-}
getMentionedVars :: PreludeNameFun -- a prelude-name lookup function, so
-- we can avoid recording prelude things
-- as "mentioned"
-> [IE]{-exports-} -- All the bits of the module body to
-> [ProtoNameFixityDecl]-- look in for "mentioned" vars.
-> [ProtoNameClassDecl]
-> [ProtoNameInstDecl]