rosella/libcompiler/primitives.scm

#lang scheme/base

(provide unary-value-primitives
         binary-value-primitives
         unary-statement-primitives
         binary-statement-primitives
         ternary-statement-primitives
         value-primitives
         statement-primitives
         all-primitives
         global-variables
         instance-variables
         frame-variables
         special-variables
         global-variable?
         instance-variable?
         frame-variable?
         special-variable?
         frame/instance-variable?
         machine-variable?)

(define unary-value-primitives
  '((%unbox            #x02 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?)
    (%make-box         #x18 make-box)
    (%make-struct      #x19 make-struct)
    (%make-float       #x1a make-float)
    (%make-lambda      #x1b make-lambda)
    (%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-value-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?)))

(define unary-statement-primitives
  '((%goto-end-if      #x40 #f)
    (%goto-end-unless  #x41 #f)))

(define binary-statement-primitives
  '((%set-box!         #x50 set-box!)
    (%set-car!         #x51 set-car!)
    (%set-cdr!         #x52 set-cdr!)))

(define ternary-statement-primitives
  '((%vector-set!      #x60 vector-set!)
    (%byte-string-set! #x61 byte-string-set!)
    (%struct-set!      #x62 struct-set!)))

(define value-primitives
 (append unary-value-primitives
         binary-value-primitives
         (list '(%if #f #f))))

(define statement-primitives
 (append unary-statement-primitives
         binary-statement-primitives
         ternary-statement-primitives))

(define all-primitives
 (append value-primitives statement-primitives))

(define global-variables
  (for/list ([i (in-range 1 64)])
    (string->uninterned-symbol (string-append "%g" (number->string i)))))

(define instance-variables
  (for/list ([i (in-range 0 64)])
    (string->uninterned-symbol (string-append "%i" (number->string i)))))

(define frame-variables
  (for/list ([i (in-range 0 120)])
    (string->uninterned-symbol (string-append "%f" (number->string i)))))

(define special-variables
  '(%nil %self %argv %ctx %k))

(define (global-variable?   var) (and (memq var global-variables)   #t))
(define (instance-variable? var) (and (memq var instance-variables) #t))
(define (frame-variable?    var) (and (memq var frame-variables)    #t))
(define (special-variable?  var) (and (memq var special-variables)  #t))

(define (frame/instance-variable? var)
  (or (frame-variable? var)
      (instance-variable? var)))

(define (machine-variable? var)
  (or (special-variable? var)
      (frame/instance-variable? var)
      (global-variable? var)))

; vim:set sw=2 expandtab: