[project @ 2000-12-07 08:17:55 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / OccName.lhs

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index a794b75..805bdf5 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -326,17 +326,9 @@ mkSuperDictSelOcc index cls_occ
 
 \begin{code}
 mkDFunOcc :: EncodedString     -- Typically the class and type glommed together e.g. "OrdMaybe"
-         -> Int                -- Unique to distinguish dfuns which share the previous two
-                               --      eg 3
-         -- The requirement is that the (string,index) pair be unique in this module
+         -> OccName            -- "$fOrdMaybe"
 
-         -> OccName    -- "$fOrdMaybe3"
-
-mkDFunOcc string index
-  = mk_deriv VarName "$f" (show_index ++ string)
-  where
-    show_index | index == 0 = ""
-              | otherwise  = show index
+mkDFunOcc string = mk_deriv VarName "$f" string
 \end{code}
 
 We used to add a '$m' to indicate a method, but that gives rise to bad
@@ -449,8 +441,11 @@ The basic encoding scheme is this.
        fooZ            fooZZ   
        :+              Zczp
        ()              Z0T
-       (,,,,)          Z4T
-
+       (,,,,)          Z4T     5-tuple
+       (#,,,,#)        Z4H     unboxed 5-tuple
+               (NB: the number is one different to the number of 
+               elements.  No real reason except that () is a zero-tuple,
+               while (,) is a 2-tuple.)
 
 \begin{code}
 -- alreadyEncoded is used in ASSERTs to check for encoded
@@ -471,20 +466,23 @@ alreadyEncodedFS fs = alreadyEncoded (_UNPK_ fs)
 
 encode :: UserString -> EncodedString
 encode cs = case maybe_tuple cs of
-               Just n  -> 'Z' : show n ++ "T"          -- Tuples go to Z2T etc
+               Just n  -> n            -- Tuples go to Z2T etc
                Nothing -> go cs
          where
                go []     = []
                go (c:cs) = encode_ch c ++ go cs
 
--- ToDo: Unboxed tuples too, perhaps?
-maybe_tuple ('(' : cs) = check_tuple (0::Int) cs
-maybe_tuple other      = Nothing
+maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
+                                (n, '#' : ')' : cs) -> Just ('Z' : shows n "H")
+                                other               -> Nothing
+maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of
+                                (n, ')' : cs) -> Just ('Z' : shows n "T")
+                                other         -> Nothing
+maybe_tuple other           = Nothing
 
-check_tuple :: Int -> String -> Maybe Int
-check_tuple n (',' : cs) = check_tuple (n+1) cs
-check_tuple n ")"       = Just n
-check_tuple n other      = Nothing
+count_commas :: Int -> String -> (Int, String)
+count_commas n (',' : cs) = count_commas (n+1) cs
+count_commas n cs        = (n,cs)
 
 encodeFS :: UserFS -> EncodedFS
 encodeFS fast_str  | all unencodedChar str = fast_str
@@ -579,6 +577,7 @@ decode_escape (c : rest)
   where
     go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
     go n ('T' : rest)          = '(' : replicate n ',' ++ ')' : decode rest
+    go n ('H' : rest)          = '(' : '#' : replicate n ',' ++ '#' : ')' : decode rest
     go n ('U' : rest)           = chr n : decode rest
     go n other = pprPanic "decode_escape" (ppr n <+> text (c:rest))