[code cleanups, used located in hstype, use packedstring for filename.
John Meacham <john@repetae.net>**20120201132053
 Ignore-this: d679fc0c77d4750e21e37df90f397149
] hunk ./Makefile.am 57
-	-fglasgow-exts -XNoMonoLocalBinds
+	-fglasgow-exts -XNoMonoLocalBinds -XNamedFieldPuns
hunk ./src/FrontEnd/Diagnostic.hs 29
-import FrontEnd.SrcLoc
hunk ./src/FrontEnd/Diagnostic.hs 30
---------------------------------------------------------------------------------
+import FrontEnd.SrcLoc
+import PackedString
hunk ./src/FrontEnd/Diagnostic.hs 93
-                    -> "on line " ++ show line ++ " in " ++ fn
+                    -> "on line " ++ show line ++ " in " ++ unpackPS fn
hunk ./src/FrontEnd/HsParser.y 477
-    : srcloc atype '::' kind { HsTyExpKind { hsTySrcLoc = $1, hsTyType = $2, hsTyKind = $4 } }
-    | type                  { $1 }
+    : srcloc atype '::' kind srcloc { HsTyExpKind { hsTyLType = located ($1,$5) $2, hsTyKind = $4 } }
+    | type                          { $1 }
hunk ./src/FrontEnd/HsPretty.hs 409
-ppHsTypePrec _ HsTyExpKind { hsTyType = t, hsTyKind = k } = do
+ppHsTypePrec _ HsTyExpKind { hsTyLType = Located _ t, hsTyKind = k } = do
hunk ./src/FrontEnd/HsSyn.hs 83
-    srcLoc HsTypeDecl	  { hsDeclSrcLoc  = sl } = sl
-    srcLoc HsDeclDeriving { hsDeclSrcLoc  = sl } = sl
-    srcLoc HsSpaceDecl    { hsDeclSrcLoc  = sl } = sl
-    srcLoc HsDataDecl	  { hsDeclSrcLoc  = sl } = sl
+    srcLoc HsTypeDecl	  { hsDeclSrcLoc = sl } = sl
+    srcLoc HsTypeFamilyDecl { hsDeclSrcLoc = sl } = sl
+    srcLoc HsDeclDeriving { hsDeclSrcLoc = sl } = sl
+    srcLoc HsSpaceDecl    { hsDeclSrcLoc = sl } = sl
+    srcLoc HsDataDecl	  { hsDeclSrcLoc = sl } = sl
hunk ./src/FrontEnd/HsSyn.hs 129
-        hsDeclSrcLoc :: SrcLoc,
-        hsDeclData :: Bool,
-        hsDeclName :: HsName,
-        hsDeclTArgs :: [HsType],
+        hsDeclSrcLoc  :: SrcLoc,
+        hsDeclData    :: !Bool,
+        hsDeclName    :: HsName,
+        hsDeclTArgs   :: [HsType],
hunk ./src/FrontEnd/HsSyn.hs 137
-        hsDeclName :: HsName,
-        hsDeclTArgs :: [HsType],
-        hsDeclType :: HsType
+        hsDeclName   :: HsName,
+        hsDeclTArgs   :: [HsType],
+        hsDeclType   :: HsType
hunk ./src/FrontEnd/HsSyn.hs 142
-        hsDeclKindDecl :: Bool,
-        hsDeclSrcLoc :: SrcLoc,
-        hsDeclContext :: HsContext,
-        hsDeclName :: HsName,
-        hsDeclArgs :: [HsName],
-        hsDeclCons :: [HsConDecl],
-        hsDeclHasKind :: Maybe HsKind,
+        hsDeclKindDecl :: !Bool,
+        hsDeclSrcLoc   :: SrcLoc,
+        hsDeclContext  :: HsContext,
+        hsDeclName     :: HsName,
+        hsDeclArgs     :: [Name],
+        hsDeclCons     :: [HsConDecl],
+        hsDeclHasKind  :: Maybe HsKind,
hunk ./src/FrontEnd/HsSyn.hs 152
-        hsDeclSrcLoc :: SrcLoc,
+        hsDeclSrcLoc  :: SrcLoc,
hunk ./src/FrontEnd/HsSyn.hs 154
-        hsDeclName :: HsName,
-        hsDeclArgs :: [HsName],
-        hsDeclCon :: HsConDecl,
+        hsDeclName    :: HsName,
+        hsDeclArgs    :: [Name],
+        hsDeclCon     :: HsConDecl,
hunk ./src/FrontEnd/HsSyn.hs 161
-        hsDeclAssoc :: HsAssoc,
-        hsDeclInt :: !Int,
-        hsDeclNames :: [HsName]
+        hsDeclAssoc  :: HsAssoc,
+        hsDeclInt    :: !Int,
+        hsDeclNames  :: [HsName]
hunk ./src/FrontEnd/HsSyn.hs 166
-        hsDeclSrcLoc :: SrcLoc,
+        hsDeclSrcLoc   :: SrcLoc,
hunk ./src/FrontEnd/HsSyn.hs 168
-        hsDeclDecls :: [HsDecl]
+        hsDeclDecls    :: [HsDecl]
hunk ./src/FrontEnd/HsSyn.hs 171
-        hsDeclSrcLoc :: SrcLoc,
-        hsDeclName :: HsName,
+        hsDeclSrcLoc   :: SrcLoc,
+        hsDeclName     :: HsName,
hunk ./src/FrontEnd/HsSyn.hs 179
-        hsDeclSrcLoc :: SrcLoc,
+        hsDeclSrcLoc   :: SrcLoc,
hunk ./src/FrontEnd/HsSyn.hs 181
-        hsDeclDecls :: [HsDecl]
+        hsDeclDecls    :: [HsDecl]
hunk ./src/FrontEnd/HsSyn.hs 215
-        hsDeclUniq :: (Module,Int),
+        hsDeclUniq   :: (Module,Int),
hunk ./src/FrontEnd/HsSyn.hs 217
-        hsDeclBool :: Bool,
-        hsDeclName :: HsName,
-        hsDeclType :: HsType
+        hsDeclBool   :: Bool,
+        hsDeclName   :: HsName,
+        hsDeclType   :: HsType
hunk ./src/FrontEnd/HsSyn.hs 222
-        hsDeclSrcLoc :: SrcLoc,
+        hsDeclSrcLoc    :: SrcLoc,
hunk ./src/FrontEnd/HsSyn.hs 229
-    hsRuleUniq :: (Module,Int),
-    hsRuleSrcLoc :: SrcLoc,
-    hsRuleIsMeta :: Bool,
-    hsRuleString :: String,
-    hsRuleFreeVars :: [(HsName,Maybe HsType)],
-    hsRuleLeftExpr :: HsExp,
+    hsRuleUniq      :: (Module,Int),
+    hsRuleSrcLoc    :: SrcLoc,
+    hsRuleIsMeta    :: Bool,
+    hsRuleString    :: String,
+    hsRuleFreeVars  :: [(HsName,Maybe HsType)],
+    hsRuleLeftExpr  :: HsExp,
hunk ./src/FrontEnd/HsSyn.hs 244
-    hsMatchName :: HsName,
-    hsMatchPats :: [HsPat],
-    hsMatchRhs :: HsRhs,
+    hsMatchName   :: HsName,
+    hsMatchPats   :: [HsPat],
+    hsMatchRhs    :: HsRhs,
hunk ./src/FrontEnd/HsSyn.hs 252
-	 = HsConDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclExists :: [HsTyVarBind], hsConDeclName :: HsName, hsConDeclConArg :: [HsBangType] }
-	 | HsRecDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclExists :: [HsTyVarBind], hsConDeclName :: HsName, hsConDeclRecArg :: [([HsName],HsBangType)] }
+    = HsConDecl {
+        hsConDeclSrcLoc :: SrcLoc,
+        hsConDeclExists :: [HsTyVarBind],
+        hsConDeclName :: HsName,
+        hsConDeclConArg :: [HsBangType]
+        }
+    | HsRecDecl {
+        hsConDeclSrcLoc :: SrcLoc,
+        hsConDeclExists :: [HsTyVarBind],
+        hsConDeclName :: HsName,
+        hsConDeclRecArg :: [([HsName],HsBangType)]
+        }
hunk ./src/FrontEnd/HsSyn.hs 289
+type LHsType = Located HsType
+
hunk ./src/FrontEnd/HsSyn.hs 292
-	 = HsTyFun   HsType HsType
-	 | HsTyTuple [HsType]
-	 | HsTyUnboxedTuple [HsType]
-	 | HsTyApp   HsType HsType
-	 | HsTyVar   { hsTypeName :: HsName }
-	 | HsTyCon   { hsTypeName :: HsName }
-         | HsTyForall {
-            hsTypeVars :: [HsTyVarBind],
-            hsTypeType :: HsQualType }
-         | HsTyExists {
-            hsTypeVars :: [HsTyVarBind],
-            hsTypeType :: HsQualType }
-         | HsTyExpKind {
-             hsTySrcLoc :: SrcLoc,
-             hsTyType :: HsType,
-             hsTyKind :: HsKind
-             }
-         -- the following are used internally
-         | HsTyAssoc
-         | HsTyEq HsType HsType
+    = HsTyFun HsType HsType
+    | HsTyTuple [HsType]
+    | HsTyUnboxedTuple [HsType]
+    | HsTyApp HsType HsType
+    | HsTyVar { hsTypeName :: HsName }
+    | HsTyCon { hsTypeName :: HsName }
+    | HsTyForall {
+       hsTypeVars :: [HsTyVarBind],
+       hsTypeType :: HsQualType }
+    | HsTyExists {
+       hsTypeVars :: [HsTyVarBind],
+       hsTypeType :: HsQualType }
+    | HsTyExpKind {
+        hsTyLType :: LHsType,
+        hsTyKind :: HsKind }
+    | HsTyStrictType {
+        hsTyStrict :: !Bool,
+        hsTyLType :: LHsType
+    }
+    -- the following is used internally
+    | HsTyAssoc
+    | HsTyEq HsType HsType
hunk ./src/FrontEnd/KindInfer.hs 1
-
hunk ./src/FrontEnd/KindInfer.hs 34
+import FrontEnd.SrcLoc
hunk ./src/FrontEnd/KindInfer.hs 48
-
hunk ./src/FrontEnd/KindInfer.hs 71
-
-
hunk ./src/FrontEnd/KindInfer.hs 80
-
hunk ./src/FrontEnd/KindInfer.hs 95
-
hunk ./src/FrontEnd/KindInfer.hs 123
-
hunk ./src/FrontEnd/KindInfer.hs 127
-
hunk ./src/FrontEnd/KindInfer.hs 130
-
hunk ./src/FrontEnd/KindInfer.hs 181
-
hunk ./src/FrontEnd/KindInfer.hs 187
-
hunk ./src/FrontEnd/KindInfer.hs 196
-
hunk ./src/FrontEnd/KindInfer.hs 222
-
hunk ./src/FrontEnd/KindInfer.hs 230
-
hunk ./src/FrontEnd/KindInfer.hs 255
-
hunk ./src/FrontEnd/KindInfer.hs 291
-kiType k HsTyExpKind { hsTyType = t, hsTyKind = ek } = do
+kiType k HsTyExpKind { hsTyLType = Located _ t, hsTyKind = ek } = do
hunk ./src/FrontEnd/KindInfer.hs 305
-
-
hunk ./src/FrontEnd/KindInfer.hs 364
-
hunk ./src/FrontEnd/KindInfer.hs 427
-
hunk ./src/FrontEnd/KindInfer.hs 449
-
hunk ./src/FrontEnd/KindInfer.hs 457
-aHsTypeToType kt HsTyExpKind { hsTyType = t } = aHsTypeToType kt t
+aHsTypeToType kt HsTyExpKind { hsTyLType = Located _ t } = aHsTypeToType kt t
hunk ./src/FrontEnd/KindInfer.hs 462
-
hunk ./src/FrontEnd/KindInfer.hs 486
-
hunk ./src/FrontEnd/KindInfer.hs 493
-
-
hunk ./src/FrontEnd/KindInfer.hs 502
-
hunk ./src/FrontEnd/Lexer.hs 34
+import PackedString
hunk ./src/FrontEnd/Lexer.hs 200
- ( "hiding", 	KW_Hiding )
+ ( "hiding", 	KW_Hiding ),
+ ( "forall",    KW_Forall )
hunk ./src/FrontEnd/Lexer.hs 303
-        Just fn -> setSrcLoc sl' { srcLocFileName = fn }
+        Just fn -> setSrcLoc sl' { srcLocFileName = packString fn }
hunk ./src/FrontEnd/ParseMonad.hs 30
-import qualified Data.Set as Set
-
hunk ./src/FrontEnd/ParseMonad.hs 33
+import qualified Control.Applicative as A
+import qualified Data.Set as Set
+
hunk ./src/FrontEnd/ParseMonad.hs 39
-import qualified Control.Applicative as A
+import PackedString
hunk ./src/FrontEnd/ParseMonad.hs 139
-		srcLocFileName = parseFilename mode,
+		srcLocFileName = packString $ parseFilename mode,
hunk ./src/FrontEnd/Rename.hs 260
+    rename HsTypeFamilyDecl { .. } = do
+        withSrcLoc hsDeclSrcLoc $ do
+        hsDeclCName <- renameTypeName hsDeclName
+        updateWith (Set.toList $ freeVars hsDeclTArgs :: [Name]) $ do
+            hsDeclTArgs <- rename hsDeclTArgs
+            return HsTypeFamilyDecl { .. }
hunk ./src/FrontEnd/Rename.hs 372
-    rename (HsQualType hsContext hsType) = HsQualType <$> rename hsContext <*> rename hsType
+    rename (HsQualType hsContext hsType) =
+        HsQualType <$> rename hsContext <*> rename hsType
hunk ./src/FrontEnd/Rename.hs 383
-    rename cd@(HsConDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclConArg = hsBangTypes }) = do
-        withSrcLoc srcLoc $ do
+    --rename cd@(HsConDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclConArg = hsBangTypes }) = do
+    rename cd@(HsConDecl {  hsConDeclName = hsName, hsConDeclConArg = hsBangTypes, .. }) = do
+        withSrcLoc hsConDeclSrcLoc $ do
hunk ./src/FrontEnd/Rename.hs 387
-        updateWith  (map (toName TypeVal . hsTyVarBindName) (hsConDeclExists cd)) $ do
-        es <- rename (hsConDeclExists cd)
+        updateWith  (map (toName TypeVal . hsTyVarBindName) hsConDeclExists) $ do
+        hsConDeclExists <- rename hsConDeclExists
hunk ./src/FrontEnd/Rename.hs 390
-        return cd { hsConDeclName = hsName', hsConDeclConArg = hsBangTypes', hsConDeclExists = es }
+        return cd { hsConDeclName = hsName', hsConDeclConArg = hsBangTypes', hsConDeclExists }
hunk ./src/FrontEnd/Rename.hs 878
---    deName mod p 
+--    deName mod p
hunk ./src/FrontEnd/SrcLoc.hs 8
-
hunk ./src/FrontEnd/SrcLoc.hs 11
-data SrcLoc = SrcLoc { srcLocFileName :: String, srcLocLine :: {-# UNPACK #-} !Int, srcLocColumn :: {-# UNPACK #-}  !Int}
+import PackedString
+
+data SrcLoc = SrcLoc { srcLocFileName :: PackedString, srcLocLine :: {-# UNPACK #-} !Int, srcLocColumn :: {-# UNPACK #-}  !Int}
hunk ./src/FrontEnd/SrcLoc.hs 19
-    {-! derive: update !-}
+    {-! derive: update, Binary !-}
hunk ./src/FrontEnd/SrcLoc.hs 21
-bogusASrcLoc = SrcLoc "bogus#" (-1) (-1)
+bogusASrcLoc = SrcLoc (packString "bogus#") (-1) (-1)
hunk ./src/FrontEnd/SrcLoc.hs 57
+    {-! derive: Binary !-}
hunk ./src/FrontEnd/SrcLoc.hs 107
-    show (SrcLoc fn l c) = fn ++ f l ++ f c where
+    show (SrcLoc fn l c) = unpackPS fn ++ f l ++ f c where
hunk ./src/FrontEnd/Syn/Traverse.hs 5
+import qualified Data.Traversable as T
hunk ./src/FrontEnd/Syn/Traverse.hs 171
-traverseHsType _ HsTyAssoc = return HsTyAssoc
-traverseHsType f x@HsTyExpKind { hsTyType = t } = f t >>= \t' -> return x { hsTyType = t' }
+traverseHsType f HsTyExpKind { .. } = do
+    hsTyLType <- T.mapM f hsTyLType
+    return HsTyExpKind { .. }
hunk ./src/FrontEnd/Syn/Traverse.hs 175
+traverseHsType f (HsTyStrictType a b ) = return HsTyStrictType `ap` return a `ap` T.mapM f b
hunk ./src/FrontEnd/Tc/Main.hs 195
-tiExpr expr@(HsExpTypeSig sloc e qt) typ = 
+tiExpr expr@(HsExpTypeSig sloc e qt) typ =
hunk ./src/FrontEnd/Tc/Main.hs 277
-tiExpr (HsIf e e1 e2) typ = do 
+tiExpr (HsIf e e1 e2) typ = do
hunk ./src/FrontEnd/TypeSyns.hs 113
-renameHsDecl dl@HsDataDecl { hsDeclContext = hsContext, hsDeclName = hsName, hsDeclArgs = hsNames1, hsDeclCons = hsConDecls  } subTable = do
-    hsName' <- renameTypeHsName hsName subTable
+renameHsDecl dl@HsDataDecl { hsDeclContext = hsContext, hsDeclCons = hsConDecls  } subTable = do
hunk ./src/FrontEnd/TypeSyns.hs 115
-    hsNames1' <- renameHsNames hsNames1 subTable
hunk ./src/FrontEnd/TypeSyns.hs 116
-    -- don't need to rename the hsNames2 as it is just a list of TypeClasses
-    return dl { hsDeclContext = hsContext', hsDeclName = hsName', hsDeclArgs = hsNames1', hsDeclCons = hsConDecls' }
+    return dl { hsDeclContext = hsContext', hsDeclCons = hsConDecls' }
hunk ./src/FrontEnd/TypeSyns.hs 124
-    hsNames1' <- renameHsNames hsNames1 subTable
hunk ./src/FrontEnd/TypeSyns.hs 125
-    return (HsNewTypeDecl srcLoc hsContext' hsName hsNames1' hsConDecl' hsNames2)
+    return (HsNewTypeDecl srcLoc hsContext' hsName hsNames1 hsConDecl' hsNames2)
hunk ./src/FrontEnd/TypeSyns.hs 199
-renameHsType' dovar t st = pp (rt t st) where
-    rt :: HsType -> SubTable -> ScopeSM (HsType)
-    rt (HsTyFun hsType1 hsType2) subTable = do
-        hsType1' <- rt hsType1 subTable
-        hsType2' <- rt hsType2 subTable
+renameHsType' dovar t st = pp (rt t) where
+    rt :: HsType -> ScopeSM HsType
+    rt (HsTyFun hsType1 hsType2) = do
+        hsType1' <- rt hsType1
+        hsType2' <- rt hsType2
hunk ./src/FrontEnd/TypeSyns.hs 205
-    rt (HsTyTuple hsTypes) subTable = do
-        hsTypes' <- mapRename rt hsTypes subTable
+    rt (HsTyTuple hsTypes) = do
+        hsTypes' <- mapM rt hsTypes
hunk ./src/FrontEnd/TypeSyns.hs 208
-    rt (HsTyUnboxedTuple hsTypes) subTable = do
-        hsTypes' <- mapRename rt hsTypes subTable
+    rt (HsTyUnboxedTuple hsTypes) = do
+        hsTypes' <- mapM rt hsTypes
hunk ./src/FrontEnd/TypeSyns.hs 211
-    rt (HsTyApp hsType1 hsType2) subTable = do
-        hsType1' <- rt hsType1 subTable
-        hsType2' <- rt hsType2 subTable
+    rt (HsTyApp hsType1 hsType2) = do
+        hsType1' <- rt hsType1
+        hsType2' <- rt hsType2
hunk ./src/FrontEnd/TypeSyns.hs 215
-    rt (HsTyVar hsName) subTable | dovar = do
-        hsName' <- renameTypeHsName hsName subTable
+    rt (HsTyVar hsName) | dovar = do
+        hsName' <- renameTypeHsName hsName ()
hunk ./src/FrontEnd/TypeSyns.hs 218
-    rt v@(HsTyVar _) _   = return v
-    rt (HsTyCon hsName) subTable = do
-        hsName' <- renameTypeHsName hsName subTable
+    rt (HsTyCon hsName) = do
+        hsName' <- renameTypeHsName hsName  ()
hunk ./src/FrontEnd/TypeSyns.hs 221
-    rt (HsTyForall ts v) subTable  = do
-        v <- renameHsQualType v subTable
+    rt (HsTyForall ts v) = do
+        v <- renameHsQualType v  ()
hunk ./src/FrontEnd/TypeSyns.hs 224
-    rt (HsTyExists ts v) subTable  = do
-        v <- renameHsQualType v subTable
+    rt (HsTyExists ts v) = do
+        v <- renameHsQualType v  ()
hunk ./src/FrontEnd/TypeSyns.hs 227
-    rt (HsTyAssoc) subTable = return HsTyAssoc
-    rt (HsTyEq a b) subTable = return HsTyEq `ap` (flip rt subTable a) `ap` (flip rt subTable b)
-    rt HsTyExpKind {} _subTable = error "cannot rename HsTyExpKind TypeSyns"
+ --   rt (HsTyAssoc) = return HsTyAssoc
+--    rt (HsTyEq a b) = return HsTyEq `ap` (flip rt a) `ap` (flip rt b)
+ --   rt HsTyExpKind {} _subTable = error "cannot rename HsTyExpKind TypeSyns"
+    rt ty = traverseHsType rt ty
hunk ./src/FrontEnd/Warning.hs 22
+import PackedString
hunk ./src/FrontEnd/Warning.hs 85
-                warnType = t ,warnMessage = m } = putErrLn (fn ++ ": "  ++ msg t m)
+                warnType = t ,warnMessage = m } = putErrLn (unpackPS fn ++ ": "  ++ msg t m)
hunk ./src/FrontEnd/Warning.hs 87
-                warnType = t ,warnMessage = m } = putErrLn (fn ++ ":" ++ pad 3 (show l) ++  " - "  ++ msg t m)
+                warnType = t ,warnMessage = m } = putErrLn (unpackPS fn ++ ":" ++ pad 3 (show l) ++  " - "  ++ msg t m)
hunk ./src/FrontEnd/Warning.hs 118
-         (fn ++ ":" ++ pad 3 (show l) ++  " - "  ++ msg t m)
+         (unpackPS fn ++ ":" ++ pad 3 (show l) ++  " - "  ++ msg t m)
hunk ./src/Ho/ReadSource.hs 29
+import PackedString
hunk ./src/Ho/ReadSource.hs 73
-                        | 'n':'o':ll <- ll, Just lo <- Map.lookup ll langmap = f ls pfs (nfs Set.\\ lo) us
+                        | 'n':'o':ll <- ll, Just lo <- Map.lookup ll langmap = f ls pfs (nfs `Set.union` lo) us
hunk ./src/Ho/ReadSource.hs 124
-        warn (bogusASrcLoc { srcLocFileName = fn }) "unknown-option" "Unknown OPTIONS pragma"
+        warn (bogusASrcLoc { srcLocFileName = packString fn }) "unknown-option" "Unknown OPTIONS pragma"
hunk ./src/PackedString.hs 9
+import Data.Generics
hunk ./src/PackedString.hs 11
-import Data.Typeable
+import GHC.Exts
hunk ./src/PackedString.hs 16
-    deriving(Typeable,Binary,Eq,Ord,Monoid)
+    deriving(Typeable,Binary,Eq,Ord,Monoid,Data)
hunk ./src/PackedString.hs 27
+
+instance IsString PackedString where
+    fromString = packString