CompilersFromScratch/Tokens.hs at master · dfeltey/CompilersFromScratch · GitHub

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
module Tokens where

import Lex
import RegEx
import Data.Char
import Prelude hiding (seq)
import CEK

lexS :: String -> Either String [Token]
lexS s = lexer rules s

notSpace :: Token -> Bool
notSpace SpaceT = False
notSpace _ = True

data Token  = LParenT
			| RParenT
			| SpaceT
			| LambdaT
			| AddT
			| MulT
			| DivT
			| SubT
			| ModT
			| EqT
			| LtT
			| GtT
			| LeqT
			| GeqT
			| LetT
			| ORT
			| ANDT
			| IFT
			| IntT Integer
			| BoolT Bool
			| VarT Name
			| PrintT
			deriving(Show,Eq)

rules = [  (Sym $ isSpace, const SpaceT)
		 , (symC '(', const LParenT)
		 , (symC ')', const RParenT)
		 , (word "lambda", const LambdaT)
		 , (symC '+', const AddT)
		 , (symC '*', const MulT)
		 , (symC '/', const DivT)
		 , (symC '-', const SubT)
		 , (symC '%', const ModT)
		 , (symC '=', const EqT)
		 , (symC '<', const LtT)
		 , (symC '>', const GtT)
		 , (word "<=", const LeqT)
		 , (word ">=", const GeqT)
		 , (word "or", const ORT)
		 , (word "and", const ANDT)
		 , (word "let", const LetT)
		 , (word "if", const IFT)
		 , (word "print", const PrintT)
		 , (seq (Sym isDigit) (star $ Sym isDigit), IntT . read)
		 , (word "True" `alt` word "False", BoolT . read)
		 , (Sym isAlpha `seq` (star $ Sym isAlpha) ,VarT)
		 ]