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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
module PGF.Lexing where
import Data.Char(isSpace,toLower,toUpper)
-- * Text lexing
-- | Text lexing with standard word capitalization of the first word of every sentence
lexText :: String -> [String]
lexText = lexText' uncapitInit
-- | Text lexing with custom treatment of the first word of every sentence.
lexText' :: (String->String) -> String -> [String]
lexText' uncap1 = uncap . lext where
lext s = case s of
c:cs | isMajorPunct c -> [c] : uncap (lext cs)
c:cs | isMinorPunct c -> [c] : lext cs
c:cs | isSpace c -> lext cs
_:_ -> let (w,cs) = break (\x -> isSpace x || isPunct x) s in w : lext cs
_ -> [s]
uncap s = case s of
w:ws -> uncap1 w:ws
_ -> s
unlexText :: [String] -> String
unlexText = capitInit . unlext where
unlext s = case s of
w:[] -> w
w:[c]:[] | isPunct c -> w ++ [c]
w:[c]:cs | isMajorPunct c -> w ++ [c] ++ " " ++ capitInit (unlext cs)
w:[c]:cs | isMinorPunct c -> w ++ [c] ++ " " ++ unlext cs
w:ws -> w ++ " " ++ unlext ws
_ -> []
-- | Bind tokens separated by Prelude.BIND, i.e. &+
bindTok :: [String] -> [String]
bindTok ws = case ws of
w1:"&+":w2:ws -> bindTok ((w1++w2):ws)
"&+":ws -> bindTok ws
w:ws -> w:bindTok ws
[] -> []
-- * Code lexing
-- | Haskell lexer, usable for much code
lexCode :: String -> [String]
lexCode ss = case lex ss of
[(w@(_:_),ws)] -> w : lexCode ws
_ -> []
unlexCode :: [String] -> String
unlexCode s = case s of
w:[] -> w
[c]:cs | isParen c -> [c] ++ unlexCode cs
w:cs@([c]:_) | isClosing c -> w ++ unlexCode cs
w:ws -> w ++ " " ++ unlexCode ws
_ -> []
-- | LaTeX lexer in the math mode: \ should not be separated from the next word
lexLatexCode :: String -> [String]
lexLatexCode = restoreBackslash . lexCode where --- quick hack: postprocess Haskell's lex
restoreBackslash ws = case ws of
"\\":w:ww -> ("\\" ++ w) : restoreBackslash ww
w:ww -> w:restoreBackslash ww
_ -> ws
-- * Mixed lexing
-- | LaTeX style lexer, with "math" environment using Code between $...$
lexMixed :: String -> [String]
lexMixed = concat . alternate False [] where
alternate env t s = case s of
'$':cs -> lex env (reverse t) : ["$"] : alternate (not env) [] cs
'\\':c:cs | elem c "()[]" -> lex env (reverse t) : [['\\',c]] : alternate (not env) [] cs
c:cs -> alternate env (c:t) cs
_ -> [lex env (reverse t)]
lex env = if env then lexLatexCode else lexText
unlexMixed :: [String] -> String
unlexMixed = capitInit . concat . alternate False where
alternate env s = case s of
_:_ -> case break (flip elem ["$","\\[","\\]","\\(","\\)"]) s of
(t,[]) -> unlex env t : []
(t,c:m) -> unlex env t : sep env c m : alternate (not env) m
_ -> []
unlex env = if env then unlexCode else (uncapitInit . unlexText)
sep env c m = case (m,env) of
([p]:_,True) | isPunct p -> c -- closing $ glued to next punct
(_, True) -> c ++ " " -- closing $ otherwise separated by space from what follows
_ -> " " ++ c -- put space before opening $
-- * Additional lexing uitilties
-- | Capitalize first letter
capitInit s = case s of
c:cs -> toUpper c : cs
_ -> s
-- | Uncapitalize first letter
uncapitInit s = case s of
c:cs -> toLower c : cs
_ -> s
-- | Unquote each string wrapped in double quotes
unquote = map unq where
unq s = case s of
'"':cs@(_:_) | last cs == '"' -> init cs
_ -> s
isPunct = flip elem ".?!,:;"
isMajorPunct = flip elem ".?!"
isMinorPunct = flip elem ",:;"
isParen = flip elem "()[]{}"
isClosing = flip elem ")]}"
|
