[project @ 2004-01-12 14:36:28 by simonpj]

[ghc-hetmet.git] / ghc / compiler / parser / RdrHsSyn.lhs

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 8d9e17d..656fc34 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -57,6 +57,7 @@ import RdrName                ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
                          setRdrNameSpace, rdrNameModule )
 import BasicTypes      ( RecFlag(..), mapIPName, maxPrecedence, initialVersion )
 import Lexer           ( P, failSpanMsgP )
+import Kind            ( liftedTypeKind )
 import HscTypes                ( GenAvailInfo(..) )
 import TysWiredIn      ( unitTyCon ) 
 import ForeignCall     ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
@@ -117,6 +118,7 @@ extract_ty (HsPredTy p)                  acc = extract_pred (unLoc p) acc
 extract_ty (HsOpTy ty1 nam ty2)      acc = extract_lty ty1 (extract_lty ty2 acc)
 extract_ty (HsParTy ty)              acc = extract_lty ty acc
 extract_ty (HsNumTy num)             acc = acc
+extract_ty (HsSpliceTy _)            acc = acc -- Type splices mention no type variables
 extract_ty (HsKindSig ty k)         acc = extract_lty ty acc
 extract_ty (HsForAllTy exp [] cx ty) acc = extract_lctxt cx (extract_lty ty acc)
 extract_ty (HsForAllTy exp tvs cx ty) 
@@ -160,7 +162,7 @@ mkClassDecl (cxt, cname, tyvars) fds sigs mbinds
   = ClassDecl { tcdCtxt = cxt, tcdLName = cname, tcdTyVars = tyvars,
                tcdFDs = fds,  
                tcdSigs = sigs,
-               tcdMeths = mbinds,
+               tcdMeths = mbinds
                }
 
 mkTyData new_or_data (context, tname, tyvars) data_cons maybe
@@ -285,9 +287,10 @@ hsIfaceType (HsPArrTy t)       = IfaceTyConApp IfacePArrTc [hsIfaceLType t]
 hsIfaceType (HsTupleTy bx ts)  = IfaceTyConApp (IfaceTupTc bx (length ts)) (hsIfaceLTypes ts)
 hsIfaceType (HsOpTy t1 tc t2)  = hs_tc_app (HsTyVar (unLoc tc)) (hsIfaceLTypes [t1, t2])
 hsIfaceType (HsParTy t)               = hsIfaceLType t
-hsIfaceType (HsNumTy n)               = panic "hsIfaceType:HsNum"
 hsIfaceType (HsPredTy p)       = IfacePredTy (hsIfaceLPred p)
 hsIfaceType (HsKindSig t _)    = hsIfaceLType t
+hsIfaceType (HsNumTy n)               = panic "hsIfaceType:HsNum"
+hsIfaceType (HsSpliceTy _)     = panic "hsIfaceType:HsSpliceTy"
 
 -----------
 hsIfaceLTypes tys = map (hsIfaceType.unLoc) tys
@@ -316,8 +319,8 @@ hs_tc_app ty args      = foldl IfaceAppTy (hsIfaceType ty) args
 hsIfaceTvs tvs = map (hsIfaceTv.unLoc) tvs
 
 -----------
-hsIfaceTv (UserTyVar n)     = (rdrNameOcc n, IfaceLiftedTypeKind)
-hsIfaceTv (KindedTyVar n k) = (rdrNameOcc n, toIfaceKind k)
+hsIfaceTv (UserTyVar n)     = (rdrNameOcc n, liftedTypeKind)
+hsIfaceTv (KindedTyVar n k) = (rdrNameOcc n, k)
 
 -----------
 hsIfaceFDs :: [([RdrName], [RdrName])] -> [([OccName], [OccName])]
@@ -385,11 +388,11 @@ getMonoBind (L loc (FunBind lf@(L _ f) inf mtchs)) binds
   = go mtchs loc binds
   where
     go mtchs1 loc1 (L loc2 (ValD (FunBind f2 inf2 mtchs2)) : binds)
-       | f == unLoc f2 = go (mtchs2 ++ mtchs1) loc binds
-       -- Remember binds is reversed, so glue mtchs2 on the front
-       -- and use loc2 as the final location
+       | f == unLoc f2 = go (mtchs2++mtchs1) loc binds
        where loc = combineSrcSpans loc1 loc2
-    go mtchs1 loc binds = (L loc (FunBind lf inf mtchs1), binds)
+    go mtchs1 loc binds
+       = (L loc (FunBind lf inf (reverse mtchs1)), binds)
+       -- reverse the final matches, to get it back in the right order
 
 getMonoBind bind binds = (bind, binds)
 
@@ -714,8 +717,6 @@ checkAPat loc e = case e of
    HsType ty          -> return (TypePat ty) 
    _                  -> patFail loc
 
-checkAPat loc _ = patFail loc
-
 checkPatField :: (Located RdrName, LHsExpr RdrName) -> P (Located RdrName, LPat RdrName)
 checkPatField (n,e) = do
   p <- checkLPat e