instructions got internal type/range checks

This commit is contained in:
ESL 2023-03-06 19:36:15 -05:00
parent 39c6a2bd34
commit 4f2732e536
4 changed files with 1411 additions and 1298 deletions

663
i.c

File diff suppressed because it is too large Load diff

1459
s.c

File diff suppressed because it is too large Load diff

340
src/s.scm
View file

@ -32,51 +32,51 @@
(define-inline (fixnum? x) %residual-fixnum? (%fixp x))
(define-inline (fxzero? x) %residual-fxzero? (%izerop (%cki x)))
(define-inline (fxzero? x) %residual-fxzero? (%izerop x))
(define-inline (fxpositive? x) %residual-fxpositive? (%iposp (%cki x)))
(define-inline (fxpositive? x) %residual-fxpositive? (%iposp x))
(define-inline (fxnegative? x) %residual-fxnegative? (%inegp (%cki x)))
(define-inline (fxnegative? x) %residual-fxnegative? (%inegp x))
(define-inline (fx+ x y) %residual-fx+ (%iadd (%cki x) (%cki y)))
(define-inline (fx+ x y) %residual-fx+ (%iadd x y))
(define-inline (fx* x y) %residual-fx* (%imul (%cki x) (%cki y)))
(define-inline (fx* x y) %residual-fx* (%imul x y))
(define-inline (fx- x y) %residual-fx- (%isub (%cki x) (%cki y)))
(define-inline (fx- x y) %residual-fx- (%isub x y))
(define-inline (fx/ x y) %residual-fx/ (%idiv (%cki x) (%cki y)))
(define-inline (fx/ x y) %residual-fx/ (%idiv x y))
(define-inline (fxquotient x y) %residual-fxquotient (%iquo (%cki x) (%cki y)))
(define-inline (fxquotient x y) %residual-fxquotient (%iquo x y))
(define-inline (fxremainder x y) %residual-fxremainder (%irem (%cki x) (%cki y)))
(define-inline (fxremainder x y) %residual-fxremainder (%irem x y))
(define-inline (fxmodquo x y) %residual-fxmodquo (%imqu (%cki x) (%cki y)))
(define-inline (fxmodquo x y) %residual-fxmodquo (%imqu x y))
(define-inline (fxmodulo x y) %residual-fxmodulo (%imlo (%cki x) (%cki y)))
(define-inline (fxmodulo x y) %residual-fxmodulo (%imlo x y))
(define-inline (fxeucquo x y) %residual-fxeucquo (%ieuq (%cki x) (%cki y))) ;euclidean-quotient
(define-inline (fxeucquo x y) %residual-fxeucquo (%ieuq x y)) ;euclidean-quotient
(define-inline (fxeucrem x y) %residual-fxeucrem (%ieur (%cki x) (%cki y))) ;euclidean-remainder
(define-inline (fxeucrem x y) %residual-fxeucrem (%ieur x y)) ;euclidean-remainder
(define-inline (fxneg x) %residual-fxneg (%ineg (%cki x)))
(define-inline (fxneg x) %residual-fxneg (%ineg x))
(define-inline (fxabs x) %residual-fxabs (%iabs (%cki x)))
(define-inline (fxabs x) %residual-fxabs (%iabs x))
(define-inline (fx<? x y) %residual-fx<? (%ilt (%cki x) (%cki y)))
(define-inline (fx<? x y) %residual-fx<? (%ilt x y))
(define-inline (fx<=? x y) %residual-fx<=? (%ile (%cki x) (%cki y)))
(define-inline (fx<=? x y) %residual-fx<=? (%ile x y))
(define-inline (fx>? x y) %residual-fx>? (%igt (%cki x) (%cki y)))
(define-inline (fx>? x y) %residual-fx>? (%igt x y))
(define-inline (fx>=? x y) %residual-fx>=? (%ige (%cki x) (%cki y)))
(define-inline (fx>=? x y) %residual-fx>=? (%ige x y))
(define-inline (fx=? x y) %residual-fx=? (%ieq (%cki x) (%cki y)))
(define-inline (fx=? x y) %residual-fx=? (%ieq x y))
(define-inline (fxmin x y) %residual-fxmin (%imin (%cki x) (%cki y)))
(define-inline (fxmin x y) %residual-fxmin (%imin x y))
(define-inline (fxmax x y) %residual-fxmax (%imax (%cki x) (%cki y)))
(define-inline (fxmax x y) %residual-fxmax (%imax x y))
(define-inline (fixnum->flonum x) %residual-fixnum->flonum (%itoj (%cki x)))
(define-inline (fixnum->flonum x) %residual-fixnum->flonum (%itoj x))
;---------------------------------------------------------------------------------------------
@ -85,51 +85,51 @@
(define-inline (flonum? x) %residual-flonum? (%flop x))
(define-inline (flzero? x) %residual-flzero? (%jzerop (%ckj x)))
(define-inline (flzero? x) %residual-flzero? (%jzerop x))
(define-inline (flpositive? x) %residual-flpositive? (%jposp (%ckj x)))
(define-inline (flpositive? x) %residual-flpositive? (%jposp x))
(define-inline (flnegative? x) %residual-flnegative? (%jnegp (%ckj x)))
(define-inline (flnegative? x) %residual-flnegative? (%jnegp x))
(define-inline (flinteger? x) %residual-flinteger? (%jintp (%ckj x)))
(define-inline (flinteger? x) %residual-flinteger? (%jintp x))
(define-inline (flnan? x) %residual-flnan? (%jnanp (%ckj x)))
(define-inline (flnan? x) %residual-flnan? (%jnanp x))
(define-inline (flinfinite? x) %residual-flinfinite? (%jinfp (%ckj x)))
(define-inline (flinfinite? x) %residual-flinfinite? (%jinfp x))
(define-inline (flfinite? x) %residual-flfinite? (%jfinp (%ckj x)))
(define-inline (flfinite? x) %residual-flfinite? (%jfinp x))
(define-inline (fleven? x) %residual-fleven? (%jevnp (%ckj x)))
(define-inline (fleven? x) %residual-fleven? (%jevnp x))
(define-inline (flodd? x) %residual-flodd? (%joddp (%ckj x)))
(define-inline (flodd? x) %residual-flodd? (%joddp x))
(define-inline (fl+ x y) %residual-fl+ (%jadd (%ckj x) (%ckj y)))
(define-inline (fl+ x y) %residual-fl+ (%jadd x y))
(define-inline (fl- x y) %residual-fl- (%jsub (%ckj x) (%ckj y)))
(define-inline (fl- x y) %residual-fl- (%jsub x y))
(define-inline (fl* x y) %residual-fl* (%jmul (%ckj x) (%ckj y)))
(define-inline (fl* x y) %residual-fl* (%jmul x y))
(define-inline (fl/ x y) %residual-fl/ (%jdiv (%ckj x) (%ckj y)))
(define-inline (fl/ x y) %residual-fl/ (%jdiv x y))
(define-inline (flneg x) %residual-flneg (%jneg (%ckj x)))
(define-inline (flneg x) %residual-flneg (%jneg x))
(define-inline (flabs x) %residual-flabs (%jabs (%ckj x)))
(define-inline (flabs x) %residual-flabs (%jabs x))
(define-inline (fl<? x y) %residual-fl<? (%jlt (%ckj x) (%ckj y)))
(define-inline (fl<? x y) %residual-fl<? (%jlt x y))
(define-inline (fl<=? x y) %residual-fl<=? (%jle (%ckj x) (%ckj y)))
(define-inline (fl<=? x y) %residual-fl<=? (%jle x y))
(define-inline (fl>? x y) %residual-fl>? (%jgt (%ckj x) (%ckj y)))
(define-inline (fl>? x y) %residual-fl>? (%jgt x y))
(define-inline (fl>=? x y) %residual-fl>=? (%jge (%ckj x) (%ckj y)))
(define-inline (fl>=? x y) %residual-fl>=? (%jge x y))
(define-inline (fl=? x y) %residual-fl=? (%jeq (%ckj x) (%ckj y)))
(define-inline (fl=? x y) %residual-fl=? (%jeq x y))
(define-inline (flmin x y) %residual-flmin (%jmin (%ckj x) (%ckj y)))
(define-inline (flmin x y) %residual-flmin (%jmin x y))
(define-inline (flmax x y) %residual-flmax (%jmax (%ckj x) (%ckj y)))
(define-inline (flmax x y) %residual-flmax (%jmax x y))
(define-inline (flonum->fixnum x) %residual-flonum->fixnum (%jtoi (%ckj x)))
(define-inline (flonum->fixnum x) %residual-flonum->fixnum (%jtoi x))
;---------------------------------------------------------------------------------------------
@ -152,26 +152,26 @@
(define-inline (inexact? x) %residual-inexact? (%flop (%ckn x)))
(define-inline (finite? x) %residual-finite? (%finp (%ckn x)))
(define-inline (finite? x) %residual-finite? (%finp x))
(define-inline (infinite? x) %residual-infinite? (%infp (%ckn x)))
(define-inline (infinite? x) %residual-infinite? (%infp x))
(define-inline (nan? x) %residual-nan? (%nanp (%ckn x)))
(define-inline (nan? x) %residual-nan? (%nanp x))
(define-inline (zero? x) %residual-zero? (%zerop (%ckn x)))
(define-inline (zero? x) %residual-zero? (%zerop x))
(define-inline (positive? x) %residual-positive? (%posp (%ckn x)))
(define-inline (positive? x) %residual-positive? (%posp x))
(define-inline (negative? x) %residual-negative? (%negp (%ckn x)))
(define-inline (negative? x) %residual-negative? (%negp x))
(define-inline (even? x) %residual-even? (%evnp (%ckn x)))
(define-inline (even? x) %residual-even? (%evnp x))
(define-inline (odd? x) %residual-odd? (%oddp (%ckn x)))
(define-inline (odd? x) %residual-odd? (%oddp x))
(define-syntax min
(syntax-rules ()
[(_ x) x]
[(_ x y) (%min (%ckn x) (%ckn y))]
[(_ x y) (%min x y)]
[(_ x y z ...) (min (min x y) z ...)]
[(_ . args) (%residual-min . args)]
[_ %residual-min]))
@ -179,7 +179,7 @@
(define-syntax max
(syntax-rules ()
[(_ x) x]
[(_ x y) (%max (%ckn x) (%ckn y))]
[(_ x y) (%max x y)]
[(_ x y z ...) (max (max x y) z ...)]
[(_ . args) (%residual-max . args)]
[_ %residual-max]))
@ -188,7 +188,7 @@
(syntax-rules ()
[(_) 0]
[(_ x) (%ckn x)]
[(_ x y) (%add (%ckn x) (%ckn y))]
[(_ x y) (%add x y)]
[(_ x y z ...) (+ (+ x y) z ...)]
[_ %residual+]))
@ -196,71 +196,71 @@
(syntax-rules ()
[(_) 1]
[(_ x) (%ckn x)]
[(_ x y) (%mul (%ckn x) (%ckn y))]
[(_ x y) (%mul x y)]
[(_ x y z ...) (* (* x y) z ...)]
[_ %residual*]))
(define-syntax -
(syntax-rules ()
[(_ x) (%neg (%ckn x))]
[(_ x y) (%sub (%ckn x) (%ckn y))]
[(_ x) (%neg x)]
[(_ x y) (%sub x y)]
[(_ x y z ...) (- (- x y) z ...)]
[(_ . args) (%residual- . args)]
[_ %residual-]))
(define-syntax /
(syntax-rules ()
[(_ x) (%div 1 (%ckn x))]
[(_ x y) (%div (%ckn x) (%ckn y))]
[(_ x) (%div 1 x)]
[(_ x y) (%div x y)]
[(_ x y z ...) (/ (/ x y) z ...)]
[(_ . args) (%residual/ . args)]
[_ %residual/]))
(define-syntax =
(syntax-rules ()
[(_ x y) (%eq (%ckn x) (%ckn y))]
[(_ x y) (%eq x y)]
[(_ x y z ...) (let ([t y]) (and (= x t) (= t z ...)))]
[(_ . args) (%residual= . args)]
[_ %residual=]))
(define-syntax <
(syntax-rules ()
[(_ x y) (%lt (%ckn x) (%ckn y))]
[(_ x y) (%lt x y)]
[(_ x y z ...) (let ([t y]) (and (< x t) (< t z ...)))]
[(_ . args) (%residual< . args)]
[_ %residual<]))
(define-syntax >
(syntax-rules ()
[(_ x y) (%gt (%ckn x) (%ckn y))]
[(_ x y) (%gt x y)]
[(_ x y z ...) (let ([t y]) (and (> x t) (> t z ...)))]
[(_ . args) (%residual> . args)]
[_ %residual>]))
(define-syntax <=
(syntax-rules ()
[(_ x y) (%le (%ckn x) (%ckn y))]
[(_ x y) (%le x y)]
[(_ x y z ...) (let ([t y]) (and (<= x t) (<= t z ...)))]
[(_ . args) (%residual<= . args)]
[_ %residual<=]))
(define-syntax >=
(syntax-rules ()
[(_ x y) (%ge (%ckn x) (%ckn y))]
[(_ x y) (%ge x y)]
[(_ x y z ...) (let ([t y]) (and (>= x t) (>= t z ...)))]
[(_ . args) (%residual>= . args)]
[_ %residual>=]))
(define-inline (abs x) %residual-abs (%abs (%ckn x)))
(define-inline (abs x) %residual-abs (%abs x))
(define-inline (quotient x y) %residual-quotient (%quo (%ckn x)))
(define-inline (remainder x y) %residual-remainder (%rem (%ckn x)))
(define-inline (quotient x y) %residual-quotient (%quo x y))
(define-inline (remainder x y) %residual-remainder (%rem x y))
(define-syntax truncate-quotient quotient)
(define-syntax truncate-remainder remainder)
(define-inline (modquo x y) %residual-modquo (%mqu (%ckn x)))
(define-inline (modulo x y) %residual-modulo (%mlo (%ckn x)))
(define-inline (modquo x y) %residual-modquo (%mqu x y))
(define-inline (modulo x y) %residual-modulo (%mlo x y))
(define-syntax floor-quotient modquo)
(define-syntax floor-remainder modulo)
@ -284,30 +284,30 @@
(define-inline (char? x) %residual-char? (%charp x))
(define-inline (char-cmp x y) %residual-char-cmp (%ccmp (%ckc x) (%ckc y)))
(define-inline (char=? x y) %residual-char=? (%ceq (%ckc x) (%ckc y)))
(define-inline (char<? x y) %residual-char<? (%clt (%ckc x) (%ckc y)))
(define-inline (char<=? x y) %residual-char<=? (%cle (%ckc x) (%ckc y)))
(define-inline (char>? x y) %residual-char>? (%cgt (%ckc x) (%ckc y)))
(define-inline (char>=? x y) %residual-char>=? (%cge (%ckc x) (%ckc y)))
(define-inline (char-cmp x y) %residual-char-cmp (%ccmp x y))
(define-inline (char=? x y) %residual-char=? (%ceq x y))
(define-inline (char<? x y) %residual-char<? (%clt x y))
(define-inline (char<=? x y) %residual-char<=? (%cle x y))
(define-inline (char>? x y) %residual-char>? (%cgt x y))
(define-inline (char>=? x y) %residual-char>=? (%cge x y))
(define-inline (char-ci-cmp x y) %residual-char-cmp (%cicmp (%ckc x) (%ckc y)))
(define-inline (char-ci=? x y) %residual-char-ci=? (%cieq (%ckc x) (%ckc y)))
(define-inline (char-ci<? x y) %residual-char-ci<? (%cilt (%ckc x) (%ckc y)))
(define-inline (char-ci<=? x y) %residual-char-ci<=? (%cile (%ckc x) (%ckc y)))
(define-inline (char-ci>? x y) %residual-char-ci>? (%cigt (%ckc x) (%ckc y)))
(define-inline (char-ci>=? x y) %residual-char-ci>=? (%cige (%ckc x) (%ckc y)))
(define-inline (char-ci-cmp x y) %residual-char-cmp (%cicmp x y))
(define-inline (char-ci=? x y) %residual-char-ci=? (%cieq x y))
(define-inline (char-ci<? x y) %residual-char-ci<? (%cilt x y))
(define-inline (char-ci<=? x y) %residual-char-ci<=? (%cile x y))
(define-inline (char-ci>? x y) %residual-char-ci>? (%cigt x y))
(define-inline (char-ci>=? x y) %residual-char-ci>=? (%cige x y))
(define-inline (char-alphabetic? x) %residual-char-alphabetic? (%calp (%ckc x)))
(define-inline (char-numeric? x) %residual-char-numeric? (%cnup (%ckc x)))
(define-inline (char-whitespace? x) %residual-char-whitespace? (%cwsp (%ckc x)))
(define-inline (char-upper-case? x) %residual-char-upper-case? (%cucp (%ckc x)))
(define-inline (char-lower-case? x) %residual-char-lower-case? (%clcp (%ckc x)))
(define-inline (char-upcase x) %residual-char-upcase (%cupc (%ckc x)))
(define-inline (char-downcase x) %residual-char-downcase (%cdnc (%ckc x)))
(define-inline (char-alphabetic? x) %residual-char-alphabetic? (%calp x))
(define-inline (char-numeric? x) %residual-char-numeric? (%cnup x))
(define-inline (char-whitespace? x) %residual-char-whitespace? (%cwsp x))
(define-inline (char-upper-case? x) %residual-char-upper-case? (%cucp x))
(define-inline (char-lower-case? x) %residual-char-lower-case? (%clcp x))
(define-inline (char-upcase x) %residual-char-upcase (%cupc x))
(define-inline (char-downcase x) %residual-char-downcase (%cdnc x))
(define-inline (char->integer x) %residual-char->integer (%ctoi (%ckc x)))
(define-inline (integer->char x) %residual-integer->char (%itoc (%cki x)))
(define-inline (char->integer x) %residual-char->integer (%ctoi x))
(define-inline (integer->char x) %residual-integer->char (%itoc x))
;char-foldcase
;digit-value
@ -319,9 +319,9 @@
(define-inline (symbol? x) %residual-symbol? (%symp x))
(define-inline (symbol->string x) %residual-symbol->string (%ytos (%cky x)))
(define-inline (symbol->string x) %residual-symbol->string (%ytos x))
(define-inline (string->symbol x) %residual-string->symbol (%stoy (%cks x)))
(define-inline (string->symbol x) %residual-string->symbol (%stoy x))
;---------------------------------------------------------------------------------------------
@ -332,13 +332,13 @@
(define-inline (pair? x) %residual-pair? (%pairp x))
(define-inline (car x) %residual-car (%car (%ckp x)))
(define-inline (car x) %residual-car (%car x))
(define-inline (set-car! x v) %residual-set-car! (%setcar (%ckp x) v))
(define-inline (set-car! x v) %residual-set-car! (%setcar x v))
(define-inline (cdr x) %residual-cdr (%cdr (%ckp x)))
(define-inline (cdr x) %residual-cdr (%cdr x))
(define-inline (set-cdr! x v) %residual-set-cdr! (%setcdr (%ckp x) v))
(define-inline (set-cdr! x v) %residual-set-cdr! (%setcdr x v))
(define-syntax c?r
(syntax-rules (a d)
@ -402,56 +402,56 @@
[(_ x ...) (%list x ...)]
[_ %residual-list]))
(define-inline (length x) %residual-length (%llen (%ckl x))) ; optimize via combo instruction "%lg"?
(define-inline (length x) %residual-length (%llen x))
(define-inline (list-ref x i) %residual-list-ref (%lget (%ckl x) (%cki i))) ; check for range, optimize combo?
(define-inline (list-ref x i) %residual-list-ref (%lget x i))
(define-inline (list-set! x i v) %residual-list-set! (%lput (%ckl x) (%cki i) v)) ; check for range, optimize combo?
(define-inline (list-set! x i v) %residual-list-set! (%lput x i v))
(define-syntax append
(syntax-rules ()
[(_) '()] [(_ x) x]
[(_ x y) (%lcat (%ckl x) y)]
[(_ x y z ...) (%lcat (%ckl x) (append y z ...))]
[(_ x y) (%lcat x y)]
[(_ x y z ...) (%lcat x (append y z ...))]
[_ %residual-append]))
(define-inline (memq v y) %residual-memq (%memq v (%ckl y))) ; optimize combo?
(define-inline (memq v y) %residual-memq (%memq v y))
(define-inline (memv v y) %residual-memv (%memv v (%ckl y))) ; optimize combo?
(define-inline (memv v y) %residual-memv (%memv v (%ckl y))) ; TODO: make sure memv checks list
(define (%member x l eq)
(and (pair? l) (if (eq x (%car l)) l (%member x (%cdr l) eq))))
(define-syntax member
(syntax-rules ()
[(_ v y) (%meme v (%ckl y))]
[(_ v y) (%meme v (%ckl y))] ; TODO: make sure meme checks list
[(_ v y eq) (%member v y eq)]
[(_ . args) (%residual-member . args)]
[_ %residual-member]))
(define-inline (assq v y) %residual-assq (%assq v (%ckl y))) ; check for a-list; optimize combo?
(define-inline (assq v y) %residual-assq (%assq v y))
(define-inline (assv v y) %residual-assv (%assv v (%ckl y))) ; check for a-list; optimize combo?
(define-inline (assv v y) %residual-assv (%assv v (%ckl y))) ; TODO: make sure assv checks list
(define (%assoc v al eq)
(and (pair? al) (if (eq v (car (%car al))) (%car al) (%assoc v (%cdr al) eq))))
(define-syntax assoc
(syntax-rules ()
[(_ v al) (%asse v (%ckl al))]
[(_ v al) (%asse v (%ckl al))] ; TODO: make sure asse checks list
[(_ v al eq) (%assoc v al eq)]
[(_ . args) (%residual-assoc . args)]
[_ %residual-assoc]))
(define-inline (list-copy x) %residual-list-copy (%lcat (%ckl x) '()))
(define-inline (list-copy x) %residual-list-copy (%lcat x '()))
(define-inline (list-tail x i) %residual-list-tail (%ltail (%ckl x) (%cki i))) ; check for range, optimize combo?
(define-inline (list-tail x i) %residual-list-tail (%ltail x i))
(define-inline (last-pair x) %residual-last-pair (%lpair (%ckp x)))
(define-inline (last-pair x) %residual-last-pair (%lpair x))
(define-inline (reverse x) %residual-reverse (%lrev (%ckl x))) ; optimize combo?
(define-inline (reverse x) %residual-reverse (%lrev x))
(define-inline (reverse! x) %residual-reverse! (%lrevi (%ckl x))) ; optimize combo?
(define-inline (reverse! x) %residual-reverse! (%lrevi x))
(define-syntax list*
(syntax-rules ()
@ -474,27 +474,27 @@
(define-syntax make-vector
(syntax-rules ()
[(_ n) (%vmk (%ckk n) #f)]
[(_ n v) (%vmk (%ckk n) v)]
[(_ n) (%vmk n #f)]
[(_ n v) (%vmk n v)]
[(_ . args) (%residual-make-vector . args)]
[_ %residual-make-vector]))
(define-inline (vector-length x) %residual-vector-length (%vlen (%ckv x))) ; optimize combo?
(define-inline (vector-length x) %residual-vector-length (%vlen x))
(define-inline (vector-ref x i) %residual-vector-ref (%vget (%ckv x) (%cki i))) ; check for range, optimize combo?
(define-inline (vector-ref x i) %residual-vector-ref (%vget x i))
(define-inline (vector-set! x i v) %residual-vector-set! (%vput (%ckv x) (%cki i) v)) ; check for range, optimize combo?
(define-inline (vector-set! x i v) %residual-vector-set! (%vput x i v))
(define-syntax vector-append
(syntax-rules ()
[(_) '#()] [(_ x) (%ckv x)]
[(_ x y) (%vcat (%ckv x) (%ckv y))]
[(_ x y) (%vcat x y)]
[(_ x y z ...) (vector-append x (vector-append y z ...))]
[_ %residual-vector-append]))
(define-inline (vector->list x) %residual-vector->list (%vtol (%ckv x)))
(define-inline (vector->list x) %residual-vector->list (%vtol x))
(define-inline (list->vector x) %residual-list->vector (%ltov (%ckl x)))
(define-inline (list->vector x) %residual-list->vector (%ltov x))
;vector->list/1/2/3
;vector-copy/1/2/3=subvector
@ -512,47 +512,47 @@
(define-syntax string
(syntax-rules ()
[(_ c ...) (%str (%ckc c) ...)]
[(_ c ...) (%str c ...)]
[_ %residual-string]))
(define-syntax make-string
(syntax-rules ()
[(_ x) (%smk (%ckk x) #\space)]
[(_ x y) (%smk (%ckk x) (%ckc y))]
[(_ x) (%smk x #\space)]
[(_ x y) (%smk x y)]
[(_ . args) (%residual-make-string . args)]
[_ %residual-make-string]))
(define-inline (string-length x) %residual-string-length (%slen (%cks x))) ; optimize combo?
(define-inline (string-length x) %residual-string-length (%slen x))
(define-inline (string-ref x i) %residual-string-ref (%sget (%cks x) (%cki i))) ; check for range, optimize combo?
(define-inline (string-ref x i) %residual-string-ref (%sget x i))
(define-inline (string-set! x i v) %residual-string-set! (%sput (%cks x) (%cki i) (%ckc v))) ; check for range, optimize combo?
(define-inline (string-set! x i v) %residual-string-set! (%sput x i v))
(define-syntax string-append
(syntax-rules ()
[(_) ""] [(_ x) (%cks x)]
[(_ x y) (%scat (%cks x) (%cks y))]
[(_ x y) (%scat x y)]
[(_ x y z ...) (string-append x (string-append y z ...))]
[_ %residual-string-append]))
(define-inline (substring x s e) %residual-substring (%ssub (%cks x) (%cki s) (%cki e))) ; check for range
(define-inline (substring x s e) %residual-substring (%ssub x s e))
(define-inline (string-cmp x y) %residual-string-cmp (%scmp (%cks x) (%cks y)))
(define-inline (string=? x y) %residual-string<? (%seq (%cks x) (%cks y)))
(define-inline (string<? x y) %residual-string<? (%slt (%cks x) (%cks y)))
(define-inline (string<=? x y) %residual-string<=? (%sle (%cks x) (%cks y)))
(define-inline (string>? x y) %residual-string>? (%sgt (%cks x) (%cks y)))
(define-inline (string>=? x y) %residual-string>=? (%sge (%cks x) (%cks y)))
(define-inline (string-ci-cmp x y) %residual-string-cmp (%sicmp (%cks x) (%cks y)))
(define-inline (string-ci=? x y) %residual-string<? (%sieq (%cks x) (%cks y)))
(define-inline (string-ci<? x y) %residual-string<? (%silt (%cks x) (%cks y)))
(define-inline (string-ci<=? x y) %residual-string<=? (%sile (%cks x) (%cks y)))
(define-inline (string-ci>? x y) %residual-string>? (%sigt (%cks x) (%cks y)))
(define-inline (string-ci>=? x y) %residual-string>=? (%sige (%cks x) (%cks y)))
(define-inline (string-cmp x y) %residual-string-cmp (%scmp x y))
(define-inline (string=? x y) %residual-string<? (%seq x y))
(define-inline (string<? x y) %residual-string<? (%slt x y))
(define-inline (string<=? x y) %residual-string<=? (%sle x y))
(define-inline (string>? x y) %residual-string>? (%sgt x y))
(define-inline (string>=? x y) %residual-string>=? (%sge x y))
(define-inline (string-ci-cmp x y) %residual-string-cmp (%sicmp x y))
(define-inline (string-ci=? x y) %residual-string<? (%sieq x y))
(define-inline (string-ci<? x y) %residual-string<? (%silt x y))
(define-inline (string-ci<=? x y) %residual-string<=? (%sile x y))
(define-inline (string-ci>? x y) %residual-string>? (%sigt x y))
(define-inline (string-ci>=? x y) %residual-string>=? (%sige x y))
(define-inline (string->list x) %residual-string->list (%stol (%cks x)))
(define-inline (string->list x) %residual-string->list (%stol x))
(define-inline (list->string x) %residual-list->string (%ltos (%ckl x))) ; list-of-chars test
(define-inline (list->string x) %residual-list->string (%ltos x))
;string-upcase
;string-downcase
@ -567,25 +567,25 @@
; Conversions
;---------------------------------------------------------------------------------------------
(define-inline (fixnum->string x r) %residual-fixnum->string (%itos (%cki x) (%cki r)))
(define-inline (fixnum->string x r) %residual-fixnum->string (%itos x r))
(define-inline (string->fixnum x r) %residual-string->fixnum (%stoi (%cks x) (%cki r)))
(define-inline (string->fixnum x r) %residual-string->fixnum (%stoi x r))
(define-inline (flonum->string x) %residual-flonum->string (%jtos (%ckj x)))
(define-inline (flonum->string x) %residual-flonum->string (%jtos x))
(define-inline (string->flonum x) %residual-string->flonum (%stoj (%cks x)))
(define-inline (string->flonum x) %residual-string->flonum (%stoj x))
(define-syntax number->string
(syntax-rules ()
[(_ x r) (%ntos (%cki x) (%cki r))]
[(_ x) (%ntos (%cki x) 10)]
[(_ x r) (%ntos x r)]
[(_ x) (%ntos x 10)]
[(_ . args) (%residual-number->string . args)]
[_ %residual-number->string]))
(define-syntax string->number
(syntax-rules ()
[(_ x r) (%ston (%cks x) (%cki r))]
[(_ x) (%ston (%cks x) 10)]
[(_ x r) (%ston x r)]
[(_ x) (%ston x 10)]
[(_ . args) (%residual-string->number . args)]
[_ %residual-string->number]))
@ -598,12 +598,12 @@
(define-syntax apply
(syntax-rules ()
[(_ p l) (%appl p (%ckl l))] ; -- check for proc?
[(_ p l) (%appl p l)]
[(_ p a b ... l) (%appl p (list* a b ... l))]
[(_ . args) (%residual-apply . args)]
[_ %residual-apply]))
(define-syntax call/cc %ccc) ; (%ccc (%ckr1 k)) -- check for 1-arg proc?
(define-syntax call/cc %ccc)
(define-syntax call-with-current-continuation call/cc)
@ -672,17 +672,17 @@
(define-inline (open-output-string) %residual-open-output-string (%oos))
(define-inline (open-input-file x) %residual-open-input-file (%otip (%cks x)))
(define-inline (open-input-file x) %residual-open-input-file (%otip x))
(define-inline (open-output-file x) %residual-open-output-file (%otop (%cks x)))
(define-inline (open-output-file x) %residual-open-output-file (%otop x))
(define-inline (open-input-string x) %residual-open-input-string (%ois (%cks x)))
(define-inline (open-input-string x) %residual-open-input-string (%ois x))
(define-inline (close-input-port x) %residual-close-input-port (%cip (%ckr x)))
(define-inline (close-input-port x) %residual-close-input-port (%cip x))
(define-inline (close-output-port x) %residual-close-output-port (%cop (%ckw x)))
(define-inline (close-output-port x) %residual-close-output-port (%cop x))
(define-inline (get-output-string x) %residual-get-output-string (%gos (%ckw x)))
(define-inline (get-output-string x) %residual-get-output-string (%gos x))
;call-with-port
;call-with-input-file
@ -726,50 +726,50 @@
(define-syntax write-char
(syntax-rules ()
[(_ x) (%wrc (%ckc x) (%sop))]
[(_ x p) (%wrc (%ckc x) (%ckw p))]
[(_ x) (%wrc x (%sop))]
[(_ x p) (%wrc x p)]
[(_ . args) (%residual-write-char . args)]
[_ %residual-write-char]))
(define-syntax write-string
(syntax-rules ()
[(_ x) (%wrs (%cks x) (%sop))]
[(_ x p) (%wrs (%cks x) (%ckw p))]
[(_ x) (%wrs x (%sop))]
[(_ x p) (%wrs x p)]
[(_ . args) (%residual-write-string . args)]
[_ %residual-write-string]))
(define-syntax display
(syntax-rules ()
[(_ x) (%wrcd x (%sop))]
[(_ x p) (%wrcd x (%ckw p))]
[(_ x p) (%wrcd x p)]
[(_ . args) (%residual-display . args)]
[_ %residual-display]))
(define-syntax write
(syntax-rules ()
[(_ x) (%wrcw x (%sop))]
[(_ x p) (%wrcw x (%ckw p))]
[(_ x p) (%wrcw x p)]
[(_ . args) (%residual-write . args)]
[_ %residual-write]))
(define-syntax newline
(syntax-rules ()
[(_) (%wrnl (%sop))]
[(_ p) (%wrnl (%ckw p))]
[(_ p) (%wrnl p)]
[(_ . args) (%residual-newline . args)]
[_ %residual-newline]))
(define-syntax write-shared
(syntax-rules ()
[(_ x) (%wrhw x (%sop))]
[(_ x p) (%wrhw x (%ckw p))]
[(_ x p) (%wrhw x p)]
[(_ . args) (%residual-write-shared . args)]
[_ %residual-write-shared]))
(define-syntax write-simple
(syntax-rules ()
[(_ x) (%wriw x (%sop))]
[(_ x p) (%wriw x (%ckw p))]
[(_ x p) (%wriw x p)]
[(_ . args) (%residual-write-simple . args)]
[_ %residual-write-simple]))

247
t.c
View file

@ -3,24 +3,23 @@
char *t_code[] = {
0,
"&0{%2.1u?{f]2}.1%pa,.1q?{t]2}.1%pd,.1,@(y11:set-member?)[22}@!(y11:set"
"-member?)",
"&0{%2.1u?{f]2}.1a,.1q?{t]2}.1d,.1,@(y11:set-member?)[22}@!(y11:set-mem"
"ber?)",
0,
"&0{%2${.3,.3,@(y11:set-member?)[02}?{.1]2}.1,.1c]2}@!(y8:set-cons)",
0,
"&0{%2.0u?{.1]2}${.3,.3%pa,@(y8:set-cons)[02},.1%pd,@(y9:set-union)[22}"
"@!(y9:set-union)",
"&0{%2.0u?{.1]2}${.3,.3a,@(y8:set-cons)[02},.1d,@(y9:set-union)[22}@!(y"
"9:set-union)",
0,
"&0{%2.0u?{n]2}${.3,.3%pa,@(y11:set-member?)[02}?{.1,.1%pd,@(y9:set-min"
"us)[22}${.3,.3%pd,@(y9:set-minus)[02},.1%pac]2}@!(y9:set-minus)",
"&0{%2.0u?{n]2}${.3,.3a,@(y11:set-member?)[02}?{.1,.1d,@(y9:set-minus)["
"22}${.3,.3d,@(y9:set-minus)[02},.1ac]2}@!(y9:set-minus)",
0,
"&0{%2.0u?{n]2}${.3,.3%pa,@(y11:set-member?)[02}?{${.3,.3%pd,@(y13:set-"
"intersect)[02},.1%pac]2}.1,.1%pd,@(y13:set-intersect)[22}@!(y13:set-in"
"tersect)",
"&0{%2.0u?{n]2}${.3,.3a,@(y11:set-member?)[02}?{${.3,.3d,@(y13:set-inte"
"rsect)[02},.1ac]2}.1,.1d,@(y13:set-intersect)[22}@!(y13:set-intersect)",
"record-case",
"l6:y12:syntax-rules;l1:y4:else;;l2:l4:y11:record-case;py2:pa;y2:ir;;y6"
@ -34,49 +33,47 @@ char *t_code[] = {
";",
0,
"&0{%2'(y1:*),.1q,.0?{.0]3}.1,.3e,.0?{.0]4}.2p?{'(y1:$),.3%paq?{.2%pdp?"
"{.2%pd%pdu}{f}}{f}?{.2%pd%pa,.4q]4}.2%pdp?{'(y3:...),.3%pd%paq?{.2%pd%"
"pdu}{f}}{f}?{.2%pa,,#0.0,.2,&2{%1.0u,.0?{.0]2}.1p?{${.3%pa,:0,@(y13:sy"
"ntax-match?)[02}?{.1%pd,:1^[21}f]2}f]2}.!0.5,.1^[61}.3p?{${.5%pa,.5%pa"
",@(y13:syntax-match?)[02}?{.3%pd,.3%pd,@(y13:syntax-match?)[42}f]4}f]4"
"}f]4}@!(y13:syntax-match?)",
"&0{%2'(y1:*),.1q,.0?{.0]3}.1,.3e,.0?{.0]4}.2p?{'(y1:$),.3aq?{.2dp?{.2d"
"du}{f}}{f}?{.2da,.4q]4}.2dp?{'(y3:...),.3daq?{.2ddu}{f}}{f}?{.2a,,#0.0"
",.2,&2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y13:syntax-match?)[02}?{.1d,:1^["
"21}f]2}f]2}.!0.5,.1^[61}.3p?{${.5a,.5a,@(y13:syntax-match?)[02}?{.3d,."
"3d,@(y13:syntax-match?)[42}f]4}f]4}f]4}@!(y13:syntax-match?)",
0,
"'0,#0.0,&1{%!0'1%i,:0^%iI+:!0.0u?{'(i10)%i,:0^%iX6%s,'(s1:#)%sS6%sX5]1"
"}.0%paY0?{'(i10)%i,:0^%iX6%s,'(s1:#)%sS6%s,.1%pa%yX4%sS6%sX5]1}'0:!0]1"
"}_1@!(y6:gensym)",
"'0,#0.0,&1{%!0'1,:0^I+:!0.0u?{'(i10),:0^X6,'(s1:#)S6X5]1}.0aY0?{'(i10)"
",:0^X6,'(s1:#)S6,.1aX4S6X5]1}'0:!0]1}_1@!(y6:gensym)",
0,
"&0{%2'0,.2,,#0.0,.4,&2{%2.0u?{f]2}.0%pa,:0q?{.1]2}'1%i,.2%iI+,.1%pd,:1"
"^[22}.!0.0^_1[22}@!(y4:posq)",
"&0{%2'0,.2,,#0.0,.4,&2{%2.0u?{f]2}.0a,:0q?{.1]2}'1,.2I+,.1d,:1^[22}.!0"
".0^_1[22}@!(y4:posq)",
0,
"&0{%2.0u,.0?{.0}{.2,.2q}_1?{n]2}${.3,.3%pd,@(y9:list-diff)[02},.1%pac]"
"2}@!(y9:list-diff)",
"&0{%2.0u,.0?{.0}{.2,.2q}_1?{n]2}${.3,.3d,@(y9:list-diff)[02},.1ac]2}@!"
"(y9:list-diff)",
0,
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3%pd,.4%pa,:0^[02},.1c]2}.!0.0^_1["
"22}@!(y5:pair*)",
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@"
"!(y5:pair*)",
0,
"&0{%1.0p?{.0%pdu]1}f]1}@!(y6:list1?)",
"&0{%1.0p?{.0du]1}f]1}@!(y6:list1?)",
0,
"&0{%1.0p?{.0%pd,@(y6:list1?)[11}f]1}@!(y6:list2?)",
"&0{%1.0p?{.0d,@(y6:list1?)[11}f]1}@!(y6:list2?)",
0,
"&0{%1.0p?{.0%pd,@(y6:list2?)[11}f]1}@!(y6:list3?)",
"&0{%1.0p?{.0d,@(y6:list2?)[11}f]1}@!(y6:list3?)",
0,
"&0{%1.0p?{.0%pd,@(y6:list3?)[11}f]1}@!(y6:list4?)",
"&0{%1.0p?{.0d,@(y6:list3?)[11}f]1}@!(y6:list4?)",
0,
"&0{%1.0L0?{.0]1}n,.1,,#0.0,&1{%2.0p?{.1,.1%pac,.1%pd,:0^[22}.0u?{.1%lA"
"9]2}.1%lA9,.1c]2}.!0.0^_1[12}@!(y15:flatten-idslist)",
"&0{%1.0L0?{.0]1}n,.1,,#0.0,&1{%2.0p?{.1,.1ac,.1d,:0^[22}.0u?{.1A9]2}.1"
"A9,.1c]2}.!0.0^_1[12}@!(y15:flatten-idslist)",
0,
"&0{%1.0p?{${.2%pd,@(y17:idslist-req-count)[01}%i,'1%iI+]1}'0]1}@!(y17:"
"idslist-req-count)",
"&0{%1.0p?{${.2d,@(y17:idslist-req-count)[01},'1I+]1}'0]1}@!(y17:idslis"
"t-req-count)",
0,
"@(y15:%25residual-pair?)@!(y9:val-core?)",
@ -94,7 +91,7 @@ char *t_code[] = {
"@(y13:%25residual-cdr)@!(y11:binding-val)",
0,
"&0{%1.0%pd,@(y12:val-special?)[11}@!(y16:binding-special?)",
"&0{%1.0d,@(y12:val-special?)[11}@!(y16:binding-special?)",
0,
"@(y13:%25residual-car)@!(y11:binding-sym)",
@ -109,7 +106,7 @@ char *t_code[] = {
"&0{%1,#0n,.2c.!0.0,&1{%0:0^]0}]2}@!(y6:new-id)",
0,
"&0{%1${.2[00}%pa]1}@!(y7:old-den)",
"&0{%1${.2[00}a]1}@!(y7:old-den)",
0,
"&0{%1.0Y0,.0?{.0]2}.1K0]2}@!(y3:id?)",
@ -138,22 +135,21 @@ char *t_code[] = {
0,
"&0{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.0K0?{.1~}{f}?{.3"
",${.6,.6,.5[02},.3,@(y5:xform)[43}.0]4}.1p~?{.2,.2,@(y11:xform-quote)["
"32}.1%pa,.2%pd,${.6,.4,t,@(y5:xform)[03},.0,'(l1:y6:syntax;)%l,.1A1?{."
"2%pa]7}'(l1:y5:quote;)%l,.1A1?{.6,.3%pa,@(y11:xform-quote)[72}'(l1:y4:"
"set!;)%l,.1A1?{.6,.3%pd%pa,.4%pa,@(y10:xform-set!)[73}'(l1:y5:begin;)%"
"l,.1A1?{.6,.3,@(y11:xform-begin)[72}'(l1:y2:if;)%l,.1A1?{.6,.3,@(y8:xf"
"orm-if)[72}'(l1:y6:lambda;)%l,.1A1?{.6,.3,@(y12:xform-lambda)[72}'(l1:"
"y4:body;)%l,.1A1?{.6,.3,@(y10:xform-body)[72}'(l1:y6:define;)%l,.1A1?{"
".6,.3%pd%pa,.4%pa,@(y12:xform-define)[73}'(l1:y13:define-syntax;)%l,.1"
"A1?{.6,.3%pd%pa,.4%pa,@(y19:xform-define-syntax)[73}t?{.1K0?{.6,${.9,."
"9,.6[02},.6,@(y5:xform)[73}.6,.3,.3,@(y10:xform-call)[73}f]7}@!(y5:xfo"
"rm)",
"32}.1a,.2d,${.6,.4,t,@(y5:xform)[03},.0,'(l1:y6:syntax;)%l,.1A1?{.2a]7"
"}'(l1:y5:quote;)%l,.1A1?{.6,.3a,@(y11:xform-quote)[72}'(l1:y4:set!;)%l"
",.1A1?{.6,.3da,.4a,@(y10:xform-set!)[73}'(l1:y5:begin;)%l,.1A1?{.6,.3,"
"@(y11:xform-begin)[72}'(l1:y2:if;)%l,.1A1?{.6,.3,@(y8:xform-if)[72}'(l"
"1:y6:lambda;)%l,.1A1?{.6,.3,@(y12:xform-lambda)[72}'(l1:y4:body;)%l,.1"
"A1?{.6,.3,@(y10:xform-body)[72}'(l1:y6:define;)%l,.1A1?{.6,.3da,.4a,@("
"y12:xform-define)[73}'(l1:y13:define-syntax;)%l,.1A1?{.6,.3da,.4a,@(y1"
"9:xform-define-syntax)[73}t?{.1K0?{.6,${.9,.9,.6[02},.6,@(y5:xform)[73"
"}.6,.3,.3,@(y10:xform-call)[73}f]7}@!(y5:xform)",
0,
"&0{%2${.2,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2"
"%pd,:0^[01},${.3%pa,:0^[01}c]1}.0V0?{:0^,${.3%vX0,,#0.4,.1,&2{%1.0p?{$"
"{.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1%lX1]1}.0]1}.!0.0^_1[01"
"},'(y5:quote),l2]2}@!(y11:xform-quote)",
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{:0^,${.3X0,,#0.4,.1,&2{%1.0p?{${.2d,:"
"0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1X1]1}.0]1}.!0.0^_1[01},'(y5:q"
"uote),l2]2}@!(y11:xform-quote)",
0,
"&0{%2${.2,.4[01},.0Y0?{.0,'(y3:ref),l2]3}.0,@(y11:binding-val)[31}@!(y"
@ -162,62 +158,58 @@ char *t_code[] = {
0,
"&0{%3${.4,.4,f,@(y5:xform)[03},${.3,.6[01},.0Y0?{.1,.1,'(y4:set!),l3]5"
"}${.2,@(y16:binding-special?)[01}?{${.3,.3,@(y16:binding-set-val!)[02}"
"'(l1:y5:begin;)]5}${.2,@(y11:binding-val)[01},'(y3:ref),.1%paq?{.2,.1%"
"pd%pa,'(y4:set!),l3]6}'(s27:set! to non-identifier form),'(y9:transfor"
"m),@(y5:error)[62}@!(y10:xform-set!)",
"'(l1:y5:begin;)]5}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.2,.1da,"
"'(y4:set!),l3]6}'(s27:set! to non-identifier form),'(y9:transform),@(y"
"5:error)[62}@!(y10:xform-set!)",
0,
"&0{%2.0L0?{.1,&1{%1:0,.1,f,@(y5:xform)[13},${.3,,#0.4,.1,&2{%1.0p?{${."
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0p?{.0%pdu}{f}?{.0%pa]3"
"}.0,'(y5:begin)c]3}'(s19:improper begin form),'(y9:transform),@(y5:err"
"or)[22}@!(y11:xform-begin)",
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0p?{.0du}{f}?{.0a]3}.0,"
"'(y5:begin)c]3}'(s19:improper begin form),'(y9:transform),@(y5:error)["
"22}@!(y11:xform-begin)",
0,
"&0{%2.0L0?{.1,&1{%1:0,.1,f,@(y5:xform)[13},${.3,,#0.4,.1,&2{%1.0p?{${."
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0%lg,'(l1:i2;)%l,.1A1?{"
"'(l1:l1:y5:begin;;),.2%lL6,'(y2:if)c]4}'(l1:i3;)%l,.1A1?{.1,'(y2:if)c]"
"4}t?{'(s17:malformed if form),'(y9:transform),@(y5:error)[42}f]4}'(s16"
":improper if form),'(y9:transform),@(y5:error)[22}@!(y8:xform-if)",
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0g,'(l1:i2;)%l,.1A1?{'("
"l1:l1:y5:begin;;),.2L6,'(y2:if)c]4}'(l1:i3;)%l,.1A1?{.1,'(y2:if)c]4}t?"
"{'(s17:malformed if form),'(y9:transform),@(y5:error)[42}f]4}'(s16:imp"
"roper if form),'(y9:transform),@(y5:error)[22}@!(y8:xform-if)",
0,
"&0{%3.1L0?{.2,&1{%1:0,.1,f,@(y5:xform)[13},${.4,,#0.4,.1,&2{%1.0p?{${."
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0u?{'(y6:lambda),.2%paq"
"?{.1%pd%pau}{f}}{f}?{.1%pd%pd%pa]4}.0,.2,'(y4:call),@(y5:pair*)[43}'(s"
"20:improper application),'(y9:transform),@(y5:error)[32}@!(y10:xform-c"
"all)",
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0u?{'(y6:lambda),.2aq?{"
".1dau}{f}}{f}?{.1dda]4}.0,.2,'(y4:call),@(y5:pair*)[43}'(s20:improper "
"application),'(y9:transform),@(y5:error)[32}@!(y10:xform-call)",
0,
"&0{%2.0L0?{n,.2,.2%pa,,#0.4,.1,&2{%3.0p?{.0%pa,${${.4,@(y7:id->sym)[01"
"},@(y6:gensym)[01},.4,.1c,${.6,.4,.6,@(y7:add-var)[03},.4%pd,:0^[53}.0"
"u?{${.3,:1%pd,@(y10:xform-body)[02},.3%lA8,'(y6:lambda),l3]3}.0,${${.4"
",@(y7:id->sym)[01},@(y6:gensym)[01},${.5,.3,.5,@(y7:add-var)[03},${.2,"
":1%pd,@(y10:xform-body)[02},.2,.7%lA8%lL6,'(y6:lambda),l3]6}.!0.0^_1[2"
"3}'(s20:improper lambda body),'(y9:transform),@(y5:error)[22}@!(y12:xf"
"orm-lambda)",
"&0{%2.0L0?{n,.2,.2a,,#0.4,.1,&2{%3.0p?{.0a,${${.4,@(y7:id->sym)[01},@("
"y6:gensym)[01},.4,.1c,${.6,.4,.6,@(y7:add-var)[03},.4d,:0^[53}.0u?{${."
"3,:1d,@(y10:xform-body)[02},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->"
"sym)[01},@(y6:gensym)[01},${.5,.3,.5,@(y7:add-var)[03},${.2,:1d,@(y10:"
"xform-body)[02},.2,.7A8L6,'(y6:lambda),l3]6}.!0.0^_1[23}'(s20:improper"
" lambda body),'(y9:transform),@(y5:error)[22}@!(y12:xform-lambda)",
0,
"&0{%2.0u?{n,'(y5:begin)c]2}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4%pap}{f}?{.4%"
"pd,.5%pa,.0%pa,${.5,.3,t,@(y5:xform)[03},.0,'(l1:y5:begin;)%l,.1A1?{.4"
",.4%pd%lL6,.9,.9,.9,.9,:0^[(i10)5}'(l1:y6:define;)%l,.1A1?{.3%pd%pa,.4"
"%pd%pd%pa,${${.5,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i10),.3,.6,@(y"
"7:add-var)[03},.8,.(i13),.3c,.(i13),.5c,.(i13),.7c,.4,:0^[(i14)5}'(l1:"
"y13:define-syntax;)%l,.1A1?{.3%pd%pa,.4%pd%pd%pa,${.9,'(l1:y9:undefine"
"d;),.5,@(y11:add-binding)[03},.7,.(i12),tc,.(i12),.4c,.(i12),.6c,.4,:0"
"^[(i13)5}t?{.1K0?{.4,${.8,.7,.6[02}c,.9,.9,.9,.9,:0^[(i10)5}.5,.(i10),"
".(i10)%lA8,.(i10)%lA8,.(i10)%lA8,@(y12:xform-labels)[(i10)5}f](i10)}.0"
",.5,.5%lA8,.5%lA8,.5%lA8,@(y12:xform-labels)[55}.!0.0^_1[25}@!(y10:xfo"
"rm-body)",
"&0{%2.0u?{n,'(y5:begin)c]2}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,."
"5a,.0a,${.5,.3,t,@(y5:xform)[03},.0,'(l1:y5:begin;)%l,.1A1?{.4,.4dL6,."
"9,.9,.9,.9,:0^[(i10)5}'(l1:y6:define;)%l,.1A1?{.3da,.4dda,${${.5,@(y7:"
"id->sym)[01},@(y6:gensym)[01},${.(i10),.3,.6,@(y7:add-var)[03},.8,.(i1"
"3),.3c,.(i13),.5c,.(i13),.7c,.4,:0^[(i14)5}'(l1:y13:define-syntax;)%l,"
".1A1?{.3da,.4dda,${.9,'(l1:y9:undefined;),.5,@(y11:add-binding)[03},.7"
",.(i12),tc,.(i12),.4c,.(i12),.6c,.4,:0^[(i13)5}t?{.1K0?{.4,${.8,.7,.6["
"02}c,.9,.9,.9,.9,:0^[(i10)5}.5,.(i10),.(i10)A8,.(i10)A8,.(i10)A8,@(y12"
":xform-labels)[(i10)5}f](i10)}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)"
"[55}.!0.0^_1[25}@!(y10:xform-body)",
0,
"&0{%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{:1,&1{%1:0,.1,f,@(y5:x"
"form)[13},${:0,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!"
"0.0^_1[01}_1,.4%lA8%lL6,.0p?{.0%pdu}{f}?{.0%pa}{.0,'(y5:begin)c},.6u?{"
".0]7}&0{%1'(l1:y5:begin;)]1},${.9,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${."
"3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.1,.8%lA8,'(y6:lambda),l3,'(y4:call),@"
"(y5:pair*)[73}.2%paY0?{.4,.3%pac,.4,${:1,.6%pa,.6%pa,@(y10:xform-set!)"
"[03}c,.4%pd,.4%pd,.4%pd,:2^[55}${${:1,.6%pa,t,@(y5:xform)[03},${.5%pa,"
":1[01},@(y16:binding-set-val!)[02}.4,.4,.4%pd,.4%pd,.4%pd,:2^[55}.!0.0"
"^_1[55}@!(y12:xform-labels)",
"0.0^_1[01}_1,.4A8L6,.0p?{.0du}{f}?{.0a}{.0,'(y5:begin)c},.6u?{.0]7}&0{"
"%1'(l1:y5:begin;)]1},${.9,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01"
"}c]1}n]1}.!0.0^_1[01}_1,.1,.8A8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)"
"[73}.2aY0?{.4,.3ac,.4,${:1,.6a,.6a,@(y10:xform-set!)[03}c,.4d,.4d,.4d,"
":2^[55}${${:1,.6a,t,@(y5:xform)[03},${.5a,:1[01},@(y16:binding-set-val"
"!)[02}.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55}@!(y12:xform-labels)",
0,
"&0{%3${.2,@(y3:id?)[01}?{${.4,.4,f,@(y5:xform)[03},${.3,@(y7:id->sym)["
@ -246,10 +238,10 @@ char *t_code[] = {
0,
"&0{%1${@(y14:*transformers*),.3,@(y16:find-top-binding)[02},${.2,@(y8:"
"binding?)[01}?{${.2,@(y11:binding-val)[01},.0p?{'(y12:syntax-rules),.1"
"%paq}{f}?{${${.4,t,@(y9:transform)[02},.4,@(y16:binding-set-val!)[02}}"
"_1.0]2}.1Y0?{${.3,'(y3:ref),l2,.4,@(y12:make-binding)[02},@(y14:*trans"
"formers*),.1c@!(y14:*transformers*).0]3}.1,@(y7:old-den)[21}@!(y19:top"
"-transformer-env)",
"aq}{f}?{${${.4,t,@(y9:transform)[02},.4,@(y16:binding-set-val!)[02}}_1"
".0]2}.1Y0?{${.3,'(y3:ref),l2,.4,@(y12:make-binding)[02},@(y14:*transfo"
"rmers*),.1c@!(y14:*transformers*).0]3}.1,@(y7:old-den)[21}@!(y19:top-t"
"ransformer-env)",
0,
"&0{%2.1,${.3,@(y19:top-transformer-env)[01},@(y16:binding-set-val!)[22"
@ -260,51 +252,48 @@ char *t_code[] = {
",@(y20:install-transformer!)[42}@!(y26:install-transformer-rules!)",
0,
"&0{%!2${f,@(y6:gensym)[01}.0u?{@(y19:top-transformer-env)}{.0%pa},.3,."
"3,@(y5:xform)[33}@!(y9:transform)",
"&0{%!2${f,@(y6:gensym)[01}.0u?{@(y19:top-transformer-env)}{.0a},.3,.3,"
"@(y5:xform)[33}@!(y9:transform)",
0,
"&0{%4,,,,,,,#0#1#2#3#4#5#6.9,&1{%1:0%l,.1A0]1}.!0.0,&1{%1${.2,:0^[01}~"
"]1}.!1.3,&1{%1.0p?{.0%pa,:0^[11}f]1}.!2.7,.9,&2{%1:0?{:0,.1q]1}${.2,@("
"y3:id?)[01}?{@(y30:denotation-of-default-ellipsis),${.3,:1[01}q]1}f]1}"
".!3.2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01"
"}}{f}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2%vX0,:1^[33}.0p?{${.2%pd,:2^[01}?{$"
"{.4,.4,.4%pd%pd,:1^[03},t,.2%pa,:1^[33}${.4,.4,.4%pd,:1^[03},.2,.2%pa,"
":1^[33}.2]3}.!0.0^_1[33}.!4.4,.2,.4,.3,.(i11),&5{%3.1,.1,.4,:0,:1,:2,:"
"3,:4,&8{%1,#0.1,&1{%0f,:0[01}.!0n,:7,:6,,#0.4,.1,:0,:1,:2,:3,:4,:5,&8{"
"%3,#0:7,.4,&2{%1.0?{:0]1}:1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^[01}?{$"
"{.4,@(y3:id?)[01}?{${.3,:1[01},${.5,:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1"
"V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3%vX0,.3%vX0,:6^[43}.1p~?{.2,.2e,.1^["
"41}${.3%pd,:3^[01}?{.1%pd%pd%lg,.3L0?{.3%lg}{${:7^[00}},.1%i,.1%iI-,.0"
"%n<0?{${:7^[00}}.0%i,.6%lA6,.3%i,.7%lA8%lA6%lA8,${:4^,t,.(i10)%pa,:5^["
"03},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1%pa,:0^[03},,#0.2,.1"
",&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),."
"6,.(i12)%pd%pd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${."
"3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list)c%l,@(y13:%"
"25residual-map),@(y5:%25appl)[02}%lL6](i11)}.2p?{${.5,.5%pd,.5%pd,:6^["
"03},.3%pa,.3%pa,:6^[43}:7^[40}.!0.0^_1[23},@(y4:%25ccc)[31}.!5.7,.2,.6"
"&0{%4,,,,,,,#0#1#2#3#4#5#6.9,&1{%1:0,.1A0]1}.!0.0,&1{%1${.2,:0^[01}~]1"
"}.!1.3,&1{%1.0p?{.0a,:0^[11}f]1}.!2.7,.9,&2{%1:0?{:0,.1q]1}${.2,@(y3:i"
"d?)[01}?{@(y30:denotation-of-default-ellipsis),${.3,:1[01}q]1}f]1}.!3."
"2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}{f"
"}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4,."
"4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0.0^"
"_1[33}.!4.4,.2,.4,.3,.(i11),&5{%3.1,.1,.4,:0,:1,:2,:3,:4,&8{%1,#0.1,&1"
"{%0f,:0[01}.!0n,:7,:6,,#0.4,.1,:0,:1,:2,:3,:4,:5,&8{%3,#0:7,.4,&2{%1.0"
"?{:0]1}:1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?"
"{${.3,:1[01},${.5,:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{$"
"{:7^[00}}_1.3,.3X0,.3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1dd"
"g,.3L0?{.3g}{${:7^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${"
":4^,t,.(i10)a,:5^[03},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1a,"
":0^[03},,#0.2,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1["
"21}.!0${.(i12),.6,.(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d"
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list"
")c,@(y13:%25residual-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,"
":6^[03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[23},@(y4:%25ccc)[31}.!5.7,.2,.6"
",.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-id)[01},.1c]1},${${.("
"i10),&1{%1:0%l,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&2{%1.0p?{${.2d,:0^["
"01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2"
"{%1:1,&1{%1:0^%l,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.3,.9,.2,.8,:0,&5{%2."
"0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3%l,.1A3,.0?{.0}{:"
"1%l,.2A3,.0?{.0}{:0^%l,.3A3}_1}_1%pd]1}.0V0?{${.2%vX0,:2^[01}%lX1]1}.0"
"p?{${.2%pd,:6^[01}?{${.2%pa,:5^[01},,,#0#1:3,&1{%1:0%l,.1A3%pd]1}.!0.2"
",.4,:4,&3{%!0${.2,:2,@(y14:%25residual-cons),@(y13:%25residual-map)[03"
"},:1%pa,:0^[12}.!1.0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[0"
"1}c]1}n]1}.!0.0^_1[01}_1,${.6%pd%pd,:2^[01},${.3,.6^c%l,@(y13:%25resid"
"ual-map),@(y5:%25appl)[02}%lL6]5}${.2%pd,:2^[01},${.3%pa,:2^[01}c]1}.0"
"]1}.!0.0^_1[21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&"
"5{%1.0u?{${:3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0"
"%pa,.0%pa,.1%pd%pa,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4%pd,:0^"
"[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rules*)",
"i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&2{%1.0p?{${.2d,:0^[01"
"},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%"
"1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#"
"0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3"
",.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}"
"?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y"
"14:%25residual-cons),@(y13:%25residual-map)[03},:1a,:0^[12}.!1.0^,${.5"
",,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,$"
"{.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-map),@(y5:%25appl)[02}L6]5}$"
"{.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6.(i10),."
"7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),'("
"y9:transform),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,."
"0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rules*)",
0,
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"
"ew-id)[01}.!0${.3%pd%pa,@(y3:id?)[01}?{${.3%pd%pd%pd,.4%pd%pd%pa,.5%pd"
"%pa,.7,@(y13:syntax-rules*)[04},.1^,l2]3}${.3%pd%pd,.4%pd%pa,f,.7,@(y1"
"3:syntax-rules*)[04},.1^,l2]3},'(y12:syntax-rules),@(y20:install-trans"
"former!)[02}",
"ew-id)[01}.!0${.3da,@(y3:id?)[01}?{${.3ddd,.4dda,.5da,.7,@(y13:syntax-"
"rules*)[04},.1^,l2]3}${.3dd,.4da,f,.7,@(y13:syntax-rules*)[04},.1^,l2]"
"3},'(y12:syntax-rules),@(y20:install-transformer!)[02}",
0,
"${${@(y19:top-transformer-env),'(y6:define),'(y6:define),@(y11:add-bin"