parser workings are tested somewhat and fixed
[software/python-on-guile.git] / modules / language / python / parser.scm
1 (define-module (language python parser)
2 #:use-module (logic guile-log)
3 #:use-module ((logic guile-log parser) #:select (*whitespace*))
4 #:use-module (ice-9 match)
5 #:use-module (ice-9 pretty-print)
6 #:use-module (language python parser-tool)
7 #:export (p))
8
9 (define do-print #f)
10 (define pp
11 (case-lambda
12 ((s x)
13 (when do-print
14 (pretty-print `(,s ,(syntax->datum x))))
15 x)
16 ((x)
17 (when do-print
18 (pretty-print (syntax->datum x)))
19 x)))
20 (define ppp
21 (case-lambda
22 ((s x)
23 (pretty-print `(,s ,(syntax->datum x)))
24 x)
25 ((x)
26 (pretty-print (syntax->datum x))
27 x)))
28
29 (define-syntax-rule (Ds f) (lambda x (apply f x)))
30 (define-syntax-rule (DDs op f ...) (op (lambda x (apply f x)) ...))
31
32 (define divide truncate/)
33 ;; +++++++++++++++++++++++++++++++++++++ SCANNER SUBSECTION
34 (define nl (f-or f-nl f-eof))
35 (define com (f-seq "#" (f* (f-not f-nl)) nl))
36 (define w (f-reg "[\t\r| ]"))
37 (define ws+ (f+ (f-or (f-reg "[\t\r| ]") com)))
38 (define ws* (f+ (f-or (f-reg "[\t\r| ]") com)))
39 (define ws ws*)
40
41
42 (define (wn_ n i)
43 (<p-lambda> (c)
44 (cond
45 ((> i n) <fail>)
46 ((= i n)
47 (.. ((f-and (f-not w) f-true) c)))
48 ((< i n)
49 (<or>
50 (<and!>
51 (.. (c) ((f-tag " ") c))
52 (.. ((wn_ n (+ i 1)) c)))
53 (<and!>
54 (.. (c) ((f-tag "\t") c))
55 (.. ((wn_ n (divide (+ i 8) 8)) c)))
56 (<and!>
57 (.. (c) ((f-tag "\r") c))
58 (.. ((wn_ n i) c))))))))
59
60 (define (wn+_ n i)
61 (<p-lambda> (c)
62 (<pp> `(,n ,i))
63 (<or>
64 (<and!>
65 (.. (c) ((f-tag " ") c))
66 (.. ((wn+_ n (+ i 1)) c)))
67 (<and!>
68 (.. (c) ((f-tag "\t") c))
69 (.. ((wn+_ n (divide (+ i 8) 8)) c)))
70 (<and!>
71 (.. (c) ((f-tag "\r") c))
72 (.. ((wn+_ n i) c)))
73 (<and!>
74 (when (> i n))
75 (<with-bind> ((INDENT (cons i INDENT)))
76 (<p-cc> c))))))
77
78 (define wn+
79 (<p-lambda> (c)
80 (<let> ((n (car INDENT)))
81 (.. ((wn+_ n 0) c)))))
82
83 (define wn
84 (<p-lambda> (c)
85 (<let> ((n (car INDENT)))
86 (.. ((wn_ n 0) c)))))
87
88 (define indent= wn)
89 (define indent+ wn+)
90 (define indent-
91 (<p-lambda> (c)
92 (<with-bind> ((INDENT (cdr INDENT)))
93 (<p-cc> c))))
94
95 (define identifier__
96 (let ()
97 (define ih (f-reg! "[a-zA-Z_]"))
98 (define i.. (f-or! 'or ih (f-reg! "[0-9]")))
99 (mk-token
100 (f-seq ih (f* i..)))))
101
102 (define keyw (make-hash-table))
103 (for-each
104 (lambda (x) (hash-set! keyw (symbol->string x) #t))
105 '(False None True and as assert break class continue def
106 del elif else except finally for from global if import
107 in is lambda nonlocal not or pass raise return try
108 while with yield))
109
110 (define decimal (mk-token (f-seq (f-reg! "[1-9]") (f* (f-reg! "[0-9]")))))
111 (define oct (mk-token
112 (f-seq "0" (f-reg "[oO]") (f+ (f-reg! "[0-7]")))))
113 (define hex (mk-token
114 (f-seq "0" (f-reg "[xX]") (f+ (f-reg! "[0-7a-fA-F]")))))
115 (define bin (mk-token
116 (f-seq "0" (f-reg "[bB]") (f+ (f-reg! "[01]")))))
117
118 (define integer
119 (<p-lambda> (c)
120 (<and!>
121 (<or>
122 (<and>
123 (.. (c) (decimal c))
124 (<p-cc> (string->number c 10)))
125 (<and>
126 (.. (c) (oct c))
127 (<p-cc> (string->number c 8)))
128 (<and>
129 (.. (c) (hex c))
130 (<p-cc> (string->number c 16)))
131 (<and>
132 (.. (c) (bin c))
133 (<p-cc> (string->number c 2)))))))
134
135 (define intpart (f+ (f-reg! "[0-9]")))
136 (define fraction (f-seq (f-tag! ".") intpart))
137 (define exponent (f-seq (f-reg! "[eE]") (f? (f-reg! "[+-]")) intpart))
138 (define pointfloat (f-or! (f-seq (f? intpart) fraction)
139 (f-seq intpart (f-tag! "."))))
140 (define exponentfloat (f-seq (f-or intpart pointfloat) exponent))
141
142 (define floatnumber (mk-token (f-or! exponentfloat pointfloat)))
143 (define float
144 (<p-lambda> (c)
145 (.. (c) (floatnumber c))
146 (<p-cc> (string->number c))))
147
148 (define imagnumber (mk-token (f-seq (f-or floatnumber integer) (f-reg "[jJ]"))))
149 (define imag
150 (<p-lambda> (c)
151 (.. (c) (imagnumber c))
152 (<p-cc> (string->number (string-append "0+" c "i")))))
153
154 (define (mk-id S c cc) cc)
155
156 (define number
157 (p-freeze 'number
158 (f-or! imag float integer)
159 mk-id))
160
161 (define identifier_
162 (let ()
163 (define (__*__ i)
164 (match (string->list i)
165 ((#\_ #\_ . l)
166 (match (reverse l)
167 ((#\_ #\_ . l) #t)
168 (_ #f)))
169 (_ #f)))
170
171 (define (__* i)
172 (match (string->list i)
173 ((#\_ #\_ . l)
174 #t)
175 (_ #f)))
176
177 (define (_* i)
178 (match (string->list i)
179 ((#\_ . l)
180 #t)
181 (_ #f)))
182
183 (<p-lambda> (c)
184 (.. (i) (identifier__ c))
185 (cond
186 ((__*__ i)
187 (<p-cc> `(#:identifier ,i #:system)))
188 ((__* i)
189 (<p-cc> `(#:identifier ,i #:private)))
190 ((_* i)
191 (<p-cc> `(#:identifier ,i #:local)))
192 ((eq? i '_)
193 (<p-cc> #:_))
194 ((hash-ref keyw i)
195 (<p-cc> `(#:keyword ,i)))
196 (else
197 (<p-cc> `(#:identifier ,i)))))))
198
199 (define identifier
200 (<p-lambda> (c)
201 (.. (i) (identifier_ c))
202 (if (not (eq? (car i) #:keyword))
203 (<p-cc> i)
204 <fail>)))
205
206 ;;;; +++++++++++++++++++++++++++++++++++++++++++++++ STRING +++++++++++++++
207 (define string-prefix (mk-token (f-reg! "[ruRU]")))
208 (define short-string-char (f-not! (f-reg "[\n\"']")))
209 (define long-string-char (f-not! "\n"))
210 (define string-esc (f-seq (f-tag "\\") (f-reg! ".")))
211 (define short-string-item (f-or short-string-char string-esc))
212 (define long-string-item (f-or long-string-char string-esc))
213
214 (define long-string
215 (mk-token
216 (f-or
217 (f-seq! "'''" (f* long-string-item) "'''")
218 (f-seq! "\"\"\"" (f* long-string-item) "\"\"\""))))
219
220 (define short-string
221 (mk-token
222 (f-or
223 (f-seq! "'" (f* short-string-item) "'")
224 (f-seq! "\"" (f* short-string-item) "\""))))
225
226 (define string
227 (p-freeze 'string-literal
228 (f-list #:string
229 (ff? string-prefix)
230 (f-or! long-string short-string))
231 mk-id))
232
233 ;; ++++++++++++++++++++++++++++++++++++++++++ BYTE ++++++++++++++++++++++++++
234
235 (define bytes-prefix
236 (mk-token
237 (f-or!
238 (f-seq! (f-tag! "b") (f-or f-true (f-reg! "[rR]")))
239 (f-seq! (f-tag! "B") (f-or f-true (f-reg! "[rR]")))
240 (f-seq! (f-tag! "r") (f-or f-true (f-reg! "[bB]")))
241 (f-seq! (f-tag! "R") (f-or f-true (f-reg! "[bB]"))))))
242
243 (define bytes-esc (f-seq "\\" (f-reg ".")))
244
245 (define short-bytes-char (f-not! (f-reg "[\\\n'\"]")))
246 (define long-bytes-char (f-not! (f-reg "[\\]")))
247
248 (define short-bytes-item
249 (f-or short-bytes-char bytes-esc))
250
251 (define long-bytes-item
252 (f-or long-bytes-char bytes-esc))
253
254 (define short-bytes
255 (mk-token
256 (f-or! (f-seq! "'" (f* short-bytes-item) "'")
257 (f-seq! "\"" (f* short-bytes-item) " \""))))
258
259 (define long-bytes
260 (mk-token
261 (f-or! (f-seq! "'''" (f* long-bytes-item) "'''")
262 (f-seq! "\"\"\"" (f* long-bytes-item) "\"\"\""))))
263
264 (define bytes-literal
265 (p-freeze 'string-literal
266 (<p-lambda> (c)
267 (.. (pre) (bytes-prefix c))
268 (.. (str) ((f-or! long-bytes short-bytes) pre))
269 (<p-cc> (#:bytes pre str)))
270 mk-id))
271
272
273 ; +++++++++++++++++++++++++++++++++++ PARSER SUBSECTION +++++++++++++++++
274 (define stmt #f)
275 (define testlist #f)
276 (define dottaed_name #f)
277 (define arglist #f)
278 (define classdef #f)
279 (define funcdef #f)
280 (define test #f)
281 (define small_stmt #f)
282
283
284 (define expr_stmt #f)
285 (define del_stmt #f)
286 (define pass_stmt #f)
287 (define flow_stmt #f)
288 (define import_stmt #f)
289 (define global_stmt #f)
290 (define nonlocal_stmt #f)
291 (define assert_stmt #f)
292 (define testlist_star_expr #f)
293 (define augassign #f)
294 (define yield_expr #f)
295 (define star_expr #f)
296 (define exprlist #f)
297 (define import_name #f)
298 (define import_from #f)
299 (define dotted_as_names #f)
300 (define import_as_names #f)
301 (define if_stmt #f)
302 (define while_stmt #f)
303 (define for_stmt #f)
304 (define try_stmt #f)
305 (define with_stmt #f)
306 (define suite #f)
307 (define except_clause #f)
308 (define with_item #f)
309 (define expr #f)
310 (define or_test #f)
311 (define lambdef #f)
312 (define lambdef_nocond #f)
313 (define and_test #f)
314 (define not_test #f)
315 (define comparison #f)
316 (define comp_op #f)
317 (define xor_expr #f)
318 (define and_expr #f)
319 (define or_expr #f)
320 (define arith_expr #f)
321 (define shift_expr #f)
322 (define term #f)
323 (define factor #f)
324 (define power #f)
325 (define atom #f)
326 (define trailer #f)
327 (define subscriptlist #f)
328 (define testlist_comp #f)
329 (define dictorsetmaker #f)
330 (define comp_for #f)
331 (define subscript #f)
332 (define sliceop #f)
333 (define argument #f)
334 (define comp_if #f)
335 (define yield_arg #f)
336 (define dotted_name #f)
337
338 (define file-input (f-seq (f* (f-or nl (f-seq indent= stmt))) f-eof))
339
340 (define eval-input (f-seq testlist (f* nl) f-eof))
341
342 (define decorator (f-cons (f-seq ws "@" ws (Ds dotted_name) ws)
343 (f-seq (ff? (f-seq "(" ws (ff? (Ds arglist))
344 ws ")" ws))
345 f-nl)))
346
347 (define decorators (ff+ decorator))
348
349
350 (define decorated (f-list #:decorated
351 decorators
352 (f-or classdef funcdef)))
353
354 (define FALSE (f-out #f))
355 (define tfpdef
356 (f-cons identifier (f-or
357 (f-seq ":" ws test ws)
358 FALSE)))
359
360 (define vfpdef identifier)
361 (define mk-py-list
362 (lambda (targlist tfpdef)
363 (let* ((t (f-or (f-seq "=" (Ds test)) FALSE))
364 (arg (f-list tfpdef t))
365 (arg.. (ff* (f-seq "," arg)))
366 (args (f-cons arg arg..))
367 (arg* (f-seq "*" (f-list tfpdef arg..)))
368 (arg** (f-seq "**" tfpdef)))
369 (f-cons
370 targlist
371 (f-or!
372 (f-cons args
373 (f-or (f-list arg* (f-or arg** FALSE))
374 (f-list FALSE FALSE)))
375 (f-list FALSE arg* (f-or arg** FALSE))
376 (f-list FALSE FALSE arg**)
377 (f-list 'a1 '() FALSE FALSE))))))
378
379 (define typedargslist (mk-py-list #:types-args-list tfpdef))
380 (define varargslist (mk-py-list #:var-args-list vfpdef))
381
382 (define parameters (f-seq! 'parameters
383 "(" (f-or typedargslist
384 (f-out (list #f #f #f)))
385 ")"))
386
387 (set! funcdef
388 (p-freeze 'funcdef
389 (f-list 'fundef
390 #:def
391 (f-seq "def" identifier)
392 parameters
393 (ff? (f-seq! "->" (Ds test)))
394 (f-seq ":" (Ds suite)))
395 mk-id))
396
397 (define simple_stmt (f-list 'simple_stmt #:stmt
398 (f-seq
399 (f-cons (Ds small_stmt)
400 (ff* (f-seq ";" (Ds small_stmt))))
401 (f? ";") (f? ws) (f-or nl f-eof))))
402 (set! small_stmt
403 (Ds
404 (f-or 'small expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt
405 nonlocal_stmt assert_stmt)))
406
407 (set! expr_stmt
408 (f-list 'expr_stmt
409 #:expr-stmt
410 (Ds testlist_star_expr)
411 (f-or!
412 (f-list 'augassign #:augassign
413 (Ds augassign)
414 (f-or (Ds yield_expr) (Ds testlist)))
415 (f-cons 'assign #:assign
416 (ff* (f-seq "="
417 (f-or (Ds yield_expr)
418 (Ds testlist_star_expr))))))))
419
420 (set! testlist_star_expr
421 (f-cons 'testlist_star_expr
422 (f-or (Ds test) (Ds star_expr))
423 (f-seq
424 (ff* (f-seq "," (f-or (Ds test) (Ds star_expr))))
425 (f? ","))))
426
427
428 (set! augassign
429 (mk-token
430 (f-seq 'augassign
431 ws
432 (apply f-or!
433 (map f-tag
434 '("+=" "-=" "*=" "/=" "%=" "&=" "|=" "^="
435 "<<=" ">>=" "**=" "//=")))
436 ws)))
437
438 (set! del_stmt (f-cons 'del_stmt #:del (f-seq "del" (Ds exprlist))))
439
440 (set! pass_stmt (f-seq 'pass_stmt "pass" #:pass))
441
442 (set! flow_stmt
443 (f-or 'flow_stmt
444 (f-seq "break" #:break)
445 (f-seq "coninue" #:continue)
446 (f-cons #:return (f-seq "return" (ff? (Ds testlist))))
447 (Ds yield_expr)
448 (f-cons #:raise (f-seq "raise"
449 (f-or (f-cons (Ds test)
450 (ff?
451 (f-seq "from" (Ds test))))
452 (f-cons FALSE FALSE))))))
453
454 (set! import_name (f-seq "import" dotted_as_names))
455 (set! import_stmt (f-or 'import_stmt import_name (Ds import_from)))
456
457
458
459 (define dottir (mk-token (f-or! (f-tag! "...") (f-tag! "."))))
460 (define dots* (ff* dottir))
461 (define dots+ (ff+ dottir))
462
463 (set! import_from
464 (f-seq 'import_from "from"
465 (f-cons
466 (f-or (f-cons dots* (Ds dotted_name)) dots+)
467 (f-seq "import" (f-or "*"
468 (f-seq "(" (Ds import_as_names) ")")
469 (Ds import_as_names))))))
470
471 (define import_as_name
472 (f-cons identifier (ff? (f-seq "as" identifier))))
473
474 (define dotted_as_name
475 (f-cons (Ds dotted_name) (ff? (f-seq "as" identifier))))
476
477 (set! import_as_names
478 (f-seq
479 (f-cons import_as_name (ff* (f-seq "," import_as_name)))
480 (f? ",")))
481
482 (set! dotted_as_names
483 (f-cons dotted_as_name (ff* (f-seq "," dotted_as_name))))
484
485 (set! dotted_name
486 (f-cons identifier (ff* (f-seq "." identifier))))
487
488 (define comma_name
489 (f-cons identifier (ff* (f-seq "," identifier))))
490
491 (set! global_stmt
492 (f-cons 'global #:global (f-seq "global" comma_name)))
493
494 (set! nonlocal_stmt
495 (f-cons 'nonlocal #:nonlocal (f-seq "nonlocal" comma_name)))
496
497 (set! assert_stmt
498 (f-cons 'assert #:assert
499 (f-seq "assert" (f-cons (Ds test) (ff* (f-seq "," (Ds test)))))))
500
501
502 (define compound_stmt
503 (Ds
504 (f-or! 'compound
505 if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef
506 decorated)))
507
508 (define single_input (f-or! (f-seq indent= simple_stmt)
509 (f-seq indent= compound_stmt nl)
510 (f-seq (f-or nl f-eof))))
511
512 (set! stmt (f-or 'stmt simple_stmt compound_stmt))
513
514 (set! if_stmt
515 (f-cons 'if_stmt
516 #:if
517 (f-seq
518 "if"
519 (f-cons (Ds test)
520 (f-seq ":"
521 (f-cons (Ds suite)
522 (f-cons
523 (ff* (f-seq "elif"
524 (f-cons (Ds test)
525 (f-seq ":" (Ds suite)))))
526 (ff? (f-seq "else" ":" (Ds suite))))))))))
527
528 (set! while_stmt
529 (f-cons 'while
530 #:while
531 (f-seq "while"
532 (f-cons (Ds test)
533 (f-seq ":"
534 (f-cons (Ds suite)
535 (ff? (f-seq "else" ":" (Ds suite)))))))))
536
537 (set! for_stmt
538 (f-cons 'for
539 #:for
540 (f-seq "for"
541 (f-cons (Ds exprlist)
542 (f-seq "in"
543 (f-cons (Ds testlist)
544 (f-cons (f-seq ":" (Ds suite))
545 (ff? (f-seq "else" ":" (Ds suite))))))))))
546
547 (set! try_stmt
548 (f-cons 'try
549 #:try
550 (f-seq ws "try" ":"
551 (f-cons (Ds suite)
552 (f-or
553 (f-cons
554 (ff+ (f-seq (Ds except_clause) ":" (Ds suite)))
555 (f-cons
556 (ff? (f-seq "else" ":" (Ds suite)))
557 (ff? (f-seq "finally" ":" ws (Ds suite)))))
558 (f-cons
559 FALSE
560 (f-cons
561 FALSE
562 (f-seq "finally" ":" (Ds suite)))))))))
563
564 (set! with_item
565 (f-cons (Ds test) (f-seq "as" (Ds expr))))
566
567 (set! with_stmt
568 (f-cons 'with
569 #:with
570 (f-seq "with"
571 (f-cons
572 (f-cons with_item
573 (ff* (f-seq "," with_item)))
574 (f-seq ":" (Ds suite))))))
575
576
577 (set! except_clause
578 (f-seq 'except "except"
579 (ff? (f-cons (Ds test) (ff? (f-seq "as" identifier))))))
580
581 (set! suite
582 (f-cons #:suite
583 (f-or! (f-list simple_stmt)
584 (f-seq nl indent+
585 (f-cons stmt
586 (ff* (f-seq indent= stmt)))
587 indent-))))
588
589 (set! test
590 (f-or! 'test
591 (f-list #:test
592 (Ds or_test)
593 (ff? (f-list
594 (f-seq "if" (Ds or_test))
595 (f-seq "else" test))))
596 (Ds lambdef)))
597
598 (define test_nocond
599 (f-or 'nocond (Ds or_test) (Ds lambdef_nocond)))
600
601 (set! lambdef
602 (f-list 'lambdef
603 #:lambdef
604 (f-seq "lambda" (ff? (Ds varargslist) '()))
605 (f-seq ":" (Ds test))))
606
607 (set! lambdef_nocond
608 (f-list 'lambdef_nocond
609 'lambdef #:lambdef
610 (f-seq "lambda" (ff? (Ds varargslist) '()))
611 (f-seq ":" test_nocond)))
612
613 (set! or_test
614 (p-freeze 'or_test
615 (f-or! 'or_test
616 (f-cons #:or (f-cons (Ds and_test) (ff+ (f-seq "or" (Ds and_test)))))
617 (Ds and_test))
618 mk-id))
619
620 (set! and_test
621 (p-freeze 'and_test
622 (f-or! 'and_test
623 (f-cons #:and (f-cons (Ds not_test) (ff+ (f-seq "and" (Ds not_test)))))
624 (Ds not_test))
625 mk-id))
626
627 (set! not_test
628 (f-or! 'not_test
629 (f-cons #:not (f-seq "not" not_test))
630 (Ds comparison)))
631
632 (set! comparison
633 (p-freeze 'comparison
634 (f-or! 'comparison
635 (f-cons #:comp
636 (f-cons (Ds expr)
637 (ff+ (f-cons (Ds comp_op) (Ds expr)))))
638 (Ds expr))
639 mk-id))
640
641 (set! comp_op
642 (f-or! 'comp_op
643 (f-seq (f-seq "not" "in" ) (f-out "notin"))
644 (f-seq (f-seq "is" "not") (f-out "isnot"))
645 (apply f-or!
646 (map (lambda (x) (f-seq x (f-out x)))
647 '("==" ">=" "<=" "<>" "!=" "in" "is" "<" ">" )))))
648
649
650 (set! star_expr (f-cons 'star_expr #:starexpr (f-seq "*" (Ds expr))))
651 (set! expr
652 (p-freeze 'expr
653 (f-or! 'expr
654 (f-cons #:bxor (f-cons (Ds xor_expr) (ff+ (f-seq "|" (Ds xor_expr)))))
655 (Ds xor_expr))
656 mk-id))
657
658 (set! xor_expr
659 (p-freeze 'xor
660 (f-or! 'xor
661 (f-cons #:band (f-cons (Ds and_expr) (ff+ (f-seq "^" (Ds and_expr)))))
662 (Ds and_expr))
663 mk-id))
664
665 (set! and_expr
666 (p-freeze 'and
667 (f-or! 'and
668 (f-cons #:band (f-cons (Ds shift_expr)
669 (ff+ (f-seq "&" (Ds shift_expr)))))
670 (Ds shift_expr))
671 mk-id))
672
673 (set! shift_expr
674 (p-freeze 'shift
675 (f-or! 'shift
676 (f-cons #:<< (f-cons (Ds arith_expr) (ff+ (f-seq "<<" (Ds arith_expr) ))))
677 (f-cons #:>> (f-cons (Ds arith_expr) (ff+ (f-seq ">>" (Ds arith_expr) ))))
678 (Ds arith_expr))
679 mk-id))
680
681 (set! arith_expr
682 (p-freeze 'arith
683 (f-or! 'arith
684 (f-cons #:+ (f-cons (Ds term) (ff+ (f-seq 'rest "+" (Ds term) ))))
685 (f-cons #:- (f-cons (Ds term) (ff+ (f-seq "-" (Ds term) ))))
686 (f-seq 'single_term (Ds term)))
687 mk-id))
688
689 (set! term
690 (p-freeze 'term
691 (f-or! 'term
692 (f-cons #:* (f-cons (Ds factor) (ff+ (f-seq "*" (Ds factor) ))))
693 (f-cons #:// (f-cons (Ds factor) (ff+ (f-seq "//" (Ds factor) ))))
694 (f-cons #:/ (f-cons (Ds factor) (ff+ (f-seq "/" (Ds factor) ))))
695 (f-cons #:% (f-cons (Ds factor) (ff+ (f-seq "%" (Ds factor) ))))
696 (f-seq 'single-factor (Ds factor)))
697 mk-id))
698
699
700 (set! factor
701 (p-freeze 'factor
702 (f-or! 'factor
703 (f-cons #:u+ (f-seq "+" factor))
704 (f-cons #:u- (f-seq "-" factor))
705 (f-cons #:u~ (f-seq "~" factor))
706 (Ds power))
707 mk-id))
708
709 (set! power
710 (p-freeze 'power
711 (f-cons 'power #:power
712 (f-cons (Ds atom)
713 (f-cons (ff* (Ds trailer))
714 (f-or! (f-seq "**" factor)
715 FALSE))))
716 mk-id))
717
718 (set! trailer
719 (f-or! 'trailer
720 (f-seq "(" (ff? (Ds arglist)) ")")
721 (f-seq "[" (Ds subscriptlist) "]")
722 (f-seq "." identifier)))
723
724 (set! atom
725 (p-freeze 'atom
726 (f-or! 'atom
727 (f-cons
728 #:subexpr
729 (f-seq "(" (ff? (f-or! (Ds yield_expr) (Ds testlist_comp))) ")"))
730 (f-cons
731 #:list
732 (f-seq "[" (ff? (Ds testlist_comp)) ")"))
733 (f-cons
734 #:dict
735 (f-seq "{" (ff? (Ds dictorsetmaker)) "}"))
736 (f-seq 'identifier identifier)
737 (f-seq 'number number)
738 (ff+ string)
739 (f-seq #:... "...")
740 (f-seq #:None "None")
741 (f-seq #:True "True")
742 (f-seq #:false "False"))
743 mk-id))
744
745 (set! testlist_comp
746 (f-cons
747 (f-or! star_expr test)
748 (f-or!
749 comp_for
750 (f-seq (ff* (f-seq "," (f-or! star_expr test)))
751 (f? ",")))))
752
753 (set! subscriptlist
754 (f-cons* 'subscriptlist
755 #:subscripts
756 (Ds subscript)
757 (f-seq (ff* (f-seq "," (Ds subscript))) (f? ","))))
758
759 (set! subscript
760 (f-or! 'subscript
761 (f-list (ff? test '()) (f-seq ":" (ff? test '())) (ff? (Ds sliceop)))
762 (f-list test FALSE FALSE)))
763
764 (set! sliceop
765 (f-seq ":" (ff? test '())))
766
767 (define exprlist
768 (let ((f (f-or expr star_expr)))
769 (f-cons f (f-seq (ff* (f-seq "," f)) (f? ",")))))
770
771 (set! testlist
772 (f-cons
773 test
774 (f-seq (ff* (f-seq "," test)) (f? ","))))
775
776 (set! dictorsetmaker
777 (let ((f (f-cons test (f-seq ":" test))))
778 (f-or!
779 (f-cons* f (f-seq (ff* (f-seq "," f)) (f? ",")))
780 (f-cons f (Ds comp_for))
781 (f-cons test (Ds comp_for))
782 (f-cons test (f-seq (ff* (f-seq "," test)) (f? ","))))))
783
784 (set! classdef
785 (f-list
786 #:classdef
787 (f-seq "class" identifier)
788 (ff? (f-seq "(" (ff? (Ds arglist) '()) ")"))
789 (f-seq ":" suite)))
790
791 (set! arglist
792 (f-or! 'arglist
793 (f-list 'arg0
794 #:arglist
795 (f-seq (ff* (f-seq (Ds argument) ",")))
796 (f-seq "*" (f-cons test (ff* (f-seq "," (Ds argument)))))
797 (ff? (f-seq "," "**" test)))
798
799 (f-list 'arg1
800 #:arglist
801 (f-seq (ff* (f-seq (Ds argument) ",")))
802 FALSE
803 (f-seq "**" test))
804
805 (f-list 'arg2
806 #:arglist
807 (f-seq (f-append (ff* (f-seq (Ds argument) ","))
808 (f-seq (Ds argument) (f? ","))))
809 FALSE FALSE)))
810
811 (set! argument
812 (f-or!
813 (f-list #:= test (f-seq "=" test))
814 (f-list #:comp test (ff? (Ds comp_for)))))
815
816 (define comp_iter (f-or! (Ds comp_for) (Ds comp_if)))
817 (define comp_for (f-list (f-seq "for" exprlist)
818 (f-seq "in" or_test)
819 (ff? comp_iter)))
820 (set! comp_if (f-list (f-seq "if" test_nocond)
821 (ff? comp_iter)))
822
823 (set! yield_expr
824 (f-list #:yield (f-seq "yield" (ff? (Ds yield_arg)))))
825
826 (set! yield_arg
827 (f-or!
828 (f-list #:from (f-seq "from" test))
829 (f-list #:list testlist)))
830
831
832 (define (p str)
833 (with-fluids ((*whitespace* (f* (f-reg "[ \t\r]"))))
834 (ppp (parse str (f-seq nl single_input)))
835 (if #f #f)))