summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/parser.scm849
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)))))))
-
-
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-19 08:24:06 +0000