[use quoteName mechanism to pre-rename certain names, fix class instance namespace bug
John Meacham <john@repetae.net>**20120206005746
 Ignore-this: 6752c4492fc492a8100cb81f25b0d50
] hunk ./selftest/Makefile 4
-	 -O -package QuickCheck -ignore-package lang  -optc-std=c99 -optc-g
+	 -O -package QuickCheck -ignore-package lang  -optc-std=c99 -optc-g \
+	-XTypeFamilies -XViewPatterns -XUndecidableInstances -XOverlappingInstances \
+	-XRecordWildCards -XRecursiveDo -XTupleSections -XParallelListComp \
+	-XGeneralizedNewtypeDeriving -XScopedTypeVariables -XFlexibleInstances \
+	-XTypeSynonymInstances -XMultiParamTypeClasses -XDeriveDataTypeable \
+	-fglasgow-exts -XNoMonoLocalBinds -XNamedFieldPuns
hunk ./selftest/SelfTest.hs 66
-appendPS :: PackedString -> PackedString
-appendPS = mconcat
+appendPS :: PackedString -> PackedString -> PackedString
+appendPS = mappend
hunk ./selftest/SelfTest.hs 98
-            in  nameType n == t && getModule n == Just (Module a) && getModule un == Nothing && show un == b && show n == (a ++ "." ++ b)
+            in  nameType n == t && getModule n == Just (toModule a) && getModule un == Nothing && show un == b && show n == (a ++ "." ++ b)
hunk ./selftest/SelfTest.hs 100
-    qc "name.nameparts" $ \t a b -> maybe True nn a && nn b ==> nameParts (toName t (a,b)) == (t,a,b)
-    qc "name.nameparts2" $ \t a b -> nn a  && nn b ==> nameParts (toName t (a,b)) == (t,Just a,b)
+    qc "name.nameparts" $ \t a b -> nn b ==> nameParts (toName t (a,b)) == (t,a,b)
+    qc "name.nameparts2" $ \t a b ->  nn b ==> nameParts (toName t (a,b)) == (t,Just a,b)
hunk ./selftest/SelfTest.hs 103
-    qc "name.getModule" $ \ t a b -> nn a && nn b ==> getModule (toName t (a,b)) == Just (Module a)
+    qc "name.getModule" $ \ t a b -> nn a && nn b ==> getModule (toName t (a,b)) == Just (toModule a)
hunk ./selftest/SelfTest.hs 105
-    qc "name.getIdent" $ \t a b -> maybe True nn a && nn b ==> getIdent (toName t (a,b)) == b
-    qc "name.setModule" $ \t a b c -> maybe True nn a && nn b && nn c ==> setModule (Module c) (toName t (a,b)) == toName t (c,b)
+    qc "name.getIdent" $ \t a b ->  nn b ==> getIdent (toName t (a :: Maybe Module,b)) == b
+    qc "name.setModule" $ \t a b c ->  nn b && nn c ==> setModule (toModule c) (toName t (a :: Maybe Module,b)) == toName t (c,b)
hunk ./selftest/SelfTest.hs 108
+    qc "name.quote" $ \ t a b -> nn a && nn b ==> let n = toName t (a,b) in fromQuotedName (quoteName n) == Just n
+    qc "name.noquote" $ \ t a b -> (nn b && (t /= QuotedName)) ==> fromQuotedName (toName t (a :: Maybe Module,b)) == Nothing
hunk ./selftest/SelfTest.hs 174
-
hunk ./selftest/SelfTest.hs 183
-instance Arbitrary Char where
-    arbitrary     = Test.QuickCheck.choose ('\32', '\128')
-    coarbitrary c = variant (fromEnum c `rem` 4)
+instance Arbitrary Module where
+    arbitrary = g `fmap` arbitrary where
+        g xs = f (filter (';' /=) xs)
+        f "" = f "X"
+        f s = toModule s
+
+--instance Arbitrary Char where
+--    arbitrary     = Test.QuickCheck.choose ('\32', '\128')
+--    coarbitrary c = variant (fromEnum c `rem` 4)
hunk ./src/FrontEnd/Exports.hs 26
-    modInfoName :: Module,
-    modInfoDefs :: [(Name,SrcLoc,[Name])],
-    modInfoConsArity :: [(Name,Int)],
-    modInfoExport :: [Name],
-    modInfoImport :: [(Name,[Name])],
-    modInfoHsModule :: HsModule,
+    modInfoName       :: Module,
+    modInfoDefs       :: [(Name,SrcLoc,[Name])],
+    modInfoConsArity  :: [(Name,Int)],
+    modInfoExport     :: [Name],
+    modInfoImport     :: [(Name,[Name])],
+    modInfoHsModule   :: HsModule,
hunk ./src/FrontEnd/Exports.hs 33
-    modInfoOptions :: Opt
+    modInfoOptions    :: Opt
hunk ./src/FrontEnd/Exports.hs 65
-                putStrLn $ " -- Imports: " ++  show (modInfoName m)
-                putStr $ unlines  (map show $ sort (modInfoImport m))
+                putStrLn $ " -- Imports: " ++ show (modInfoName m)
+                putStr $ unlines  (sort $ map show (modInfoImport m))
hunk ./src/FrontEnd/Exports.hs 68
-                putStrLn $ " -- Exports: " ++  show (modInfoName m)
-                mapM_ putStrLn (sort [ show (nameType n) ++ " " ++ show n |  n <- modInfoExport m])
+                putStrLn $ " -- Exports: " ++ show (modInfoName m)
+                mapM_ putStrLn (sort [ show (nameType n) ++ " " ++ show n | n <- modInfoExport m])
hunk ./src/FrontEnd/Rename.hs 50
-newtype ScopeState = ScopeState {
-    unique         :: Int
-    }
+newtype ScopeState = ScopeState Int
hunk ./src/FrontEnd/Rename.hs 107
-    startState = ScopeState { unique = 1 }
+    startState = ScopeState 1
hunk ./src/FrontEnd/Rename.hs 157
---getTypeClassModule :: HsQualType -> Maybe Module
---getTypeClassModule typ =
---   case hsQualTypeType typ of
---      HsTyApp cls arg -> getModule (hsTypeName cls)
---      _ -> error "instance must consist of a type class application"
hunk ./src/FrontEnd/Rename.hs 160
-qualifyMethodName :: Maybe Module -> Name -> Name
-qualifyMethodName Nothing name = name
-qualifyMethodName (Just mod) name = qualifyName mod name
+qualifyMethodName :: Module -> Name -> Name
+qualifyMethodName mod name = quoteName . toName Val $ qualifyName mod name
hunk ./src/FrontEnd/Rename.hs 163
-qualifyInstMethod :: Maybe Module -> HsDecl -> HsDecl
-qualifyInstMethod moduleName decl = case decl of
-    HsPatBind srcLoc HsPVar {hsPatName = name} rhs decls -> HsPatBind srcLoc
-            (HsPVar {hsPatName = qualifyMethodName moduleName name})
-            rhs decls
-    HsFunBind matches -> HsFunBind $ map
-            (\(m@HsMatch { .. }) -> m { hsMatchName = qualifyMethodName moduleName hsMatchName })
-            matches
-    _ -> decl
+qualifyInstMethod :: Maybe Module -> HsDecl -> RM HsDecl
+qualifyInstMethod Nothing decl = rename decl
+qualifyInstMethod (Just moduleName) decl = case decl of
+    HsPatBind srcLoc HsPVar {hsPatName = name} rhs decls -> 
+        rename $ HsPatBind srcLoc (HsPVar {hsPatName = qualifyMethodName moduleName name}) rhs decls
+    HsFunBind matches -> rename $ HsFunBind (map f matches) where
+        f m@HsMatch { hsMatchName } = m { hsMatchName = qualifyMethodName moduleName hsMatchName } 
+    _ -> rename decl
hunk ./src/FrontEnd/Rename.hs 267
-        --updateWithN TypeVal hsQualType $ do
-        --hsQualType' <- renameClassHead hsQualType
-        hsDecls' <- rename $
-            --hsDecls
-           map (qualifyInstMethod (getTypeClassModule classHead')) hsDecls
+        hsDecls' <- mapM (qualifyInstMethod (getTypeClassModule classHead')) hsDecls
hunk ./src/FrontEnd/Rename.hs 625
--- This looks up a replacement name in the subtable.
--- Regardless of whether the name is found, if it's not qualified
--- it will be qualified with the current module's prefix.
hunk ./src/FrontEnd/Rename.hs 628
+    | Just n <- fromQuotedName hsName = return n
hunk ./src/FrontEnd/Rename.hs 639
-            sl <- getSrcLoc
-            warn sl (UndefinedName hsName) err
+            addWarn (UndefinedName hsName) err
hunk ./src/FrontEnd/Rename.hs 642
-            sl <- getSrcLoc
hunk ./src/FrontEnd/Rename.hs 643
-            warn sl (UndefinedName hsName) err
+            addWarn (UndefinedName hsName) err
hunk ./src/FrontEnd/Rename.hs 688
-    getNames x = [x]
+    getNames x | nameType x == QuotedName = []
+               | otherwise = [x]
hunk ./src/FrontEnd/Rename.hs 784
-        u <- gets unique
-        modify (\s -> s {unique = unique s + 1})
+        ScopeState u <- get
+        modify (\(ScopeState s) -> ScopeState (1 + s))
hunk ./src/FrontEnd/Warning.hs 117
-    f UnknownOption {} = True
hunk ./src/Name/Name.hs 28
+    quoteName,
+    fromQuotedName,
hunk ./src/Name/Name.hs 44
+-------------
+-- Name types
+-------------
+
hunk ./src/Name/Name.hs 58
+    | QuotedName
hunk ./src/Name/Name.hs 61
-newtype Name = Name Atom
-    deriving(Ord,Eq,Typeable,Binary,Data,ToAtom,FromAtom)
-
hunk ./src/Name/Name.hs 70
+-----------------
+-- name definiton
+-----------------
+
+newtype Name = Name Atom
+    deriving(Ord,Eq,Typeable,Binary,Data,ToAtom,FromAtom)
+
hunk ./src/Name/Name.hs 79
---isConstructorLike [] = error "isConstructorLike: empty"
hunk ./src/Name/Name.hs 82
+    | nameType name == QuotedName = name
hunk ./src/Name/Name.hs 86
+    | nameType name == QuotedName = name
hunk ./src/Name/Name.hs 89
-{-
-fromTypishHsName, fromValishHsName :: HsName -> Name
-fromTypishHsName name
-    | isUpper x || x `elem` ":(" = toName TypeConstructor name
-    | otherwise = toName TypeVal name
-    where (x:_) = (hsIdentString . hsNameIdent  $ name)
-fromValishHsName name
-    | isUpper x || x `elem` ":(" = toName DataConstructor name
-    | otherwise = toName Val name
-    where (x:_) = (hsIdentString . hsNameIdent  $ name)
-    -}
hunk ./src/Name/Name.hs 115
---instance ToName (Maybe String,String) where
---    toName nt (Just m,i) = createName nt m i
---    toName nt (Nothing,i) = createUName nt i
---    fromName n = case nameParts n of
---        (nt,a,b) -> (nt,(a,b))
-
hunk ./src/Name/Name.hs 163
-nameType (Name a) = toEnum $ fromIntegral ( a `unsafeByteIndex` 0)  - ord '1'
+nameType (Name a) = toEnum $ fromIntegral ( a `unsafeByteIndex` 0) - ord '1'
hunk ./src/Name/Name.hs 167
---nameName (Name a) = f $ tail (fromAtom a) where
---    f (';':xs) = UnQual $ HsIdent xs
---    f xs | (a,_:b) <- span (/= ';') xs  = Qual (Module a) (HsIdent b)
---    f _ = error $ "invalid Name: " ++ (show $ (fromAtom a :: String))
hunk ./src/Name/Name.hs 176
+        (QuotedName,Nothing,b) -> showChar '`' . showString b
hunk ./src/Name/Name.hs 191
-mainModule = Module "Main@"
-primModule = Module "Prim@"
-preludeModule = Module "Prelude"
-
-toModule :: String -> Module
-toModule s = Module $ toAtom s
-
hunk ./src/Name/Name.hs 193
+type Class = Name
+
+-------------
+-- Quoting
+-------------
+
+quoteName :: Name -> Name
+quoteName (Name n) = createUName QuotedName (fromAtom n)
+fromQuotedName :: Name -> Maybe Name
+fromQuotedName n = case nameParts n of
+    (QuotedName,Nothing,s) -> Just $ Name (toAtom s)
+    _ -> Nothing
+
+--------------
+-- Modules
+--------------
hunk ./src/Name/Name.hs 213
--- useful synonym
-type Class = Name
hunk ./src/Name/Name.hs 221
+
+mainModule = Module "Main@"
+primModule = Module "Prim@"
+preludeModule = Module "Prelude"
+
+toModule :: String -> Module
+toModule s = Module $ toAtom s
+