diff options
| -rw-r--r-- | modules/language/python/parser-tool.scm | 4 | ||||
| -rw-r--r-- | modules/language/python/parser.scm | 237 |
2 files changed, 125 insertions, 116 deletions
diff --git a/modules/language/python/parser-tool.scm b/modules/language/python/parser-tool.scm index cd94ef7..00359c9 100644 --- a/modules/language/python/parser-tool.scm +++ b/modules/language/python/parser-tool.scm @@ -11,12 +11,12 @@ #:export (f-seq f-seq! f-or f-or! f-not f-not! f-true f-false f-cons f-cons* f-list INDENT <p-lambda> f* ff* ff? f? ff+ f+ f-reg f-reg! f-tag f-tag! f-eof f-out f-and f-and! - mk-token p-freeze parse + mk-token p-freeze parse f-append .. xx <p-cc> f-pk)) ;; Preliminary -(define do-print #f) +(define do-print #t) (define pp (case-lambda ((s x) diff --git a/modules/language/python/parser.scm b/modules/language/python/parser.scm index 43051ff..180ec0a 100644 --- a/modules/language/python/parser.scm +++ b/modules/language/python/parser.scm @@ -59,6 +59,7 @@ (define (wn+_ n i) (<p-lambda> (c) + (<pp> `(,n ,i)) (<or> (<and!> (.. (c) ((f-tag " ") c)) @@ -70,7 +71,7 @@ (.. (c) ((f-tag "\r") c)) (.. ((wn+_ n i) c))) (<and!> - (when (i > n)) + (when (> i n)) (<with-bind> ((INDENT (cons i INDENT))) (<p-cc> c)))))) @@ -91,14 +92,16 @@ (<with-bind> ((INDENT (cdr INDENT))) (<p-cc> c)))) - -(define ih (f-reg! "a-zA-Z_")) -(define i.. (f-or ih (f-reg! "0-9"))) -(define identifier_ (f-seq ih (f* i..))) +(define identifier__ + (let () + (define ih (f-reg! "[a-zA-Z_]")) + (define i.. (f-or! 'or ih (f-reg! "[0-9]"))) + (mk-token + (f-seq ih (f* i..))))) (define keyw (make-hash-table)) (for-each - (lambda (x) (hash-set! keyw x #t)) + (lambda (x) (hash-set! keyw (symbol->string x) #t)) '(False None True and as assert break class continue def del elif else except finally for from global if import in is lambda nonlocal not or pass raise return try @@ -106,8 +109,7 @@ (define decimal (mk-token (f-seq (f-reg! "[1-9]") (f* (f-reg! "[0-9]"))))) (define oct (mk-token - (mk-token - (f-seq "0" (f-reg "[oO]") (f+ (f-reg! "[0-7]")))))) + (f-seq "0" (f-reg "[oO]") (f+ (f-reg! "[0-7]"))))) (define hex (mk-token (f-seq "0" (f-reg "[xX]") (f+ (f-reg! "[0-7a-fA-F]"))))) (define bin (mk-token @@ -156,7 +158,7 @@ (f-or! imag float integer) mk-id)) -(define symbol +(define identifier_ (let () (define (__*__ i) (match (string->list i) @@ -179,26 +181,27 @@ (_ #f))) (<p-lambda> (c) - (.. (i) (identifier_ c)) + (.. (i) (identifier__ c)) (cond ((__*__ i) - (#:identifier i #:system)) + (<p-cc> `(#:identifier ,i #:system))) ((__* i) - (#:identifier i #:private)) + (<p-cc> `(#:identifier ,i #:private))) ((_* i) - (#:identifier i #:local)) + (<p-cc> `(#:identifier ,i #:local))) ((eq? i '_) - (#:_)) + (<p-cc> #:_)) ((hash-ref keyw i) - (#:keyword i)) + (<p-cc> `(#:keyword ,i))) (else - (#:identifier i)))))) + (<p-cc> `(#:identifier ,i))))))) (define identifier (<p-lambda> (c) (.. (i) (identifier_ c)) - (when (not (eq? (car i) #:keyword)) - (<p-cc> c)))) + (if (not (eq? (car i) #:keyword)) + (<p-cc> i) + <fail>))) ;;;; +++++++++++++++++++++++++++++++++++++++++++++++ STRING +++++++++++++++ (define string-prefix (mk-token (f-reg! "[ruRU]"))) @@ -220,14 +223,11 @@ (f-seq! "'" (f* short-string-item) "'") (f-seq! "\"" (f* short-string-item) "\"")))) -(define string-literal +(define string (p-freeze 'string-literal - (<p-lambda> (c) - (xx (pre) (<or> - (.. (string-prefix c)) - (<p-cc> #f))) - (.. (str) (f-or! long-string short-string)) - (<p-cc> (#:string pre str))) + (f-list #:string + (ff? string-prefix) + (f-or! long-string short-string)) mk-id)) ;; ++++++++++++++++++++++++++++++++++++++++++ BYTE ++++++++++++++++++++++++++ @@ -273,7 +273,7 @@ ; +++++++++++++++++++++++++++++++++++ PARSER SUBSECTION +++++++++++++++++ (define stmt #f) (define testlist #f) -(define dotted_name #f) +(define dottaed_name #f) (define arglist #f) (define classdef #f) (define funcdef #f) @@ -333,14 +333,15 @@ (define argument #f) (define comp_if #f) (define yield_arg #f) - +(define dotted_name #f) (define file-input (f-seq (f* (f-or nl (f-seq indent= stmt))) f-eof)) (define eval-input (f-seq testlist (f* nl) f-eof)) -(define decorator (f-cons (f-seq ws "@" ws dotted_name ws) - (f-seq (ff? (f-seq "(" ws (ff? arglist) ws ")" ws)) +(define decorator (f-cons (f-seq ws "@" ws (Ds dotted_name) ws) + (f-seq (ff? (f-seq "(" ws (ff? (Ds arglist)) + ws ")" ws)) f-nl))) (define decorators (ff+ decorator)) @@ -352,54 +353,52 @@ (define FALSE (f-out #f)) (define tfpdef - (f-cons (f-seq ws identifier ws) (f-or - (f-seq ":" ws test ws) - FALSE))) + (f-cons identifier (f-or + (f-seq ":" ws test ws) + FALSE))) (define vfpdef identifier) (define mk-py-list (lambda (targlist tfpdef) - (let* ((t (f-or (f-seq "=" ws test ws) FALSE)) - (arg (f-list ws tfpdef ws t ws)) - (arg.. (ff* (f-seq ws "," arg))) + (let* ((t (f-or (f-seq "=" (Ds test)) FALSE)) + (arg (f-list tfpdef t)) + (arg.. (ff* (f-seq "," arg))) (args (f-cons arg arg..)) - (arg* (f-seq ws "*" ws (f-list tfpdef ws arg..))) - (arg** (f-seq ws "**" tfpdef))) + (arg* (f-seq "*" (f-list tfpdef arg..))) + (arg** (f-seq "**" tfpdef))) (f-cons - (f-out targlist) - (f-or + targlist + (f-or! (f-cons args (f-or (f-list arg* (f-or arg** FALSE)) (f-list FALSE FALSE))) (f-list FALSE arg* (f-or arg** FALSE)) - (f-list FALSE FALSE arg**)))))) + (f-list FALSE FALSE arg**) + (f-list 'a1 '() FALSE FALSE)))))) (define typedargslist (mk-py-list #:types-args-list tfpdef)) (define varargslist (mk-py-list #:var-args-list vfpdef)) -(define parameters (f-seq! (f-tag "(") (f-or typedargslist - (f-out (list #f #f #f))) - (f-tag ")"))) +(define parameters (f-seq! 'parameters + "(" (f-or typedargslist + (f-out (list #f #f #f))) + ")")) (set! funcdef (p-freeze 'funcdef - (<p-lambda> (c) - (.. (c) ((f-tag "def") c)) - (.. (c) (ws c)) - (.. (id) (identifier c)) - (.. (c) (ws id)) - (.. (pa) (parameters c)) - (.. (c) (ws pa)) - (.. (te) ((ff? (f-seq! ws "->" ws test)) c)) - (.. (su) (f-seq! ":" ws suite)) - (<p-cc> (list #:funcdef id pa te su))) - mk-id)) + (f-list 'fundef + #:def + (f-seq "def" identifier) + parameters + (ff? (f-seq! "->" (Ds test))) + (f-seq ":" (Ds suite))) + mk-id)) (define simple_stmt (f-list 'simple_stmt #:stmt (f-seq (f-cons (Ds small_stmt) (ff* (f-seq ";" (Ds small_stmt)))) - (f? ";") (f? ws) nl))) + (f? ";") (f? ws) (f-or nl f-eof)))) (set! small_stmt (Ds (f-or 'small expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt @@ -409,11 +408,11 @@ (f-list 'expr_stmt #:expr-stmt (Ds testlist_star_expr) - (f-or - (f-list #:augassign + (f-or! + (f-list 'augassign #:augassign (Ds augassign) (f-or (Ds yield_expr) (Ds testlist))) - (f-cons #:assign + (f-cons 'assign #:assign (ff* (f-seq "=" (f-or (Ds yield_expr) (Ds testlist_star_expr)))))))) @@ -473,7 +472,7 @@ (f-cons identifier (ff? (f-seq "as" identifier)))) (define dotted_as_name - (f-cons dotted_name (ff? (f-seq "as" identifier)))) + (f-cons (Ds dotted_name) (ff? (f-seq "as" identifier)))) (set! import_as_names (f-seq @@ -508,7 +507,7 @@ (define single_input (f-or! (f-seq indent= simple_stmt) (f-seq indent= compound_stmt nl) - (f-seq nl))) + (f-seq (f-or nl f-eof)))) (set! stmt (f-or 'stmt simple_stmt compound_stmt)) @@ -521,7 +520,7 @@ (f-seq ":" (f-cons (Ds suite) (f-cons - (ff+ (f-seq "elif" + (ff* (f-seq "elif" (f-cons (Ds test) (f-seq ":" (Ds suite))))) (ff? (f-seq "else" ":" (Ds suite)))))))))) @@ -530,40 +529,40 @@ (f-cons 'while #:while (f-seq "while" - (f-cons test + (f-cons (Ds test) (f-seq ":" - (f-cons suite - (ff? (f-seq "else" ":" suite)))))))) + (f-cons (Ds suite) + (ff? (f-seq "else" ":" (Ds suite))))))))) (set! for_stmt (f-cons 'for #:for (f-seq "for" - (f-cons exprlist + (f-cons (Ds exprlist) (f-seq "in" - (f-cons testlist - (f-cons (f-seq ":" suite) - (ff? (f-seq "else" ":" suite))))))))) + (f-cons (Ds testlist) + (f-cons (f-seq ":" (Ds suite)) + (ff? (f-seq "else" ":" (Ds suite)))))))))) (set! try_stmt (f-cons 'try #:try (f-seq ws "try" ":" - (f-cons suite + (f-cons (Ds suite) (f-or (f-cons - (ff+ (f-seq except_clause ":" suite)) + (ff+ (f-seq (Ds except_clause) ":" (Ds suite))) (f-cons - (ff? (f-seq "else" ":" suite)) - (ff? (f-seq "finally" ":" ws suite)))) + (ff? (f-seq "else" ":" (Ds suite))) + (ff? (f-seq "finally" ":" ws (Ds suite))))) (f-cons FALSE (f-cons FALSE - (f-seq "finally" ":" suite)))))))) + (f-seq "finally" ":" (Ds suite))))))))) (set! with_item - (f-cons test (f-seq "as" (Ds expr)))) + (f-cons (Ds test) (f-seq "as" (Ds expr)))) (set! with_stmt (f-cons 'with @@ -581,35 +580,35 @@ (set! suite (f-cons #:suite - (f-or (f-list simple_stmt) - (f-seq nl indent+ - (f-cons stmt - (ff* (f-seq indent= stmt))) - indent-)))) + (f-or! (f-list simple_stmt) + (f-seq nl indent+ + (f-cons stmt + (ff* (f-seq indent= stmt))) + indent-)))) (set! test - (f-or 'test - (f-cons #:if - (f-cons (f-seq "if" (Ds or_test)) - (f-seq "else" test))) - (Ds lambdef) - (f-cons (f-out #f) - (f-cons (Ds or_test) FALSE)))) - + (f-or! 'test + (f-list #:test + (Ds or_test) + (ff? (f-list + (f-seq "if" (Ds or_test)) + (f-seq "else" test)))) + (Ds lambdef))) (define test_nocond (f-or 'nocond (Ds or_test) (Ds lambdef_nocond))) (set! lambdef - (f-cons 'lambdef + (f-list 'lambdef #:lambdef - (f-cons (f-seq "lambda" (ff? (Ds varargslist) '())) - (f-seq ":" (Ds test))))) + (f-seq "lambda" (ff? (Ds varargslist) '())) + (f-seq ":" (Ds test)))) + (set! lambdef_nocond - (f-cons 'lambdef_nocond + (f-list 'lambdef_nocond 'lambdef #:lambdef - (f-cons (f-seq "lambda" (ff? (Ds varargslist) '())) - (f-seq ":" test_nocond)))) + (f-seq "lambda" (ff? (Ds varargslist) '())) + (f-seq ":" test_nocond))) (set! or_test (p-freeze 'or_test @@ -645,7 +644,7 @@ (f-seq (f-seq "is" "not") (f-out "isnot")) (apply f-or! (map (lambda (x) (f-seq x (f-out x))) - '("<" ">" "==" ">=" "<=" "<>" "!=" "in" "is"))))) + '("==" ">=" "<=" "<>" "!=" "in" "is" "<" ">" ))))) (set! star_expr (f-cons 'star_expr #:starexpr (f-seq "*" (Ds expr)))) @@ -736,11 +735,11 @@ (f-seq "{" (ff? (Ds dictorsetmaker)) "}")) (f-seq 'identifier identifier) (f-seq 'number number) - (f-cons #:string (ff+ string)) - (f-cons #:... "...") - (f-cons #:None "None") - (f-cons #:True "True") - (f-cons #:false "False")) + (ff+ string) + (f-seq #:... "...") + (f-seq #:None "None") + (f-seq #:True "True") + (f-seq #:false "False")) mk-id)) (set! testlist_comp @@ -752,17 +751,18 @@ (f? ","))))) (set! subscriptlist - (f-cons - subscript + (f-cons* 'subscriptlist + #:subscripts + (Ds subscript) (f-seq (ff* (f-seq "," (Ds subscript))) (f? ",")))) -(set! subscript - (f-or! - (f-list (ff? test) ":" (ff? test) (ff? (Ds sliceop))) +(set! subscript + (f-or! 'subscript + (f-list (ff? test '()) (f-seq ":" (ff? test '())) (ff? (Ds sliceop))) (f-list test FALSE FALSE))) (set! sliceop - (f-seq ":" (ff? test))) + (f-seq ":" (ff? test '()))) (define exprlist (let ((f (f-or expr star_expr))) @@ -771,7 +771,7 @@ (set! testlist (f-cons test - (f-seq (ff* "," test) (f? ",")))) + (f-seq (ff* (f-seq "," test)) (f? ",")))) (set! dictorsetmaker (let ((f (f-cons test (f-seq ":" test)))) @@ -789,15 +789,24 @@ (f-seq ":" suite))) (set! arglist - (f-or! - (f-list (f-seq (ff+ (f-seq (Ds argument) ",")) (f? ",")) - FALSE FALSE) - (f-list (f-seq (ff* (f-seq (Ds argument) ","))) - FALSE - (ff? (f-seq "**" test))) - (f-list (f-seq (ff* (f-seq (Ds argument) ","))) + (f-or! 'arglist + (f-list 'arg0 + #:arglist + (f-seq (ff* (f-seq (Ds argument) ","))) (f-seq "*" (f-cons test (ff* (f-seq "," (Ds argument))))) - (ff? (f-seq "," "**" test))))) + (ff? (f-seq "," "**" test))) + + (f-list 'arg1 + #:arglist + (f-seq (ff* (f-seq (Ds argument) ","))) + FALSE + (f-seq "**" test)) + + (f-list 'arg2 + #:arglist + (f-seq (f-append (ff* (f-seq (Ds argument) ",")) + (f-seq (Ds argument) (f? ",")))) + FALSE FALSE))) (set! argument (f-or! |