Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 13:05:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Expand number of inlined prims

Browse source
This commit is contained in:
Justin Ethier 2017-04-29 07:01:29 +00:00
parent 0d3ae68f87
commit 94fac5c512
1 changed files with 23 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
scheme/inexact.sld
View file

@ -7,6 +7,7 @@
;;;; This module contains the inexact library from r7rs. ;;;; This module contains the inexact library from r7rs.
;;;; ;;;;
(define-library (scheme inexact) (define-library (scheme inexact)
(import (scheme base))
(export (export
acos acos
asin asin
@ -22,6 +23,19 @@
tan tan
) )
(begin (begin
(define-syntax define-inexact-op
(er-macro-transformer
(lambda (expr rename compare)
(let* ((fnc (cadr expr))
(op (caddr expr)))
`(define-c ,fnc
"(void *data, int argc, closure _, object k, object z)"
,(string-append
" return_inexact_double_op(data, k, " op ", z);")
"(void *data, object ptr, object z)"
,(string-append
" return_inexact_double_op_no_cps(data, ptr, " op ", z);"))))))
(define-c nan? (define-c nan?
"(void *data, int argc, closure _, object k, object z)" "(void *data, int argc, closure _, object k, object z)"
" Cyc_check_num(data, z); " Cyc_check_num(data, z);
@ -46,41 +60,18 @@
return_closcall1(data, k, boolean_t);") return_closcall1(data, k, boolean_t);")
(define (finite? z) (define (finite? z)
(if (infinite? z) #f #t)) (if (infinite? z) #f #t))
(define-c acos
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, acos, z);")
(define-c asin
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, asin, z);")
(define-c atan
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, atan, z);")
(define-c cos
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, cos, z);")
(define-c exp
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, exp, z);")
(define (log z1 . z2) (define (log z1 . z2)
(if (null? z2) (if (null? z2)
(c-log z1) (c-log z1)
(let ((z2* (car z2))) (let ((z2* (car z2)))
(/ (c-log z1) (c-log z2*))))) (/ (c-log z1) (c-log z2*)))))
(define-c c-log (define-inexact-op c-log "log")
"(void *data, int argc, closure _, object k, object z)" (define-inexact-op exp "exp")
" return_inexact_double_op(data, k, log, z);" (define-inexact-op sqrt "sqrt")
"(void *data, object ptr, object z)" (define-inexact-op sin "sin")
" return_inexact_double_op_no_cps(data, ptr, log, z);" (define-inexact-op cos "cos")
) (define-inexact-op tan "tan")
(define-c sin (define-inexact-op asin "asin")
"(void *data, int argc, closure _, object k, object z)" (define-inexact-op acos "acos")
" return_inexact_double_op(data, k, sin, z);" (define-inexact-op atan "atan")
"(void *data, object ptr, object z)"
" return_inexact_double_op_no_cps(data, ptr, sin, z);")
(define-c sqrt
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, sqrt, z);")
(define-c tan
"(void *data, int argc, closure _, object k, object z)"
" return_inexact_double_op(data, k, tan, z);")
)) ))