From 052e48e9e865e44fb13ef73c2b9bbd6ce5cbdbc7 Mon Sep 17 00:00:00 2001 From: dyb Date: Thu, 5 Apr 2018 21:28:33 -0700 Subject: [PATCH] committing @akeep library change with rebuilt boot files: - fixed an issue with the library system where an exception that occurs during visit or revisit left the library in an inconsistent state that caused it to appear that it was still in the process of running. This manifested in it raising a cyclic dependency exception, even though there really is not a cyclic dependency. The various library management functions involved will now reset the part of the library when an exception occurs. This also means that if the library visit or revisit failed for a transient reason (such as a missing or incorrect library version that can be fixed by updating the library-directories) it is now possible to recover from these errors. expand-lang.ss, syntax.ss, interpret.ss, compile.ss, cprep.ss, 8.ms original commit: 6dbd72496fb4eaf5fb65453d0ae0a75f0ef2ad80 --- LOG | 12 ++ mats/8.ms | 249 +++++++++++++++++++++++++++++++ release_notes/release_notes.stex | 15 +- s/compile.ss | 14 +- s/cprep.ss | 4 +- s/expand-lang.ss | 6 +- s/interpret.ss | 4 +- s/syntax.ss | 70 ++++++--- 8 files changed, 337 insertions(+), 37 deletions(-) diff --git a/LOG b/LOG index e47cf494c3..cf89a8ee73 100644 --- a/LOG +++ b/LOG @@ -905,3 +905,15 @@ field names in define-record-type field specs. syntax.ss, record.ms, root-experr* +- fixed an issue with the library system where an exception that occurs + during visit or revisit left the library in an inconsistent state that + caused it to appear that it was still in the process of running. This + manifested in it raising a cyclic dependency exception, even though + there really is not a cyclic dependency. The various library + management functions involved will now reset the part of the library + when an exception occurs. This also means that if the library visit + or revisit failed for a transient reason (such as a missing or + incorrect library version that can be fixed by updating the + library-directories) it is now possible to recover from these errors. + expand-lang.ss, syntax.ss, interpret.ss, compile.ss, cprep.ss, + 8.ms diff --git a/mats/8.ms b/mats/8.ms index 33e183fdc3..409086babc 100644 --- a/mats/8.ms +++ b/mats/8.ms @@ -8730,6 +8730,255 @@ "revisiting testfile-l6-prog1\n#((10 . 12))\n") ) +(mat library-regression + ; test that failing invoke code does not result in cyclic dependency problem on re-run + (equal? + (separate-eval + '(begin + (library (invoke-fail) + (export x) + (import (chezscheme)) + (define x #f) + (error #f "failed to load library (invoke-fail)")) + (guard (e [else + (guard (e2 [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval 'x (environment '(chezscheme) '(invoke-fail))))]) + (eval 'x (environment '(chezscheme) '(invoke-fail)))))) + "Exception: failed to load library (invoke-fail)\nException: failed to load library (invoke-fail)\n") + + ; test that true cyclic dependency will always report the same thing + (equal? + (separate-eval + '(begin + (library (invoke-cyclic) + (export x y) + (import (chezscheme)) + (define x #f) + (define y (eval '(if x 5 10) (environment '(chezscheme) '(invoke-cyclic))))) + (guard (e [else + (guard (e2 [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval 'x (environment '(chezscheme) '(invoke-cyclic))))]) + (eval 'x (environment '(chezscheme) '(invoke-cyclic)))))) + "Exception: cyclic dependency involving invocation of library (invoke-cyclic)\nException: cyclic dependency involving invocation of library (invoke-cyclic)\n") + + (begin + ; library to help make it easier to cause a failure in the visit-code that + ; does not lead to failure during compilation of the file. + (with-output-to-file "testfile-lr-l1.ss" + (lambda () + (pretty-print + '(library (testfile-lr-l1) + (export make-it-fail) + (import (chezscheme)) + (define make-it-fail (make-parameter #f (lambda (x) (and x #t))))))) + 'replace) + ; simple test to define one macro and potentially to raise an error when + ; defining the second one. + (with-output-to-file "testfile-lr-l2.ss" + (lambda () + (pretty-print + '(library (testfile-lr-l2) + (export M1 M2) + (import (chezscheme) (testfile-lr-l1)) + (define-syntax M1 + (identifier-syntax #f)) + + (define-syntax M2 + (if (make-it-fail) + (error 'M2 "user requested failure with (make-it-fail) parameter") + (lambda (x) + (syntax-case x () + [(_ expr) #'expr]))))))) + 'replace) + ; more complete test that attempts to create the various types of things + ; that can be defined in visit code so that we can verify things are being + ; properly reset. + (with-output-to-file "testfile-lr-l3.ss" + (lambda () + (pretty-print + '(library (testfile-lr-l3) + (export a b c d e f g h) + (import (chezscheme) (testfile-lr-l1)) + + (module a (x) (define x 5)) + (alias b cons) + (define-syntax c (make-compile-time-value 5)) + (define d 5) + (meta define e 5) + (define-syntax f (identifier-syntax #f)) + (define $g (make-parameter #f)) + (define-syntax g + (make-variable-transformer + (lambda (x) + (syntax-case x () + [(set! _ v) #'($g v)] + [_ #'($g)] + [(_ e* ...) #'(($g) e* ...)])))) + (define-property f g 10) + (define-syntax h + (if (make-it-fail) + (error 'h "user requested failure with (make-it-fail) parameter") + (lambda (x) + (syntax-case x () + [(_ expr) #'expr]))))))) + 'replace) + (separate-compile + '(lambda (x) + (parameterize ([compile-imported-libraries #t]) + (for-each compile-library x))) + '(list "testfile-lr-l1" "testfile-lr-l2" "testfile-lr-l3")) + #t) + + (equal? + (separate-eval + '(begin + (import (testfile-lr-l2) (testfile-lr-l1)) + (make-it-fail #t) + (guard (e [else + (guard (e2 + [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval 'M1 (environment '(testfile-lr-l2))))]) + (eval 'M1 (environment '(testfile-lr-l2)))))) + "Exception in M2: user requested failure with (make-it-fail) parameter\nException in M2: user requested failure with (make-it-fail) parameter\n") + + ; module is defined as part of import code, run time bindings are setup as part of invoke code + (equal? + (separate-eval + '(begin + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (import a) + x)) + "5\n") + + ; alias is part of module binding ribcage, set up by import code + (equal? + (separate-eval + '(begin + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (b 'a 'b))) + "(a . b)\n") + + ; compile-time-value is set in visit code, should show same error each time it is referenced + (equal? + (separate-eval + '(begin + (library (lookup) + (export lookup) + (import (chezscheme)) + (define-syntax lookup + (lambda (x) + (syntax-case x () + [(_ id) (lambda (rho) #`'#,(rho #'id))] + [(_ id key) (lambda (rho) #`'#,(rho #'id #'key))])))) + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (guard (e [else + (guard (e2 + [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval '(lookup c) (environment '(testfile-lr-l3) '(lookup))))]) + (eval '(lookup c) (environment '(testfile-lr-l3) '(lookup)))))) + "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n") + + ; defines are set up as part of invoke code + (equal? + (separate-eval + '(begin + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + d)) + "5\n") + + ; meta defines are set up as part of visit code + (equal? + (separate-eval + '(begin + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (guard (e [else + (guard (e2 + [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval '(let () + (define-syntax get-e + (lambda (x) + (syntax-case x () + [(_) #`'#,e]))) + (get-e)) + (environment '(chezscheme) '(testfile-lr-l3))))]) + (eval '(let () + (define-syntax get-e + (lambda (x) + (syntax-case x () + [(_) #`'#,e]))) + (get-e)) + (environment '(chezscheme) '(testfile-lr-l3)))))) + "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n") + + ; macros are set up as part of visit code + (equal? + (separate-eval + '(begin + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (guard (e [else + (guard (e2 + [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval 'f (environment '(testfile-lr-l3))))]) + (eval 'f (environment '(testfile-lr-l3)))))) + "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n") + + ; variable transformer macros are set up as part of visit code + (equal? + (separate-eval + '(begin + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (guard (e [else + (guard (e2 + [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval 'g (environment '(testfile-lr-l3))))]) + (eval 'g (environment '(testfile-lr-l3)))))) + "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n") + + ; properties are setup as part of visit code. + (equal? + (separate-eval + '(begin + (library (lookup) + (export lookup) + (import (chezscheme)) + (define-syntax lookup + (lambda (x) + (syntax-case x () + [(_ id) (lambda (rho) #`'#,(rho #'id))] + [(_ id key) (lambda (rho) #`'#,(rho #'id #'key))])))) + (import (testfile-lr-l3) (testfile-lr-l1)) + (make-it-fail #t) + (guard (e [else + (guard (e2 + [else + (display-condition e) (newline) + (display-condition e2) (newline)]) + (eval '(lookup f g) (environment '(testfile-lr-l3) '(lookup))))]) + (eval '(lookup f g) (environment '(testfile-lr-l3) '(lookup)))))) + "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n") +) + (mat cross-library-optimization (begin (with-output-to-file "testfile-clo-1a.ss" diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 564c013d50..2bc6ef1d4b 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -1566,13 +1566,24 @@ in fasl files does not generally make sense. %----------------------------------------------------------------------------- \section{Bug Fixes}\label{section:bugfixes} -\subsection{Incomplete handling of import specs within standalone export forms} +\subsection{Misleading cyclic dependency error (9.5)} + +The library system no longer reports a cyclic dependency error +during the second and subsequent attempts to visit or invoke a +library after the first attempt fails for some reason other than +an actual cyclic dependency. +The fix also allows a library to be visited or invoked successfully +on the second or subsequent attempt if the visit or invoke failed +for a transient reason, such as a missing or incorrect version in +an imported library. + +\subsection{Incomplete handling of import specs within standalone export forms (9.5)} A bug that limited the \scheme{(import \var{import-spec} \dots)} form within a standalone \scheme{export} form to \scheme{(import \var{import-spec})} has been fixed. -\subsection{Permission denied after deleting files or directories in Windows} +\subsection{Permission denied after deleting files or directories in Windows (9.5)} In Windows, deleting a file or directory briefly leaves the file or directory in a state where a subsequent create operation fails with diff --git a/s/compile.ss b/s/compile.ss index c56e3195a4..32eca11865 100644 --- a/s/compile.ss +++ b/s/compile.ss @@ -461,8 +461,8 @@ (Inner : Inner (ir) -> Inner () [,lsrc lsrc] ; NB: workaround for nanopass tag snafu [(program ,uid ,body) ($build-invoke-program uid body)] - [(library/ct ,uid ,import-code ,visit-code) - ($build-install-library/ct-code uid import-code visit-code)] + [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code) + ($build-install-library/ct-code uid export-id* import-code visit-code)] [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body) ($build-install-library/rt-code uid dl* db* dv* de* body)] [else ir])) @@ -916,7 +916,7 @@ (program-node-ir-set! maybe-program ir) (values)]) (ctLibrary : ctLibrary (ir situation) -> * () - [(library/ct ,uid ,import-code ,visit-code) + [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code) (when (eq? situation 'revisit) ($oops who "encountered revisit-only compile-time library ~s while processing wpo file ~s" (lookup-path uid) ifn)) (record-ct-lib-ir! uid ir) (values)]) @@ -1042,8 +1042,8 @@ (define build-install-library/ct-code (lambda (node) (nanopass-case (Lexpand ctLibrary) (library-node-ctir node) - [(library/ct ,uid ,import-code ,visit-code) - ($build-install-library/ct-code uid + [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code) + ($build-install-library/ct-code uid export-id* (if (library-node-visible? node) import-code void-pr) (if (library-node-visible? node) visit-code void-pr))]))) @@ -1449,8 +1449,8 @@ (Inner : Inner (ir) -> Expr () [,lsrc lsrc] [(program ,uid ,body) ($build-invoke-program uid body)] - [(library/ct ,uid ,import-code ,visit-code) - ($build-install-library/ct-code uid import-code visit-code)] + [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code) + ($build-install-library/ct-code uid export-id* import-code visit-code)] [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body) ($build-install-library/rt-code uid dl* db* dv* de* body)] [else (sorry! who "unexpected Lexpand record ~s" ir)]) diff --git a/s/cprep.ss b/s/cprep.ss index 35cf39e1eb..5d22e50d3c 100644 --- a/s/cprep.ss +++ b/s/cprep.ss @@ -26,8 +26,8 @@ (Inner : Inner (ir) -> * (val) [,lsrc (go lsrc)] [(program ,uid ,body) (go ($build-invoke-program uid body))] - [(library/ct ,uid ,import-code ,visit-code) - (go ($build-install-library/ct-code uid import-code visit-code))] + [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code) + (go ($build-install-library/ct-code uid export-id* import-code visit-code))] [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body) (go ($build-install-library/rt-code uid dl* db* dv* de* body))] [,linfo/ct `(library/ct-info ,(library-info-uid linfo/ct) ,(library/ct-info-import-req* linfo/ct) diff --git a/s/expand-lang.ss b/s/expand-lang.ss index 8421f86eb5..b9000e786a 100644 --- a/s/expand-lang.ss +++ b/s/expand-lang.ss @@ -80,10 +80,10 @@ (define maybe-label? (lambda (x) (or (not x) (gensym? x)))) (define-language Lexpand - (nongenerative-id #{Lexpand fgy7v2wrvj0so4ro8kvhqo-1}) + (nongenerative-id #{Lexpand fgy7v2wrvj0so4ro8kvhqo-2}) (terminals (maybe-label (dl)) - (gensym (uid)) + (gensym (uid export-id)) (library-path (path)) (library-version (version)) (maybe-optimization-loc (db)) @@ -110,7 +110,7 @@ prog lsrc) (ctLibrary (ctlib) - (library/ct uid import-code visit-code)) + (library/ct uid (export-id* ...) import-code visit-code)) (rtLibrary (rtlib) (library/rt uid (dl* ...) diff --git a/s/interpret.ss b/s/interpret.ss index ec382314d3..d019327f12 100644 --- a/s/interpret.ss +++ b/s/interpret.ss @@ -666,8 +666,8 @@ [,lsrc (ibeval lsrc)] [(program ,uid ,body) (ibeval ($build-invoke-program uid body))] - [(library/ct ,uid ,import-code ,visit-code) - (ibeval ($build-install-library/ct-code uid import-code visit-code))] + [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code) + (ibeval ($build-install-library/ct-code uid export-id* import-code visit-code))] [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body) (ibeval ($build-install-library/rt-code uid dl* db* dv* de* body))] [,linfo/rt ($install-library/rt-desc linfo/rt for-import? ofn)] diff --git a/s/syntax.ss b/s/syntax.ss index 6992c49145..afebf6b188 100644 --- a/s/syntax.ss +++ b/s/syntax.ss @@ -828,9 +828,10 @@ ,(build-sequence no-source init*))))) (define build-top-library/ct - (lambda (uid import-code* visit-code*) + (lambda (uid export-id* import-code* visit-code*) (with-output-language (Lexpand ctLibrary) `(library/ct ,uid + (,export-id* ...) ,(build-lambda no-source '() (build-sequence no-source import-code*)) ,(if (null? visit-code*) @@ -2357,9 +2358,10 @@ (mutable clo*) ; cross-library optimization information (mutable loaded-import-reqs) (mutable loaded-visit-reqs) + (mutable export-id*) ; ids that need to be reset when visit-code raises an exception (mutable import-code) (mutable visit-code)) - (nongenerative #{ctdesc bthma8spr7lds76z4hlmr9-1}) + (nongenerative #{ctdesc bthma8spr7lds76z4hlmr9-2}) (sealed #t)) (define-record-type rtdesc @@ -2375,6 +2377,7 @@ libdesc-loaded-visit-reqs libdesc-loaded-visit-reqs-set! libdesc-import-code libdesc-import-code-set! libdesc-visit-code libdesc-visit-code-set! + libdesc-visit-id* libdesc-visit-id*-set! libdesc-clo* libdesc-clo*-set!) (define get-ctdesc (lambda (desc) @@ -2416,6 +2419,12 @@ (define libdesc-visit-code-set! (lambda (desc x) (ctdesc-visit-code-set! (get-ctdesc desc) x))) + (define libdesc-visit-id* + (lambda (desc) + (ctdesc-export-id* (get-ctdesc desc)))) + (define libdesc-visit-id*-set! + (lambda (desc x) + (ctdesc-export-id*-set! (get-ctdesc desc) x))) (define libdesc-clo* (lambda (desc) (ctdesc-clo* (get-ctdesc desc)))) @@ -2460,10 +2469,15 @@ (when (eq? p 'pending) ($oops #f "cyclic dependency involving visit of library ~s" (libdesc-path desc))) (libdesc-visit-code-set! desc 'pending) - (for-each (lambda (req) (visit-library (libreq-uid req))) (libdesc-visit-visit-req* desc)) - (for-each (lambda (req) (invoke-library (libreq-uid req))) (libdesc-visit-req* desc)) - (p) - (libdesc-visit-code-set! desc #f))]))] + (on-reset + (begin + (for-each (lambda (id) ($sc-put-cte id (make-binding 'visit uid) #f)) (libdesc-visit-id* desc)) + (libdesc-visit-code-set! desc p)) + (for-each (lambda (req) (visit-library (libreq-uid req))) (libdesc-visit-visit-req* desc)) + (for-each (lambda (req) (invoke-library (libreq-uid req))) (libdesc-visit-req* desc)) + (p)) + (libdesc-visit-code-set! desc #f) + (libdesc-visit-id*-set! desc '()))]))] [else ($oops #f "library ~:s is not defined" uid)]))) (define invoke-library @@ -2480,8 +2494,9 @@ (when (eq? p 'pending) ($oops #f "cyclic dependency involving invocation of library ~s" (libdesc-path desc))) (libdesc-invoke-code-set! desc 'pending) - (for-each (lambda (req) (invoke-library (libreq-uid req))) (libdesc-invoke-req* desc)) - (p) + (on-reset (libdesc-invoke-code-set! desc p) + (for-each (lambda (req) (invoke-library (libreq-uid req))) (libdesc-invoke-req* desc)) + (p)) (libdesc-invoke-code-set! desc #f))]))] [else ($oops #f "library ~:s is not defined" uid)]))) @@ -2525,8 +2540,9 @@ (when (eq? p 'pending) ($oops #f "cyclic dependency involving invocation of library ~s" (libdesc-path desc))) (libdesc-invoke-code-set! desc 'pending) - (for-each (lambda (req) (invoke-library (libreq-uid req))) (libdesc-invoke-req* desc)) - (p) + (on-reset (libdesc-invoke-code-set! desc p) + (for-each (lambda (req) (invoke-library (libreq-uid req))) (libdesc-invoke-req* desc)) + (p)) (libdesc-invoke-code-set! desc #f))])) (unless (memp (lambda (x) (eq? (libreq-uid x) uid)) req*) (set! req* (cons (make-libreq (libdesc-path desc) (libdesc-version desc) uid) req*))))] @@ -2626,7 +2642,7 @@ (install-library library-path library-uid ; import-code & visit-code is #f because vthunk invocation has already set up compile-time environment (make-libdesc library-path library-version outfn #f - (make-ctdesc include-req* import-req* visit-visit-req* visit-req* '() #t #t #f #f) + (make-ctdesc include-req* import-req* visit-visit-req* visit-req* '() #t #t '() #f #f) (make-rtdesc invoke-req* #t (top-level-eval-hook (build-lambda no-source '() @@ -2666,6 +2682,13 @@ build-void (lambda () (build-top-library/ct library-uid + ; visit-time exports (making them available for reset on visit-code failure) + (fold-left (lambda (ls x) + (let ([label (car x)] [exp (cdr x)]) + (if (and (pair? exp) (eq? (car exp) 'visit)) + (cons label ls) + ls))) + '() env*) ; setup code `(,(build-cte-install bound-id (build-data no-source interface-binding) '*system*) ,@(if (null? env*) @@ -4632,11 +4655,12 @@ (when desc (put-library-descriptor uid desc))))) (define-who install-library/ct-code - (lambda (uid import-code visit-code) + (lambda (uid export-id* import-code visit-code) (let ([desc (get-library-descriptor uid)]) (unless desc (sorry! who "unable to install visit code for non-existent library ~s" uid)) (let ([ctdesc (libdesc-ctdesc desc)]) (unless ctdesc (sorry! who "unable to install visit code for revisit-only library ~s" uid)) + (ctdesc-export-id*-set! ctdesc export-id*) (ctdesc-import-code-set! ctdesc import-code) (ctdesc-visit-code-set! ctdesc visit-code))))) @@ -5077,7 +5101,8 @@ [(#t) (void)] [(#f) (libdesc-loaded-invoke-reqs-set! desc 'pending) - (for-each (make-load-req load-invoke-library path) (libdesc-invoke-req* desc)) + (on-reset (libdesc-loaded-invoke-reqs-set! desc #f) + (for-each (make-load-req load-invoke-library path) (libdesc-invoke-req* desc))) (libdesc-loaded-invoke-reqs-set! desc #t)] [(pending) ($oops #f "cyclic dependency involving invocation of library ~s" (libdesc-path desc))])))))) (define load-visit-library @@ -5091,8 +5116,9 @@ [(#t) (void)] [(#f) (libdesc-loaded-visit-reqs-set! desc 'pending) - (for-each (make-load-req load-visit-library path) (libdesc-visit-visit-req* desc)) - (for-each (make-load-req load-invoke-library path) (libdesc-visit-req* desc)) + (on-reset (libdesc-loaded-visit-reqs-set! desc #f) + (for-each (make-load-req load-visit-library path) (libdesc-visit-visit-req* desc)) + (for-each (make-load-req load-invoke-library path) (libdesc-visit-req* desc))) (libdesc-loaded-visit-reqs-set! desc #t)] [(pending) ($oops #f "cyclic dependency involving visit of library ~s" (libdesc-path desc))])))))) (define load-import-library @@ -5106,7 +5132,8 @@ [(#t) (void)] [(#f) (libdesc-loaded-import-reqs-set! desc 'pending) - (for-each (make-load-req load-import-library path) (libdesc-import-req* desc)) + (on-reset (libdesc-loaded-import-reqs-set! desc #f) + (for-each (make-load-req load-import-library path) (libdesc-import-req* desc))) (libdesc-loaded-import-reqs-set! desc #t)] [(pending) ($oops #f "cyclic dependency involving import of library ~s" (libdesc-path desc))])))))) (define import-library @@ -5261,9 +5288,10 @@ (build-lambda no-source '() body)))) (set-who! $build-install-library/ct-code - (lambda (uid import-code visit-code) + (lambda (uid export-id* import-code visit-code) (build-primcall no-source 3 '$install-library/ct-code (build-data no-source uid) + (build-data no-source export-id*) import-code visit-code))) @@ -5393,7 +5421,7 @@ (library/ct-info-visit-visit-req* linfo/ct) (library/ct-info-visit-req* linfo/ct) (library/ct-info-clo* linfo/ct) - #f #f 'loading 'loading))))) + #f #f '() 'loading 'loading))))) (set! $install-library/rt-desc (lambda (linfo/rt for-import? ofn) @@ -5405,8 +5433,8 @@ uid ofn (make-rtdesc (library/rt-info-invoke-req* linfo/rt) #f 'loading))))) (set! $install-library/ct-code - (lambda (uid import-code visit-code) - (install-library/ct-code uid import-code visit-code))) + (lambda (uid export-id* import-code visit-code) + (install-library/ct-code uid export-id* import-code visit-code))) (set! $install-library/rt-code (lambda (uid invoke-code) @@ -5482,7 +5510,7 @@ (lambda (path uid) (install-library path uid (make-libdesc path (if (eq? (car path) 'rnrs) '(6) '()) #f #t - (make-ctdesc '() '() '() '() '() #t #t #f #f) + (make-ctdesc '() '() '() '() '() #t #t '() #f #f) (make-rtdesc '() #t #f))))) (set! $make-base-modules (lambda ()