blob: 458f2609ef16cec15a17d5d4b81ec007987778fe (
plain) (
blame)
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
|
implementation module WhileLexer
from StdOverloaded import class ==
import _SystemArray, StdBool, StdChar, StdList, StdString
import GenEq
import Common
import WhileCommon
derive gEq Token
instance == Token where == a b = a === b
lex :: [Char] -> Either Error [Token]
lex [] = pure []
lex ['s':'k':'i':'p':cs]
| noident cs = lexyield SkipToken cs
lex ['i':'f':cs]
| noident cs = lexyield IfToken cs
lex ['t':'h':'e':'n':cs]
| noident cs = lexyield ThenToken cs
lex ['e':'l':'s':'e':cs]
| noident cs = lexyield ElseToken cs
lex ['w':'h':'i':'l':'e':cs]
| noident cs = lexyield WhileToken cs
lex ['d':'o':cs]
| noident cs = lexyield DoToken cs
lex ['t':'r':'u':'e':cs]
| noident cs = lexyield (BoolToken True) cs
lex ['f':'a':'l':'s':'e':cs]
| noident cs = lexyield (BoolToken False) cs
lex [';':cs] = lexyield CompToken cs
lex [':':'=':cs] = lexyield AssToken cs
lex ['<':'=':cs] = lexyield LeToken cs
lex ['<':'>':cs] = lexyield NeToken cs
lex ['<':cs] = lexyield LtToken cs
lex ['>':'=':cs] = lexyield GeToken cs
lex ['>':cs] = lexyield GtToken cs
lex ['=':cs] = lexyield EqToken cs
lex ['|':cs] = lexyield OrToken cs
lex ['&':cs] = lexyield AndToken cs
lex ['~':cs] = lexyield NotToken cs
lex ['+':cs] = lexyield AddToken cs
lex ['-':cs] = lexyield SubToken cs
lex ['*':cs] = lexyield MulToken cs
lex ['/':cs] = lexyield DivToken cs
lex ['(':cs] = lexyield ParenOpen cs
lex [')':cs] = lexyield ParenClose cs
lex cs=:[c:rest]
| isAlpha c = let (id, cs`) = span isAlpha cs in
lexyield (VarToken (toString id)) cs`
| isDigit c = let (lit, cs`) = span isDigit cs in
lexyield (LiteralToken (toInt lit)) cs`
| isSpace c = lex rest
lex [c:_] = Left (Lextime ("Unexpected character in input: " +++ {c}))
instance toInt [Char] where toInt cs = toInt (toString cs)
lexyield :: Token [Char] -> Either Error [Token]
lexyield tk cs = lex cs >>= \cs` -> pure [tk:cs`]
noident :: [Char] -> Bool
noident [] = True
noident [c:_] = not (isAlpha c)
|
