Reorganisation of the source tree

Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.

The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level.  The build system now makes no
pretense at being multi-project, it is just the GHC build system.

No doubt this will break many things, and there will be a period of
instability while we fix the dependencies.  A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.

1 files changed, 174 insertions, 0 deletions

diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs
new file mode 100644
index 0000000000..6ff502a8ae
--- /dev/null
+++ b/compiler/deSugar/MatchCon.lhs
@@ -0,0 +1,174 @@
+
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[MatchCon]{Pattern-matching constructors}
+
+\begin{code}
+module MatchCon ( matchConFamily ) where
+
+#include "HsVersions.h"
+
+import Id( idType )
+
+import {-# SOURCE #-} Match	( match )
+
+import HsSyn		( Pat(..), HsConDetails(..) )
+import DsBinds		( dsLHsBinds )
+import DataCon		( isVanillaDataCon, dataConInstOrigArgTys )
+import TcType		( tcTyConAppArgs )
+import Type		( mkTyVarTys )
+import CoreSyn
+import DsMonad
+import DsUtils
+
+import Id		( Id )
+import Type             ( Type )
+import ListSetOps	( equivClassesByUniq )
+import SrcLoc		( unLoc, Located(..) )
+import Unique		( Uniquable(..) )
+import Outputable
+\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
+alternatives for a @Case@ expression.  There are several choices:
+\begin{enumerate}
+\item
+Generate an alternative for every constructor in the family, whether
+they are used in this set of equations or not; this is what the Wadler
+chapter does.
+\begin{description}
+\item[Advantages:]
+(a)~Simple.  (b)~It may also be that large sparsely-used constructor
+families are mainly handled by the code for literals.
+\item[Disadvantages:]
+(a)~Not practical for large sparsely-used constructor families, e.g.,
+the ASCII character set.  (b)~Have to look up a list of what
+constructors make up the whole family.
+\end{description}
+
+\item
+Generate an alternative for each constructor used, then add a default
+alternative in case some constructors in the family weren't used.
+\begin{description}
+\item[Advantages:]
+(a)~Alternatives aren't generated for unused constructors.  (b)~The
+STG is quite happy with defaults.  (c)~No lookup in an environment needed.
+\item[Disadvantages:]
+(a)~A spurious default alternative may be generated.
+\end{description}
+
+\item
+``Do it right:'' generate an alternative for each constructor used,
+and add a default alternative if all constructors in the family
+weren't used.
+\begin{description}
+\item[Advantages:]
+(a)~You will get cases with only one alternative (and no default),
+which should be amenable to optimisation.  Tuples are a common example.
+\item[Disadvantages:]
+(b)~Have to look up constructor families in TDE (as above).
+\end{description}
+\end{enumerate}
+
+We are implementing the ``do-it-right'' option for now.  The arguments
+to @matchConFamily@ are the same as to @match@; the extra @Int@
+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]
+	       -> DsM MatchResult
+matchConFamily (var:vars) ty eqns_info
+  = let
+	-- Sort into equivalence classes by the unique on the constructor
+	-- All the EqnInfos should start with a ConPat
+	groups = equivClassesByUniq get_uniq eqns_info
+	get_uniq (EqnInfo { eqn_pats = ConPatOut (L _ data_con) _ _ _ _ _ : _}) = getUnique data_con
+
+	-- Get the wrapper from the head of each group.  We're going to
+	-- use it as the pattern in this case expression, so we need to 
+	-- ensure that any type variables it mentions in the pattern are
+	-- in scope.  So we put its wrappers outside the case, and
+	-- zap the wrapper for it. 
+	wraps :: [CoreExpr -> CoreExpr]
+	wraps = map (eqn_wrap . head) groups
+
+	groups' = [ eqn { eqn_wrap = idWrapper } : eqns | eqn:eqns <- groups ]
+    in
+	-- Now make a case alternative out of each group
+    mappM (match_con vars ty) groups'	`thenDs` \ alts ->
+    returnDs (adjustMatchResult (foldr (.) idWrapper wraps) $
+	      mkCoAlgCaseMatchResult var ty alts)
+\end{code}
+
+And here is the local function that does all the work.  It is
+more-or-less the @matchCon@/@matchClause@ functions on page~94 in
+Wadler's chapter in SLPJ.  The function @shift_con_pats@ does what the
+list comprehension in @matchClause@ (SLPJ, p.~94) does, except things
+are trickier in real life.  Works for @ConPats@, and we want it to
+fail catastrophically for anything else (which a list comprehension
+wouldn't).  Cf.~@shift_lit_pats@ in @MatchLits@.
+
+\begin{code}
+match_con vars ty eqns
+  = do	{ -- Make new vars for the con arguments; avoid new locals where possible
+	  arg_vars     <- selectMatchVars (map unLoc arg_pats1) arg_tys
+	; eqns'        <- mapM shift eqns 
+	; match_result <- match (arg_vars ++ vars) ty eqns'
+	; return (con, tvs1 ++ dicts1 ++ arg_vars, match_result) }
+  where
+    ConPatOut (L _ con) tvs1 dicts1 _ (PrefixCon arg_pats1) pat_ty = firstPat (head eqns)
+
+    shift eqn@(EqnInfo { eqn_wrap = wrap, 
+		         eqn_pats = ConPatOut _ tvs ds bind (PrefixCon arg_pats) _ : pats })
+	= do { prs <- dsLHsBinds bind
+	     ; return (eqn { eqn_wrap = wrap . wrapBinds (tvs `zip` tvs1) 
+					     . wrapBinds (ds  `zip` dicts1)
+					     . mkDsLet (Rec prs),
+			     eqn_pats = map unLoc arg_pats ++ pats }) }
+
+     	-- Get the arg types, which we use to type the new vars
+	-- to match on, from the "outside"; the types of pats1 may 
+	-- be more refined, and hence won't do
+    arg_tys = dataConInstOrigArgTys con inst_tys
+    inst_tys | isVanillaDataCon con = tcTyConAppArgs pat_ty	-- Newtypes opaque!
+	     | otherwise	    = mkTyVarTys tvs1
+\end{code}
+
+Note [Existentials in shift_con_pat]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+	data T = forall a. Ord a => T a (a->Int)
+
+	f (T x f) True  = ...expr1...
+	f (T y g) False = ...expr2..
+
+When we put in the tyvars etc we get
+
+	f (T a (d::Ord a) (x::a) (f::a->Int)) True =  ...expr1...
+	f (T b (e::Ord b) (y::a) (g::a->Int)) True =  ...expr2...
+
+After desugaring etc we'll get a single case:
+
+	f = \t::T b::Bool -> 
+	    case t of
+	       T a (d::Ord a) (x::a) (f::a->Int)) ->
+	    case b of
+		True  -> ...expr1...
+		False -> ...expr2...
+
+*** We have to substitute [a/b, d/e] in expr2! **
+Hence
+		False -> ....((/\b\(e:Ord b).expr2) a d)....
+
+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.  
+