X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FhsSyn%2FHsSyn.lhs;h=c996f227723d649811c724f498b7f7a406b8e253;hb=d876992cf9b9fb07cb913b0c297d9a42b746c29a;hp=290bc85756f82af1f166a8526c1f268492ecbc46;hpb=dbc254c3dcd64761015a3d1c191ac742caafbf4c;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs
index 290bc85..c996f22 100644
--- a/ghc/compiler/hsSyn/HsSyn.lhs
+++ b/ghc/compiler/hsSyn/HsSyn.lhs
@@ -9,11 +9,6 @@ therefore, is almost nothing but re-exporting.
 
 \begin{code}
 module HsSyn (
-
-	-- NB: don't reexport HsCore
-	-- this module tells about "real Haskell"
-
-	module HsSyn,
 	module HsBinds,
 	module HsDecls,
 	module HsExpr,
@@ -23,10 +18,11 @@ module HsSyn (
 	module HsTypes,
 	Fixity, NewOrData, 
 
+	HsModule(..), HsExtCore(..),
+	collectStmtsBinders, collectStmtBinders,
 	collectHsBinders,   collectLocatedHsBinders, 
 	collectMonoBinders, collectLocatedMonoBinders,
-	collectSigTysFromHsBinds, collectSigTysFromMonoBinds,
-	hsModule, hsImports
+	collectSigTysFromHsBinds, collectSigTysFromMonoBinds
      ) where
 
 #include "HsVersions.h"
@@ -39,10 +35,11 @@ import HsImpExp
 import HsLit
 import HsPat
 import HsTypes
-import BasicTypes	( Fixity, Version, NewOrData )
+import HscTypes		( DeprecTxt )
+import BasicTypes	( Fixity, NewOrData )
 
 -- others:
-import Name		( NamedThing )
+import IfaceSyn		( IfaceBinding )
 import Outputable
 import SrcLoc		( SrcLoc )
 import Module		( Module )
@@ -52,10 +49,10 @@ All we actually declare here is the top-level structure for a module.
 \begin{code}
 data HsModule name
   = HsModule
-	Module
-	(Maybe Version)		-- source interface version number
-	(Maybe [IE name])	-- export list; Nothing => export everything
-				-- Just [] => export *nothing* (???)
+	(Maybe Module)		-- Nothing => "module X where" is omitted
+				--	(in which case the next field is Nothing too)
+	(Maybe [IE name])	-- Export list; Nothing => export list omitted, so export everything
+				-- Just [] => export *nothing*
 				-- Just [...] => as you would expect...
 	[ImportDecl name]	-- We snaffle interesting stuff out of the
 				-- imported interfaces early on, adding that
@@ -64,14 +61,23 @@ data HsModule name
 	[HsDecl name]	-- Type, class, value, and interface signature decls
 	(Maybe DeprecTxt)	-- reason/explanation for deprecation of this module
 	SrcLoc
+
+data HsExtCore name	-- Read from Foo.hcr
+  = HsExtCore
+	Module
+	[TyClDecl name]	-- Type declarations only; just as in Haskell source,
+			-- so that we can infer kinds etc
+	[IfaceBinding]	-- And the bindings
 \end{code}
 
 \begin{code}
-instance (NamedThing name, OutputableBndr name)
+instance (OutputableBndr name)
 	=> Outputable (HsModule name) where
 
-    ppr (HsModule name iface_version exports imports
-		      decls deprec src_loc)
+    ppr (HsModule Nothing _ imports decls _ src_loc)
+      = pp_nonnull imports $$ pp_nonnull decls
+
+    ppr (HsModule (Just name) exports imports decls deprec src_loc)
       = vcat [
 	    case exports of
 	      Nothing -> pp_header (ptext SLIT("where"))
@@ -90,11 +96,8 @@ instance (NamedThing name, OutputableBndr name)
 
 	pp_modname = ptext SLIT("module") <+> ppr name
 
-	pp_nonnull [] = empty
-	pp_nonnull xs = vcat (map ppr xs)
-
-hsModule  (HsModule mod _ _ _ _ _ _) = mod
-hsImports (HsModule mod vers exports imports decls deprec src_loc) = imports
+pp_nonnull [] = empty
+pp_nonnull xs = vcat (map ppr xs)
 \end{code}
 
 
@@ -119,6 +122,7 @@ it should return @[x, y, f, a, b]@ (remember, order important).
 
 \begin{code}
 collectLocatedHsBinders :: HsBinds name -> [(name,SrcLoc)]
+-- Used at top level only; so no need for an IPBinds case
 collectLocatedHsBinders EmptyBinds = []
 collectLocatedHsBinders (MonoBind b _ _) 
  = collectLocatedMonoBinders b
@@ -126,11 +130,11 @@ collectLocatedHsBinders (ThenBinds b1 b2)
  = collectLocatedHsBinders b1 ++ collectLocatedHsBinders b2
 
 collectHsBinders :: HsBinds name -> [name]
-collectHsBinders EmptyBinds = []
-collectHsBinders (MonoBind b _ _) 
- = collectMonoBinders b
-collectHsBinders (ThenBinds b1 b2)
- = collectHsBinders b1 ++ collectHsBinders b2
+collectHsBinders EmptyBinds 	   = []
+collectHsBinders (IPBinds _)	   = []		-- Implicit parameters don't create
+						-- ordinary bindings
+collectHsBinders (MonoBind b _ _)  = collectMonoBinders b
+collectHsBinders (ThenBinds b1 b2) = collectHsBinders b1 ++ collectHsBinders b2
 
 collectLocatedMonoBinders :: MonoBinds name -> [(name,SrcLoc)]
 collectLocatedMonoBinders binds
@@ -149,13 +153,24 @@ collectMonoBinders binds
     go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
     go (FunMonoBind f _ _ loc) acc = f : acc
     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
+    go (VarMonoBind v _)       acc = v : acc
+    go (AbsBinds _ _ dbinds _ binds) acc
+      = [dp | (_,dp,_) <- dbinds] ++ go binds acc
 \end{code}
 
+
+%************************************************************************
+%*									*
+\subsection{Getting patterns out of bindings}
+%*									*
+%************************************************************************
+
 Get all the pattern type signatures out of a bunch of bindings
 
 \begin{code}
 collectSigTysFromHsBinds :: HsBinds name -> [HsType name]
 collectSigTysFromHsBinds EmptyBinds        = [] 
+collectSigTysFromHsBinds (IPBinds _)       = [] 
 collectSigTysFromHsBinds (MonoBind b _ _)  = collectSigTysFromMonoBinds b
 collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++
 					     collectSigTysFromHsBinds b2
@@ -188,6 +203,7 @@ collectStmtBinders (BindStmt pat _ _) = collectPatBinders pat
 collectStmtBinders (LetStmt binds)    = collectHsBinders binds
 collectStmtBinders (ExprStmt _ _ _)   = []
 collectStmtBinders (ResultStmt _ _)   = []
+collectStmtBinders (RecStmt ss _ _ _) = collectStmtsBinders ss
 collectStmtBinders other              = panic "collectStmtBinders"
 \end{code}