1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

-----------------------------------------------------------------------
--- Operations to change names of the original program into names
--- used in the target program
-----------------------------------------------------------------------
module Names where

import Char (isAlphaNum)
import List (intersperse)
import Maybe (fromJust, isJust)

genCorrectIdentifier [] = error "genCorrectIdentifier: empty identifier"
genCorrectIdentifier (c:cs)
  | all opChar (c:cs) = c:cs
  | otherwise         = replaceNonIdChars "" "" (c:cs)
 where
  opChar = (`elem` "!#$%&*+./<=>?@\\^|-~")

showOpChar :: Char -> String
showOpChar c = case c of
  '_' -> "_" --"underscore" TODO: Can this lead to a name clash?
  '~' -> "tilde"
  '!' -> "bang"
  '@' -> "at"
  '#' -> "hash"
  '$' -> "dollar"
  '%' -> "percent"
  '^' -> "caret"
  '&' -> "ampersand"
  '*' -> "star"
  '+' -> "plus"
  '-' -> "minus"
  '=' -> "eq"
  '<' -> "lt"
  '>' -> "gt"
  '?' -> "qmark"
  '.' -> "dot"
  '/' -> "slash"
  '|' -> "bar"
  '\\' ->"backslash"
  ':' -> "colon"
  '(' -> "oparen"
  ')' -> "cparen"
  '[' -> "obracket"
  ']' -> "cbracket"
  ',' -> "comma"
  '\'' -> "tick"
  _   -> error $ "unexpected symbol: " ++ show c

-- | replaces characters that are not valid haskell identifiers,
-- | if there were no characters replaced, the first prefix,
-- | otherwise the snd prefix ist prepended
replaceNonIdChars :: String -> String -> String -> String
replaceNonIdChars pfxNonOp pfxOp str = case strings of
  []  -> error "replaceNonIdChars: empty identifier"
  [s] -> if isAlphaNum (head str)
            then pfxNonOp ++ s
            else pfxOp    ++ s
  _   -> pfxOp ++ concat (intersperse "_" strings)
 where strings       = separateAndReplace isIdentChar showOpChar str
       isIdentChar c = isAlphaNum c || c == '_' || c == '\''

separateAndReplace :: (a -> Bool) -> (a -> [a]) -> [a] -> [[a]]
separateAndReplace pred f list = case rest of
  [] -> case sep of
    [] -> []
    _  -> [sep]
  (x:xs) -> case sep of
    [] -> f x : separateAndReplace pred f xs
    _  -> sep : f x : separateAndReplace pred f xs
 where (sep,rest) = break  (not . pred) list