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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
(define-module (c old lex)
:use-module (ice-9 peg)
:use-module (c old operators)
:export (lex))
;; Like define-peg-pattern, but body is evaluated
(define-syntax define-peg-pattern*
(lambda (stx)
(syntax-case stx ()
((_ sym accum pat)
#`(define sym
(let ((matchf (compile-peg-pattern (datum->syntax #'stx pat) 'accum)))
(let ((syn ((@ (ice-9 peg codegen) wrap-parser-for-users) #'stx matchf 'accum 'sym)))
((@ (system base compile) compile)
((@ (ice-9 peg cache) cg-cached-parser)
syn)))))))))
(define-peg-pattern base-8-digit body
(range #\0 #\7))
(define-peg-pattern base-10-digit body
(range #\0 #\9))
(define-peg-pattern base-16-digit body
(or (range #\0 #\9)
(range #\A #\F)
(range #\a #\f)))
;; https://en.cppreference.com/w/cpp/language/integer_literal
(define-peg-pattern base-10 all (+ base-10-digit))
(define-peg-pattern base-8 all (and (ignore "0") (+ base-8-digit)))
(define-peg-pattern base-16 all (and (ignore (and "0" (or "x" "X")))
(+ base-16-digit)))
;; accept anything now, ensure correctnes later
(define-peg-pattern integer-suffix all
(* (or "u" "U" "l" "L")))
(define-peg-pattern integer all
(and (or base-8 base-16 base-10) (? integer-suffix)))
(define-peg-pattern float-suffix all
(* (or "f" "F" "l" "L")))
(define-peg-pattern exponent all
(and (ignore (or "e" "E")) (? (or "+" "-")) base-10))
;; Helper patterns for creating named groups in float
(define-peg-pattern float-integer all base-10)
(define-peg-pattern float-decimal all base-10)
(define-peg-pattern float all
(or (and float-integer exponent (? float-suffix))
(and (? float-integer) (ignore ".") float-decimal (? exponent) (? float-suffix))
(and float-integer (ignore ".") (? exponent) (? float-suffix))))
(define-peg-pattern number body
(or float integer))
(define-peg-pattern group all
(and (ignore "(") expr (ignore ")")))
(define-peg-pattern base-8-char all
(and base-8-digit
(? base-8-digit)
(? base-8-digit)))
(define-peg-pattern base-16-char all
(and (ignore "x") base-16-digit (? base-16-digit)))
(define-peg-pattern escaped-char all
(and (ignore "\\") (or base-16-char
base-8-char
peg-any)))
(define-peg-pattern char all
(and (ignore "'") (or escaped-char peg-any) (ignore "'")))
(define-peg-pattern quot none "\"")
(define-peg-pattern string all
(and quot (* (or escaped-char (and (not-followed-by "\"") peg-any))) quot))
(define-peg-pattern* operator all
`(or ,@(map symbol->string symbol-binary-operators)
,@(map (lambda (op) `(and ,(symbol->string op) ws))
wordy-binary-operators)
"?" ":"))
;; whitespace
(define-peg-pattern ws none
(or " " " " "\n"))
;; space (for when whitespace is optional)
(define-peg-pattern sp none (* ws))
(define-peg-pattern safe-letter body
(or "_"
(range #\A #\Z)
(range #\a #\z)))
(define-peg-pattern variable all
(and safe-letter
(* (or safe-letter
base-10-digit))))
(define-peg-pattern prefix-operator all
;; It's important that ++ and -- are BEFORE + and -
;; otherwise the first + is found, leaving the second +, which fails
;; to lex since it's an invalid token
;; TODO sizeof can be written as a prefix operator
;; (without parenthesis) if the operand is an expression.
(or "*" "&" "++" "--"
"!" "~" "+" "-"))
;;; Note that stacked pre or postfix operators without parenthesis
;;; dosen't work. So `*&C' is invalid, while `*(&C)' is valid.
(define-peg-pattern prefix all
(and prefix-operator sp (or variable group funcall literal)))
(define-peg-pattern postfix-operator all
(or "++" "--" "*"))
(define-peg-pattern postfix all
;; literals can't be in-place incremented and decremented
;; Make sure we don't match postfix-operator here, since
;; that also gives us an infinite loop.
(and (or prefix funcall group variable) sp postfix-operator))
(define-peg-pattern infix all
;; first case is "same" as expr, but in different order to prevent
;; infinite self reference. Pre and postfix not here, solved by having
;; them before infix in expr
(and (or funcall postfix prefix group literal variable)
sp operator sp expr))
(define-peg-pattern funcall all
(and variable sp group))
(define-peg-pattern literal body
(or char string number))
;;; main parser
(define-peg-pattern expr body
(+ (and sp (or
;; float must be BEFORE infix, otherwise 3.2 is parsed as (infix 3 (operator ".") 2)
;; that however breaks the infix logic, meaning that floating point numbers can't be
;; used in basic arithmetic.
;; TODO remove all implicit order of operations handling in the lexer, and move it to
;; the parser. This should also fix the case of typecasts being applied incorrectly.
float
infix postfix prefix funcall group literal variable)
sp)))
(define (lex string)
(peg:tree (match-pattern expr string)))
|
