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

scheme/flonum (v4.2.3.8)

Browse Source 
svn: r17348

original commit: fdd7122994
This commit is contained in:
Matthew Flatt 2009-12-18 15:40:00 +00:00
parent 2d1e7602c1
commit 1b7935c819
1 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/compiler/decompile.ss
View File

@ -14,6 +14,7 @@
(parameterize ([current-namespace ns])
(namespace-require ''#%kernel)
(namespace-require ''#%unsafe)
(namespace-require ''#%flonum)
(for/list ([l (namespace-mapped-symbols)])
(cons l (with-handlers ([exn:fail? (lambda (x) #f)])
(compile l))))))]
@ -350,16 +351,23 @@
[else #f]))
(if (and (symbol? (car a))
(case (length a)
[(2) (memq (car a) '(unsafe-flabs
unsafe-flsqrt
unsafe-fx->fl))]
[(3) (memq (car a) '(unsafe-fl+ unsafe-fl- unsafe-fl* unsafe-fl/
unsafe-fl< unsafe-fl>
unsafe-fl=
unsafe-fl<= unsafe-fl>=
unsafe-flvector-ref))]
[(2) (memq (car a) '(flabs flsqrt ->fl
unsafe-flabs
unsafe-flsqrt
unsafe-fx->fl))]
[(3) (memq (car a) '(fl+ fl- fl* fl/
fl< fl> fl<= fl>= fl=
flvector-ref
unsafe-fl+ unsafe-fl- unsafe-fl* unsafe-fl/
unsafe-fl< unsafe-fl>
unsafe-fl=
unsafe-fl<= unsafe-fl>=
unsafe-flvector-ref
unsafe-f64vector-ref))]
[(4) (memq (car a) '(unsafe-flvector-set!))]
[(4) (memq (car a) '(flvector-set!
unsafe-flvector-set!
unsafe-f64vector-set!))]
[else #f])
(andmap unboxable? args (cdr a)))
(cons '#%flonum a)