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

Add an arith-expr syntax class, to simplify parts of the optimizer.

Browse Source 
original commit: ec696f26ae5375b83f4eb8666047e803b19214e4
This commit is contained in:
Vincent St-Amour 2011-05-16 17:56:30 -04:00
parent 6cb0669985
commit 58360f3a16
1 changed files with 36 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/typed-scheme/optimizer/numeric-utils.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require syntax/parse
(require syntax/parse racket/dict syntax/id-table
(for-template racket/base racket/flonum racket/fixnum racket/unsafe/ops)
"../utils/utils.rkt"
(types numeric-tower)
(optimizer utils))
@ -20,3 +21,37 @@
(and (subtypeof? t -Real)
(not (subtypeof? t -Rat))
(not (subtypeof? t -Flonum))))
(define-syntax-class arith-expr
(pattern (#%plain-app op:arith-op args ...)))
(define-syntax-class arith-op
(pattern
op:id
#:when (dict-ref arith-ops #'op (lambda () #f))))
;; limited to operation that actually perform arithmeric
;; so, no comparisons, or coercions, or constructors (make-rectangular), accessors, etc.
(define arith-ops
(make-immutable-free-id-table
(map (lambda (x) (list x #t))
(list #'* #'+ #'- #'/
#'max #'min #'add1 #'sub1
#'quotient #'remainder #'modulo
#'arithmetic-shift #'bitwise-and #'bitwise-ior #'bitwise-xor #'bitwise-not
#'abs #'floor #'ceiling #'truncate #'round
#'expt #'sqrt #'integer-sqrt #'log #'exp
#'cos #'sin #'tan #'acos #'asin #'atan
#'gcd #'lcm #'sgn #'sqr #'conjugate
#'sinh #'cosh #'tanh
#'fx+ #'fx- #'fx* #'fxquotient #'fxremainder #'fxmodulo #'fxabs
#'unsafe-fx+ #'unsafe-fx- #'unsafe-fx* #'unsafe-fxquotient #'unsafe-fxremainder #'unsafe-fxmodulo #'unsafe-fxabs
#'fxand #'fxior #'fxxor #'fxnot #'fxlshift #'fxrshift
#'unsafe-fxand #'unsafe-fxior #'unsafe-fxxor #'unsafe-fxnot #'unsafe-fxlshift #'unsafe-fxrshift
#'fxmax #'fxmin #'unsafe-fxmax #'unsafe-fxmin
#'flabs #'fl+ #'fl- #'fl* #'fl/ #'flmin #'flmax
#'unsafe-flabs #'unsafe-fl+ #'unsafe-fl- #'unsafe-fl* #'unsafe-fl/ #'unsafe-flmin #'unsafe-flmax
#'flround #'flfloor #'flceiling #'fltruncate
#'unsafe-flround #'unsafe-flfloor #'unsafe-flceiling #'unsafe-fltruncate
#'flsin #'flcos #'fltan #'flasin #'flacos #'flatan
#'unsafe-flsin #'unsafe-flcos #'unsafe-fltan #'unsafe-flasin #'unsafe-flacos #'unsafe-flatan
#'fllog #'flexp #'flsqrt
#'unsafe-fllog #'unsafe-flexp #'unsafe-flsqrt))))