43051ffcc1250114598b210bc709a60bd5730361
[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 (<or>
63 (<and!>
64 (.. (c) ((f-tag " ") c))
65 (.. ((wn+_ n (+ i 1)) c)))
66 (<and!>
67 (.. (c) ((f-tag "\t") c))
68 (.. ((wn+_ n (divide (+ i 8) 8)) c)))
69 (<and!>
70 (.. (c) ((f-tag "\r") c))
71 (.. ((wn+_ n i) c)))
72 (<and!>
73 (when (i > n))
74 (<with-bind> ((INDENT (cons i INDENT)))
75 (<p-cc> c))))))
76
77 (define wn+
78 (<p-lambda> (c)
79 (<let> ((n (car INDENT)))
80 (.. ((wn+_ n 0) c)))))
81
82 (define wn
83 (<p-lambda> (c)
84 (<let> ((n (car INDENT)))
85 (.. ((wn_ n 0) c)))))
86
87 (define indent= wn)
88 (define indent+ wn+)
89 (define indent-
90 (<p-lambda> (c)
91 (<with-bind> ((INDENT (cdr INDENT)))
92 (<p-cc> c))))
93
94
95 (define ih (f-reg! "a-zA-Z_"))
96 (define i.. (f-or ih (f-reg! "0-9")))
97 (define identifier_ (f-seq ih (f* i..)))
98
99 (define keyw (make-hash-table))
100 (for-each
101 (lambda (x) (hash-set! keyw x #t))
102 '(False None True and as assert break class continue def
103 del elif else except finally for from global if import
104 in is lambda nonlocal not or pass raise return try
105 while with yield))
106
107 (define decimal (mk-token (f-seq (f-reg! "[1-9]") (f* (f-reg! "[0-9]")))))
108 (define oct (mk-token
109 (mk-token
110 (f-seq "0" (f-reg "[oO]") (f+ (f-reg! "[0-7]"))))))
111 (define hex (mk-token
112 (f-seq "0" (f-reg "[xX]") (f+ (f-reg! "[0-7a-fA-F]")))))
113 (define bin (mk-token
114 (f-seq "0" (f-reg "[bB]") (f+ (f-reg! "[01]")))))
115
116 (define integer
117 (<p-lambda> (c)
118 (<and!>
119 (<or>
120 (<and>
121 (.. (c) (decimal c))
122 (<p-cc> (string->number c 10)))
123 (<and>
124 (.. (c) (oct c))
125 (<p-cc> (string->number c 8)))
126 (<and>
127 (.. (c) (hex c))
128 (<p-cc> (string->number c 16)))
129 (<and>
130 (.. (c) (bin c))
131 (<p-cc> (string->number c 2)))))))
132
133 (define intpart (f+ (f-reg! "[0-9]")))
134 (define fraction (f-seq (f-tag! ".") intpart))
135 (define exponent (f-seq (f-reg! "[eE]") (f? (f-reg! "[+-]")) intpart))
136 (define pointfloat (f-or! (f-seq (f? intpart) fraction)
137 (f-seq intpart (f-tag! "."))))
138 (define exponentfloat (f-seq (f-or intpart pointfloat) exponent))
139
140 (define floatnumber (mk-token (f-or! exponentfloat pointfloat)))
141 (define float
142 (<p-lambda> (c)
143 (.. (c) (floatnumber c))
144 (<p-cc> (string->number c))))
145
146 (define imagnumber (mk-token (f-seq (f-or floatnumber integer) (f-reg "[jJ]"))))
147 (define imag
148 (<p-lambda> (c)
149 (.. (c) (imagnumber c))
150 (<p-cc> (string->number (string-append "0+" c "i")))))
151
152 (define (mk-id S c cc) cc)
153
154 (define number
155 (p-freeze 'number
156 (f-or! imag float integer)
157 mk-id))
158
159 (define symbol
160 (let ()
161 (define (__*__ i)
162 (match (string->list i)
163 ((#\_ #\_ . l)
164 (match (reverse l)
165 ((#\_ #\_ . l) #t)
166 (_ #f)))
167 (_ #f)))
168
169 (define (__* i)
170 (match (string->list i)
171 ((#\_ #\_ . l)
172 #t)
173 (_ #f)))
174
175 (define (_* i)
176 (match (string->list i)
177 ((#\_ . l)
178 #t)
179 (_ #f)))
180
181 (<p-lambda> (c)
182 (.. (i) (identifier_ c))
183 (cond
184 ((__*__ i)
185 (#:identifier i #:system))
186 ((__* i)
187 (#:identifier i #:private))
188 ((_* i)
189 (#:identifier i #:local))
190 ((eq? i '_)
191 (#:_))
192 ((hash-ref keyw i)
193 (#:keyword i))
194 (else
195 (#:identifier i))))))
196
197 (define identifier
198 (<p-lambda> (c)
199 (.. (i) (identifier_ c))
200 (when (not (eq? (car i) #:keyword))
201 (<p-cc> c))))
202
203 ;;;; +++++++++++++++++++++++++++++++++++++++++++++++ STRING +++++++++++++++
204 (define string-prefix (mk-token (f-reg! "[ruRU]")))
205 (define short-string-char (f-not! (f-reg "[\n\"']")))
206 (define long-string-char (f-not! "\n"))
207 (define string-esc (f-seq (f-tag "\\") (f-reg! ".")))
208 (define short-string-item (f-or short-string-char string-esc))
209 (define long-string-item (f-or long-string-char string-esc))
210
211 (define long-string
212 (mk-token
213 (f-or
214 (f-seq! "'''" (f* long-string-item) "'''")
215 (f-seq! "\"\"\"" (f* long-string-item) "\"\"\""))))
216
217 (define short-string
218 (mk-token
219 (f-or
220 (f-seq! "'" (f* short-string-item) "'")
221 (f-seq! "\"" (f* short-string-item) "\""))))
222
223 (define string-literal
224 (p-freeze 'string-literal
225 (<p-lambda> (c)
226 (xx (pre) (<or>
227 (.. (string-prefix c))
228 (<p-cc> #f)))
229 (.. (str) (f-or! long-string short-string))
230 (<p-cc> (#:string pre str)))
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 dotted_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
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 dotted_name ws)
343 (f-seq (ff? (f-seq "(" ws (ff? arglist) ws ")" ws))
344 f-nl)))
345
346 (define decorators (ff+ decorator))
347
348
349 (define decorated (f-list #:decorated
350 decorators
351 (f-or classdef funcdef)))
352
353 (define FALSE (f-out #f))
354 (define tfpdef
355 (f-cons (f-seq ws identifier ws) (f-or
356 (f-seq ":" ws test ws)
357 FALSE)))
358
359 (define vfpdef identifier)
360 (define mk-py-list
361 (lambda (targlist tfpdef)
362 (let* ((t (f-or (f-seq "=" ws test ws) FALSE))
363 (arg (f-list ws tfpdef ws t ws))
364 (arg.. (ff* (f-seq ws "," arg)))
365 (args (f-cons arg arg..))
366 (arg* (f-seq ws "*" ws (f-list tfpdef ws arg..)))
367 (arg** (f-seq ws "**" tfpdef)))
368 (f-cons
369 (f-out targlist)
370 (f-or
371 (f-cons args
372 (f-or (f-list arg* (f-or arg** FALSE))
373 (f-list FALSE FALSE)))
374 (f-list FALSE arg* (f-or arg** FALSE))
375 (f-list FALSE FALSE arg**))))))
376
377 (define typedargslist (mk-py-list #:types-args-list tfpdef))
378 (define varargslist (mk-py-list #:var-args-list vfpdef))
379
380 (define parameters (f-seq! (f-tag "(") (f-or typedargslist
381 (f-out (list #f #f #f)))
382 (f-tag ")")))
383
384 (set! funcdef
385 (p-freeze 'funcdef
386 (<p-lambda> (c)
387 (.. (c) ((f-tag "def") c))
388 (.. (c) (ws c))
389 (.. (id) (identifier c))
390 (.. (c) (ws id))
391 (.. (pa) (parameters c))
392 (.. (c) (ws pa))
393 (.. (te) ((ff? (f-seq! ws "->" ws test)) c))
394 (.. (su) (f-seq! ":" ws suite))
395 (<p-cc> (list #:funcdef id pa te su)))
396 mk-id))
397
398 (define simple_stmt (f-list 'simple_stmt #:stmt
399 (f-seq
400 (f-cons (Ds small_stmt)
401 (ff* (f-seq ";" (Ds small_stmt))))
402 (f? ";") (f? ws) nl)))
403 (set! small_stmt
404 (Ds
405 (f-or 'small expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt
406 nonlocal_stmt assert_stmt)))
407
408 (set! expr_stmt
409 (f-list 'expr_stmt
410 #:expr-stmt
411 (Ds testlist_star_expr)
412 (f-or
413 (f-list #:augassign
414 (Ds augassign)
415 (f-or (Ds yield_expr) (Ds testlist)))
416 (f-cons #:assign
417 (ff* (f-seq "="
418 (f-or (Ds yield_expr)
419 (Ds testlist_star_expr))))))))
420
421 (set! testlist_star_expr
422 (f-cons 'testlist_star_expr
423 (f-or (Ds test) (Ds star_expr))
424 (f-seq
425 (ff* (f-seq "," (f-or (Ds test) (Ds star_expr))))
426 (f? ","))))
427
428
429 (set! augassign
430 (mk-token
431 (f-seq 'augassign
432 ws
433 (apply f-or!
434 (map f-tag
435 '("+=" "-=" "*=" "/=" "%=" "&=" "|=" "^="
436 "<<=" ">>=" "**=" "//=")))
437 ws)))
438
439 (set! del_stmt (f-cons 'del_stmt #:del (f-seq "del" (Ds exprlist))))
440
441 (set! pass_stmt (f-seq 'pass_stmt "pass" #:pass))
442
443 (set! flow_stmt
444 (f-or 'flow_stmt
445 (f-seq "break" #:break)
446 (f-seq "coninue" #:continue)
447 (f-cons #:return (f-seq "return" (ff? (Ds testlist))))
448 (Ds yield_expr)
449 (f-cons #:raise (f-seq "raise"
450 (f-or (f-cons (Ds test)
451 (ff?
452 (f-seq "from" (Ds test))))
453 (f-cons FALSE FALSE))))))
454
455 (set! import_name (f-seq "import" dotted_as_names))
456 (set! import_stmt (f-or 'import_stmt import_name (Ds import_from)))
457
458
459
460 (define dottir (mk-token (f-or! (f-tag! "...") (f-tag! "."))))
461 (define dots* (ff* dottir))
462 (define dots+ (ff+ dottir))
463
464 (set! import_from
465 (f-seq 'import_from "from"
466 (f-cons
467 (f-or (f-cons dots* (Ds dotted_name)) dots+)
468 (f-seq "import" (f-or "*"
469 (f-seq "(" (Ds import_as_names) ")")
470 (Ds import_as_names))))))
471
472 (define import_as_name
473 (f-cons identifier (ff? (f-seq "as" identifier))))
474
475 (define dotted_as_name
476 (f-cons dotted_name (ff? (f-seq "as" identifier))))
477
478 (set! import_as_names
479 (f-seq
480 (f-cons import_as_name (ff* (f-seq "," import_as_name)))
481 (f? ",")))
482
483 (set! dotted_as_names
484 (f-cons dotted_as_name (ff* (f-seq "," dotted_as_name))))
485
486 (set! dotted_name
487 (f-cons identifier (ff* (f-seq "." identifier))))
488
489 (define comma_name
490 (f-cons identifier (ff* (f-seq "," identifier))))
491
492 (set! global_stmt
493 (f-cons 'global #:global (f-seq "global" comma_name)))
494
495 (set! nonlocal_stmt
496 (f-cons 'nonlocal #:nonlocal (f-seq "nonlocal" comma_name)))
497
498 (set! assert_stmt
499 (f-cons 'assert #:assert
500 (f-seq "assert" (f-cons (Ds test) (ff* (f-seq "," (Ds test)))))))
501
502
503 (define compound_stmt
504 (Ds
505 (f-or! 'compound
506 if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef
507 decorated)))
508
509 (define single_input (f-or! (f-seq indent= simple_stmt)
510 (f-seq indent= compound_stmt nl)
511 (f-seq nl)))
512
513 (set! stmt (f-or 'stmt simple_stmt compound_stmt))
514
515 (set! if_stmt
516 (f-cons 'if_stmt
517 #:if
518 (f-seq
519 "if"
520 (f-cons (Ds test)
521 (f-seq ":"
522 (f-cons (Ds suite)
523 (f-cons
524 (ff+ (f-seq "elif"
525 (f-cons (Ds test)
526 (f-seq ":" (Ds suite)))))
527 (ff? (f-seq "else" ":" (Ds suite))))))))))
528
529 (set! while_stmt
530 (f-cons 'while
531 #:while
532 (f-seq "while"
533 (f-cons test
534 (f-seq ":"
535 (f-cons suite
536 (ff? (f-seq "else" ":" suite))))))))
537
538 (set! for_stmt
539 (f-cons 'for
540 #:for
541 (f-seq "for"
542 (f-cons exprlist
543 (f-seq "in"
544 (f-cons testlist
545 (f-cons (f-seq ":" suite)
546 (ff? (f-seq "else" ":" suite)))))))))
547
548 (set! try_stmt
549 (f-cons 'try
550 #:try
551 (f-seq ws "try" ":"
552 (f-cons suite
553 (f-or
554 (f-cons
555 (ff+ (f-seq except_clause ":" suite))
556 (f-cons
557 (ff? (f-seq "else" ":" suite))
558 (ff? (f-seq "finally" ":" ws suite))))
559 (f-cons
560 FALSE
561 (f-cons
562 FALSE
563 (f-seq "finally" ":" suite))))))))
564
565 (set! with_item
566 (f-cons test (f-seq "as" (Ds expr))))
567
568 (set! with_stmt
569 (f-cons 'with
570 #:with
571 (f-seq "with"
572 (f-cons
573 (f-cons with_item
574 (ff* (f-seq "," with_item)))
575 (f-seq ":" (Ds suite))))))
576
577
578 (set! except_clause
579 (f-seq 'except "except"
580 (ff? (f-cons (Ds test) (ff? (f-seq "as" identifier))))))
581
582 (set! suite
583 (f-cons #:suite
584 (f-or (f-list simple_stmt)
585 (f-seq nl indent+
586 (f-cons stmt
587 (ff* (f-seq indent= stmt)))
588 indent-))))
589
590 (set! test
591 (f-or 'test
592 (f-cons #:if
593 (f-cons (f-seq "if" (Ds or_test))
594 (f-seq "else" test)))
595 (Ds lambdef)
596 (f-cons (f-out #f)
597 (f-cons (Ds or_test) FALSE))))
598
599
600 (define test_nocond
601 (f-or 'nocond (Ds or_test) (Ds lambdef_nocond)))
602
603 (set! lambdef
604 (f-cons 'lambdef
605 #:lambdef
606 (f-cons (f-seq "lambda" (ff? (Ds varargslist) '()))
607 (f-seq ":" (Ds test)))))
608 (set! lambdef_nocond
609 (f-cons 'lambdef_nocond
610 'lambdef #:lambdef
611 (f-cons (f-seq "lambda" (ff? (Ds varargslist) '()))
612 (f-seq ":" test_nocond))))
613
614 (set! or_test
615 (p-freeze 'or_test
616 (f-or! 'or_test
617 (f-cons #:or (f-cons (Ds and_test) (ff+ (f-seq "or" (Ds and_test)))))
618 (Ds and_test))
619 mk-id))
620
621 (set! and_test
622 (p-freeze 'and_test
623 (f-or! 'and_test
624 (f-cons #:and (f-cons (Ds not_test) (ff+ (f-seq "and" (Ds not_test)))))
625 (Ds not_test))
626 mk-id))
627
628 (set! not_test
629 (f-or! 'not_test
630 (f-cons #:not (f-seq "not" not_test))
631 (Ds comparison)))
632
633 (set! comparison
634 (p-freeze 'comparison
635 (f-or! 'comparison
636 (f-cons #:comp
637 (f-cons (Ds expr)
638 (ff+ (f-cons (Ds comp_op) (Ds expr)))))
639 (Ds expr))
640 mk-id))
641
642 (set! comp_op
643 (f-or! 'comp_op
644 (f-seq (f-seq "not" "in" ) (f-out "notin"))
645 (f-seq (f-seq "is" "not") (f-out "isnot"))
646 (apply f-or!
647 (map (lambda (x) (f-seq x (f-out x)))
648 '("<" ">" "==" ">=" "<=" "<>" "!=" "in" "is")))))
649
650
651 (set! star_expr (f-cons 'star_expr #:starexpr (f-seq "*" (Ds expr))))
652 (set! expr
653 (p-freeze 'expr
654 (f-or! 'expr
655 (f-cons #:bxor (f-cons (Ds xor_expr) (ff+ (f-seq "|" (Ds xor_expr)))))
656 (Ds xor_expr))
657 mk-id))
658
659 (set! xor_expr
660 (p-freeze 'xor
661 (f-or! 'xor
662 (f-cons #:band (f-cons (Ds and_expr) (ff+ (f-seq "^" (Ds and_expr)))))
663 (Ds and_expr))
664 mk-id))
665
666 (set! and_expr
667 (p-freeze 'and
668 (f-or! 'and
669 (f-cons #:band (f-cons (Ds shift_expr)
670 (ff+ (f-seq "&" (Ds shift_expr)))))
671 (Ds shift_expr))
672 mk-id))
673
674 (set! shift_expr
675 (p-freeze 'shift
676 (f-or! 'shift
677 (f-cons #:<< (f-cons (Ds arith_expr) (ff+ (f-seq "<<" (Ds arith_expr) ))))
678 (f-cons #:>> (f-cons (Ds arith_expr) (ff+ (f-seq ">>" (Ds arith_expr) ))))
679 (Ds arith_expr))
680 mk-id))
681
682 (set! arith_expr
683 (p-freeze 'arith
684 (f-or! 'arith
685 (f-cons #:+ (f-cons (Ds term) (ff+ (f-seq 'rest "+" (Ds term) ))))
686 (f-cons #:- (f-cons (Ds term) (ff+ (f-seq "-" (Ds term) ))))
687 (f-seq 'single_term (Ds term)))
688 mk-id))
689
690 (set! term
691 (p-freeze 'term
692 (f-or! 'term
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-cons #:% (f-cons (Ds factor) (ff+ (f-seq "%" (Ds factor) ))))
697 (f-seq 'single-factor (Ds factor)))
698 mk-id))
699
700
701 (set! factor
702 (p-freeze 'factor
703 (f-or! 'factor
704 (f-cons #:u+ (f-seq "+" factor))
705 (f-cons #:u- (f-seq "-" factor))
706 (f-cons #:u~ (f-seq "~" factor))
707 (Ds power))
708 mk-id))
709
710 (set! power
711 (p-freeze 'power
712 (f-cons 'power #:power
713 (f-cons (Ds atom)
714 (f-cons (ff* (Ds trailer))
715 (f-or! (f-seq "**" factor)
716 FALSE))))
717 mk-id))
718
719 (set! trailer
720 (f-or! 'trailer
721 (f-seq "(" (ff? (Ds arglist)) ")")
722 (f-seq "[" (Ds subscriptlist) "]")
723 (f-seq "." identifier)))
724
725 (set! atom
726 (p-freeze 'atom
727 (f-or! 'atom
728 (f-cons
729 #:subexpr
730 (f-seq "(" (ff? (f-or! (Ds yield_expr) (Ds testlist_comp))) ")"))
731 (f-cons
732 #:list
733 (f-seq "[" (ff? (Ds testlist_comp)) ")"))
734 (f-cons
735 #:dict
736 (f-seq "{" (ff? (Ds dictorsetmaker)) "}"))
737 (f-seq 'identifier identifier)
738 (f-seq 'number number)
739 (f-cons #:string (ff+ string))
740 (f-cons #:... "...")
741 (f-cons #:None "None")
742 (f-cons #:True "True")
743 (f-cons #:false "False"))
744 mk-id))
745
746 (set! testlist_comp
747 (f-cons
748 (f-or! star_expr test)
749 (f-or!
750 comp_for
751 (f-seq (ff* (f-seq "," (f-or! star_expr test)))
752 (f? ",")))))
753
754 (set! subscriptlist
755 (f-cons
756 subscript
757 (f-seq (ff* (f-seq "," (Ds subscript))) (f? ","))))
758
759 (set! subscript
760 (f-or!
761 (f-list (ff? test) ":" (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* "," 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!
793 (f-list (f-seq (ff+ (f-seq (Ds argument) ",")) (f? ","))
794 FALSE FALSE)
795 (f-list (f-seq (ff* (f-seq (Ds argument) ",")))
796 FALSE
797 (ff? (f-seq "**" test)))
798 (f-list (f-seq (ff* (f-seq (Ds argument) ",")))
799 (f-seq "*" (f-cons test (ff* (f-seq "," (Ds argument)))))
800 (ff? (f-seq "," "**" test)))))
801
802 (set! argument
803 (f-or!
804 (f-list #:= test (f-seq "=" test))
805 (f-list #:comp test (ff? (Ds comp_for)))))
806
807 (define comp_iter (f-or! (Ds comp_for) (Ds comp_if)))
808 (define comp_for (f-list (f-seq "for" exprlist)
809 (f-seq "in" or_test)
810 (ff? comp_iter)))
811 (set! comp_if (f-list (f-seq "if" test_nocond)
812 (ff? comp_iter)))
813
814 (set! yield_expr
815 (f-list #:yield (f-seq "yield" (ff? (Ds yield_arg)))))
816
817 (set! yield_arg
818 (f-or!
819 (f-list #:from (f-seq "from" test))
820 (f-list #:list testlist)))
821
822
823 (define (p str)
824 (with-fluids ((*whitespace* (f* (f-reg "[ \t\r]"))))
825 (ppp (parse str (f-seq nl single_input)))
826 (if #f #f)))