major update, parser works on simple expressions

2 files changed, 232 insertions, 175 deletions

diff --git a/modules/language/python/parser-tool.scm b/modules/language/python/parser-tool.scm
index 754917f..cd94ef7 100644
--- a/modules/language/python/parser-tool.scm
+++ b/modules/language/python/parser-tool.scm
@@ -16,7 +16,7 @@
 		  f-pk))
 
 ;; Preliminary
-(define do-print #t)
+(define do-print #f)
 (define pp
   (case-lambda
    ((s x)
@@ -42,5 +42,5 @@
   ;; Sets up a standar parser functionals with INDENT field added
   (setup-parser
    <p-define> <p-lambda> <fail> <p-cc> <succeds> .. xx
-   X XL ((N 0) (M 0) (INDENT 0))
+   X XL ((N 0) (M 0) (INDENT (list 0)))
    s-false s-true s-mk-seq s-mk-and s-mk-or))
diff --git a/modules/language/python/parser.scm b/modules/language/python/parser.scm
index 9ea1d4f..43051ff 100644
--- a/modules/language/python/parser.scm
+++ b/modules/language/python/parser.scm
@@ -1,11 +1,12 @@
 (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))
 
-(define do-print #t)
+(define do-print #f)
 (define pp
   (case-lambda
     ((s x)
@@ -16,55 +17,72 @@
      (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 com (f-seq "#" (f* (f-not f-nl)) f-nl))
+(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 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))))))))
+     (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)
-    (cond
-     ((> 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)))
+     (<and!>
+      (when (i > n))
       (<with-bind> ((INDENT (cons i INDENT)))
-        (<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))
+        (<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+)
@@ -377,34 +395,40 @@
      (<p-cc> (list #:funcdef id pa te su)))
    mk-id))
 
-(define simple_stmt (f-list #:stmt
+(define simple_stmt (f-list 'simple_stmt #:stmt
 			    (f-seq
-			     (f-cons small_stmt
-				     (ff* (f-seq ";" small_stmt)))
-			     ws (f? ";") ws nl)))
+			     (f-cons (Ds small_stmt)
+				     (ff* (f-seq ";" (Ds small_stmt))))
+                             (f? ";") (f? ws) nl)))
 (set! small_stmt
-  (f-or expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt
-	nonlocal_stmt assert_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-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))))))))
+ (f-list 'expr_stmt
+   #:expr-stmt
+   (Ds testlist_star_expr)
+   (f-or
+    (f-list #:augassign
+            (Ds augassign)
+            (f-or (Ds yield_expr) (Ds testlist)))
+    (f-cons #:assign
+       (ff* (f-seq "=" 
+                   (f-or (Ds yield_expr)
+                         (Ds 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? ","))))
+  (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
+   (f-seq 'augassign
     ws
     (apply f-or!
 	   (map f-tag
@@ -412,37 +436,38 @@
 		  "<<=" ">>=" "**=" "//=")))
     ws)))
 
-(set! del_stmt  (f-cons #:del (f-seq "del" exprlist)))
+(set! del_stmt  (f-cons 'del_stmt #:del (f-seq "del" (Ds exprlist))))
 
-(set! pass_stmt (f-seq "pass" #:pass))
+(set! pass_stmt (f-seq 'pass_stmt "pass" #:pass))
 
 (set! flow_stmt 
-  (f-or
+  (f-or 'flow_stmt
    (f-seq "break"   #:break)
    (f-seq "coninue" #:continue)
-   (f-cons #:return (f-seq "return" (ff? testlist)))
-   yield_expr
+   (f-cons #:return (f-seq "return" (ff? (Ds testlist))))
+   (Ds yield_expr)
    (f-cons #:raise  (f-seq "raise" 
-			   (f-or (f-cons test
+			   (f-or (f-cons (Ds test)
 					 (ff?
-					  (f-seq "from" test)))
+					  (f-seq "from" (Ds test))))
 				 (f-cons FALSE FALSE))))))
 
-(set! import_stmt (f-or import_name import_from))
-
 (set! import_name (f-seq "import" dotted_as_names))
+(set! import_stmt (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 "from"
+  (f-seq 'import_from "from"
 	 (f-cons
-	  (f-or (f-cons dots* dotted_name) dots+)
+	  (f-or (f-cons dots* (Ds dotted_name)) dots+)
 	  (f-seq "import" (f-or "*"
-				(f-seq "(" import_as_names ")")
-				import_as_names)))))
+				(f-seq "(" (Ds import_as_names) ")")
+				(Ds import_as_names))))))
 
 (define import_as_name 
   (f-cons identifier (ff? (f-seq "as" identifier))))
@@ -465,42 +490,44 @@
   (f-cons identifier (ff* (f-seq "," identifier))))
 
 (set! global_stmt
-  (f-cons #:global (f-seq "global" comma_name)))
+  (f-cons 'global #:global (f-seq "global" comma_name)))
 
 (set! nonlocal_stmt
-  (f-cons #:nonlocal (f-seq "nonlocal" comma_name)))
+  (f-cons 'nonlocal #:nonlocal (f-seq "nonlocal" comma_name)))
 
 (set! assert_stmt
-  (f-cons #:assert
-	  (f-seq "assert" (f-cons test (ff* (f-seq  "," test))))))
+  (f-cons 'assert #:assert
+	  (f-seq "assert" (f-cons (Ds test) (ff* (f-seq  "," (Ds test)))))))
 
 
 (define compound_stmt
-  (f-or! if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef 
-	 decorated))
+  (Ds 
+   (f-or! 'compound
+          if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef 
+          decorated)))
 
-(define single_input (f-or! (f-seq (f-pk 1) indent= simple_stmt) 
-                            (f-seq (f-pk 2) indent= compound_stmt nl)
-                            (f-seq (f-pk 0) nl)))
+(define single_input (f-or! (f-seq indent= simple_stmt) 
+                            (f-seq indent= compound_stmt nl)
+                            (f-seq nl)))
 
-(set! stmt (f-or simple_stmt compound_stmt))
+(set! stmt (f-or 'stmt simple_stmt compound_stmt))
 
 (set! if_stmt
-  (f-cons 
+  (f-cons 'if_stmt
    #:if
    (f-seq 
     "if"
-    (f-cons test
+    (f-cons (Ds test)
 	    (f-seq ":"
-		   (f-cons suite
+		   (f-cons (Ds suite)
 			   (f-cons
 			    (ff+ (f-seq "elif"
-					(f-cons test
-						(f-seq ":" suite))))
-			    (ff? (f-seq "else" ":" suite)))))))))
+					(f-cons (Ds test)
+						(f-seq ":" (Ds suite)))))
+			    (ff? (f-seq "else" ":" (Ds suite))))))))))
 
 (set! while_stmt
-  (f-cons 
+  (f-cons 'while
    #:while
    (f-seq "while"
 	  (f-cons test
@@ -509,7 +536,7 @@
 				 (ff? (f-seq "else" ":" suite))))))))
 
 (set! for_stmt
-  (f-cons 
+  (f-cons 'for
    #:for
    (f-seq "for"
 	  (f-cons exprlist
@@ -519,7 +546,7 @@
 			       (ff? (f-seq "else" ":" suite)))))))))
 
 (set! try_stmt
-  (f-cons
+  (f-cons 'try
    #:try
    (f-seq ws "try" ":"
 	  (f-cons suite
@@ -535,21 +562,22 @@
 		     FALSE
 		     (f-seq "finally" ":" suite))))))))
 
+(set! with_item
+  (f-cons test (f-seq "as" (Ds expr))))
+
 (set! with_stmt
-  (f-cons
+  (f-cons 'with
    #:with
    (f-seq "with"
 	  (f-cons
 	   (f-cons with_item
 		   (ff* (f-seq "," with_item)))
-	   (f-seq ":" suite)))))
+	   (f-seq ":" (Ds 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))))))
+  (f-seq 'except "except"
+	 (ff? (f-cons (Ds test) (ff? (f-seq "as" identifier))))))
 
 (set! suite  
   (f-cons #:suite
@@ -560,51 +588,59 @@
 		       indent-))))
 
 (set! test
-  (f-or
+  (f-or 'test
    (f-cons #:if
-	   (f-cons (f-seq "if"   or_test)
+	   (f-cons (f-seq "if"   (Ds or_test))
 		   (f-seq "else" test)))
-   lambdef
+   (Ds lambdef)
    (f-cons (f-out #f)
-	   (f-cons or_test FALSE))))
+	   (f-cons (Ds or_test) FALSE))))
 
 
 (define test_nocond
-  (f-or or_test lambdef_nocond))
+  (f-or 'nocond (Ds or_test) (Ds lambdef_nocond)))
 
 (set! lambdef
-  (f-cons
+  (f-cons 'lambdef
    #:lambdef
-   (f-cons (f-seq "lambda" (ff? varargslist '()))
-	   (f-seq ":" test))))
+   (f-cons (f-seq "lambda" (ff? (Ds varargslist) '()))
+	   (f-seq ":" (Ds test)))))
 (set! lambdef_nocond
-  (f-cons
-   #:lambdef
-   (f-cons (f-seq "lambda" (ff? varargslist '()))
+  (f-cons 'lambdef_nocond
+   'lambdef #:lambdef
+   (f-cons (f-seq "lambda" (ff? (Ds 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))
+  (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
-  (f-or! (f-cons #:and (f-cons not_test (ff* (f-seq "and" not_test))))
-	 not_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!
-   (f-cons #:not (f-seq "not" not_test))
-   comparison))
+  (f-or! 'not_test
+   (f-cons #:not (f-seq "not"  not_test))
+   (Ds comparison)))
 
 (set! comparison
-  (f-or!
-   (f-cons #:comp
-	   (f-cons expr
-		   (ff+ (f-cons comp_op expr))))
-   expr))
+  (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! 
+  (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!
@@ -612,80 +648,100 @@
 	       '("<" ">" "==" ">=" "<=" "<>" "!=" "in" "is")))))
 			  
 
-(set! star_expr (f-cons #:starexpr (f-seq "*" expr)))
+(set! star_expr (f-cons 'star_expr #:starexpr (f-seq "*" (Ds expr))))
 (set! expr
-  (f-or!
-   (f-cons #:bxor (f-cons xor_expr (ff+ (f-seq "|" xor_expr))))
-   xor_expr))
+  (p-freeze 'expr
+    (f-or! 'expr
+     (f-cons #:bxor (f-cons (Ds xor_expr) (ff+ (f-seq "|" (Ds xor_expr)))))
+     (Ds xor_expr))
+    mk-id))
+
 (set! xor_expr
-  (f-or!
-   (f-cons #:band (f-cons and_expr (ff+ (f-seq "^" and_expr))))
-   and_expr))
+ (p-freeze 'xor
+   (f-or! 'xor
+     (f-cons #:band (f-cons (Ds and_expr) (ff+ (f-seq "^" (Ds and_expr)))))
+     (Ds and_expr))
+   mk-id))
 
 (set! and_expr
-  (f-or!
-   (f-cons #:band (f-cons shift_expr (ff+ (f-seq "&" shift_expr))))
-   shift_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
-  (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))
+  (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
-  (f-or!
-   (f-cons #:+ (f-cons term (ff+ (f-seq "+" term))))
-   (f-cons #:- (f-cons term (ff+ (f-seq "-" term))))
-   term))
+  (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
-  (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))
+  (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
-  (f-or!
-   (f-cons #:u+ (f-seq "+" factor))
-   (f-cons #:u- (f-seq "-" factor))
-   (f-cons #:u~ (f-seq "~" factor))
-   power))
+  (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
-  (f-cons #:power 
-     (f-cons atom 
-	(f-cons (ff* trailer)
-		(f-or! (f-seq "**" factor)
-		       FALSE)))))
+  (p-freeze 'power
+    (f-cons 'power #:power
+       (f-cons (Ds atom) 
+   	  (f-cons (ff* (Ds trailer))
+                  (f-or! (f-seq "**" factor)
+                         FALSE))))
+    mk-id))
 
 (set! trailer
-  (f-or!
-   (f-seq "(" (ff? arglist) ")")
-   (f-seq "[" subscriptlist "]")
+  (f-or! 'trailer
+   (f-seq "(" (ff? (Ds arglist)) ")")
+   (f-seq "[" (Ds subscriptlist) "]")
    (f-seq "." identifier)))
 
 (set! atom
-  (f-or!
+  (p-freeze 'atom
+  (f-or! 'atom
    (f-cons
     #:subexpr
-    (f-seq "(" ff? (f-or! yield_expr testlist_comp) ")"))
+    (f-seq "(" (ff? (f-or! (Ds yield_expr) (Ds testlist_comp))) ")"))
    (f-cons
     #:list
-    (f-seq "[" (ff? testlist_comp) ")"))
+    (f-seq "[" (ff? (Ds testlist_comp)) ")"))
    (f-cons
     #:dict
-    (f-seq "{" (ff? dictorsetmaker) "}"))
-   identifier
-   number
+    (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")))
+   (f-cons #:false   "False"))
+  mk-id))
 
 (set! testlist_comp
   (f-cons
@@ -698,11 +754,11 @@
 (set! subscriptlist
   (f-cons
    subscript
-   (f-seq (ff* (f-seq "," subscript)) (f? ","))))
+   (f-seq (ff* (f-seq "," (Ds  subscript))) (f? ","))))
 
 (set! subscript
   (f-or!
-   (f-list (ff? test) ":" (ff? test) (ff? sliceop))
+   (f-list (ff? test) ":" (ff? test) (ff? (Ds sliceop)))
    (f-list test FALSE FALSE)))
 
 (set! sliceop
@@ -721,34 +777,34 @@
   (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  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? arglist '()) ")"))
+   (ff? (f-seq "(" (ff? (Ds arglist) '()) ")"))
    (f-seq ":" suite)))
       
 (set! arglist
   (f-or!
-   (f-list (f-seq (ff+ (f-seq argument ",")) (f? ","))
+   (f-list (f-seq (ff+ (f-seq (Ds argument) ",")) (f? ","))
 	   FALSE FALSE)
-   (f-list (f-seq (ff* (f-seq argument ",")))
+   (f-list (f-seq (ff* (f-seq (Ds argument) ",")))
 	   FALSE
 	   (ff? (f-seq "**" test)))
-   (f-list (f-seq (ff* (f-seq argument ",")))
-	   (f-seq "*" (f-cons test (ff* (f-seq "," argument))))
+   (f-list (f-seq (ff* (f-seq (Ds argument) ",")))
+	   (f-seq "*" (f-cons test (ff* (f-seq "," (Ds argument)))))
 	   (ff? (f-seq "," "**" test)))))
    
 (set! argument
   (f-or!
    (f-list #:=    test (f-seq "=" test))
-   (f-list #:comp test (ff? comp_for))))
+   (f-list #:comp test (ff? (Ds comp_for)))))
 
-(define comp_iter (f-or! comp_for comp_if))
+(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)))
@@ -756,7 +812,7 @@
 			  (ff? comp_iter)))
 
 (set! yield_expr
-  (f-list #:yield (f-seq "yield" (ff? yield_arg))))
+  (f-list #:yield (f-seq "yield" (ff? (Ds yield_arg)))))
 
 (set! yield_arg
   (f-or!
@@ -765,5 +821,6 @@
 
 
 (define (p str)
-  (pp (parse str single_input))
-  (if #f #f))
+  (with-fluids ((*whitespace* (f* (f-reg "[ \t\r]"))))
+    (ppp (parse str (f-seq nl single_input)))
+    (if #f #f)))