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

add more operators

Browse Source 
svn: r17773
This commit is contained in:
Jon Rafkind 2010-01-22 22:14:28 +00:00
parent e0fff18e68
commit bee5af120b
1 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
collects/honu/private/honu-typed-scheme.ss
View File

@ -29,7 +29,10 @@
(define-literal honu-return)
(define-literal semicolon)
(define-literal 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->=)
;; (define-syntax (\; stx) (raise-syntax-error '\; "out of context" stx))
@ -428,16 +431,36 @@ x(2)
#:with result #'e.result])
;; infix operators in the appropriate precedence level
;; things defined lower in the table have a higher precedence.
;; the first set of operators is `expression-1'
(splicing-let-syntax ([sl (make-rename-transformer #'syntax-lambda)])
(infix-operators expression-1 expression-last
([honu-+ (sl (left right)
#'(+ left right))]
[honu-- (sl (left right)
#'(- left right))])
([honu-* (sl (left right)
#'(* left right))]
[honu-/ (sl (left right)
#'(/ left right))])))
([honu-= (sl (left right) #'(= left right))]
[honu-+= (sl (left right) #'(+ left right))]
[honu--= (sl (left right) #'(- left right))]
[honu-*= (sl (left right) #'(* left right))]
[honu-/= (sl (left right) #'(/ left right))]
[honu-%= (sl (left right) #'(modulo left right))]
[honu-&= (sl (left right) #'(+ left right))]
[honu-^= (sl (left right) #'(+ left right))]
[honu-\|= (sl (left right) #'(+ left right))]
[honu-<<= (sl (left right) #'(+ left right))]
[honu->>= (sl (left right) #'(+ left right))]
[honu->>>= (sl (left right) #'(+ left right))])
([honu-|| (sl (left right) #'(+ left right))])
([honu->> (sl (left right) #'(+ left right))]
[honu-<< (sl (left right) #'(+ left right))]
[honu->>> (sl (left right) #'(+ left right))]
[honu-< (sl (left right) #'(< left right))]
[honu-> (sl (left right) #'(> left right))]
[honu-<= (sl (left right) #'(<= left right))]
[honu->= (sl (left right) #'(>= left right))])
([honu-+ (sl (left right) #'(+ left right))]
[honu-- (sl (left right) #'(- left right))])
([honu-* (sl (left right) #'(* left right))]
[honu-% (sl (left right) #'(modulo left right))]
[honu-/ (sl (left right) #'(/ left right))])))
;; (printf "~a\n" (syntax-class-parse function stx))
(syntax-parse stx