parser workings are tested somewhat and fixed
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 8 Jun 2014 14:50:41 +0000 (16:50 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 8 Jun 2014 14:50:41 +0000 (16:50 +0200)
modules/language/python/parser-tool.scm
modules/language/python/parser.scm

index cd94ef71788c45ccfd77e514cd0e8ba2240858f9..00359c975fda60091a7fb593780faaca76ce8054 100644 (file)
   #: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)
index 43051ffcc1250114598b210bc709a60bd5730361..180ec0ab9ddd9ad2f6f9c073515b30cabfc417cf 100644 (file)
@@ -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))))))
 
     (<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
 
 (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 
     (f-or! imag float integer)
     mk-id))
 
-(define symbol
+(define identifier_
   (let ()
     (define (__*__ i)
       (match (string->list i)
        (_ #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]")))
     (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 ++++++++++++++++++++++++++
 ; +++++++++++++++++++++++++++++++++++ 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)
 (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))
 
 (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
  (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))))))))
   (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
 
 (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))
 
            (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))))))))))
   (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
 
 (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
    (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))))
     (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
           (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)))
 (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))))
    (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!