diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index d5f93c509f..3c46ddaa6a 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -7,6 +7,7 @@ racket/class "private/macro2.rkt" "private/class.rkt" + "private/operator.rkt" (prefix-in literal: "private/literals.rkt") (prefix-in syntax-parse: syntax/parse) (prefix-in racket: racket/base) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index fcffb0256f..e3595b936f 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -94,29 +94,6 @@ #'(rest ...) #f)]))) -(define-syntax-rule (define-binary-operator name precedence associativity operator) - (begin - (provide name) - (define-honu-operator/syntax name precedence associativity - ;; binary - (lambda (left right) - (with-syntax ([left left] - [right right]) - #'(%racket (operator left right)))) - ;; unary - (lambda (argument) - (with-syntax ([argument argument]) - #'(%racket (operator argument))))))) - -(define-syntax-rule (define-unary-operator name precedence associativity operator) - (begin - (provide name) - (define-honu-operator/syntax name precedence associativity - #f - ;; unary - (lambda (argument) - (with-syntax ([argument argument]) - #'(%racket (operator argument))))))) (begin-for-syntax (define-syntax (parse-expression stx) @@ -212,47 +189,6 @@ ;; possibly handle other types of data [else (error 'dot "don't know how to deal with ~a (~a)" 'left left*)])))))) -(provide honu-flow) -(define-honu-operator/syntax honu-flow 0.001 'left - (lambda (left right) - (with-syntax ([left left] - [right right]) - #'(%racket (right left))))) - -(provide honu-assignment) -(define-honu-operator/syntax honu-assignment 0.0001 'left - (lambda (left right) - (with-syntax ([left left] - [right right]) - #'(%racket (set! left right))))) - -(define-binary-operator honu-+ 1 'left +) -(define-binary-operator honu-- 1 'left -) -(define-binary-operator honu-* 2 'left *) -(define-binary-operator honu-/ 2 'left /) -(define-binary-operator honu-^ 2 'right expt) -(define-binary-operator honu-< 0.9 'left <) -(define-binary-operator honu-<= 0.9 'left <=) -(define-binary-operator honu-> 0.9 'left >) -(define-binary-operator honu->= 0.9 'left >=) -;; (define-binary-operator honu-= 0.9 'left =) -(define-binary-operator honu-and 0.5 'left and) -(define-binary-operator honu-or 0.5 'left or) -(define-binary-operator honu-cons 0.1 'right cons) -(define-binary-operator honu-map 0.09 'left map) -(define-binary-operator honu-string=? 1 'left string=?) -(define-binary-operator honu-modulo 2 'left modulo) - -(define-binary-operator honu-to 0.001 'left - (lambda (left right) - (for/list ([i (in-range left right)]) i))) - -(define-unary-operator honu-not 0.7 'left not) - -(define-binary-operator honu-== 1 'left equal?) -(define-binary-operator honu-not-equal 1 'left (lambda (left right) - (not (equal? left right)))) - (begin-for-syntax (define (fix-module-name name) diff --git a/collects/honu/core/private/literals.rkt b/collects/honu/core/private/literals.rkt index 17af7ec578..1c5219bf1a 100644 --- a/collects/honu/core/private/literals.rkt +++ b/collects/honu/core/private/literals.rkt @@ -15,17 +15,16 @@ (define-literal honu-return) (define-literal semicolon) -(define-literal honu-+ honu-* honu-/ honu-- honu-|| honu-% +(define-literal honu-|| honu-% honu-+= honu--= honu-*= honu-/= honu-%= honu-&= honu-^= honu-\|= honu-<<= honu->>= honu->>>= - honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->= + honu->> honu-<< honu->>> honu-!= honu-equal honu-<- honu-literal honu-then honu-? honu-: honu-comma honu-. #%braces #%brackets #%parens colon - honu-and ellipses-comma ellipses-comma* ellipses-repeat honu-in honu-where diff --git a/collects/honu/core/private/operator.rkt b/collects/honu/core/private/operator.rkt index 675752113d..bc02bfdbe6 100644 --- a/collects/honu/core/private/operator.rkt +++ b/collects/honu/core/private/operator.rkt @@ -3,7 +3,8 @@ (require (for-syntax racket/base "transformer.rkt" "fixture.rkt" - syntax/parse)) + syntax/parse) + (only-in "literals.rkt" %racket)) (provide define-honu-operator/syntax) (define-syntax (define-honu-operator/syntax stx) @@ -18,3 +19,68 @@ (syntax-parse stx [(_ name transformer) #'(define-syntax name (make-fixture transformer))])) + +(define-syntax-rule (define-binary-operator name precedence associativity operator) + (begin + (provide name) + (define-honu-operator/syntax name precedence associativity + ;; binary + (lambda (left right) + (with-syntax ([left left] + [right right]) + #'(%racket (operator left right)))) + ;; unary + (lambda (argument) + (with-syntax ([argument argument]) + #'(%racket (operator argument))))))) + +(define-syntax-rule (define-unary-operator name precedence associativity operator) + (begin + (provide name) + (define-honu-operator/syntax name precedence associativity + #f + ;; unary + (lambda (argument) + (with-syntax ([argument argument]) + #'(%racket (operator argument))))))) + +(provide honu-flow) +(define-honu-operator/syntax honu-flow 0.001 'left + (lambda (left right) + (with-syntax ([left left] + [right right]) + #'(%racket (right left))))) + +(provide honu-assignment) +(define-honu-operator/syntax honu-assignment 0.0001 'left + (lambda (left right) + (with-syntax ([left left] + [right right]) + #'(%racket (set! left right))))) + +(define-binary-operator honu-+ 1 'left +) +(define-binary-operator honu-- 1 'left -) +(define-binary-operator honu-* 2 'left *) +(define-binary-operator honu-/ 2 'left /) +(define-binary-operator honu-^ 2 'right expt) +(define-binary-operator honu-< 0.9 'left <) +(define-binary-operator honu-<= 0.9 'left <=) +(define-binary-operator honu-> 0.9 'left >) +(define-binary-operator honu->= 0.9 'left >=) +;; (define-binary-operator honu-= 0.9 'left =) +(define-binary-operator honu-and 0.5 'left and) +(define-binary-operator honu-or 0.5 'left or) +(define-binary-operator honu-cons 0.1 'right cons) +(define-binary-operator honu-map 0.09 'left map) +(define-binary-operator honu-string=? 1 'left string=?) +(define-binary-operator honu-modulo 2 'left modulo) + +(define-binary-operator honu-to 0.001 'left + (lambda (left right) + (for/list ([i (in-range left right)]) i))) + +(define-unary-operator honu-not 0.7 'left not) + +(define-binary-operator honu-== 1 'left equal?) +(define-binary-operator honu-not-equal 1 'left (lambda (left right) + (not (equal? left right)))) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 6d4f2fa103..33bef090ea 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -10,6 +10,7 @@ "compile.rkt" (prefix-in transformer: "transformer.rkt") (prefix-in fixture: "fixture.rkt") + "operator.rkt" macro-debugger/emit racket/pretty syntax/stx