Create showName, which takes an additional prefix-context argument
authorStefan O'Rear <stefanor@cox.net>
Sun, 1 Apr 2007 16:46:35 +0000 (16:46 +0000)
committerStefan O'Rear <stefanor@cox.net>
Sun, 1 Apr 2007 16:46:35 +0000 (16:46 +0000)
libraries/template-haskell/Language/Haskell/TH/Syntax.hs

index d376a37..5485bc9 100644 (file)
@@ -431,20 +431,36 @@ instance Ord NameFlavour where
                                            (m1 `compare` m2) 
   (NameG _ _ _)    `compare` other       = GT
 
-instance Show Name where
-  show (Name occ NameS) = occString occ
-
+showName :: Bool -> Name -> String
+showName pflg nm | pf && pnam = nms
+                 | pf         = "(" ++ nms ++ ")"
+                 | pnam       = "`" ++ nms ++ "`"
+                 | otherwise  = nms
+    where
        -- For now, we make the NameQ and NameG print the same, even though
        -- NameQ is a qualified name (so what it means depends on what the
        -- current scope is), and NameG is an original name (so its meaning
        -- should be independent of what's in scope.
        -- We may well want to distinguish them in the end.
-  show (Name occ (NameQ m))      = modString m ++ "." ++ occString occ
-  show (Name occ (NameG ns p m)) = modString m ++ "." ++ occString occ
+       -- Ditto NameU and NameL
+        nms = case nm of
+                    Name occ NameS          -> occString occ
+                    Name occ (NameQ m)      -> modString m ++ "." ++ occString occ
+                    Name occ (NameG ns p m) -> modString m ++ "." ++ occString occ
+                    Name occ (NameU u)      -> occString occ ++ "_" ++ show (I# u)
+                    Name occ (NameL u)      -> occString occ ++ "_" ++ show (I# u)
+
+        pnam = classify nms
+
+        classify "" = False -- shouldn't happen; . operator is handled below
+        classify (x:xs) | isAlpha x || x == '_' =
+                            case dropWhile (/='.') xs of
+                                  (_:xs') -> classify xs'
+                                  []      -> True
+                        | otherwise = False
 
-       -- Ditto NameU and NameL  
-  show (Name occ (NameU u)) = occString occ ++ "_" ++ show (I# u)
-  show (Name occ (NameL u)) = occString occ ++ "_" ++ show (I# u)
+instance Show Name where
+  show = showName True
 
 
 --     Tuple data and type constructors