--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+%
+\section[HsDecls]{Abstract syntax: global declarations}
+
+Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
+@InstDecl@, @DefaultDecl@.
+
+\begin{code}
+#include "HsVersions.h"
+
+module HsDecls where
+
+import HsBinds ( nullMonoBinds, ProtoNameMonoBinds(..),
+ MonoBinds, Sig
+ )
+import HsPat ( ProtoNamePat(..), RenamedPat(..), InPat )
+import HsPragmas ( DataPragmas, TypePragmas, ClassPragmas,
+ InstancePragmas, ClassOpPragmas
+ )
+import HsTypes
+import Id ( Id )
+import Name ( Name )
+import Outputable
+import Pretty
+import ProtoName ( cmpProtoName, ProtoName(..) ) -- .. for pragmas only
+import SrcLoc ( SrcLoc )
+import Unique ( Unique )
+import Util
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[FixityDecl]{A fixity declaration}
+%* *
+%************************************************************************
+
+These are only used in generating interfaces at the moment. They are
+not used in pretty-printing.
+
+\begin{code}
+data FixityDecl name
+ = InfixL name Int
+ | InfixR name Int
+ | InfixN name Int
+
+type ProtoNameFixityDecl = FixityDecl ProtoName
+type RenamedFixityDecl = FixityDecl Name
+\end{code}
+
+\begin{code}
+instance (NamedThing name, Outputable name)
+ => Outputable (FixityDecl name) where
+ ppr sty (InfixL var prec) = ppCat [ppStr "infixl", ppInt prec, pprOp sty var]
+ ppr sty (InfixR var prec) = ppCat [ppStr "infixr", ppInt prec, pprOp sty var]
+ ppr sty (InfixN var prec) = ppCat [ppStr "infix ", ppInt prec, pprOp sty var]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TyDecl]{An algebraic datatype or type-synonym declaration (plus @DataTypeSig@...)}
+%* *
+%************************************************************************
+
+\begin{code}
+data TyDecl name
+ = TyData (Context name) -- context (not used yet)
+ name -- type constructor
+ [name] -- type variables
+ [ConDecl name] -- data constructors
+ [name] -- derivings
+ (DataPragmas name)
+ SrcLoc
+
+ | TySynonym name -- type constructor
+ [name] -- type variables
+ (MonoType name) -- synonym expansion
+ TypePragmas
+ SrcLoc
+
+type ProtoNameTyDecl = TyDecl ProtoName
+type RenamedTyDecl = TyDecl Name
+\end{code}
+
+\begin{code}
+instance (NamedThing name, Outputable name)
+ => Outputable (TyDecl name) where
+
+ ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
+ = ppAbove (ifPprShowAll sty (ppr sty src_loc)) -- ToDo: pragmas
+ (ppHang (ppCat [ppStr "data", pprContext sty context, ppr sty tycon, interppSP sty tyvars])
+ 4
+ (ppSep [
+ ppr sty condecls,
+ if (null derivings) then
+ ppNil
+ else
+ ppBesides [ppStr "deriving (", interpp'SP sty derivings, ppStr ")"]]))
+
+ ppr sty (TySynonym tycon tyvars mono_ty pragmas src_loc)
+ = ppHang (ppCat [ppStr "type", ppr sty tycon, interppSP sty tyvars])
+ 4 (ppCat [ppEquals, ppr sty mono_ty,
+ ifPprShowAll sty (ppr sty src_loc)]) -- ToDo: pragmas
+\end{code}
+
+A type for recording what type synonyms the user wants treated as {\em
+abstract} types. It's called a ``Sig'' because it's sort of like a
+``type signature'' for an synonym declaration.
+
+Note: the Right Way to do this abstraction game is for the language to
+support it.
+\begin{code}
+data DataTypeSig name
+ = AbstractTypeSig name -- tycon to abstract-ify
+ SrcLoc
+ | SpecDataSig name -- tycon to specialise
+ (MonoType name)
+ SrcLoc
+
+
+type ProtoNameDataTypeSig = DataTypeSig ProtoName
+type RenamedDataTypeSig = DataTypeSig Name
+
+instance (NamedThing name, Outputable name)
+ => Outputable (DataTypeSig name) where
+
+ ppr sty (AbstractTypeSig tycon _)
+ = ppCat [ppStr "{-# ABSTRACT", ppr sty tycon, ppStr "#-}"]
+
+ ppr sty (SpecDataSig tycon ty _)
+ = ppCat [ppStr "{-# SPECIALSIE data", ppr sty ty, ppStr "#-}"]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[ConDecl]{A data-constructor declaration}
+%* *
+%************************************************************************
+
+A data constructor for an algebraic data type.
+
+\begin{code}
+data ConDecl name = ConDecl name [MonoType name] SrcLoc
+
+type ProtoNameConDecl = ConDecl ProtoName
+type RenamedConDecl = ConDecl Name
+\end{code}
+
+In checking interfaces, we need to ``compare'' @ConDecls@. Use with care!
+\begin{code}
+eqConDecls cons1 cons2
+ = case (cmpList cmp cons1 cons2) of { EQ_ -> True; _ -> False }
+ where
+ cmp (ConDecl n1 tys1 _) (ConDecl n2 tys2 _)
+ = case cmpProtoName n1 n2 of
+ EQ_ -> cmpList (cmpMonoType cmpProtoName) tys1 tys2
+ xxx -> xxx
+\end{code}
+
+\begin{code}
+instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
+
+ ppr sty (ConDecl con mono_tys src_loc)
+ = ppCat [pprNonOp sty con,
+ ppInterleave ppNil (map (pprParendMonoType sty) mono_tys)]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[ClassDecl]{A class declaration}
+%* *
+%************************************************************************
+
+\begin{code}
+data ClassDecl name pat
+ = ClassDecl (Context name) -- context...
+ name -- name of the class
+ name -- the class type variable
+ [Sig name] -- methods' signatures
+ (MonoBinds name pat) -- default methods
+ (ClassPragmas name)
+ SrcLoc
+
+type ProtoNameClassDecl = ClassDecl ProtoName ProtoNamePat
+type RenamedClassDecl = ClassDecl Name RenamedPat
+\end{code}
+
+\begin{code}
+instance (NamedThing name, Outputable name,
+ NamedThing pat, Outputable pat)
+ => Outputable (ClassDecl name pat) where
+
+ ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
+ = ppAboves [ppCat [ppStr "class", pprContext sty context, ppr sty clas,
+ ppr sty tyvar, ppStr "where"],
+ -- ToDo: really shouldn't print "where" unless there are sigs
+ ppNest 4 (ppAboves (map (ppr sty) sigs)),
+ ppNest 4 (ppr sty methods),
+ ppNest 4 (ppr sty pragmas)]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[InstDecl]{An instance declaration (also, @SpecialisedInstanceSig@)}
+%* *
+%************************************************************************
+
+\begin{code}
+data InstDecl name pat
+ = InstDecl (Context name)
+ name -- class
+ (MonoType name)
+ (MonoBinds name pat)
+ Bool -- True <=> This instance decl is from the
+ -- module being compiled; False <=> It is from
+ -- an imported interface.
+
+ FAST_STRING{-ModuleName-}
+ -- The module where the instance decl
+ -- originally came from; easy enough if it's
+ -- the module being compiled; otherwise, the
+ -- info comes from a pragma.
+
+ FAST_STRING
+ -- Name of the module who told us about this
+ -- inst decl (the `informer') ToDo: listify???
+
+ [Sig name] -- actually user-supplied pragmatic info
+ (InstancePragmas name) -- interface-supplied pragmatic info
+ SrcLoc
+
+type ProtoNameInstDecl = InstDecl ProtoName ProtoNamePat
+type RenamedInstDecl = InstDecl Name RenamedPat
+\end{code}
+
+\begin{code}
+instance (NamedThing name, Outputable name,
+ NamedThing pat, Outputable pat)
+ => Outputable (InstDecl name pat) where
+
+ ppr sty (InstDecl context clas ty binds local modname imod uprags pragmas src_loc)
+ = let
+ top_matter = ppCat [ppStr "instance", pprContext sty context, ppr sty clas, ppr sty ty]
+ in
+ if nullMonoBinds binds && null uprags then
+ ppAbove top_matter (ppNest 4 (ppr sty pragmas))
+ else
+ ppAboves [
+ ppCat [top_matter, ppStr "where"],
+ ppNest 4 (ppr sty uprags),
+ ppNest 4 (ppr sty binds),
+ ppNest 4 (ppr sty pragmas) ]
+\end{code}
+
+A type for recording what instances the user wants to specialise;
+called a ``Sig'' because it's sort of like a ``type signature'' for an
+instance.
+\begin{code}
+data SpecialisedInstanceSig name
+ = InstSpecSig name -- class
+ (MonoType name) -- type to specialise to
+ SrcLoc
+
+type ProtoNameSpecialisedInstanceSig = SpecialisedInstanceSig ProtoName
+type RenamedSpecialisedInstanceSig = SpecialisedInstanceSig Name
+
+instance (NamedThing name, Outputable name)
+ => Outputable (SpecialisedInstanceSig name) where
+
+ ppr sty (InstSpecSig clas ty _)
+ = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[DefaultDecl]{A @default@ declaration}
+%* *
+%************************************************************************
+
+There can only be one default declaration per module, but it is hard
+for the parser to check that; we pass them all through in the abstract
+syntax, and that restriction must be checked in the front end.
+
+\begin{code}
+data DefaultDecl name
+ = DefaultDecl [MonoType name]
+ SrcLoc
+
+type ProtoNameDefaultDecl = DefaultDecl ProtoName
+type RenamedDefaultDecl = DefaultDecl Name
+\end{code}
+
+\begin{code}
+instance (NamedThing name, Outputable name)
+ => Outputable (DefaultDecl name) where
+
+ ppr sty (DefaultDecl tys src_loc)
+ = ppBesides [ppStr "default (", interpp'SP sty tys, ppStr ")"]
+\end{code}
projects / ghc-hetmet.git / blobdiff