X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FOccName.lhs;h=2de02e760fcbb3ccfaca34343ae59a08565175c1;hb=b0306f6e4545478d031ff619ee7c666cc1d8d381;hp=50b39fe7f004ab95d866f4e24f01c61a884dac03;hpb=0e2c58247410a9317064bbddbf294644c0300b14;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs index 50b39fe..2de02e7 100644 --- a/ghc/compiler/basicTypes/OccName.lhs +++ b/ghc/compiler/basicTypes/OccName.lhs @@ -753,6 +753,19 @@ decode_num_esc d rest go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest go n ('U' : rest) = chr n : decode rest go n other = pprPanic "decode_num_esc" (ppr n <+> text other) + +decode_tuple :: Char -> EncodedString -> UserString +decode_tuple d rest + = go (digitToInt d) rest + where + -- NB. recurse back to decode after decoding the tuple, because + -- the tuple might be embedded in a longer name. + go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest + go 0 ('T':rest) = "()" ++ decode rest + go n ('T':rest) = '(' : replicate (n-1) ',' ++ ")" ++ decode rest + go 1 ('H':rest) = "(# #)" ++ decode rest + go n ('H':rest) = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ decode rest + go n other = pprPanic "decode_tuple" (ppr n <+> text other) \end{code} @@ -793,17 +806,6 @@ count_commas n cs = (n,cs) \end{code} \begin{code} -decode_tuple :: Char -> EncodedString -> UserString -decode_tuple d rest - = go (digitToInt d) rest - where - go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest - go 0 ['T'] = "()" - go n ['T'] = '(' : replicate (n-1) ',' ++ ")" - go 1 ['H'] = "(# #)" - go n ['H'] = '(' : '#' : replicate (n-1) ',' ++ "#)" - go n other = pprPanic "decode_tuple" (ppr n <+> text other) - mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName mkTupleOcc ns bx ar = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))