Initial commit
authorStefan Israelsson Tampe <stis@kriver.(none)>
Wed, 28 May 2014 18:03:42 +0000 (20:03 +0200)
committerStefan Israelsson Tampe <stis@kriver.(none)>
Wed, 28 May 2014 18:03:42 +0000 (20:03 +0200)
modules/language/python/parser-tool.scm [new file with mode: 0644]
modules/language/python/parser.scm [new file with mode: 0644]

diff --git a/modules/language/python/parser-tool.scm b/modules/language/python/parser-tool.scm
new file mode 100644 (file)
index 0000000..ec7b504
--- /dev/null
@@ -0,0 +1,48 @@
+(define-module (language python parser-tool)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (logic guile-log parsing scanner)
+  #:use-module ((logic guile-log parser)
+               #:select (setup-parser
+                         f-nl f-nl!                      
+                         *current-file-parsing*
+                         make-file-reader file-next-line file-skip))
+  #:use-module (logic guile-log)
+  #:re-export (f-nl f-nl!)
+  #: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
+                 .. xx <p-cc>
+                 f-pk))
+
+;; Preliminary
+(define do-print #t)
+(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)))
+
+
+(begin
+  (define-guile-log-parser-tool (<p-lambda> (X XL N M INDENT)) <p-define> .. 
+    xx <p-cc>)
+
+
+  (make-guile-log-scanner-tools <p-lambda> <fail> <p-cc> <succeds> .. 
+                               (X XL N M INDENT)
+                               (c) (d)
+                               s-false s-true s-mk-seq s-mk-and s-mk-or)
+
+  ;; Sets up a standar parser functionals with INDENT field added
+  (setup-parser
+   <p-define> <p-lambda> <fail> <p-cc> <succeds> .. xx
+   X XL N M (0 0 0)
+   s-false s-true s-mk-seq s-mk-and s-mk-or
+   s-seq s-and s-and! s-and!! s-or 
+   pp))
diff --git a/modules/language/python/parser.scm b/modules/language/python/parser.scm
new file mode 100644 (file)
index 0000000..639955e
--- /dev/null
@@ -0,0 +1,770 @@
+(define-module (language python parser)
+  #:use-module (logic guile-log)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (language python parser-tool)
+  #:export (p))
+
+(define do-print #t)
+(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  divide truncate/)
+;; +++++++++++++++++++++++++++++++++++++ SCANNER SUBSECTION
+(define com (f-seq "#" (f* (f-not f-nl)) f-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 nl f-nl)
+
+(define (wn_ n i)
+  (<p-lambda> (c)
+    (cond
+     ((> i n) <fail>)
+     ((= i n)
+      (.. ((f-not w) 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)
+    (cond
+     ((> i n)
+      (<let>  ((Inew (cons i INDENT)))
+       (<syntax-parameterize> ((INDENT (lambda x #'Inew)))
+         (<p-cc> 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) (wn+_ n 0))
+(define (wn n) (wn_ n 0))
+
+(define indent= wn)
+(define indent+ wn+)
+(define indent-
+  (<p-lambda> (c)
+    (<let> ((i (cdr INDENT)))
+       (<syntax-parameterize> ((INDENT (lambda x #'i)))
+        (<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 keyw (make-hash-table))
+(for-each
+ (lambda (x) (hash-set! keyw 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
+                (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 symbol
+  (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)
+       (#:identifier i #:system))
+      ((__*    i)
+       (#:identifier i #:private))
+      ((_*     i)
+       (#:identifier i #:local))
+      ((eq? i '_)
+       (#:_))
+      ((hash-ref keyw i)
+       (#:keyword i))
+      (else
+       (#:identifier i))))))
+       
+(define identifier 
+  (<p-lambda> (c)
+     (.. (i) (identifier_ c))
+     (when (not (eq? (car i) #:keyword))
+        (<p-cc> c))))
+
+;;;; +++++++++++++++++++++++++++++++++++++++++++++++ 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-literal 
+  (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)))
+    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 dotted_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 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))
+                                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 (f-seq ws identifier ws) (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)))
+          (args    (f-cons arg arg..))
+          (arg*    (f-seq ws "*" ws (f-list tfpdef ws arg..)))
+          (arg**   (f-seq ws "**" tfpdef)))
+      (f-cons
+       (f-out 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**))))))
+
+(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 ")")))
+
+(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))
+
+(define simple_stmt (f-list #:stmt
+                           (f-seq
+                            (f-cons small_stmt
+                                    (ff* (f-seq ";" small_stmt)))
+                            ws (f? ";") ws nl)))
+(set! small_stmt
+  (f-or expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt
+       nonlocal_stmt assert_stmt))
+
+(set! expr_stmt 
+  (f-seq testlist_star_expr
+        (f-or
+         (f-seq augassign 
+                (f-or (f-or yield_expr testlist)
+                      (f* (f-seq "=" 
+                                 (f-or yield_expr
+                                       testlist_star_expr))))))))
+
+(set! testlist_star_expr
+  (f-cons (f-or test star_expr) 
+         (f-seq 
+          (ff* (f-seq "," (f-or test star_expr)))
+          (f? ","))))
+
+
+(set! augassign
+  (mk-token
+   (f-seq
+    ws
+    (apply f-or!
+          (map f-tag
+               '("+=" "-=" "*=" "/=" "%=" "&=" "|=" "^="
+                 "<<=" ">>=" "**=" "//=")))
+    ws)))
+
+(set! del_stmt  (f-cons #:del (f-seq "del" exprlist)))
+
+(set! pass_stmt (f-seq "pass" #:pass))
+
+(set! flow_stmt 
+  (f-or
+   (f-seq "break"   #:break)
+   (f-seq "coninue" #:continue)
+   (f-cons #:return (f-seq "return" (ff? testlist)))
+   yield_expr
+   (f-cons #:raise  (f-seq "raise" 
+                          (f-or (f-cons test
+                                        (ff?
+                                         (f-seq "from" test)))
+                                (f-cons FALSE FALSE))))))
+
+(set! import_stmt (f-or import_name import_from))
+
+(set! import_name (f-seq "import" dotted_as_names))
+
+(define dottir (mk-token (f-or! (f-tag! "...") (f-tag! "."))))
+(define dots*  (ff* dottir))
+(define dots+  (ff+ dottir))
+
+(set! import_from
+  (f-seq "from"
+        (f-cons
+         (f-or (f-cons dots* dotted_name) dots+)
+         (f-seq "import" (f-or "*"
+                               (f-seq "(" import_as_names ")")
+                               import_as_names)))))
+
+(define import_as_name 
+  (f-cons identifier (ff? (f-seq "as" identifier))))
+
+(define dotted_as_name
+  (f-cons 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 (f-seq "global" comma_name)))
+
+(set! nonlocal_stmt
+  (f-cons #:nonlocal (f-seq "nonlocal" comma_name)))
+
+(set! assert_stmt
+  (f-cons #:assert
+         (f-seq "assert" (f-cons test (ff* (f-seq  "," test))))))
+
+
+(define compound_stmt
+  (f-or! if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef 
+        decorated))
+
+(define single_input (f-or (f-seq (f-pk 0) nl)
+                          (f-seq (f-pk 1) indent= simple_stmt) 
+                          (f-seq (f-pk 2) indent= compound_stmt nl)))
+
+(set! stmt (f-or simple_stmt compound_stmt))
+
+(set! if_stmt
+  (f-cons 
+   #:if
+   (f-seq 
+    "if"
+    (f-cons test
+           (f-seq ":"
+                  (f-cons suite
+                          (f-cons
+                           (ff+ (f-seq "elif"
+                                       (f-cons test
+                                               (f-seq ":" suite))))
+                           (ff? (f-seq "else" ":" suite)))))))))
+
+(set! while_stmt
+  (f-cons 
+   #:while
+   (f-seq "while"
+         (f-cons test
+                 (f-seq ":"
+                        (f-cons suite
+                                (ff? (f-seq "else" ":" suite))))))))
+
+(set! for_stmt
+  (f-cons 
+   #:for
+   (f-seq "for"
+         (f-cons exprlist
+            (f-seq "in"
+                   (f-cons testlist
+                      (f-cons (f-seq ":" suite)
+                              (ff? (f-seq "else" ":" suite)))))))))
+
+(set! try_stmt
+  (f-cons
+   #:try
+   (f-seq ws "try" ":"
+         (f-cons suite
+                 (f-or
+                  (f-cons
+                   (ff+ (f-seq except_clause ":" suite))
+                   (f-cons
+                    (ff? (f-seq "else" ":" suite))
+                    (ff? (f-seq "finally" ":" ws suite))))
+                  (f-cons
+                   FALSE
+                   (f-cons
+                    FALSE
+                    (f-seq "finally" ":" suite))))))))
+
+(set! with_stmt
+  (f-cons
+   #:with
+   (f-seq "with"
+         (f-cons
+          (f-cons with_item
+                  (ff* (f-seq "," with_item)))
+          (f-seq ":" suite)))))
+
+(set! with_item
+  (f-cons test (f-seq "as" expr)))
+
+(set! except_clause
+  (f-seq "except"
+        (ff? (f-cons 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
+   (f-cons #:if
+          (f-cons (f-seq "if"   or_test)
+                  (f-seq "else" test)))
+   lambdef
+   (f-cons (f-out #f)
+          (f-cons or_test FALSE))))
+
+
+(define test_nocond
+  (f-or or_test lambdef_nocond))
+
+(set! lambdef
+  (f-cons
+   #:lambdef
+   (f-cons (f-seq "lambda" (ff? varargslist '()))
+          (f-seq ":" test))))
+(set! lambdef_nocond
+  (f-cons
+   #:lambdef
+   (f-cons (f-seq "lambda" (ff? varargslist '()))
+          (f-seq ":" test_nocond))))
+
+(set! or_test
+  (f-or! (f-cons #:or (f-cons and_test (ff+ (f-seq "or" and_test))))
+        and_test))
+
+(set! and_test
+  (f-or! (f-cons #:and (f-cons not_test (ff* (f-seq "and" not_test))))
+        not_test))
+
+(set! not_test
+  (f-or!
+   (f-cons #:not (f-seq "not" not_test))
+   comparison))
+
+(set! comparison
+  (f-or!
+   (f-cons #:comp
+          (f-cons expr
+                  (ff+ (f-cons comp_op expr))))
+   expr))
+
+(set! comp_op
+  (f-or! 
+   (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 #:starexpr (f-seq "*" expr)))
+(set! expr
+  (f-or!
+   (f-cons #:bxor (f-cons xor_expr (ff+ (f-seq "|" xor_expr))))
+   xor_expr))
+(set! xor_expr
+  (f-or!
+   (f-cons #:band (f-cons and_expr (ff+ (f-seq "^" and_expr))))
+   and_expr))
+
+(set! and_expr
+  (f-or!
+   (f-cons #:band (f-cons shift_expr (ff+ (f-seq "&" shift_expr))))
+   shift_expr))
+
+(set! shift_expr
+  (f-or!
+   (f-cons #:<< (f-cons arith_expr (ff+ (f-seq "<<" arith_expr))))
+   (f-cons #:>> (f-cons arith_expr (ff+ (f-seq ">>" arith_expr))))
+   arith_expr))
+
+(set! arith_expr
+  (f-or!
+   (f-cons #:+ (f-cons term (ff+ (f-seq "+" term))))
+   (f-cons #:- (f-cons term (ff+ (f-seq "-" term))))
+   term))
+
+(set! term
+  (f-or!
+   (f-cons #:*  (f-cons factor (ff+ (f-seq "*"  factor))))
+   (f-cons #:// (f-cons factor (ff+ (f-seq "//" factor))))
+   (f-cons #:/  (f-cons factor (ff+ (f-seq "/"  factor))))
+   (f-cons #:%  (f-cons factor (ff+ (f-seq "%"  factor))))
+   factor))
+
+
+(set! factor
+  (f-or!
+   (f-cons #:u+ (f-seq "+" factor))
+   (f-cons #:u- (f-seq "-" factor))
+   (f-cons #:u~ (f-seq "~" factor))
+   power))
+
+(set! power
+  (f-cons #:power 
+     (f-cons atom 
+       (f-cons (ff* trailer)
+               (f-or! (f-seq "**" factor)
+                      FALSE)))))
+
+(set! trailer
+  (f-or!
+   (f-seq "(" (ff? arglist) ")")
+   (f-seq "[" subscriptlist "]")
+   (f-seq "." identifier)))
+
+(set! atom
+  (f-or!
+   (f-cons
+    #:subexpr
+    (f-seq "(" ff? (f-or! yield_expr testlist_comp) ")"))
+   (f-cons
+    #:list
+    (f-seq "[" (ff? testlist_comp) ")"))
+   (f-cons
+    #:dict
+    (f-seq "{" (ff? dictorsetmaker) "}"))
+   identifier
+   number
+   (f-cons #:string  (ff+ string))
+   (f-cons #:...     "...")
+   (f-cons #:None    "None")
+   (f-cons #:True    "True")
+   (f-cons #:false   "False")))
+
+(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
+   subscript
+   (f-seq (ff* (f-seq "," subscript)) (f? ","))))
+
+(set! subscript
+  (f-or!
+   (f-list (ff? test) ":" (ff? test) (ff? 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* "," 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    comp_for)
+     (f-cons  test 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? arglist '()) ")"))
+   (f-seq ":" suite)))
+      
+(set! arglist
+  (f-or!
+   (f-list (f-seq (ff+ (f-seq argument ",")) (f? ","))
+          FALSE FALSE)
+   (f-list (f-seq (ff* (f-seq argument ",")))
+          FALSE
+          (ff? (f-seq "**" test)))
+   (f-list (f-seq (ff* (f-seq argument ",")))
+          (f-seq "*" (f-cons test (ff* (f-seq "," argument))))
+          (ff? (f-seq "," "**" test)))))
+   
+(set! argument
+  (f-or!
+   (f-list #:=    test (f-seq "=" test))
+   (f-list #:comp test (ff? comp_for))))
+
+(define comp_iter (f-or! comp_for 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? yield_arg))))
+
+(set! yield_arg
+  (f-or!
+   (f-list #:from (f-seq "from" test))
+   (f-list #:list testlist)))
+
+
+(define (p str)
+  (pp (parse str single_input))
+  (if #f #f))