[honu] support postfix unary operators

collects/honu/core/private/honu2.rkt

@@ -148,18 +148,18 @@
 (define-honu-syntax define-make-honu-binary-operator
   (lambda (code)
     (syntax-parse code
-      [(_ name:id level:number association:honu-expression function:honu-expression . rest)
+      [(_ name:id level:honu-expression association:honu-expression function:honu-expression . rest)
        (define out (racket-syntax
-                     (define-binary-operator name level association.result function.result)))
+                     (define-binary-operator name level.result association.result function.result)))
        (values out #'rest #t)])))
 
 (provide define-make-honu-unary-operator)
 (define-honu-syntax define-make-honu-unary-operator
   (lambda (code)
     (syntax-parse code
-      [(_ name:id function:honu-expression . rest)
+      [(_ name:id level:honu-expression postfix?:honu-expression function:honu-expression . rest)
        (define out (racket-syntax
-                     (define-unary-operator name function.result)))
+                     (define-unary-operator name level.result postfix?.result function.result)))
        (values out #'rest #t)])))
 
 ;; equals can have a compile time property that allows it to do something like set!

collects/honu/core/private/operator.rkt

@@ -12,9 +12,9 @@
 (define-syntax (define-honu-operator/syntax stx)
   (syntax-parse stx
     [(_ name precedence associativity binary-function)
-     (syntax/loc stx (define-syntax name (make-honu-operator precedence associativity binary-function #f)))]
+     (syntax/loc stx (define-syntax name (make-honu-operator precedence associativity binary-function #f #f)))]
-    [(_ name precedence associativity binary-function unary-function)
+    [(_ name precedence associativity binary-function unary-function postfix?)
-     (syntax/loc stx (define-syntax name (make-honu-operator precedence associativity binary-function unary-function)))]))
+     (syntax/loc stx (define-syntax name (make-honu-operator precedence associativity binary-function unary-function postfix?)))]))
 
 (define-syntax (define-honu-fixture stx)
   (syntax-parse stx
@@ -29,14 +29,29 @@
                                                  [right right])
                                      (racket-syntax (operator left right))))))
 
-(define-syntax-rule (define-unary-operator name operator)
+(define-syntax-rule (define-unary+binary-operator name precedence associativity operator)
-                    ;; precedence and associativity dont matter for unary 
+    (define-honu-operator/syntax name precedence associativity
-                    (define-honu-operator/syntax name 0 'left
+                                 ;; binary
+                                 (lambda (left right)
+                                   (with-syntax ([left left]
+                                                 [right right])
+                                     (racket-syntax (operator left right))))
+                                 ;; unary
+                                 (lambda (arg)
+                                   (with-syntax ([arg arg])
+                                     (racket-syntax (operator arg))))
+                                 ;; binary operators should not be able to be postfix
+                                 #f))
+
+(define-syntax-rule (define-unary-operator name precedence postfix? operator)
+                    ;; associativity dont matter for unary 
+                    (define-honu-operator/syntax name precedence 'left
                                                  #f
                                                  ;; unary
                                                  (lambda (argument)
                                                    (with-syntax ([argument (honu->racket argument)])
-                                                     (racket-syntax (operator argument))))))
+                                                     (racket-syntax (operator argument))))
+                                                 postfix?))
 
 (define-honu-operator/syntax honu-flow 0.001 'left
   (lambda (left right)
@@ -90,8 +105,8 @@
 (define-honu-operator-= honu-*= *)
 (define-honu-operator-= honu-/= /)
 
-(define-binary-operator honu-+ 1 'left +)
+(define-unary+binary-operator honu-+ 1 'left +)
-(define-binary-operator honu-- 1 'left -)
+(define-unary+binary-operator honu-- 1 'left -)
 (define-binary-operator honu-* 2 'left *)
 (define-binary-operator honu-/ 2 'left /)
 (define-binary-operator honu-^ 2 'right expt)
@@ -111,7 +126,7 @@
                         (lambda (left right)
                           (for/list ([i (in-range left right)]) i)))
 
-(define-unary-operator honu-not not)
+(define-unary-operator honu-not 0.7 #f not)
 
 (define-binary-operator honu-== 1 'left equal?)
 (define-binary-operator honu-not-equal 1 'left (lambda (left right)

collects/honu/core/private/parse2.rkt

@@ -390,10 +390,14 @@
           (define-values (output rest) (transformer current stream))
           (do-parse rest precedence left output)]
          [(honu-operator? #'head)
-          (define new-precedence (transformer:honu-operator-ref (syntax-local-value #'head) 0))
+          (define operator (syntax-local-value #'head))
-          (define association (transformer:honu-operator-ref (syntax-local-value #'head) 1))
+
-          (define binary-transformer (transformer:honu-operator-ref (syntax-local-value #'head) 2))
+          (define new-precedence (transformer:operator-precedence operator))
-          (define unary-transformer (transformer:honu-operator-ref (syntax-local-value #'head) 3))
+          (define association (transformer:operator-association operator))
+          (define binary-transformer (transformer:operator-binary-transformer operator))
+          (define unary-transformer (transformer:operator-unary-transformer operator))
+          (define postfix? (transformer:operator-postfix? operator))
+
           (define higher
             (case association
               [(left) >]
@@ -409,7 +413,10 @@
                                           (if current
                                             (if binary-transformer
                                               (binary-transformer (parse-all-expression current) right)
-                                              (error 'binary "cannot be used as a binary operator in ~a" #'head))
+                                              ;; use a unary transformer in postfix position
+                                              (if (and postfix? unary-transformer)
+                                                (unary-transformer current)
+                                                (error 'binary "cannot be used as a binary operator in ~a" #'head)))
                                             (if unary-transformer
                                               (unary-transformer right)
                                               (error 'unary "cannot be used as a unary operator in ~a" #'head))))
@@ -425,7 +432,13 @@
             ;; if we have a unary transformer then we have to keep parsing
             (if unary-transformer
               (if current
-                (values (left current) stream)
+                (if postfix?
+                  (do-parse #'(rest ...)
+                            precedence 
+                            left
+                            (unary-transformer current))
+                  (values (left current) stream))
+
                 (do-parse #'(rest ...) new-precedence
                                       (lambda (stuff)
                                         (define right (parse-all stuff))

collects/honu/core/private/transformer.rkt

@@ -27,17 +27,36 @@
 (provide (rename-out [prop:honu-operator? honu-operator?])
          make-honu-operator
          (rename-out [-honu-operator-ref honu-operator-ref]))
+
 (define-values (prop:honu-operator prop:honu-operator? prop:honu-operator-ref)
                (make-struct-type-property 'honu-operator))
 
 #;
 (provide honu-operator?)
-(define-values (struct:honu-operator -make-honu-operator honu-operator? -honu-operator-ref honu-operator-set!)
-               (make-struct-type 'honu-operator #f 4 0 #f 
-                                 (list (list prop:honu-operator #t))
-                                 (current-inspector) 0))
 
-(define (make-honu-operator precedence associativity binary unary)
+(define operator-fields '(precedence assocation binary unary postfix?))
+
+(define-values (struct:honu-operator -make-honu-operator honu-operator? -honu-operator-ref honu-operator-set!)
+               (make-struct-type 'honu-operator #f (length operator-fields) 0 #f 
+                                 (list (list prop:honu-operator #t))
+                                 (current-inspector)
+                                 0))
+
+(define (get n)
+  (lambda (operator)
+    (-honu-operator-ref operator n)))
+
+(provide operator-precedence operator-association
+         operator-binary-transformer operator-unary-transformer
+         operator-postfix?)
+
+(define operator-precedence (get 0))
+(define operator-association (get 1))
+(define operator-binary-transformer (get 2))
+(define operator-unary-transformer (get 3))
+(define operator-postfix? (get 4))
+
+(define (make-honu-operator precedence associativity binary unary postfix?)
   (when (and (procedure? binary)
              (not (procedure-arity-includes? binary 2)))
     (raise-type-error
@@ -50,4 +69,4 @@
       'define-honu-operator/syntax
       "procedure (arity 1)"
       unary))
-  (-make-honu-operator precedence associativity binary unary))
+  (-make-honu-operator precedence associativity binary unary postfix?))

collects/tests/honu/operators.honu

@@ -17,6 +17,14 @@ binary_operator b1 2 'left
 
 3 b1 8
 
-unary_operator u1 function(x){ x - 2 }
+unary_operator u1 4 true function(x){ x - 2 }
 
 2 + u1 u1 5
+
+unary_operator u2 5 true function(x){ x + 8 }
+unary_operator u3 5 true function(x){ x * 2 };
+
+7 u3;
+u2 7 u3;
+1 + u2 7 u3;
+1 + u2 7 u3 * 3;