Cleaned up.

EHC/SVNREVISION

@@ -1 +1 @@
-2128:2129M
+2137M

EHC/src/ehc/Base/Binary.chs

@@ -186,4 +186,3 @@ instance Enum a => Binary a where
   get   = do n <- get
              return (toEnum n)
 
-

EHC/src/ehc/Base/Common.chs

@@ -94,6 +94,9 @@
 %%[9 export(snd3,thd)
 %%]
 
+%%[(8 codegen) import({%{EH}Base.Strictness}) export(module {%{EH}Base.Strictness})
+%%]
+
 %%[20 export(ppCurlysAssocL)
 %%]
 

EHC/src/ehc/Base/Opts.chs

@@ -379,7 +379,7 @@ defaultEHCOpts
       ,  ehcOptPriv             =   False
       ,  ehcOptHsChecksInEH     =   False
 %%[[1
-      ,  ehcOptShowEH           =   False
+      ,  ehcOptShowEH           =   True
 %%][99
       ,  ehcOptShowEH           =   False
 %%]]
@@ -514,7 +514,7 @@ ehcCmdLineOpts
 %%[[1
      ,  Option "p"  ["pretty"]           (OptArg oPretty "hs|eh|ast|-")       "show pretty printed source or EH abstract syntax tree, default=eh, -=off, (downstream only)"
 %%][(8 codegen)
-     ,  Option "p"  ["pretty"]           (OptArg oPretty "hs|eh|ast|ty-")     "show pretty printed source, EH abstract syntax tree or TyCore ast, default=eh, -=off, (downstream only)"
+     ,  Option "p"  ["pretty"]           (OptArg oPretty "hs|eh|ast|ty|-")    "show pretty printed source, EH abstract syntax tree or TyCore ast, default=eh, -=off, (downstream only)"
 %%]]
 %%[[1
      ,  Option "d"  ["debug"]            (NoArg oDebug)                       "show debug information"

EHC/src/ehc/Base/Strictness.chs

@@ -7,7 +7,10 @@
 %%% Strictness Common for HS, EH, Ty, TyCore
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-%%[8 module {%{EH}Base.Strictness} import({%{EH}Base.Common})
+%%[8 module {%{EH}Base.Strictness}
+%%]
+
+%%[(8 codegen) hs import({%{EH}Base.HsName})
 %%]
 
 %%[(20 codegen) hs import(Control.Monad, {%{EH}Base.Binary}, {%{EH}Base.Serialize})

EHC/src/ehc/EH.cag

@@ -72,9 +72,6 @@
 %%[90 hs import({%{EH}Foreign})
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[1 ag import({EH/AbsSyn})
 %%]
 

EHC/src/ehc/EH/AbsSyn.cag

@@ -628,9 +628,6 @@ DERIVING AnnDtMonoRestrict : Eq, Ord
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[1.AllNT
-
-DERIVING AllNT KiExprAnn TyExprAnn ExprAnn PatExprAnn : Show
-
 SET AllNT
     = AllTyExpr AllDecl AllPatExpr AllExpr
 %%[[5

EHC/src/ehc/EH/InferTyExpr.cag

@@ -355,12 +355,12 @@ SEM TyExpr
 ATTR PrExpr [ | | ki: Ty ]
 
 SEM PrExpr
-  | *           lhs  .   ki                  =   kiStar
-  | Class       loc  .   (tkgi_,clKiNmErrs)  =   tyKiGamLookupByNameErr (hsnClass2Kind @nm) @lhs.tyKiGam
-                     .   fo_                 =   fitsIn weakFIOpts defaultFIEnv @lUniq @tyExprs.kiVarMp
-                                                   (@tyExprs.kiL `mkArrow` kiStar) (tkgiKi @tkgi_)
-                lhs  .   kiVarMp             =   foVarMp @fo_ |=> @tyExprs.kiVarMp
-                loc  .   lUniq               :   UNIQUEREF gUniq
+  | *           lhs         .   ki                  =   kiStar
+  | Class       loc         .   (tkgi_,clKiNmErrs)  =   tyKiGamLookupByNameErr (hsnClass2Kind @nm) @lhs.tyKiGam
+                            .   fo_                 =   fitsIn weakFIOpts defaultFIEnv @lUniq @tyExprs.kiVarMp
+                                                          (@tyExprs.kiL `mkArrow` kiStar) (tkgiKi @tkgi_)
+                lhs         .   kiVarMp             =   foVarMp @fo_ |=> @tyExprs.kiVarMp
+                loc         .   lUniq               :   UNIQUEREF gUniq
 %%]
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

EHC/src/ehc/EH/MainAG.cag

@@ -117,9 +117,6 @@
 %%[(100 hmtyinfer) -99.DerivationTree
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%% Import of all separate aspects
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -186,9 +183,6 @@ WRAPPER AGItf
 
 %%[(8 codegen) ag import({EH/ToCore})
 %%]
-
-%%[1 hs import(Debug.Trace)
-%%]
 %%[(8 codegen) ag import({EH/ToTyCore})
 %%]
 

EHC/src/ehc/EHC/CompilePhase/Translations.chs

@@ -7,9 +7,6 @@ Translation to another AST
 %%[8 module {%{EH}EHC.CompilePhase.Translations}
 %%]
 
-%%[1 import(Debug.Trace)
-%%]
-
 -- general imports
 %%[8 import(qualified Data.Map as Map, qualified Data.Set as Set, qualified EH.Util.FastSeq as Seq)
 %%]
@@ -301,20 +298,3 @@ cpTranslateByteCode modNm
         }
 %%]
 
-
-
-%%[1 import(Debug.Trace)
-%%]
-%%[1 import(Debug.Trace)
-%%]
-%%[1 import(Debug.Trace)
-%%]
-%%[1 import(Debug.Trace)
-%%]
-%%[1 import(Debug.Trace)
-%%]
-%%[1 import(Debug.Trace)
-%%]
-%%[1 import(Debug.Trace)
-%%]
-

EHC/src/ehc/EHC/CompileRun.chs

@@ -62,7 +62,7 @@ data EHCompileRunStateInfo
       , crsiHSInh       :: !HSSem.Inh_AGItf                     -- current inh attrs for HS sem
       , crsiEHInh       :: !EHSem.Inh_AGItf                     -- current inh attrs for EH sem
 %%[[(8 codegen)
-	  , crsiCoreInh     :: !Core2GrSem.Inh_CodeAGItf            -- current inh attrs for Core2Grin sem
+      , crsiCoreInh     :: !Core2GrSem.Inh_CodeAGItf            -- current inh attrs for Core2Grin sem
 %%]]
 %%[[20
       , crsiMbMainNm    :: !(Maybe HsName)                      -- name of main module, if any

EHC/src/ehc/HS.cag

@@ -78,9 +78,6 @@
 %%[5 -1.Token hs import({%{EH}Scanner.Token})
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[1 ag import({HS/AbsSyn})
 %%]
 

EHC/src/ehc/HS/MainAG.cag

@@ -38,9 +38,6 @@
 %%[9 hs import({%{EH}Pred})
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[20 hs import(qualified EH.Util.Rel as Rel,{%{EH}Module})
 %%]
 
@@ -50,7 +47,7 @@
 %%[97 hs import(Data.Ratio,{%{EH}Scanner.Common(floatDenot2NomDenom,intDenot2Integer)})
 %%]
 
-%%[5 hs import({%{EH}Base.Debug} as Debug, Debug.Trace)
+%%[97 hs import({%{EH}Base.Debug} as Debug)
 %%]
 
 %%[99 hs import(qualified {%{EH}Base.Pragma} as Pragma)

EHC/src/ehc/HS/Parser.chs

@@ -26,7 +26,7 @@
 %%]
 
 -- debugging
-%%[1 import(EH.Util.Utils, EH.Util.Pretty, Debug.Trace)
+%%[1 import(EH.Util.Utils, EH.Util.Pretty)
 %%]
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -440,14 +440,16 @@ pDeriving
 pConstructor :: HSParser Constructor
 pConstructor
   =   con
-      <**> (   (\ts c -> mkRngNm Constructor_Constructor c ts) <$> pList pTypeBase
+      <**> (   (\ts c -> mkRngNm Constructor_Constructor c ts) <$> pList pTB
 %%]
 %%[7
            <|> pCurlys' ((\fs r c -> mkRngNm Constructor_Record c fs) <$> pList1Sep pCOMMA pFieldDeclaration)
 %%]
 %%[5
            )
-  <|> (\l o r -> Constructor_Infix (mkRange1 o) l (tokMkQName o) r) <$> pType <*> conop <*> pType
+  <|> (\l o r -> Constructor_Infix (mkRange1 o) l (tokMkQName o) r) <$> pT <*> conop <*> pT
+  where pT  = pAnnotatedType pType
+        pTB = pAnnotatedType pTypeBase
 %%]
 
 %%[9
@@ -461,7 +463,7 @@ pContextedConstructor
 pFieldDeclaration :: HSParser FieldDeclaration
 pFieldDeclaration
   = (\vs@(v:_) -> FieldDeclaration_FieldDeclaration (mkRange1 v) (tokMkQNames vs))
-    <$> pList1Sep pCOMMA var <* pDCOLON <*> pType
+    <$> pList1Sep pCOMMA var <* pDCOLON <*> pAnnotatedType pType
 %%]
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -625,9 +627,6 @@ pTypeBase
         <|> (\fs r -> Type_RowSumUpdate r (Type_RowSumEmpty r) fs) <$> pFlds
         )
 %%]]
-%%[[5
-  <|> (\x -> Type_Annotate (mkRange1 x) TypeAnnotation_Strict) <$> pBANG <*> pTypeBase
-%%]]
 %%[[(5 tauphi)
   <|> ((Type_Annotate . mkRange1) <$> pAT)
      <*> (   (TypeAnnotation_AnnotationName . tokMkQName <$> tyvar)
@@ -787,6 +786,12 @@ pTypeLeftHandSide
         pLhsTail =   pList1 pTypePatternBase
 %%]
 
+%%[5
+pAnnotatedType :: HSParser Type -> HSParser Type
+pAnnotatedType pT
+  =   (\x -> Type_Annotate (mkRange1 x) TypeAnnotation_Strict) <$> pBANG <*> pT
+%%]
+
 %%[9.pTypeContextPrefix
 pContextItemsPrefix1 :: HSParser ContextItems
 pContextItemsPrefix1

EHC/src/ehc/HS/Pretty.cag

@@ -182,7 +182,7 @@ SEM Type
     | Parenthesized
         loc         .   pp          =   ppParens @type.pp
     | Annotate
-        loc         .   pp          =   @annotation.ppWrap @type.pp -- "@" >|< @annotation.pp >#< @type.pp
+        loc         .   pp          =   @annotation.ppWrap @type.pp
 %%]
 %%[2
     | Wildcard
@@ -610,7 +610,7 @@ SEM Literal
     | Char
         loc         .   pp          =   pp ("'" ++ @value ++ "'")
 %%]
-%%[[5
+%%[5
     | String
         loc         .   pp          =   pp (show @value)
 %%]

EHC/src/ehc/Ty.cag

@@ -24,9 +24,6 @@ used by EHC. The AST is described in Ty/AbsSyn.
 %%[(1 hmtyinfer || hmtyast) hs import(Data.Maybe, qualified Data.Set as Set, qualified Data.Map as Map) 
 %%]
 
-%%[(2 hmtyinfer || hmtyast) hs import(Debug.Trace) 
-%%]
-
 %%[(2 hmtyinfer || hmtyast) hs export(TyVarId, mkTyVar, mkNewTyVar, mkNewUIDTyVarL, mkNewTyVarL, mkTyFreshProd, mkTyFreshProdFrom, tyEnsureNonAny) 
 %%]
 
@@ -102,9 +99,6 @@ acoreBuiltinUndefined
 %%[(13 hmtyinfer || hmtyast) hs export(PredSeq(..))
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[(20 hmtyinfer || hmtyast) hs import(Control.Monad, {%{EH}Base.Binary}, {%{EH}Base.Serialize})
 %%]
 
@@ -709,60 +703,42 @@ tyAnnDecomposeMk t
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[(4 hmtyinfer || hmtyast) hs export(tyIsVar,tyIsCon)
-tyIsAnn :: Ty -> Bool
-tyIsAnn = isJust . tyMbAnn
-
-ignoreAnn :: (Ty -> a) -> Ty -> a
-ignoreAnn f ty = f (fromMaybe ty (tyMbAnnTy ty))
-
-
 tyIsVar :: Ty -> Bool
-tyIsVar = ignoreAnn (isJust . tyMbVar)
+tyIsVar = isJust . tyMbVar
 
 tyIsCon :: Ty -> Bool
-tyIsCon = ignoreAnn (isJust . tyMbCon)
+tyIsCon = isJust . tyMbCon
 
 tyMbQu :: Ty -> Maybe TyQu
-tyMbQu = ignoreAnn f
-  where
-    f t = case t of
--- =======
--- tyMbQu t
---   = case tyUnAnn t of
--- >>>>>>> .merge-right.r1926
+tyMbQu t
+  = case tyUnAnn t of
 %%[[4
-            Ty_Quant q _ _
-%%][6      
-            Ty_Quant q _ _ _
+      Ty_Quant q _ _
+%%][6
+      Ty_Quant q _ _ _
 %%]]
-              -> Just q
-            _ -> Nothing
+        -> Just q
+      _ -> Nothing
 
 tyIsQu :: Ty -> Bool
-tyIsQu = ignoreAnn (isJust . tyMbQu)
+tyIsQu = isJust . tyMbQu
 %%]
 
 %%[(4_2 hmtyinfer || hmtyast) hs
 tyIsAlts :: Ty -> Bool
-tyIsAlts = ignoreAnn f
-  where
-    f t = case t of {Ty_Alts _ _ -> True; _ -> False}
+tyIsAlts t = case t of {Ty_Alts _ _ -> True; _ -> False}
 %%]
 
 %%[(10 hmtyinfer || hmtyast) hs export(tyIsEmptyRow)
 tyIsEmptyRow :: Ty -> Bool
-tyIsEmptyRow = ignoreAnn f
-  where
-    f = maybe False (== hsnRowEmpty) . tyMbCon
+tyIsEmptyRow = maybe False (== hsnRowEmpty) . tyMbCon
 %%]
 
 Only used to steer PP:
 
 %%[(4 hmtyinfer || hmtyast) hs export(tyIsSimple)
 tyIsSimple :: Ty -> Bool
-tyIsSimple = ignoreAnn f
-  where
-    f t = tyIsVar t || tyIsCon t
+tyIsSimple t = tyIsVar t || tyIsCon t
 %%]
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

EHC/src/ehc/Ty/FitsIn.chs

@@ -32,9 +32,6 @@
 %%[(2 hmtyinfer) import({%{EH}VarMp},{%{EH}Substitutable})
 %%]
 
-%%[(4 hmtyinfer) import(Debug.Trace)
-%%]
-
 %%[(4 hmtyinfer) import({%{EH}Ty.Trf.Instantiate}, {%{EH}Ty.FitsInCommon2}, {%{EH}Base.Opts}, {%{EH}Gam.Full}, Data.Maybe,Data.List as List)
 %%]
 %%[(4 hmtyinfer) import({%{EH}Ty.AppSpineGam})

EHC/src/ehc/Ty/Ftv.cag

@@ -19,9 +19,6 @@ Compute free type variables of a type.
 %%[(4 hmtyinfer || hmtyast) hs import(qualified Data.Map as Map)
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[(2 hmtyinfer || hmtyast).WRAPPER ag import({Ty/AbsSyn})
 WRAPPER
   TyAGItf

EHC/src/ehc/Ty/Pretty.cag

@@ -28,9 +28,6 @@
 %%[(9 hmtyinfer || hmtyast) hs export(ppTyPr)
 %%]
 
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[(1 hmtyinfer || hmtyast).WRAPPER ag import({Ty/AbsSyn},{Ty/CommonAG})
 WRAPPER TyAGItf
 %%]

EHC/src/ehc/Ty/ToTyCore.cag

@@ -26,11 +26,6 @@
 
 %%[(8 codegen) hs import (qualified Data.Set as Set)
 %%]
-%%[(8 codegen) hs import (Debug.Trace)
-%%]
-
-%%[(8 codegen) hs import({%{EH}Base.Strictness})
-%%]
 
 %%[(8 codegen) ag import({Ty/AbsSyn},{Ty/CommonAG})
 WRAPPER TyAGItf

EHC/src/ehc/Ty/Trf/Canonic.cag

@@ -41,9 +41,6 @@ Currently (20090821) only empty implicits \verb@Impls_Tail@ are replaced by
 %%[(9 hmtyinfer) hs import(Data.Maybe,qualified Data.Set as Set)
 %%]
 
-%%[(9 codegen) hs import({%{EH}Base.Strictness})
-%%]
-
 %%[(11 hmtyinfer) hs import({%{EH}Base.Opts},{%{EH}Ty.Trf.BetaReduce})
 %%]