~ chicken-core (chicken-5) b3aff204780a190ebb296736579444581c17529d
commit b3aff204780a190ebb296736579444581c17529d Author: Evan Hanson <evhan@foldling.org> AuthorDate: Tue Feb 9 12:19:16 2016 +1300 Commit: Evan Hanson <evhan@foldling.org> CommitDate: Tue Mar 8 22:52:35 2016 +1300 Give load-library and load-extension a void result Also, use the normal, non-##sys# load-extension in require-for-syntax and standardize the names of the auxiliary load-library/extension procedures to (hopefully) make their roles slightly more clear. diff --git a/core.scm b/core.scm index 8898b16f..9c424a89 100644 --- a/core.scm +++ b/core.scm @@ -672,7 +672,7 @@ ,(walk (caddr x) e se dest ldest h ln))) ((##core#require-for-syntax) - (##sys#load-extension (cadr x)) + (load-extension (cadr x)) '(##core#undefined)) ((##core#require) diff --git a/eval.scm b/eval.scm index 5b447b78..b3522fd9 100644 --- a/eval.scm +++ b/eval.scm @@ -703,8 +703,8 @@ (compile `(##sys#provide (##core#quote ,(cadr x))) e #f tf cntr se)] [(##core#require-for-syntax) - (let ((id (strip-syntax (cadr x)))) - (##sys#load-extension id) + (let ((id (cadr x))) + (load-extension id) (compile `(##core#begin ,@(map (lambda (x) @@ -1097,34 +1097,36 @@ (##sys#check-list x) x) ) ) ) -(define load-library-0 +(define load-library/internal (let ((display display)) - (lambda (uname lib) + (lambda (uname lib loc) (let ((libs (if lib (##sys#list lib) (cons (##sys#string-append (##sys#slot uname 1) load-library-extension) (dynamic-load-libraries)))) (top - (c-toplevel uname 'load-library))) + (c-toplevel uname loc))) (when (load-verbose) (display "; loading library ") (display uname) (display " ...\n") ) (let loop ((libs libs)) - (cond ((null? libs) #f) - ((##sys#dload (##sys#make-c-string (##sys#slot libs 0) 'load-library) top) #t) - (else (loop (##sys#slot libs 1))))))))) - -(define load-library - (lambda (uname #!optional lib) - (##sys#check-symbol uname 'load-library) - (unless (not lib) (##sys#check-string lib 'load-library)) - (or (##sys#provided? uname) - (load-library-0 uname lib) - (##sys#error 'load-library "unable to load library" uname _dlerror) ) ) ) - -(define ##sys#load-library load-library) + (cond ((null? libs) + (##sys#error loc "unable to load library" uname _dlerror)) + ((##sys#dload (##sys#make-c-string (##sys#slot libs 0) 'load-library) top)) + (else + (loop (##sys#slot libs 1))))))))) + +(define (##sys#load-library uname #!optional lib loc) + (unless (##sys#provided? uname) + (load-library/internal uname lib loc) + (##core#undefined))) + +(define (load-library uname #!optional lib) + (##sys#check-symbol uname 'load-library) + (unless (not lib) (##sys#check-string lib 'load-library)) + (##sys#load-library uname lib 'load-library)) (define ##sys#include-forms-from-file (let ((with-input-from-file with-input-from-file) @@ -1215,12 +1217,11 @@ (or (check pa) (loop (##sys#slot paths 1)) ) ) ) ) ) ) )) -(define (##sys#load-extension id #!optional (alternates '()) loc) +(define (load-extension/internal id alternates loc) (cond ((##sys#provided? id)) ((any ##sys#provided? alternates)) ((memq id core-units) - (or (load-library-0 id #f) - (##sys#error loc "cannot load core library" id))) + (load-library/internal id #f loc)) ((##sys#find-extension id #f) => (lambda (ext) (load/internal ext #f #f #f #f id) @@ -1228,6 +1229,10 @@ (else (##sys#error loc "cannot load extension" id)))) +(define (##sys#load-extension id #!optional (alternates '()) loc) + (load-extension/internal id alternates loc) + (##core#undefined)) + (define (load-extension id) (##sys#check-symbol id 'load-extension) (##sys#load-extension id '() 'load-extension)) diff --git a/types.db b/types.db index 2ecacece..ccda394a 100644 --- a/types.db +++ b/types.db @@ -844,7 +844,7 @@ (chicken.eval#eval (procedure chicken.eval#eval (* #!optional (struct environment)) . *)) (chicken.eval#extension-information (#(procedure #:clean) chicken.eval#extension-information (symbol) *)) (chicken.eval#load (procedure chicken.eval#load (string #!optional (procedure (*) . *)) undefined)) -(chicken.eval#load-extension (#(procedure #:enforce) chicken.eval#load-extension (symbol) boolean)) +(chicken.eval#load-extension (#(procedure #:enforce) chicken.eval#load-extension (symbol) undefined)) (chicken.eval#load-library (#(procedure #:enforce) chicken.eval#load-library (symbol #!optional string) undefined)) (chicken.eval#load-relative (#(procedure #:enforce) chicken.eval#load-relative (string #!optional (procedure (*) . *)) undefined)) (chicken.eval#load-verbose (#(procedure #:clean) chicken.eval#load-verbose (#!optional *) *))Trap