178 lines
6.1 KiB
Scheme
178 lines
6.1 KiB
Scheme
#lang scheme/base
|
|
|
|
(provide unary-primitives
|
|
binary-primitives
|
|
ternary-primitives
|
|
side-effect-primitive?
|
|
all-primitives
|
|
transient-variables
|
|
global-variables
|
|
instance-variables
|
|
special-variables
|
|
global-variable?
|
|
instance-variable?
|
|
transient-variable?
|
|
special-variable?
|
|
machine-variable?)
|
|
|
|
(define unary-primitives
|
|
'((#%unbox #x01 unbox)
|
|
(#%weak-unbox #x02 weak-unbox)
|
|
(#%car #x03 car)
|
|
(#%cdr #x04 cdr)
|
|
(#%boolean? #x08 boolean?)
|
|
(#%fixnum? #x09 fixnum?)
|
|
(#%box? #x0a box?)
|
|
(#%pair? #x0b pair?)
|
|
(#%vector? #x0c vector?)
|
|
(#%byte-string? #x0d byte-string?)
|
|
(#%struct? #x0e struct?)
|
|
(#%float? #x0f float?)
|
|
(#%builtin? #x10 builtin?)
|
|
(#%weak-box? #x11 weak-box?)
|
|
(#%make-box #x18 make-box)
|
|
(#%make-struct #x19 make-struct)
|
|
(#%make-float #x1a make-float)
|
|
(#%make-lambda #x1b make-lambda)
|
|
(#%make-weak-box #x1c make-weak-box)
|
|
(#%not #x20 not)
|
|
(#%bit-not #x21 bit-not)
|
|
(#%fix- #x22 fix-)
|
|
(#%float- #x23 float-)
|
|
(#%vector-size #x28 vector-size)
|
|
(#%byte-string-size #x29 byte-string-size)
|
|
(#%struct-nslots #x2a struct-nslots)
|
|
(#%struct-type #x2b struct-type)
|
|
(#%hash-value #x2c hash-value)
|
|
(#%acos #x30 acos)
|
|
(#%asin #x31 asin)
|
|
(#%atan #x32 atan)
|
|
(#%cos #x33 cos)
|
|
(#%sin #x34 sin)
|
|
(#%tan #x35 tan)
|
|
(#%cosh #x36 cosh)
|
|
(#%sinh #x37 sinh)
|
|
(#%tanh #x38 tanh)
|
|
(#%exp #x39 exp)
|
|
(#%frexp #x3a frexp)
|
|
(#%log #x3b log)
|
|
(#%log10 #x3c log10)
|
|
(#%modf #x3d modf)
|
|
(#%sqrt #x3e sqrt)
|
|
(#%ceil #x3f ceil)
|
|
(#%fabs #x40 fabs)
|
|
(#%floor #x41 floor)
|
|
(#%erf #x50 erf)
|
|
(#%erfc #x51 erfc)
|
|
(#%j0 #x52 j0)
|
|
(#%j1 #x53 j1)
|
|
(#%lgamma #x54 lgamma)
|
|
(#%y0 #x55 y0)
|
|
(#%y1 #x56 y1)
|
|
(#%asinh #x57 asinh)
|
|
(#%acosh #x58 acosh)
|
|
(#%atanh #x59 atanh)
|
|
(#%cbrt #x5a cbrt)
|
|
(#%logb #x5b logb)
|
|
(#%expm1 #x5c expm1)
|
|
(#%ilogb #x5d ilogb)
|
|
(#%log1p #x5e log1p)
|
|
(#%normal? #x70 normal?)
|
|
(#%finite? #x71 finite?)
|
|
(#%subnormal? #x72 subnormal?)
|
|
(#%infinite? #x73 infinite?)
|
|
(#%nan? #x74 nan?)))
|
|
|
|
(define binary-primitives
|
|
'((#%eq? #x01 eq?)
|
|
(#%cons #x02 cons)
|
|
(#%make-vector #x03 make-vector)
|
|
(#%make-byte-string #x04 make-byte-string)
|
|
(#%vector-ref #x05 vector-ref)
|
|
(#%byte-string-ref #x06 byte-string-ref)
|
|
(#%struct-ref #x07 struct-ref)
|
|
(#%fix+ #x08 fix+)
|
|
(#%fix- #x09 fix-)
|
|
(#%fix* #x0a fix*)
|
|
(#%fix/ #x0b fix/)
|
|
(#%fix% #x0c fix%)
|
|
(#%fix< #x0d fix<)
|
|
(#%fix>= #x0e fix>=)
|
|
(#%bit-and #x10 bit-and)
|
|
(#%bit-or #x11 bit-or)
|
|
(#%bit-xor #x12 bit-xor)
|
|
(#%fix<< #x14 fix<<)
|
|
(#%fix>> #x15 fix>>)
|
|
(#%fix>>> #x16 fix>>>)
|
|
(#%float+ #x18 float+)
|
|
(#%float- #x19 float-)
|
|
(#%float* #x1a float*)
|
|
(#%float/ #x1b float/)
|
|
(#%float= #x1c float=)
|
|
(#%float< #x1d float<)
|
|
(#%float>= #x1e float>=)
|
|
(#%atan2 #x20 atan2)
|
|
(#%pow #x21 pow)
|
|
(#%ldexp #x22 ldexp)
|
|
(#%fmod #x23 fmod)
|
|
(#%hypot #x24 hypot)
|
|
(#%jn #x25 jn)
|
|
(#%yn #x26 yn)
|
|
(#%nextafter #x27 nextafter)
|
|
(#%remainder #x28 remainder)
|
|
(#%scalb #x29 scalb)
|
|
(#%kind-of? #x30 kind-of?)
|
|
(#%byte-string= #x31 byte-string=)
|
|
(#%byte-string< #x32 byte-string<)
|
|
(#%byte-string>= #x33 byte-string>=)
|
|
(#%set-box! #x50 set-box!)
|
|
(#%set-car! #x51 set-car!)
|
|
(#%set-cdr! #x52 set-cdr!)
|
|
(#%tail-call-if #x70 (gensym))
|
|
(#%fatal-error-if #xff fatal-error-if)))
|
|
|
|
(define ternary-primitives
|
|
'((#%if #x10 if)
|
|
(#%vector-set! #x20 vector-set!)
|
|
(#%byte-string-set! #x21 byte-string-set!)
|
|
(#%struct-set! #x22 struct-set!)
|
|
(#%vector-ref-immed #xff (gensym))))
|
|
|
|
(define all-primitives
|
|
(append unary-primitives
|
|
binary-primitives
|
|
ternary-primitives))
|
|
|
|
(define (side-effect-primitive? sym)
|
|
(memq sym '(#%make-box #%make-struct #%make-lambda #%make-weak-box #%cons #%make-vector
|
|
#%make-byte-string #%set-box! #%set-car! #%set-cdr! #%tail-call-if
|
|
#%fatal-error-if #%struct-set! #%vector-set! #%byte-string-set!)))
|
|
|
|
(define transient-variables
|
|
(for/list ([i (in-range 0 128)])
|
|
(string->uninterned-symbol (string-append "#%t" (number->string i)))))
|
|
|
|
(define global-variables
|
|
(for/list ([i (in-range 0 64)])
|
|
(string->uninterned-symbol (string-append "#%g" (number->string i)))))
|
|
|
|
(define instance-variables
|
|
(for/list ([i (in-range 0 48)])
|
|
(string->uninterned-symbol (string-append "#%i" (number->string i)))))
|
|
|
|
(define special-variables
|
|
'(#%f #%nil #%undef #%self #%globals #%inst #%argv #%kw-args #%kw-vals #%ctx #%k))
|
|
|
|
(define (global-variable? var) (and (memq var global-variables) #t))
|
|
(define (instance-variable? var) (and (memq var instance-variables) #t))
|
|
(define (transient-variable? var) (and (memq var transient-variables) #t))
|
|
(define (special-variable? var) (and (memq var special-variables) #t))
|
|
|
|
(define (machine-variable? var)
|
|
(or (special-variable? var)
|
|
(transient-variable? var)
|
|
(instance-variable? var)
|
|
(global-variable? var)))
|
|
|
|
; vim:set sw=2 expandtab:
|