parser workings are tested somewhat and fixed

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!