fix parsing for operators

collects/honu/core/private/honu2.rkt

@@ -22,9 +22,27 @@
                (do-parse)))
          #'rest)])))
 
+(define-syntax-rule (define-binary-operator name precedence operator)
+                    (begin
+                      (provide name)
+                      (define-honu-operator/syntax name precedence
+                                                   (lambda (left right)
+                                                     (with-syntax ([left left]
+                                                                   [right right])
+                                                       #'(operator left right))))))
+
 (provide honu-+)
 (define-honu-operator/syntax honu-+ 1
                              (lambda (left right)
                                (with-syntax ([left left]
                                              [right right])
                                  #'(+ left right))))
+
+(provide honu--)
+(define-honu-operator/syntax honu-- 1
+                             (lambda (left right)
+                               (with-syntax ([left left]
+                                             [right right])
+                                 #'(- left right))))
+
+(define-binary-operator honu-* 2 *)

collects/honu/core/private/parse2.rkt

@@ -68,11 +68,34 @@
   (and (identifier? what)
        ((literal-set->predicate check) what)))
 
+;; 1 + 1
+;; ^
+;;  left: identity
+;;  current: 1
+;; 1 + 1
+;;   ^
+;;  left: (lambda (x) (+ 1 x))
+;;  current: #f
+;; 1 + 1
+;;     ^
+;;  left: (lambda (x) (+ 1 x))
+;;  current: 1
+;;
+;; 1 + 1 * 2
+;;       ^
+;;  left: (lambda (x) (left (* 1 x)))
+;;  current: #f
+;;
+;; 1 + 1 * 2
+;;         ^
+;;  left: (lambda (x) (left (* 1 x)))
+;;  current: 2
+
 (define (parse input)
   (define (do-parse stream precedence left current)
     (debug "parse ~a precedence ~a left ~a current ~a\n" stream precedence left current)
     (syntax-parse stream
-      [() left]
+      [() (left current)]
       [(head rest ...)
        (cond
          [(honu-macro? #'head)
@@ -82,7 +105,7 @@
                           ((syntax-local-value #'head) #'(head rest ...) #f)])
               (with-syntax ([parsed parsed]
                             [rest unparsed])
-                (do-parse #'rest precedence #'parsed current)
+                (do-parse #'rest precedence (lambda (x) x) #'parsed)
                 #;
                 #'(splicing-let-syntax ([more-parsing (lambda (stx)
                                                         (do-parse (stx-cdr stx)
@@ -94,39 +117,42 @@
           (define new-precedence (transformer:honu-operator-ref (syntax-local-value #'head) 0))
           (define operator-transformer (transformer:honu-operator-ref (syntax-local-value #'head) 1))
           (define association 'left)
-          (define check
+          (define higher
             (case association
               [(left) >]
               [(right) >=]))
           (printf "new precedence ~a\n" new-precedence)
-          (if (check new-precedence precedence)
+          (if (higher new-precedence precedence)
             (do-parse #'(rest ...) new-precedence
                       (lambda (stuff)
-                        (operator-transformer left stuff))
+                        (left (operator-transformer current stuff)))
-                      current)
+                      #f)
-            (left current))]
+            (do-parse #'(head rest ...)
+                      0
+                      (lambda (x) x)
+                      (left current)))]
          [(semicolon? #'head)
-          (with-syntax ([so-far left])
+          (with-syntax ([so-far (left current)])
             #'(splicing-let-syntax ([more (lambda (stx)
                                             (parse #'(rest ...)))])
                 so-far (more)))]
          [(identifier? #'head)
-          (do-parse #'(rest ...) precedence #'head current)]
+          (do-parse #'(rest ...) precedence left #'head)]
          [else (syntax-parse #'head
                  #:literal-sets (cruft)
                  [x:number (do-parse #'(rest ...)
-                                     precedence (left #'x) current)]
+                                     precedence left #'x)]
                  [(#%parens args ...)
                   (debug "function call ~a\n" left)
-                  (with-syntax ([left left])
+                  (with-syntax ([current current])
-                    #'(left args ...))
+                    #'(current args ...))
                   #;
                   (error 'parse "function call")]
                  [else (error 'what "dont know ~a" #'head)])]
 
          )]))
 
-  (do-parse input 0 (lambda (x) x) #'(void)))
+  (do-parse input 0 (lambda (x) x) #f))
 
 (define (parse2 forms)
   (debug "parse forms ~a\n" forms)

collects/tests/honu/test.rkt

@@ -4,7 +4,9 @@
   (prefix-in macro_ honu/core/private/macro2)
   (rename-in honu/core/private/honu2
              [honu-function honu_function]
-             [honu-+ honu_plus])
+             [honu-+ honu_plus]
+             [honu-* honu_times]
+             [honu-- honu_minus])
   (rename-in honu/core/private/literals
              [honu-= =]
              [semicolon |;|])
@@ -46,3 +48,9 @@
 
 (let ()
   (fake-module-begin #hx(1 honu_plus 1)))
+
+(let ()
+  (fake-module-begin #hx(1 honu_plus 1 honu_minus 4)))
+
+(let ()
+  (fake-module-begin #hx(1 honu_plus 1 honu_minus 4 honu_times 8)))