suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[honu] move operators to their own module

Browse Source
This commit is contained in:
Jon Rafkind 2012-01-26 12:09:28 -07:00
parent 1fac120cd2
commit d6be1fbdee
5 changed files with 71 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/honu/core/main.rkt
View File

@ -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)

64
collects/honu/core/private/honu2.rkt
View File

@ -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)

5
collects/honu/core/private/literals.rkt
View File

@ -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

68
collects/honu/core/private/operator.rkt
View File

@ -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))))

1
collects/honu/core/private/parse2.rkt
View File

@ -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