TranslateId.hs revision 3f69b6948966979163bdfe8331c38833d5d90ecd
4752N/A{- |
4752N/AModule : $Header$
4752N/ACopyright : (c) Katja Groeblinghoff, C.Maeder, Uni Bremen 2003 - 2004
4752N/ALicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
4752N/A
4752N/AMaintainer : Christian.Maeder@dfki.de
4752N/AStability : experimental
4752N/APortability : portable
4752N/A
4752N/ATranslation of identifiers to Haskell.
6982N/A-}
6982N/A
4752N/Amodule Haskell.TranslateId (IdCase(..), translateIdWithType) where
4752N/A
4752N/Aimport Common.Id
4752N/Aimport qualified Data.Map as Map
6982N/Aimport qualified Data.Set as Set
6982N/Aimport Data.Char
6982N/A
6982N/A-- | Converts an identifier to a valid lower or upper case Haskell name
4752N/AtranslateIdWithType :: IdCase -> Id -> String
4752N/AtranslateIdWithType ty i =
4752N/A let s = translateId i ""
4752N/A c = if null s then error "translateIdWithTyper" else head s
4752N/A in case ty of
5821N/A UpperId ->
4752N/A if isLower c || c == '_' || isDigit c
4752N/A then "A__" ++ s else s
4752N/A LowerId ->
4752N/A if isUpper c || c == '_' || isDigit c || s `Set.member` lowerCaseList
4752N/A then "a__" ++ s else s
4752N/A
4752N/A-- reserved Haskell keywords
4752N/AlowerCaseList :: Set.Set String
4752N/AlowerCaseList = Set.fromList [
4752N/A "case", "class", "data", "default", "deriving", "do", "else",
4752N/A "if", "import", "in", "infix", "infixl", "infixr", "instance",
4752N/A "let", "module", "newtype", "of", "then", "type", "where"]
4752N/A
4752N/A-- | Letter case indicator
4752N/Adata IdCase = UpperId | LowerId
4752N/A
4752N/A-- | Converts an identifier to a valid Haskell name
4752N/AtranslateId :: Id -> ShowS
4752N/AtranslateId (Id tlist idlist _) =
4752N/A showSepList id translateToken tlist . translateCompound idlist
4752N/A
4752N/A-- | Translate a 'Token' according to the 'symbolMapping'.
4752N/AtranslateToken :: Token -> ShowS
4752N/AtranslateToken t = let str = tokStr t in showString $
4752N/A if isPlace t then "_2"
4752N/A else if all isDigit str && not (isSingle str) then '_' : str
4752N/A else if head str == '\'' then
4752N/A "_3" ++ concatMap (('_' : ) . show . ord) (tail str) ++ "_X"
4752N/A else concatMap symbolMapping str
4752N/A
4752N/A-- | Translate a compound list
4752N/AtranslateCompound :: [Id] -> ShowS
4752N/A-- [ , ]
4752N/AtranslateCompound ids = noShow (null ids) $ showString "_F"
4752N/A . showSepList (showString "_K") translateId ids
4752N/A . showString "_J"
4752N/A
4752N/A-- | Converts characters to parts of Haskell identifiers
4752N/A-- thereby translating special ones
4752N/AsymbolMapping :: Char -> String
4752N/AsymbolMapping c = Map.findWithDefault [c] c $ Map.fromList
4752N/A-- avoid compound symbols and keep map injective
4752N/A-- Special / reserved
4752N/A [('_' , "_1"), -- \95
4752N/A ('{' , "_b"), -- \123
4752N/A ('}' , "_r"), -- \125
4752N/A ('[' , "_s"), -- \91
4752N/A (']' , "_q"), -- \93
4752N/A ('.' , "_d"), -- \46
4752N/A ('\'', "_p"),
4752N/A-- Symbols
4752N/A ('+' , "_P"), -- \43
4752N/A ('-' , "_M"), -- \45
4752N/A ('*' , "_T"), -- \42
4752N/A ('/' , "_S"), -- \47
4752N/A ('\\', "_B"), -- \92
4752N/A ('&' , "_A"), -- \38
4752N/A ('=' , "_E"), -- \61
4752N/A ('<' , "_L"), -- \60
4752N/A ('>' , "_G"), -- \62
4752N/A ('!' , "_R"), -- \33
4752N/A ('?' , "_Q"), -- \63
4752N/A (':' , "_C"), -- \58
4752N/A ('$' , "_D"), -- \36
4752N/A ('@' , "_O"), -- \64
4752N/A ('#' , "_H"), -- \35
4752N/A ('^' , "_V"), -- \94
4752N/A ('|' , "_I"), -- \124
4752N/A ('~' , "_N"), -- \126
4752N/A ('\161',"_e"),
4752N/A ('\162',"_c"),
4752N/A ('\163',"_l"),
4752N/A ('\167',"_f"),
4752N/A ('\169',"_a"),
4752N/A ('\172',"_n"),
4752N/A ('\176',"_h"),
4752N/A ('\177',"_k"),
4752N/A ('\178',"_w"),
4752N/A ('\179',"_t"),
4752N/A ('\181',"_y"),
4752N/A ('\182',"_j"),
4752N/A ('\183',"_i"),
4752N/A ('\185',"_o"),
4752N/A ('\191',"_u"),
4752N/A ('\215',"_m"),
4752N/A ('\247',"_g")]
4752N/A