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