put coqPassCoreToCore on the CoreM monad, greatly simplify Desugar.lhs

[ghc-hetmet.git] / compiler / hsSyn / HsTypes.lhs

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 38608a4..75e6c23 100644 (file)
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -26,6 +26,7 @@ module HsTypes (
        hsTyVarKind, hsTyVarNameKind,
        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
        splitHsInstDeclTy, splitHsFunType,
+       splitHsAppTys, mkHsAppTys,
        
        -- Type place holder
        PostTcType, placeHolderType, PostTcKind, placeHolderKind,
@@ -155,6 +156,8 @@ data HsType name
 
   | HsPArrTy           (LHsType name)  -- Elem. type of parallel array: [:t:]
 
+  | HsModalBoxType     name (LHsType name)     -- modal types; first argument is the environment classifier
+
   | HsTupleTy          Boxity
                        [LHsType name]  -- Element types (length gives arity)
 
@@ -168,8 +171,6 @@ data HsType name
        -- interface files smaller), so when printing a HsType we may need to
        -- add parens.  
 
-  | HsNumTy             Integer                -- Generics only
-
   | HsPredTy           (HsPred name)   -- Only used in the type of an instance
                                        -- declaration, eg.  Eq [a] -> Eq a
                                        --                             ^^^^
@@ -294,6 +295,19 @@ replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
 
 
 \begin{code}
+splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
+splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
+splitHsAppTys f                  as = (f,as)
+
+mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
+mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
+mkHsAppTys fun_ty (arg_ty:arg_tys)
+  = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
+  where
+    mk_app fun arg = HsAppTy (noLoc fun) arg   
+       -- Add noLocs for inner nodes of the application; 
+       -- they are never used 
+
 splitHsInstDeclTy 
     :: OutputableBndr name
     => HsType name 
@@ -439,8 +453,8 @@ ppr_mono_ty _    (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
 ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
 ppr_mono_ty _    (HsListTy ty)      = brackets (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty _    (HsPArrTy ty)      = pabrackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty _    (HsModalBoxType ecn ty) = ppr_modalBoxType (ppr ecn) (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty _    (HsPredTy pred)     = ppr pred
-ppr_mono_ty _    (HsNumTy n)         = integer n  -- generics only
 ppr_mono_ty _    (HsSpliceTy s _ _)  = pprSplice s
 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
 
@@ -476,6 +490,10 @@ ppr_fun_ty ctxt_prec ty1 ty2
 --------------------------
 pabrackets :: SDoc -> SDoc
 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
+
+ppr_modalBoxType :: SDoc -> SDoc -> SDoc
+ppr_modalBoxType ecn p = ptext (sLit "<[") <> p <> ptext (sLit "]>@") <> ecn 
+
 \end{code}