[honu] add binary_operator and unary_operator forms for plain expression-based operators

collects/honu/core/main.rkt

@@ -38,6 +38,8 @@
                                    [racket:read-line readLine]
                                    [honu-with-input-from-file withInputFromFile]
                                    [define-make-honu-operator operator]
+                                   [define-make-honu-binary-operator binary_operator]
+                                   [define-make-honu-unary-operator unary_operator]
                                    [honu-match match]
                                    [honu-with with]
                                    [literal:honu-where where]

collects/honu/core/private/honu2.rkt

@@ -144,6 +144,24 @@
        (define out (racket-syntax (define-honu-operator/syntax name level association.result function.result)))
        (values out #'rest #t)])))
 
+(provide define-make-honu-binary-operator)
+(define-honu-syntax define-make-honu-binary-operator
+  (lambda (code)
+    (syntax-parse code
+      [(_ name:id level:number association:honu-expression function:honu-expression . rest)
+       (define out (racket-syntax
+                     (define-binary-operator name level 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)
+       (define out (racket-syntax
+                     (define-unary-operator name function.result)))
+       (values out #'rest #t)])))
+
 ;; equals can have a compile time property that allows it to do something like set!
 ;; v.x could return a syntax object with a property that can be invoked by an equals
 ;; thing so that it can be rewritten to do the set! thing

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)
-     #'(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)))]
     [(_ name precedence associativity binary-function unary-function)
-     #'(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)))]))
 
 (define-syntax (define-honu-fixture stx)
   (syntax-parse stx
@@ -27,19 +27,16 @@
                                  (lambda (left right)
                                    (with-syntax ([left left]
                                                  [right right])
-                                     (racket-syntax (operator left right))))
-                                 ;; unary
-                                 (lambda (argument)
-                                   (with-syntax ([argument (honu->racket argument)])
-                                     (racket-syntax (operator argument))))))
+                                     (racket-syntax (operator left right))))))
 
-(define-syntax-rule (define-unary-operator name precedence associativity operator)
-                      (define-honu-operator/syntax name precedence associativity
-                                                   #f
-                                                   ;; unary
-                                                   (lambda (argument)
-                                                     (with-syntax ([argument (honu->racket argument)])
-                                                       (racket-syntax (operator argument))))))
+(define-syntax-rule (define-unary-operator name operator)
+                    ;; precedence and associativity dont matter for unary 
+                    (define-honu-operator/syntax name 0 'left
+                                                 #f
+                                                 ;; unary
+                                                 (lambda (argument)
+                                                   (with-syntax ([argument (honu->racket argument)])
+                                                     (racket-syntax (operator argument))))))
 
 (define-honu-operator/syntax honu-flow 0.001 'left
   (lambda (left right)
@@ -114,7 +111,7 @@
                         (lambda (left right)
                           (for/list ([i (in-range left right)]) i)))
 
-(define-unary-operator honu-not 0.7 'left not)
+(define-unary-operator honu-not 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

@@ -397,7 +397,8 @@
           (define higher
             (case association
               [(left) >]
-              [(right) >=]))
+              [(right) >=]
+              [else (raise-syntax-error 'parse "invalid associativity. must be either 'left or 'right" association)]))
           (debug "precedence old ~a new ~a higher? ~a\n" precedence new-precedence (higher new-precedence precedence))
           (if (higher new-precedence precedence)
             (let-values ([(parsed unparsed)

collects/tests/honu/operators.honu

@@ -9,3 +9,14 @@ operator gg 2 'left
   }
 
 3 gg 4 gg 5
+
+binary_operator b1 2 'left
+  function(left, right){
+    left + right * 2
+  }
+
+3 b1 8
+
+unary_operator u1 function(x){ x - 2 }
+
+2 + u1 u1 5