dont parse raw scheme syntax. fix comma replacer

collects/honu/private/more.ss

@@ -3,6 +3,7 @@
 (require "honu-typed-scheme.ss"
          "literals.ss"
          syntax/parse
+         mzlib/trace
          (for-syntax syntax/parse
                      syntax/stx
                      racket/list
@@ -15,17 +16,45 @@
 
 (provide (all-defined-out))
 
+(define (combine-syntax lexical . all)
+  (define consed (for/fold ([item all])
+                           ([out '()])
+                           (cons item out)))
+  (datum->syntax lexical consed lexical))
+
 (define (replace-commas stuff)
-    (syntax-parse stuff #:literals (ellipses-comma)
+  (printf "Replace commas with: ~a\n" (syntax->datum stuff))
-      [((ellipses-comma z) thing blah ...)
+  (syntax-parse stuff #:literals (ellipses-comma)
-       (with-syntax ([(rest ...) (replace-commas #'(thing blah ...))])
+    [((ellipses-comma z) thing blah ...)
-         #'(z honu-comma rest ...))]
+     #;
-      [((ellipses-comma z)) #'z]
+     (printf "Thing ~a and blah ~a replaced ~a\n" #'thing #'(blah ...) (replace-commas #'(thing blah ...)))
-      [(z rest ...)
+     (with-syntax ([(rest ...) (replace-commas #'(thing blah ...))])
-       (with-syntax ([z* (replace-commas #'z)]
+       #;
-                     [(rest* ...) (replace-commas #'(rest ...))])
+       (combine-syntax stuff #'z #'honu-comma #'(rest ...))
-         #'(z* rest* ...))]
+       (datum->syntax stuff (cons #'z (cons #'honu-comma #'(rest ...)))
-      [else stuff]))
+                      stuff)
+       #;
+       #'(z honu-comma rest ...))]
+    [(front (ellipses-comma z) thing more ...)
+     (with-syntax ([front* (replace-commas #'front)]
+                   [(rest* ...) (replace-commas #'(thing more ...))])
+       (datum->syntax stuff (cons #'front*
+                                  (cons #'z #'(rest* ...)))
+                      stuff))]
+    [((ellipses-comma z)) (datum->syntax stuff #'(z) stuff)]
+    [(z rest ...)
+     (with-syntax ([z* (replace-commas #'z)]
+                   [(rest* ...) (replace-commas #'(rest ...))])
+       #;
+       (combine-syntax stuff #'z #'(rest* ...))
+       (datum->syntax stuff
+                      (cons #'z* #'(rest* ...))
+                      stuff)
+       #;
+       #'(z* rest* ...))]
+    [else stuff]))
+
+(trace replace-commas)
 
 (define-syntax (fix-template stuff)
   (define (fix stuff)
@@ -56,6 +85,14 @@
       [(a ellipses-comma rest ...)
        (with-syntax ([a* (replace #'a)]
                      [(rest* ...) (replace #'(rest ...))])
+         (datum->syntax stuff
+                        (cons
+                          (cons #'ellipses-comma (cons #'a* '()))
+                          (cons
+                            #'(... ...)
+                            #'(rest* ...)))
+                        stuff)
+         #;
          #'((ellipses-comma a*) (... ...) rest* ...))]
       [(z rest ...)
        (with-syntax ([z* (replace #'z)]

collects/honu/private/parse.rkt

@@ -147,8 +147,8 @@
                  (#%parens (~var arg (expression-1 context)) ...))
            #:with call 
            (begin
-             (printf "Resulting call is ~a\n" (syntax->datum #'(e arg.result ...)))
+             (printf "Resulting call. e is ~a -- ~a\n" #'e (syntax->datum #'(e arg.result ...)))
-           #'(e arg.result ...))]
+           #'(e.x arg.result ...))]
 
   [pattern (~seq (~var e honu-identifier
                        #;
@@ -159,21 +159,22 @@
                              (~optional honu-comma)) ...))
            #:with call 
            (begin
-             (printf "Resulting call is ~a\n" (syntax->datum #'(e arg.result ...)))
+             (printf "Resulting call is ~a\n" (syntax->datum #'(e.x arg.result ...)))
-             #'(e arg.result ...))])
+             #'(e.x arg.result ...))])
 
 (define-splicing-syntax-class honu-identifier
   [pattern (~seq x:identifier) #:when (not (free-identifier=? #'honu-comma #'x))])
 
 (define-splicing-syntax-class (expression-last context)
                               #:literals (#%parens)
+  [pattern (~seq raw:raw-scheme-syntax) #:with result #'raw]
   [pattern (~seq (#%parens (~var e (expression-1 context)))) #:with result #'e.result]
   #;
   [pattern (~seq (~var e (honu-transformer context))) #:with result #'e.result]
   [pattern (~seq (~var call (call context))) #:with result #'call.call]
   [pattern (~seq x:number) #:with result #'x]
   [pattern (~seq x:str) #:with result #'x]
-  [pattern (~seq x:honu-identifier) #:with result #'x]
+  [pattern (~seq x:honu-identifier) #:with result #'x.x]
   #;
   [pattern (~seq (~var e (honu-expr context))) #:with result #'e.result]
   )
@@ -189,7 +190,7 @@
                     (~var right (next context))
 
                     (~var new-right (do-rest context ((attribute op.func) left #'right.result))))
-              #:with result (attribute new-right.result))
+              #:with result (apply-scheme-syntax (attribute new-right.result)))
      (pattern (~seq) #:with result left))
    (define-splicing-syntax-class (name context)
      (pattern (~seq (~var left (next context))
@@ -388,7 +389,22 @@
 
 (define-splicing-syntax-class expression-comma
   #:literals (honu-comma)
-  [pattern ((~seq (~var expr (expression-1 the-expression-context)) (~optional comma)) ...)])
+  #;
+  [pattern ;; ((~seq x) ...)
+           (x ...)
+           #:with (expr ...) (filter (lambda (n)
+                                       (not (free-identifier=? #'honu-comma n)))
+                                     (syntax->list #'(x ...)))]
+  #;
+  [pattern ((~seq (~var expr honu-identifier) (~optional honu-comma)) ...)]
+  
+  #;
+  [pattern (~seq (~var expr honu-identifier) (~optional honu-comma))]
+
+  [pattern (~seq (~var expr (expression-1 the-expression-context)) (~optional honu-comma)) #:with result #'expr.result]
+
+  #;
+  [pattern ((~seq (~var expr (expression-1 the-expression-context)) (~optional honu-comma)) ...)])
 
 (define (parse-an-expr stx)
   (printf "Parse an expr ~a\n" (syntax->datum stx))
@@ -419,7 +435,7 @@
       #;
       [(x:number . rest) (values #'x #'rest)]
       ))
-  (printf "Parsing ~a\n" stx)
+  (printf "Parsing ~a\n" (syntax->datum stx))
   (cond
     [(stx-null? stx) (values stx '())]
     #;
@@ -478,8 +494,6 @@
                                              ))]
     [else (parse-one stx context)]))
 
-
-
 (define operator? 
   (let ([sym-chars (string->list "+-_=?:<>.!%^&*/~|")])
     (lambda (stx)

collects/honu/private/syntax.ss

@@ -22,6 +22,9 @@
 (define-syntax-rule (scheme-syntax stx)
                     (syntax-property (syntax stx) honu-scheme-syntax #t))
 
+(define (apply-scheme-syntax stx)
+  (syntax-property stx honu-scheme-syntax #t))
+
 #;
 (define-syntax (scheme-syntax stx)
   (syntax-case stx ()