diff --git a/src/ikarus.boot b/src/ikarus.boot index 2ac2c70..11946b9 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/library-manager.ss b/src/library-manager.ss index d609bf1..3aefec5 100644 --- a/src/library-manager.ss +++ b/src/library-manager.ss @@ -4,7 +4,7 @@ (import (scheme)) (define-record library - (id name ver imp* vis* inv* exp-subst exp-env visit-state invoke-state)) + (id name ver imp* vis* inv* subst env visit-state invoke-state)) (define (find-dependencies ls) (cond @@ -20,12 +20,12 @@ [(pred (car ls)) (car ls)] [else (f (cdr ls))]))) - (define (find-library-by-name name) + (define (lm:find-library-by-name name) (find-library-by (lambda (x) (equal? (library-name x) name)))) (define (find-library-by-name/die name) - (or (find-library-by-name name) + (or (lm:find-library-by-name name) (error #f "cannot find library ~s" name))) (define (lm:install-library id name ver @@ -35,7 +35,7 @@ [inv-lib* (map find-library-by-name/die inv*)]) (unless (and (symbol? id) (list? name) (list? ver)) (error 'install-library "invalid spec ~s ~s ~s" id name ver)) - (when (find-library-by-name name) + (when (lm:find-library-by-name name) (error 'install-library "~s is already installed" name)) (let ([lib (make-library id name ver imp-lib* vis-lib* inv-lib* exp-subst exp-env visit-code invoke-code)]) @@ -485,6 +485,8 @@ [$current-frame $current-frame-label (core-prim . $current-frame)] [$seal-frame-and-call $seal-frame-and-call-label (core-prim . $seal-frame-and-call)] [installed-libraries installed-libraries-label (core-prim . installed-libraries)] + [library-subst/env library-subst/env-label (core-prim . library-subst/env)] + [find-library-by-name find-library-by-name-label (core-prim . find-library-by-name)] )) (let ([subst @@ -500,4 +502,10 @@ (primitive-set! 'installed-libraries (lambda () *all-libraries*)) + (primitive-set! 'library-subst/env + (lambda (x) + (unless (library? x) + (error 'library-subst/env "~s is not a library" x)) + (values (library-subst x) (library-env x)))) + (primitive-set! 'find-library-by-name lm:find-library-by-name) (primitive-set! 'install-library lm:install-library)) diff --git a/src/libsyntax.ss b/src/libsyntax.ss index 24ebc04..bbec610 100644 --- a/src/libsyntax.ss +++ b/src/libsyntax.ss @@ -551,476 +551,35 @@ (stx-error x))]))) (define scheme-stx (lambda (sym) - (cond - [(assq sym scheme-env) => - (lambda (x) - (let ([name (car x)] [label (cadr x)]) - (add-subst - (make-rib (list name) (list top-mark*) (list label)) - (stx sym top-mark* '()))))] - [else (stx sym top-mark* '())]))) - (define scheme-env ; the-env - '([define define-label (define)] - [define-syntax define-syntax-label (define-syntax)] - [module module-label (module)] - [begin begin-label (begin)] - [set! set!-label (set!)] - [define-record define-record-label (macro . define-record)] - [include include-label (macro . include)] - [syntax-rules syntax-rules-macro (macro . syntax-rules)] - [quasiquote quasiquote-macro (macro . quasiquote)] - [with-syntax with-syntax-label (macro . with-syntax)] - [let let-label (macro . let)] - [let* let*-label (macro . let*)] - [cond cond-label (macro . cond)] - [and and-label (macro . and)] - [or or-label (macro . or)] - [case case-label (core-macro . case)] - [foreign-call foreign-call-label (core-macro . foreign-call)] - [quote quote-label (core-macro . quote)] - [syntax-case syntax-case-label (core-macro . syntax-case)] - [syntax syntax-label (core-macro . syntax)] - [lambda lambda-label (core-macro . lambda)] - [case-lambda case-lambda-label (core-macro . case-lambda)] - [let-values let-values-label (core-macro . let-values)] - [type-descriptor type-descriptor-label (core-macro . type-descriptor)] - [letrec letrec-label (core-macro . letrec)] - [if if-label (core-macro . if)] - [when when-label (core-macro . when)] - [unless unless-label (core-macro . unless)] - [parameterize parameterize-label (core-macro . parameterize)] - ;;; prims - [void void-label (core-prim . void)] - [not not-label (core-prim . not)] - [boolean? boolean-label (core-prim . boolean?)] - [null? null?-label (core-prim . null?)] - [procedure? procedure?-label (core-prim . procedure?)] - [eof-object? eof-object?-label (core-prim . eof-object?)] - [eof-object eof-object-label (core-prim . eof-object)] - ;;; comparison - [eq? eq?-label (core-prim . eq?)] - [eqv? eqv?-label (core-prim . eqv?)] - [equal? equal?-label (core-prim . equal?)] - ;;; pairs/lists - [cons cons-label (core-prim . cons)] - [pair? pair?-label (core-prim . pair?)] - [car car-label (core-prim . car)] - [cdr cdr-label (core-prim . cdr)] - [set-car! set-car!-label (core-prim . set-car!)] - [set-cdr! set-cdr!-label (core-prim . set-cdr!)] - [caar caar-label (core-prim . caar)] - [cdar cdar-label (core-prim . cdar)] - [cadr cadr-label (core-prim . cadr)] - [cddr cddr-label (core-prim . cddr)] - [caaar caaar-label (core-prim . caaar)] - [cdaar cdaar-label (core-prim . cdaar)] - [cadar cadar-label (core-prim . cadar)] - [cddar cddar-label (core-prim . cddar)] - [caadr caadr-label (core-prim . caadr)] - [cdadr cdadr-label (core-prim . cdadr)] - [caddr caddr-label (core-prim . caddr)] - [cdddr cdddr-label (core-prim . cdddr)] - [caaaar caaaar-label (core-prim . caaaar)] - [cdaaar cdaaar-label (core-prim . cdaaar)] - [cadaar cadaar-label (core-prim . cadaar)] - [cddaar cddaar-label (core-prim . cddaar)] - [caadar caadar-label (core-prim . caadar)] - [cdadar cdadar-label (core-prim . cdadar)] - [caddar caddar-label (core-prim . caddar)] - [cdddar cdddar-label (core-prim . cdddar)] - [caaadr caaadr-label (core-prim . caaadr)] - [cdaadr cdaadr-label (core-prim . cdaadr)] - [cadadr cadadr-label (core-prim . cadadr)] - [cddadr cddadr-label (core-prim . cddadr)] - [caaddr caaddr-label (core-prim . caaddr)] - [cdaddr cdaddr-label (core-prim . cdaddr)] - [cadddr cadddr-label (core-prim . cadddr)] - [cddddr cddddr-label (core-prim . cddddr)] - [list list-label (core-prim . list)] - [list-ref list-ref-label (core-prim . list-ref)] - [make-list make-list-label (core-prim . make-list)] - [list* list*-label (core-prim . list*)] - [list? list?-label (core-prim . list?)] - [append append-label (core-prim . append)] - [last-pair last-pair-label (core-prim . last-pair)] - [reverse reverse-label (core-prim . reverse)] - [length length-label (core-prim . length)] - [assq assq-label (core-prim . assq)] - [assv assv-label (core-prim . assv)] - [assoc assoc-label (core-prim . assoc)] - [memq memq-label (core-prim . memq)] - [memv memv-label (core-prim . memv)] - [member member-label (core-prim . member)] - [$car $car-label (core-prim . $car)] - [$cdr $cdr-label (core-prim . $cdr)] - [$set-car! $set-car!-label (core-prim . $set-car!)] - [$set-cdr! $set-cdr!-label (core-prim . $set-cdr!)] - [$memq $memq-label (core-prim . $memq)] - [$memv $memv-label (core-prim . $memv)] - ;;; weak conses - [bwp-object? bwp-object?-label (core-prim . bwp-object?)] - [weak-cons weak-cons-label (core-prim . weak-cons)] - [weak-pair? weak-pair?-label (core-prim . weak-pair?)] - ;;; chars - [char? char?-label (core-prim . char?)] - [char=? char=?-label (core-prim . char=?)] - [char? char>?-label (core-prim . char>?)] - [char<=? char<=?-label (core-prim . char<=?)] - [char>=? char>=?-label (core-prim . char>=?)] - [integer->char integer->char-label (core-prim . integer->char)] - [char->integer char->integer-label (core-prim . char->integer)] - [char-whitespace? char-whitespace?-label (core-prim . char-whitespace?)] - [$char? $char?-label (core-prim . $char?)] - [$char= $char=-label (core-prim . $char=)] - [$char< $char<-label (core-prim . $char<)] - [$char> $char>-label (core-prim . $char>)] - [$char<= $char<=-label (core-prim . $char<=)] - [$char>= $char>=-label (core-prim . $char>=)] - [$char->fixnum $char->fixnum-label (core-prim . $char->fixnum)] - [$fixnum->char $fixnum->char-label (core-prim . $fixnum->char)] - ;;; strings - [string? string?-label (core-prim . string?)] - [string string-label (core-prim . string)] - [make-string make-string-label (core-prim . make-string)] - [string-ref string-ref-label (core-prim . string-ref)] - [string-set! string-set!-label (core-prim . string-set!)] - [string-length string-length-label (core-prim . string-length)] - [string=? string=?-label (core-prim . string=?)] - [substring substring-label (core-prim . substring)] - [string-append string-append-label (core-prim . string-append)] - [string->list string->list-label (core-prim . string->list)] - [list->string list->string-label (core-prim . list->string)] - [uuid uuid-label (core-prim . uuid)] - [date-string date-string-label (core-prim . date-string)] - [$make-string $make-string-label (core-prim . $make-string)] - [$string-ref $string-ref-label (core-prim . $string-ref)] - [$string-set! $string-set!-label (core-prim . $string-set!)] - [$string-length $string-length-label (core-prim . $string-length)] - ;;; vectors - [vector vector-label (core-prim . vector)] - [make-vector make-vector-label (core-prim . make-vector)] - [vector-ref vector-ref-label (core-prim . vector-ref)] - [vector-set! vector-set!-label (core-prim . vector-set!)] - [vector? vector?-label (core-prim . vector?)] - [vector-length vector-length-label (core-prim . vector-length)] - [list->vector list->vector-label (core-prim . list->vector)] - [vector->list vector->list-label (core-prim . vector->list)] - [$make-vector $make-vector-label (core-prim . $make-vector)] - [$vector-length $vector-length-label (core-prim . $vector-length)] - [$vector-ref $vector-ref-label (core-prim . $vector-ref)] - [$vector-set! $vector-set!-label (core-prim . $vector-set!)] - ;;; iterators - [for-each for-each-label (core-prim . for-each)] - [map map-label (core-prim . map)] - [andmap andmap-label (core-prim . andmap)] - [ormap ormap-label (core-prim . ormap)] - ;;; fixnums - [fixnum? fixnum-label (core-prim . fixnum?)] - [fx< fx<-label (core-prim . fx<)] - [fx<= fx<=-label (core-prim . fx<=)] - [fx> fx>-label (core-prim . fx>)] - [fx>= fx>=-label (core-prim . fx>=)] - [fx= fx=-label (core-prim . fx=)] - [fx- fx--label (core-prim . fx-)] - [fx+ fx+-label (core-prim . fx+)] - [fx* fx*-label (core-prim . fx*)] - [fxzero? fxzero?-label (core-prim . fxzero?)] - [fxadd1 fxadd1-label (core-prim . fxadd1)] - [fxsub1 fxsub1-label (core-prim . fxsub1)] - [fxquotient fxquotient-label (core-prim . fxquotient)] - [fxremainder fxremainder-label (core-prim . fxremainder)] - [fxmodulo fxmodulo-label (core-prim . fxmodulo)] - [fxsll fxsll-label (core-prim . fxsll)] - [fxsra fxsra-label (core-prim . fxsra)] - [fxlogand fxlogand-label (core-prim . fxlogand)] - [fxlogxor fxlogxor-label (core-prim . fxlogxor)] - [fxlogor fxlogor-label (core-prim . fxlogor)] - [fxlognot fxlognot-label (core-prim . fxlognot)] - [fixnum->string fixnum->string-label (core-prim . fixnum->string)] - [$fxzero? $fxzero?-label (core-prim . $fxzero?)] - [$fxadd1 $fxadd1-label (core-prim . $fxadd1)] - [$fxsub1 $fxsub1-label (core-prim . $fxsub1)] - [$fx>= $fx>=-label (core-prim . $fx>=)] - [$fx<= $fx<=-label (core-prim . $fx<=)] - [$fx> $fx>-label (core-prim . $fx>)] - [$fx< $fx<-label (core-prim . $fx<)] - [$fx= $fx=-label (core-prim . $fx=)] - [$fxsll $fxsll-label (core-prim . $fxsll)] - [$fxsra $fxsra-label (core-prim . $fxsra)] - [$fxquotient $fxquotient-label (core-prim . $fxquotient)] - [$fxmodulo $fxmodulo-label (core-prim . $fxmodulo)] - [$fxlogxor $fxlogxor-label (core-prim . $fxlogxor)] - [$fxlogor $fxlogor-label (core-prim . $fxlogor)] - [$fxlognot $fxlognot-label (core-prim . $fxlognot)] - [$fxlogand $fxlogand-label (core-prim . $fxlogand)] - [$fx+ $fx+-label (core-prim . $fx+)] - [$fx* $fx*-label (core-prim . $fx*)] - [$fx- $fx--label (core-prim . $fx-)] - ;;; flonum - [string->flonum string->flonum-label (core-prim . string->flonum)] - ;;; generic arithmetic - [- minus-label (core-prim . -)] - [= =-label (core-prim . =)] - [< <-label (core-prim . <)] - [> >-label (core-prim . >)] - [<= <=-label (core-prim . <=)] - [>= >=-label (core-prim . >=)] - [* *-label (core-prim . *)] - [+ plus-label (core-prim . +)] - [add1 add1-label (core-prim . add1)] - [sub1 sub1-label (core-prim . sub1)] - [number? number?-label (core-prim . number?)] - [bignum? bignum?-label (core-prim . bignum?)] - [integer? integer?-label (core-prim . integer?)] - [flonum? flonum?-label (core-prim . flonum?)] - [quotient quotient-label (core-prim . quotient)] - [remainder remainder-label (core-prim . remainder)] - [quotient+remainder quotient+remainder-label (core-prim . quotient+remainder)] - [number->string number->string-label (core-prim . number->string)] - [string->number string->number-label (core-prim . string->number)] - ;;; other numerics - [flonum->string flonum->string-label (core-prim . flonum->string)] - [string->flonum string->flonum-label (core-prim . string->flonum)] - ;;; symbols/gensyms - [symbol? symbol?-label (core-prim . symbol?)] - [gensym? gensym?-label (core-prim . gensym?)] - [gensym gensym-label (core-prim . gensym)] - [getprop getprop-label (core-prim . getprop)] - [putprop putprop-label (core-prim . putprop)] - [remprop remprop-label (core-prim . remprop)] - [property-list property-list-label (core-prim . property-list)] - [string->symbol string->symbol-label (core-prim . string->symbol)] - [symbol->string symbol->string-label (core-prim . symbol->string)] - [gensym->unique-string gensym->unique-string-label (core-prim . gensym->unique-string)] - [$make-symbol $make-symbol-label (core-prim . $make-symbol)] - [$symbol-unique-string $symbol-unique-string-label (core-prim . $symbol-unique-string)] - [$symbol-value $symbol-value-label (core-prim . $symbol-value)] - [$symbol-string $symbol-string-label (core-prim . $symbol-string)] - [$symbol-plist $symbol-plist-label (core-prim . $symbol-plist)] - [$set-symbol-value! $set-symbol-value!-label (core-prim . $set-symbol-value!)] - [$set-symbol-string! $set-symbol-string!-label (core-prim . $set-symbol-string!)] - [$set-symbol-unique-string! $set-symbol-unique-string!-label (core-prim . $set-symbol-unique-string!)] - [$set-symbol-plist! $set-symbol-plist!-label (core-prim . $set-symbol-plist!)] - ;;; top-level - [top-level-bound? top-level-bound-label (core-prim . top-level-bound?)] - [top-level-value top-level-value-label (core-prim . top-level-value)] - [set-top-level-value! set-top-level-value!-label (core-prim . set-top-level-value!)] - ;;; guardians - [make-guardian make-guardian-label (core-prim . make-guardian)] - ;;; IO/low-level - [$make-port/input $make-port/input-label (core-prim . $make-port/input)] - [$make-port/output $make-port/output-label (core-prim . $make-port/output)] - [$make-port/both $make-port/both-label (core-prim . $make-port/both)] - [$port-handler $port-handler-label (core-prim . $port-handler)] - [$port-input-buffer $port-input-buffer-label (core-prim . $port-input-buffer)] - [$port-input-index $port-input-index-label (core-prim . $port-input-index)] - [$port-input-size $port-input-size-label (core-prim . $port-input-size)] - [$port-output-buffer $port-output-buffer-label (core-prim . $port-output-buffer)] - [$port-output-index $port-output-index-label (core-prim . $port-output-index)] - [$port-output-size $port-output-size-label (core-prim . $port-output-size)] - [$set-port-input-index! $set-port-input-index!-label (core-prim . $set-port-input-index!)] - [$set-port-input-size! $set-port-input-size!-label (core-prim . $set-port-input-size!)] - [$set-port-output-index! $set-port-output-index!-label (core-prim . $set-port-output-index!)] - [$set-port-output-size! $set-port-output-size!-label (core-prim . $set-port-output-size!)] - [make-input-port make-input-port-label (core-prim . make-input-port)] - [make-output-port make-output-port-label (core-prim . make-output-port)] - [make-input/output-port make-input/output-port-label (core-prim . make-input/output-port)] - [$make-input-port $make-input-port-label (core-prim . $make-input-port)] - [$make-output-port $make-output-port-label (core-prim . $make-output-port)] - [$make-input/output-port $make-input/output-port-label (core-prim . $make-input/output-port)] - [port-output-index port-output-index-label (core-prim . port-output-index)] - [port-output-size port-output-size-label (core-prim . port-output-size)] - [port-output-buffer port-output-buffer-label (core-prim . port-output-buffer)] - [set-port-output-index! set-port-output-index!-label (core-prim . set-port-output-index!)] - [set-port-output-size! set-port-output-size!-label (core-prim . set-port-output-size!)] - [port-input-buffer port-input-buffer-label (core-prim . port-input-buffer)] - [port-input-index port-input-index-label (core-prim . port-input-index)] - [port-input-size port-input-size-label (core-prim . port-input-size)] - [set-port-input-index! set-port-input-index!-label (core-prim . set-port-input-index!)] - [set-port-input-size! set-port-input-size!-label (core-prim . set-port-input-size!)] - [*standard-input-port* *standard-input-port*-label (core-prim . *standard-input-port*)] - [*standard-output-port* *standard-output-port*-label (core-prim . *standard-output-port*)] - [*standard-error-port* *standard-error-port*-label (core-prim . *standard-error-port*)] - [*current-input-port* *current-input-port*-label (core-prim . *current-input-port*)] - [*current-output-port* *current-output-port*-label (core-prim . *current-output-port*)] - ;;; IO/ports - [output-port? output-port?-label (core-prim . output-port?)] - [input-port? input-port?-label (core-prim . input-port?)] - [port? port?-label (core-prim . port?)] - [port-name port-name-label (core-prim . port-name)] - [input-port-name input-port-name-label (core-prim . input-port-name)] - [output-port-name output-port-name-label (core-prim . output-port-name)] - [open-input-file open-input-file-label (core-prim . open-input-file)] - [with-input-from-file with-input-from-file-label (core-prim . with-input-from-file)] - [with-output-to-file with-output-to-file-label (core-prim . with-output-to-file)] - [open-output-file open-output-file-label (core-prim . open-output-file)] - [open-output-string open-output-string-label (core-prim . open-output-string)] - [get-output-string get-output-string-label (core-prim . get-output-string)] - [close-input-port close-input-port-label (core-prim . close-input-port)] - [close-output-port close-output-port-label (core-prim . close-output-port)] - [console-input-port console-input-port-label (core-prim . console-input-port)] - [console-output-port console-output-port-label (core-prim . console-output-port)] - [current-input-port current-input-port-label (core-prim . current-input-port)] - [current-output-port current-output-port-label (core-prim . current-output-port)] - [standard-input-port standard-input-port-label (core-prim . standard-input-port)] - [standard-output-port standard-output-port-label (core-prim . standard-output-port)] - [standard-error-port standard-error-port-label (core-prim . standard-error-port)] - [flush-output-port flush-output-port-label (core-prim . flush-output-port)] - [reset-input-port! reset-input-port!-label (core-prim . reset-input-port!)] - [$flush-output-port $flush-output-port-label (core-prim . $flush-output-port)] - [$reset-input-port! $reset-input-port!-label (core-prim . $reset-input-port!)] - [$close-input-port $close-input-port-label (core-prim . $close-input-port)] - [$close-output-port $close-output-port-label (core-prim . $close-output-port)] - ;;; IO/high-level - [display display-label (core-prim . display)] - [write write-label (core-prim . write)] - [write-char write-char-label (core-prim . write-char)] - [read read-label (core-prim . read)] - [read-char read-char-label (core-prim . read-char)] - [read-token read-token-label (core-prim . read-token)] - [peek-char peek-char-label (core-prim . peek-char)] - [unread-char unread-char-label (core-prim . unread-char)] - [newline newline-label (core-prim . newline)] - [printf printf-label (core-prim . printf)] - [format format-label (core-prim . format)] - [pretty-print pretty-print-label (core-prim . pretty-print)] - [comment-handler comment-handler-label (core-prim . comment-handler)] - [print-gensym print-gensym-label (core-prim . print-gensym)] - [gensym-count gensym-count-label (core-prim . gensym-count)] - [gensym-prefix gensym-prefix-label (core-prim . gensym-prefix)] - [$write-char $write-char-label (core-prim . $write-char)] - [$read-char $read-char-label (core-prim . $read-char)] - [$peek-char $peek-char-label (core-prim . $peek-char)] - [$unread-char $unread-char-label (core-prim . $unread-char)] - ;;; hash tables - [make-hash-table make-hash-table-label (core-prim . make-hash-table)] - [hash-table? hash-table?-label (core-prim . hash-table?)] - [get-hash-table get-hash-table-label (core-prim . get-hash-table)] - [put-hash-table! put-hash-table!-label (core-prim . put-hash-table!)] - ;;; evaluation / control - [make-parameter make-parameter-label (core-prim . make-parameter)] - [apply apply-label (core-prim . apply)] - [values values-label (core-prim . values)] - [call-with-values cwv-label (core-prim . call-with-values)] - [current-eval current-eval-label (core-prim . current-eval)] - [call/cc call/cc-label (core-prim . call/cc)] - [call/cf call/cf-label (core-prim . call/cf)] - [dynamic-wind dynamic-wind-label (core-prim . dynamic-wind)] - [error error-label (core-prim . error)] - [print-error print-error-label (core-prim . print-error)] - [error-handler error-handler-label (core-prim . error-handler)] - [interrupt-handler interrupt-handler-label (core-prim . interrupt-handler)] - [exit exit-label (core-prim . exit)] - [compile compile-label (core-prim . compile)] - [compile-core-expr-to-port compile-core-expr-to-port-label (core-prim . compile-core-expr-to-port)] - [eval eval-label (core-prim . eval)] - [load load-label (core-prim . load)] - [expand-mode expand-mode-label (core-prim . expand-mode)] - [assembler-output assembler-output-label (core-prim . assembler-output)] - [current-expand current-expand-label (core-prim . current-expand)] - [expand expand-label (core-prim . expand)] - [fasl-write fasl-write-label (core-prim . fasl-write)] - [new-cafe new-cafe-label (core-prim . new-cafe)] - [command-line-arguments command-line-arguments-label (core-prim . command-line-arguments)] - [list*->code* list*->code*-label (core-prim . list*->code*)] - ;[primitive-location primitive-location-label (core-prim . primitive-location)] - [install-library install-library-label (core-prim . install-library)] - [installed-libraries installed-libraries-label (core-prim . installed-libraries)] - ;;; record/mid-level - [record? record?-label (core-prim . record?)] - [make-record-type make-record-type-label (core-prim . make-record-type)] - [record-type-descriptor record-type-descriptor-label (core-prim . record-type-descriptor)] - [record-type-field-names record-type-field-names-label (core-prim . record-type-field-names)] - [record-type-symbol record-type-symbol-label (core-prim . record-type-symbol)] - [record-type-name record-type-name-label (core-prim . record-type-name)] - [record-name record-name-label (core-prim . record-name)] - [record-constructor record-constructor-label (core-prim . record-constructor)] - [record-predicate record-predicate-labe (core-prim . record-predicate)] - [record-length record-length-label (core-prim . record-length)] - [record-printer record-printer-label (core-prim . record-printer)] - [record-ref record-ref-label (core-prim . record-ref)] - [record-field-accessor record-field-accessor-label (core-prim . record-field-accessor)] - [record-field-mutator record-field-mutator-label (core-prim . record-field-mutator)] - ;;; records/low-level - [$base-rtd $base-rtd-label (core-prim . $base-rtd)] - [$record-set! $record-set!-label (core-prim . $record-set!)] - [$record-ref $record-ref-label (core-prim . $record-ref)] - [$record-rtd $record-rtd-label (core-prim . $record-rtd)] - [$record $record-label (core-prim . $record)] - [$make-record $make-record-label (core-prim . $make-record)] - [$record? $record?-label (core-prim . $record?)] - [$record/rtd? $record/rtd?-label (core-prim . $record/rtd?)] - ;;; syntax-case - [identifier? identifier?-label (core-prim . identifier?)] - [syntax-error syntax-error-label (core-prim . syntax-error)] - [generate-temporaries generate-temporaries-label (core-prim . generate-temporaries)] - [free-identifier=? free-identifier=?-label (core-prim . free-identifier=?)] - [chi-top-library chi-top-library-label (core-prim . chi-top-library)] - [boot-library-expand boot-library-expand-label (core-prim . boot-library-expand)] - ;;; codes - [$closure-code $closure-code-label (core-prim . $closure-code)] - [$code? $code?-label (core-prim . $code?)] - [$code->closure $code->closure-label (core-prim . $code->closure)] - [$code-reloc-vector $code-reloc-vector-label (core-prim . $code-reloc-vector)] - [$code-freevars $code-freevars-label (core-prim . $code-freevars)] - [$code-size $code-size-label (core-prim . $code-size)] - [$code-ref $code-ref-label (core-prim . $code-ref)] - [$code-set! $code-set!-label (core-prim . $code-set!)] - [code? code?-label (core-prim . code?)] - [make-code make-code-label (core-prim . make-code)] - [code-reloc-vector code-reloc-vector-label (core-prim . code-reloc-vector)] - [set-code-reloc-vector! set-code-reloc-vector!-label (core-prim . set-code-reloc-vector!)] - [code-size code-size-label (core-prim . code-size)] - [code-freevars code-freevars-label (core-prim . code-freevars)] - [code-ref code-ref-label (core-prim . code-ref)] - [code-set! code-set!-label (core-prim . code-set!)] - ;;; tcbuckets - [$make-tcbucket $make-tcbucket-label (core-prim . $make-tcbucket)] - [$tcbucket-key $tcbucket-key-label (core-prim . $tcbucket-key)] - [$tcbucket-val $tcbucket-val-label (core-prim . $tcbucket-val)] - [$tcbucket-next $tcbucket-next-label (core-prim . $tcbucket-next)] - [$set-tcbucket-val! $set-tcbucket-val!-label (core-prim . $set-tcbucket-val!)] - [$set-tcbucket-next! $set-tcbucket-next!-label (core-prim . $set-tcbucket-next!)] - [$set-tcbucket-tconc! $set-tcbucket-tconc!-label (core-prim . $set-tcbucket-tconc!)] - ;;; misc - [immediate? immediate?-label (core-prim . immediate?)] - [pointer-value pointer-value-label (core-prim . pointer-value)] - [$forward-ptr? $forward-ptr?-label (core-prim . $forward-ptr?)] - ;;; junk that should go away - [$unbound-object? $unbound-object?-label (core-prim . $unbound-object?)] - [$make-call-with-values-procedure $make-cwv-procedure (core-prim . $make-call-with-values-procedure)] - [$make-values-procedure $make-values-procedure (core-prim . $make-values-procedure)] - [primitive-set! primitive-set!-label (core-prim . primitive-set!)] - [primitive? primitive?-label (core-prim . primitive?)] - [primitive-ref primitive-ref-label (core-prim . primitive-ref)] - [$$apply $$apply-label (core-prim . $$apply)] - [$arg-list $arg-list-label (core-prim . $arg-list)] - [$interrupted? $interrupted?-label (core-prim . $interrupted?)] - [$unset-interrupted! $unset-interrupted!-label (core-prim . $unset-interrupted!)] - [$fp-at-base $fp-at-base-label (core-prim . $fp-at-base)] - [$primitive-call/cc $primitive-call/cc-label (core-prim . $primitive-call/cc)] - [$frame->continuation $frame->continuation-label (core-prim . $frame->continuation)] - [$current-frame $current-frame-label (core-prim . $current-frame)] - [$seal-frame-and-call $seal-frame-and-call-label (core-prim . $seal-frame-and-call)] - [foo foo-label (core-prim . foo)] - )) + (let-values ([(subst env) + (library-subst/env + (find-library-by-name '(scheme)))]) + (cond + [(assq sym subst) => + (lambda (x) + (let ([name (car x)] [label (cdr x)]) + (add-subst + (make-rib (list name) (list top-mark*) (list label)) + (stx sym top-mark* '()))))] + [else (stx sym top-mark* '())])))) (define make-scheme-rib (lambda () (let ([rib (make-empty-rib)]) - (for-each - (lambda (x) - (let ([name (car x)] [label (cadr x)]) - (extend-rib! rib (stx name top-mark* '()) label))) - scheme-env) + (let-values ([(subst env) + (library-subst/env + (find-library-by-name '(scheme)))]) + (for-each + (lambda (x) + (let ([name (car x)] [label (cdr x)]) + (extend-rib! rib (stx name top-mark* '()) label))) + subst)) rib))) (define make-scheme-env (lambda () - (map - (lambda (x) - (let ([name (car x)] [label (cadr x)] [binding (caddr x)]) - (cons label binding))) - scheme-env))) + (let-values ([(subst env) + (library-subst/env + (find-library-by-name '(scheme)))]) + env))) ;;; macros (define add-lexicals (lambda (lab* lex* r)