From c468e328a54daa35684c57541b934d3bb603ccfe Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 11 Feb 2013 15:22:06 +0900 Subject: [PATCH] defining load on source files in scheme --- lib/init-7.scm | 21 +++++++++++++++++++++ opcodes.c | 2 +- 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/lib/init-7.scm b/lib/init-7.scm index 9b7616fb..9a16fadf 100644 --- a/lib/init-7.scm +++ b/lib/init-7.scm @@ -956,6 +956,27 @@ (let ((thunk (compile x (if (pair? o) (car o) (interaction-environment))))) (if (procedure? thunk) (thunk) (raise thunk)))) +(define (load base . o) + (let* ((env (if (pair? o) (car o) (interaction-environment))) + (file (find-module-file base)) + (len (and file (string-length file))) + (ext *shared-object-extension*) + (ext-len (string-length ext))) + (cond + ((not file) + (error "couldn't find file" base)) + ((and (> len ext-len 0) (equal? ext (substring file (- len ext-len)))) + (%load file env)) + (else + (call-with-input-file file + (lambda (in) + (let lp () + (let ((x (read in))) + (cond + ((not (eof-object? x)) + (eval x env) + (lp))))))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; promises diff --git a/opcodes.c b/opcodes.c index a5f89cf7..8cd9c762 100644 --- a/opcodes.c +++ b/opcodes.c @@ -167,7 +167,7 @@ _FN0(_I(SEXP_ENV), "make-environment", 0, sexp_make_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op), _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op), -_FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "load", (sexp)"interaction-environment", sexp_load_op), +_FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "%load", (sexp)"interaction-environment", sexp_load_op), _FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%import", 0, sexp_env_import_op), _FN2OPTP(SEXP_VOID, _I(SEXP_EXCEPTION), _I(SEXP_OPORT), "print-exception", (sexp)"current-error-port", sexp_print_exception_op), _FN1OPTP(SEXP_VOID, _I(SEXP_OPORT), "print-stack-trace", (sexp)"current-error-port", sexp_stack_trace_op),