diff options
author | Ricardo Wurmus <rekado@elephly.net> | 2019-06-04 12:18:40 +0200 |
---|---|---|
committer | Ricardo Wurmus <rekado@elephly.net> | 2019-06-04 12:18:40 +0200 |
commit | b8cd9073f7d555d47802220a7286be1ad29a258b (patch) | |
tree | 6547cae52dc6d31426e21b6c22675a3ca19c165f | |
parent | 46a1ce8c8dc4d3f3333694fd35c85fc97941e9f1 (diff) |
parser: Remove unused module.
This module has been replaced with (parser stis-parser lang
python3-parser).
* modules/language/python/parser.scm: Remove file.
-rw-r--r-- | modules/language/python/parser.scm | 849 |
1 files changed, 0 insertions, 849 deletions
diff --git a/modules/language/python/parser.scm b/modules/language/python/parser.scm deleted file mode 100644 index 55fc02e..0000000 --- a/modules/language/python/parser.scm +++ /dev/null @@ -1,849 +0,0 @@ -(define-module (language python parser) - #:use-module (logic guile-log) - #:use-module ((logic guile-log parser) #:select (*whitespace*)) - #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) - #:use-module (language python parser-tool) - #:export (p python-parser)) - -(define do-print #f) -(define pp - (case-lambda - ((s x) - (when do-print - (pretty-print `(,s ,(syntax->datum x)))) - x) - ((x) - (when do-print - (pretty-print (syntax->datum x))) - x))) -(define ppp - (case-lambda - ((s x) - (pretty-print `(,s ,(syntax->datum x))) - x) - ((x) - (pretty-print (syntax->datum x)) - x))) - -(define-syntax-rule (Ds f) (lambda x (apply f x))) -(define-syntax-rule (DDs op f ...) (op (lambda x (apply f x)) ...)) - -(define divide truncate/) -;; +++++++++++++++++++++++++++++++++++++ SCANNER SUBSECTION -(define nl (f-or f-nl f-eof)) -(define com (f-seq "#" (f* (f-not f-nl)) nl)) -(define w (f-reg "[\t\r| ]")) -(define ws+ (f+ (f-or (f-reg "[\t\r| ]") com))) -(define ws* (f+ (f-or (f-reg "[\t\r| ]") com))) -(define ws ws*) - - -(define (wn_ n i) - (<p-lambda> (c) - (cond - ((> i n) <fail>) - ((= i n) - (.. ((f-and (f-not w) f-true) c))) - ((< i n) - (<or> - (<and!> - (.. (c) ((f-tag " ") c)) - (.. ((wn_ n (+ i 1)) c))) - (<and!> - (.. (c) ((f-tag "\t") c)) - (.. ((wn_ n (divide (+ i 8) 8)) c))) - (<and!> - (.. (c) ((f-tag "\r") c)) - (.. ((wn_ n i) c)))))))) - -(define (wn+_ n i) - (<p-lambda> (c) - (<pp> `(,n ,i)) - (<or> - (<and!> - (.. (c) ((f-tag " ") c)) - (.. ((wn+_ n (+ i 1)) c))) - (<and!> - (.. (c) ((f-tag "\t") c)) - (.. ((wn+_ n (divide (+ i 8) 8)) c))) - (<and!> - (.. (c) ((f-tag "\r") c)) - (.. ((wn+_ n i) c))) - (<and!> - (when (> i n)) - (<with-bind> ((INDENT (cons i INDENT))) - (<p-cc> c)))))) - -(define wn+ - (<p-lambda> (c) - (<let> ((n (car INDENT))) - (.. ((wn+_ n 0) c))))) - -(define wn - (<p-lambda> (c) - (<let> ((n (car INDENT))) - (.. ((wn_ n 0) c))))) - -(define indent= wn) -(define indent+ wn+) -(define indent- - (<p-lambda> (c) - (<with-bind> ((INDENT (cdr INDENT))) - (<p-cc> c)))) - -(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 (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 - while with yield)) - -(define decimal (mk-token (f-seq (f-reg! "[1-9]") (f* (f-reg! "[0-9]"))))) -(define oct (mk-token - (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 - (f-seq "0" (f-reg "[bB]") (f+ (f-reg! "[01]"))))) - -(define integer - (<p-lambda> (c) - (<and!> - (<or> - (<and> - (.. (c) (decimal c)) - (<p-cc> (string->number c 10))) - (<and> - (.. (c) (oct c)) - (<p-cc> (string->number c 8))) - (<and> - (.. (c) (hex c)) - (<p-cc> (string->number c 16))) - (<and> - (.. (c) (bin c)) - (<p-cc> (string->number c 2))))))) - -(define intpart (f+ (f-reg! "[0-9]"))) -(define fraction (f-seq (f-tag! ".") intpart)) -(define exponent (f-seq (f-reg! "[eE]") (f? (f-reg! "[+-]")) intpart)) -(define pointfloat (f-or! (f-seq (f? intpart) fraction) - (f-seq intpart (f-tag! ".")))) -(define exponentfloat (f-seq (f-or intpart pointfloat) exponent)) - -(define floatnumber (mk-token (f-or! exponentfloat pointfloat))) -(define float - (<p-lambda> (c) - (.. (c) (floatnumber c)) - (<p-cc> (string->number c)))) - -(define imagnumber (mk-token (f-seq (f-or floatnumber integer) (f-reg "[jJ]")))) -(define imag - (<p-lambda> (c) - (.. (c) (imagnumber c)) - (<p-cc> (string->number (string-append "0+" c "i"))))) - -(define (mk-id S c cc) cc) - -(define number - (p-freeze 'number - (f-or! imag float integer) - mk-id)) - -(define identifier_ - (let () - (define (__*__ i) - (match (string->list i) - ((#\_ #\_ . l) - (match (reverse l) - ((#\_ #\_ . l) #t) - (_ #f))) - (_ #f))) - - (define (__* i) - (match (string->list i) - ((#\_ #\_ . l) - #t) - (_ #f))) - - (define (_* i) - (match (string->list i) - ((#\_ . l) - #t) - (_ #f))) - - (<p-lambda> (c) - (.. (i) (identifier__ c)) - (cond - ((__*__ i) - (<p-cc> `(#:identifier ,i #:system))) - ((__* i) - (<p-cc> `(#:identifier ,i #:private))) - ((_* i) - (<p-cc> `(#:identifier ,i #:local))) - ((eq? i '_) - (<p-cc> #:_)) - ((hash-ref keyw i) - (<p-cc> `(#:keyword ,i))) - (else - (<p-cc> `(#:identifier ,i))))))) - -(define identifier - (<p-lambda> (c) - (.. (i) (identifier_ c)) - (if (not (eq? (car i) #:keyword)) - (<p-cc> i) - <fail>))) - -;;;; +++++++++++++++++++++++++++++++++++++++++++++++ STRING +++++++++++++++ -(define string-prefix (mk-token (f-reg! "[ruRU]"))) -(define short-string-char (f-not! (f-reg "[\n\"']"))) -(define long-string-char (f-not! "\n")) -(define string-esc (f-seq (f-tag "\\") (f-reg! "."))) -(define short-string-item (f-or short-string-char string-esc)) -(define long-string-item (f-or long-string-char string-esc)) - -(define long-string - (mk-token - (f-or - (f-seq! "'''" (f* long-string-item) "'''") - (f-seq! "\"\"\"" (f* long-string-item) "\"\"\"")))) - -(define short-string - (mk-token - (f-or - (f-seq! "'" (f* short-string-item) "'") - (f-seq! "\"" (f* short-string-item) "\"")))) - -(define string - (p-freeze 'string-literal - (f-list #:string - (ff? string-prefix) - (f-or! long-string short-string)) - mk-id)) - -;; ++++++++++++++++++++++++++++++++++++++++++ BYTE ++++++++++++++++++++++++++ - -(define bytes-prefix - (mk-token - (f-or! - (f-seq! (f-tag! "b") (f-or f-true (f-reg! "[rR]"))) - (f-seq! (f-tag! "B") (f-or f-true (f-reg! "[rR]"))) - (f-seq! (f-tag! "r") (f-or f-true (f-reg! "[bB]"))) - (f-seq! (f-tag! "R") (f-or f-true (f-reg! "[bB]")))))) - -(define bytes-esc (f-seq "\\" (f-reg "."))) - -(define short-bytes-char (f-not! (f-reg "[\\\n'\"]"))) -(define long-bytes-char (f-not! (f-reg "[\\]"))) - -(define short-bytes-item - (f-or short-bytes-char bytes-esc)) - -(define long-bytes-item - (f-or long-bytes-char bytes-esc)) - -(define short-bytes - (mk-token - (f-or! (f-seq! "'" (f* short-bytes-item) "'") - (f-seq! "\"" (f* short-bytes-item) " \"")))) - -(define long-bytes - (mk-token - (f-or! (f-seq! "'''" (f* long-bytes-item) "'''") - (f-seq! "\"\"\"" (f* long-bytes-item) "\"\"\"")))) - -(define bytes-literal - (p-freeze 'string-literal - (<p-lambda> (c) - (.. (pre) (bytes-prefix c)) - (.. (str) ((f-or! long-bytes short-bytes) pre)) - (<p-cc> (#:bytes pre str))) - mk-id)) - - -; +++++++++++++++++++++++++++++++++++ PARSER SUBSECTION +++++++++++++++++ -(define stmt #f) -(define testlist #f) -(define dottaed_name #f) -(define arglist #f) -(define classdef #f) -(define funcdef #f) -(define test #f) -(define small_stmt #f) - - -(define expr_stmt #f) -(define del_stmt #f) -(define pass_stmt #f) -(define flow_stmt #f) -(define import_stmt #f) -(define global_stmt #f) -(define nonlocal_stmt #f) -(define assert_stmt #f) -(define testlist_star_expr #f) -(define augassign #f) -(define yield_expr #f) -(define star_expr #f) -(define exprlist #f) -(define import_name #f) -(define import_from #f) -(define dotted_as_names #f) -(define import_as_names #f) -(define if_stmt #f) -(define while_stmt #f) -(define for_stmt #f) -(define try_stmt #f) -(define with_stmt #f) -(define suite #f) -(define except_clause #f) -(define with_item #f) -(define expr #f) -(define or_test #f) -(define lambdef #f) -(define lambdef_nocond #f) -(define and_test #f) -(define not_test #f) -(define comparison #f) -(define comp_op #f) -(define xor_expr #f) -(define and_expr #f) -(define or_expr #f) -(define arith_expr #f) -(define shift_expr #f) -(define term #f) -(define factor #f) -(define power #f) -(define atom #f) -(define trailer #f) -(define subscriptlist #f) -(define testlist_comp #f) -(define dictorsetmaker #f) -(define comp_for #f) -(define subscript #f) -(define sliceop #f) -(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 (Ds dotted_name) ws) - (f-seq (ff? (f-seq "(" ws (ff? (Ds arglist)) - ws ")" ws)) - f-nl))) - -(define decorators (ff+ decorator)) - - -(define decorated (f-list #:decorated - decorators - (f-or classdef funcdef))) - -(define FALSE (f-out #f)) -(define tfpdef - (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 "=" (Ds test)) FALSE)) - (arg (f-list tfpdef t)) - (arg.. (ff* (f-seq "," arg))) - (args (f-cons arg arg..)) - (arg* (f-seq "*" (f-list tfpdef arg..))) - (arg** (f-seq "**" tfpdef))) - (f-cons - 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 '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! 'parameters - "(" (f-or typedargslist - (f-out (list #f #f #f))) - ")")) - -(set! funcdef - (p-freeze 'funcdef - (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) (f-or nl f-eof)))) -(set! small_stmt - (Ds - (f-or 'small expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt - nonlocal_stmt assert_stmt))) - -(set! expr_stmt - (f-list 'expr_stmt - #:expr-stmt - (Ds testlist_star_expr) - (f-or! - (f-list 'augassign #:augassign - (Ds augassign) - (f-or (Ds yield_expr) (Ds testlist))) - (f-cons 'assign #:assign - (ff* (f-seq "=" - (f-or (Ds yield_expr) - (Ds testlist_star_expr)))))))) - -(set! testlist_star_expr - (f-cons 'testlist_star_expr - (f-or (Ds test) (Ds star_expr)) - (f-seq - (ff* (f-seq "," (f-or (Ds test) (Ds star_expr)))) - (f? ",")))) - - -(set! augassign - (mk-token - (f-seq 'augassign - ws - (apply f-or! - (map f-tag - '("+=" "-=" "*=" "/=" "%=" "&=" "|=" "^=" - "<<=" ">>=" "**=" "//="))) - ws))) - -(set! del_stmt (f-cons 'del_stmt #:del (f-seq "del" (Ds exprlist)))) - -(set! pass_stmt (f-seq 'pass_stmt "pass" #:pass)) - -(set! flow_stmt - (f-or 'flow_stmt - (f-seq "break" #:break) - (f-seq "continue" #:continue) - (f-cons #:return (f-seq "return" (ff? (Ds testlist)))) - (Ds yield_expr) - (f-cons #:raise (f-seq "raise" - (f-or (f-cons (Ds test) - (ff? - (f-seq "from" (Ds test)))) - (f-cons FALSE FALSE)))))) - -(set! import_name (f-seq "import" dotted_as_names)) -(set! import_stmt (f-list #:import - (f-or 'import_stmt import_name (Ds import_from)))) - - - -(define dottir (mk-token (f-or! (f-tag! "...") (f-tag! ".")))) -(define dots* (ff* dottir)) -(define dots+ (ff+ dottir)) - -(set! import_from - (f-seq 'import_from "from" - (f-cons - (f-or (f-cons dots* (Ds dotted_name)) dots+) - (f-seq "import" (f-or "*" - (f-seq "(" (Ds import_as_names) ")") - (Ds import_as_names)))))) - -(define import_as_name - (f-cons identifier (ff? (f-seq "as" identifier)))) - -(define dotted_as_name - (f-cons (Ds dotted_name) (ff? (f-seq "as" identifier)))) - -(set! import_as_names - (f-seq - (f-cons import_as_name (ff* (f-seq "," import_as_name))) - (f? ","))) - -(set! dotted_as_names - (f-cons dotted_as_name (ff* (f-seq "," dotted_as_name)))) - -(set! dotted_name - (f-cons identifier (ff* (f-seq "." identifier)))) - -(define comma_name - (f-cons identifier (ff* (f-seq "," identifier)))) - -(set! global_stmt - (f-cons 'global #:global (f-seq "global" comma_name))) - -(set! nonlocal_stmt - (f-cons 'nonlocal #:nonlocal (f-seq "nonlocal" comma_name))) - -(set! assert_stmt - (f-cons 'assert #:assert - (f-seq "assert" (f-cons (Ds test) (ff* (f-seq "," (Ds test))))))) - - -(define compound_stmt - (Ds - (f-or! 'compound - if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef - decorated))) - -(define single_input (f-or! (f-seq indent= simple_stmt) - (f-seq indent= compound_stmt nl) - (f-seq (f-or nl f-eof)))) - - -(set! stmt (f-or 'stmt simple_stmt compound_stmt)) - -(set! if_stmt - (f-cons 'if_stmt - #:if - (f-seq - "if" - (f-cons (Ds test) - (f-seq ":" - (f-cons (Ds suite) - (f-cons - (ff* (f-seq "elif" - (f-cons (Ds test) - (f-seq ":" (Ds suite))))) - (ff? (f-seq "else" ":" (Ds suite)))))))))) - -(set! while_stmt - (f-cons 'while - #:while - (f-seq "while" - (f-cons (Ds test) - (f-seq ":" - (f-cons (Ds suite) - (ff? (f-seq "else" ":" (Ds suite))))))))) - -(set! for_stmt - (f-cons 'for - #:for - (f-seq "for" - (f-cons (Ds exprlist) - (f-seq "in" - (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 (Ds suite) - (f-or - (f-cons - (ff+ (f-list (Ds except_clause) ":" (Ds suite))) - (f-cons - (ff? (f-seq "else" ":" (Ds suite))) - (ff? (f-seq "finally" ":" ws (Ds suite))))) - (f-cons - FALSE - (f-cons - FALSE - (f-seq "finally" ":" (Ds suite))))))))) - -(set! with_item - (f-cons (Ds test) (f-seq "as" (Ds expr)))) - -(set! with_stmt - (f-cons 'with - #:with - (f-seq "with" - (f-cons - (f-cons with_item - (ff* (f-seq "," with_item))) - (f-seq ":" (Ds suite)))))) - - -(set! except_clause - (f-seq 'except "except" - (ff? (f-cons (Ds test) (ff? (f-seq "as" identifier)))))) - -(set! suite - (f-cons #:suite - (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-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-list 'lambdef - #:lambdef - (f-seq "lambda" (ff? (Ds varargslist) '())) - (f-seq ":" (Ds test)))) - -(set! lambdef_nocond - (f-list 'lambdef_nocond - 'lambdef #:lambdef - (f-seq "lambda" (ff? (Ds varargslist) '())) - (f-seq ":" test_nocond))) - -(set! or_test - (p-freeze 'or_test - (f-or! 'or_test - (f-cons #:or (f-cons (Ds and_test) (ff+ (f-seq "or" (Ds and_test))))) - (Ds and_test)) - mk-id)) - -(set! and_test - (p-freeze 'and_test - (f-or! 'and_test - (f-cons #:and (f-cons (Ds not_test) (ff+ (f-seq "and" (Ds not_test))))) - (Ds not_test)) - mk-id)) - -(set! not_test - (f-or! 'not_test - (f-cons #:not (f-seq "not" not_test)) - (Ds comparison))) - -(set! comparison - (p-freeze 'comparison - (f-or! 'comparison - (f-cons #:comp - (f-cons (Ds expr) - (ff+ (f-cons (Ds comp_op) (Ds expr))))) - (Ds expr)) - mk-id)) - -(set! comp_op - (f-or! 'comp_op - (f-seq (f-seq "not" "in" ) (f-out "notin")) - (f-seq (f-seq "is" "not") (f-out "isnot")) - (apply f-or! - (map (lambda (x) (f-seq x (f-out x))) - '("==" ">=" "<=" "<>" "!=" "in" "is" "<" ">" ))))) - - -(set! star_expr (f-cons 'star_expr #:starexpr (f-seq "*" (Ds expr)))) -(set! expr - (p-freeze 'expr - (f-or! 'expr - (f-cons #:bor (f-cons (Ds xor_expr) (ff+ (f-seq "|" (Ds xor_expr))))) - (Ds xor_expr)) - mk-id)) - -(set! xor_expr - (p-freeze 'xor - (f-or! 'xor - (f-cons #:bxor (f-cons (Ds and_expr) (ff+ (f-seq "^" (Ds and_expr))))) - (Ds and_expr)) - mk-id)) - -(set! and_expr - (p-freeze 'and - (f-or! 'and - (f-cons #:band (f-cons (Ds shift_expr) - (ff+ (f-seq "&" (Ds shift_expr))))) - (Ds shift_expr)) - mk-id)) - -(set! shift_expr - (p-freeze 'shift - (f-or! 'shift - (f-cons #:<< (f-cons (Ds arith_expr) (ff+ (f-seq "<<" (Ds arith_expr) )))) - (f-cons #:>> (f-cons (Ds arith_expr) (ff+ (f-seq ">>" (Ds arith_expr) )))) - (Ds arith_expr)) - mk-id)) - -(set! arith_expr - (p-freeze 'arith - (f-or! 'arith - (f-cons #:+ (f-cons (Ds term) (ff+ (f-seq 'rest "+" (Ds term) )))) - (f-cons #:- (f-cons (Ds term) (ff+ (f-seq "-" (Ds term) )))) - (f-seq 'single_term (Ds term))) - mk-id)) - -(set! term - (p-freeze 'term - (f-or! 'term - (f-cons #:* (f-cons (Ds factor) (ff+ (f-seq "*" (Ds factor) )))) - (f-cons #:// (f-cons (Ds factor) (ff+ (f-seq "//" (Ds factor) )))) - (f-cons #:/ (f-cons (Ds factor) (ff+ (f-seq "/" (Ds factor) )))) - (f-cons #:% (f-cons (Ds factor) (ff+ (f-seq "%" (Ds factor) )))) - (f-seq 'single-factor (Ds factor))) - mk-id)) - - -(set! factor - (p-freeze 'factor - (f-or! 'factor - (f-cons #:u+ (f-seq "+" factor)) - (f-cons #:u- (f-seq "-" factor)) - (f-cons #:u~ (f-seq "~" factor)) - (Ds power)) - mk-id)) - -(set! power - (p-freeze 'power - (f-cons 'power #:power - (f-cons (f-or (f-list #:f (Ds identifier) ":" (Ds atom)) (Ds atom)) - (f-cons (ff* (Ds trailer)) - (f-or! (f-seq "**" factor) - FALSE)))) - mk-id)) - -(set! trailer - (f-or! 'trailer - (f-seq "(" (ff? (Ds arglist)) ")") - (f-seq "[" (Ds subscriptlist) "]") - (f-seq (f-list #:dot (ff+ "." identifier)))) - -(set! atom - (p-freeze 'atom - (f-or! 'atom - (f-cons - #:subexpr - (f-seq "(" (ff? (f-or! (Ds yield_expr) (Ds testlist_comp))) ")")) - (f-cons - #:list - (f-seq "[" (ff? (Ds testlist_comp)) ")")) - (f-cons - #:dict - (f-seq "{" (ff? (Ds dictorsetmaker)) "}")) - (f-seq 'identifier identifier) - (f-seq 'number number) - (ff+ string) - (f-seq #:... "...") - (f-seq #:None "None") - (f-seq #:True "True") - (f-seq #:false "False")) - mk-id)) - -(set! testlist_comp - (f-cons - (f-or! star_expr test) - (f-or! - comp_for - (f-seq (ff* (f-seq "," (f-or! star_expr test))) - (f? ","))))) - -(set! subscriptlist - (f-cons* 'subscriptlist - #:subscripts - (Ds subscript) - (f-seq (ff* (f-seq "," (Ds subscript))) (f? ",")))) - -(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 '()))) - -(define exprlist - (let ((f (f-or expr star_expr))) - (f-cons f (f-seq (ff* (f-seq "," f)) (f? ","))))) - -(set! testlist - (f-cons - test - (f-seq (ff* (f-seq "," test)) (f? ",")))) - -(set! dictorsetmaker - (let ((f (f-cons test (f-seq ":" test)))) - (f-or! - (f-cons* f (f-seq (ff* (f-seq "," f)) (f? ","))) - (f-cons f (Ds comp_for)) - (f-cons test (Ds comp_for)) - (f-cons test (f-seq (ff* (f-seq "," test)) (f? ",")))))) - -(set! classdef - (f-list - #:classdef - (f-seq "class" identifier) - (ff? (f-seq "(" (ff? (Ds arglist) '()) ")")) - (f-seq ":" suite))) - -(set! arglist - (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))) - - (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! - (f-list #:= test (f-seq "=" test)) - (f-list #:comp test (ff? (Ds comp_for))))) - -(define comp_iter (f-or! (Ds comp_for) (Ds comp_if))) -(define comp_for (f-list (f-seq "for" exprlist) - (f-seq "in" or_test) - (ff? comp_iter))) -(set! comp_if (f-list (f-seq "if" test_nocond) - (ff? comp_iter))) - -(set! yield_expr - (f-list #:yield (f-seq "yield" (ff? (Ds yield_arg))))) - -(set! yield_arg - (f-or! - (f-list #:from (f-seq "from" test)) - (f-list #:list testlist))) - - -(define input (f-seq - (ff+ (f-seq (f? ws) - (f-or! (f-seq indent= simple_stmt) - (f-seq indent= compound_stmt nl)))) - - (f-seq (f? ws) (f-or nl f-eof)))) - -(define (p str) - (with-fluids ((*whitespace* (f* (f-reg "[ \t\r]")))) - (parse str input))) - -(define (python-parser . l) - (with-fluids ((*whitespace* (f* (f-reg "[ \t\r]")))) - (ppp (apply parse (append l (list (f-seq nl ws single_input ws))))))) - - |