(define (provided? feature)
(and (memq feature *features*) #t))
-;;; presumably deprecated.
-(define feature? provided?)
+(begin-deprecated
+ (define feature? provided?))
;;; let format alias simple-format until the more complete version is loaded
(define format simple-format)
(define (and=> value procedure) (and value (procedure value)))
(define (make-hash-table k) (make-vector k '()))
-(begin-deprecated
- (define (id x)
- (issue-deprecation-warning "`id' is deprecated. Use `identity' instead.")
- (identity x))
- (define (-1+ n)
- (issue-deprecation-warning "`-1+' is deprecated. Use `1-' instead.")
- (1- n))
- (define (return-it . args)
- (issue-deprecation-warning "`return-it' is deprecated. Use `noop' instead.")
- (apply noop args)))
-
;;; apply-to-args is functionally redundant with apply and, worse,
;;; is less general than apply since it only takes two arguments.
;;;
(if (even? k) acc (proc acc x))
proc))))
-(begin-deprecated
- (define (string-character-length s)
- (issue-deprecation-warning "`string-character-length' is deprecated. Use `string-length' instead.")
- (string-length s))
- (define (flags . args)
- (issue-deprecation-warning "`flags' is deprecated. Use `logior' instead.")
- (apply logior args)))
-
\f
;;; {Symbol Properties}
;;;
(define (tms:cutime obj) (vector-ref obj 3))
(define (tms:cstime obj) (vector-ref obj 4))
-(define (file-position . args) (apply ftell args))
-(define (file-set-position . args) (apply fseek args))
+(define file-position ftell)
+(define (file-set-position port offset . whence)
+ (let ((whence (if (eq? whence '()) SEEK_SET (car whence))))
+ (seek port offset whence)))
(define (move->fdes fd/port fd)
(cond ((integer? fd/port)
(putenv (string-append name "=" value))
(putenv name)))
+(define (unsetenv name)
+ "Remove the entry for NAME from the environment."
+ (putenv name))
+
\f
;;; {Load Paths}
;;;
;; This is mostly for the internal use of the code generated by
;; scm_compile_shell_switches.
+
+(define (turn-on-debugging)
+ (debug-enable 'debug)
+ (debug-enable 'backtrace)
+ (read-enable 'positions))
+
(define (load-user-init)
(let* ((home (or (getenv "HOME")
(false-if-exception (passwd:dir (getpwuid (getuid))))
;; to maximally one module.
(set-procedure-property! closure 'module module))))
-(begin-deprecated
- (define (eval-in-module exp mod)
- (issue-deprecation-warning
- "`eval-in-module' is deprecated. Use `eval' instead.")
- (eval exp mod)))
-
\f
;;; {Observer protocol}
;;;
((module-binder m) m v #t))
(begin
(let ((answer (make-undefined-variable)))
- (variable-set-name-hint! answer v)
(module-obarray-set! (module-obarray m) v answer)
(module-modified m)
answer))))
(define (module-ensure-local-variable! module symbol)
(or (module-local-variable module symbol)
(let ((var (make-undefined-variable)))
- (variable-set-name-hint! var symbol)
(module-add! module symbol var)
var)))
(variable-set! variable value)
(module-modified module))
(let ((variable (make-variable value)))
- (variable-set-name-hint! variable name)
(module-add! module name variable)))))
;; MODULE-DEFINED? -- exported
;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
(define (try-load-module name)
- (or (begin-deprecated (try-module-linked name))
- (try-module-autoload name)
- (begin-deprecated (try-module-dynamic-link name))))
+ (try-module-autoload name))
(define (purify-module! module)
"Removes bindings in MODULE which are inherited from the (guile) module."
(eq? (car (last-pair use-list)) the-scm-module))
(set-module-uses! module (reverse (cdr (reverse use-list)))))))
-;; Return a module that is a interface to the module designated by
+;; Return a module that is an interface to the module designated by
;; NAME.
;;
;; `resolve-interface' takes two keyword arguments:
;; is the name in the used module and SEEN is the name in the using
;; module. Note that SEEN is also passed through RENAMER, below. The
;; default is to select all bindings. If you specify no selection but
-;; a renamer, only the bindings that already exists in the used module
+;; a renamer, only the bindings that already exist in the used module
;; are made available in the interface. Bindings that are added later
;; are not picked up.
;;
(orig (if direct? bspec (car bspec)))
(seen (if direct? bspec (cdr bspec))))
(module-add! custom-i (renamer seen)
- (or (module-local-variable module orig)
+ (or (module-local-variable public-i orig)
+ (module-local-variable module orig)
(error
;; fixme: format manually for now
(simple-format
(lambda (symbol)
(symbol-append prefix symbol)))
+;; This function is called from "modules.c". If you change it, be
+;; sure to update "modules.c" as well.
+
(define (process-define-module args)
(let* ((module-id (car args))
(module (resolve-module module-id #f))
(beautify-user-module! module)
(let loop ((kws kws)
(reversed-interfaces '())
- (exports '()))
+ (exports '())
+ (re-exports '()))
(if (null? kws)
(begin
(for-each (lambda (interface)
(module-use! module interface))
(reverse reversed-interfaces))
- (module-export! module exports))
+ (module-export! module exports)
+ (module-re-export! module re-exports))
(case (car kws)
((#:use-module #:use-syntax)
(or (pair? (cdr kws))
(unrecognized kws))
(let* ((interface-args (cadr kws))
(interface (apply resolve-interface interface-args)))
- (and (eq? (car kws) 'use-syntax)
- (or (symbol? (car spec))
+ (and (eq? (car kws) #:use-syntax)
+ (or (symbol? (caar interface-args))
(error "invalid module name for use-syntax"
- spec))
+ (car interface-args)))
(set-module-transformer!
module
- (module-ref interface (car
- (last-pair (car interface-args)))
+ (module-ref interface
+ (car (last-pair (car interface-args)))
#f)))
(loop (cddr kws)
(cons interface reversed-interfaces)
- exports)))
+ exports
+ re-exports)))
((#:autoload)
(or (and (pair? (cdr kws)) (pair? (cddr kws)))
(unrecognized kws))
(cadr kws)
(caddr kws))
reversed-interfaces)
- exports))
+ exports
+ re-exports))
((#:no-backtrace)
(set-system-module! module #t)
- (loop (cdr kws) reversed-interfaces exports))
+ (loop (cdr kws) reversed-interfaces exports re-exports))
((#:pure)
(purify-module! module)
- (loop (cdr kws) reversed-interfaces exports))
- ((#:export)
+ (loop (cdr kws) reversed-interfaces exports re-exports))
+ ((#:export #:export-syntax)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (loop (cddr kws)
+ reversed-interfaces
+ (append (cadr kws) exports)
+ re-exports))
+ ((#:re-export #:re-export-syntax)
(or (pair? (cdr kws))
(unrecognized kws))
(loop (cddr kws)
reversed-interfaces
- (append (cadr kws) exports)))
+ exports
+ (append (cadr kws) re-exports)))
(else
(unrecognized kws)))))
module))
(define autoloads-in-progress '())
+;; This function is called from "modules.c". If you change it, be
+;; sure to update "modules.c" as well.
+
(define (try-module-autoload module-name)
(let* ((reverse-name (reverse module-name))
(name (symbol->string (car reverse-name)))
\f
;;; Dynamic linking of modules
-;; This method of dynamically linking Guile Extensions is deprecated.
-;; Use `load-extension' explicitely from Scheme code instead.
-
-(begin-deprecated
-
- (define (split-c-module-name str)
- (let loop ((rev '())
- (start 0)
- (pos 0)
- (end (string-length str)))
- (cond
- ((= pos end)
- (reverse (cons (string->symbol (substring str start pos)) rev)))
- ((eq? (string-ref str pos) #\space)
- (loop (cons (string->symbol (substring str start pos)) rev)
- (+ pos 1)
- (+ pos 1)
- end))
- (else
- (loop rev start (+ pos 1) end)))))
-
- (define (convert-c-registered-modules dynobj)
- (let ((res (map (lambda (c)
- (list (split-c-module-name (car c)) (cdr c) dynobj))
- (c-registered-modules))))
- (c-clear-registered-modules)
- res))
-
- (define registered-modules '())
-
- (define (register-modules dynobj)
- (set! registered-modules
- (append! (convert-c-registered-modules dynobj)
- registered-modules)))
-
- (define (warn-autoload-deprecation modname)
- (issue-deprecation-warning
- "Autoloading of compiled code modules is deprecated."
- "Write a Scheme file instead that uses `load-extension'.")
- (issue-deprecation-warning
- (simple-format #f "(You just autoloaded module ~S.)" modname)))
-
- (define (init-dynamic-module modname)
- ;; Register any linked modules which have been registered on the C level
- (register-modules #f)
- (or-map (lambda (modinfo)
- (if (equal? (car modinfo) modname)
- (begin
- (warn-autoload-deprecation modname)
- (set! registered-modules (delq! modinfo registered-modules))
- (let ((mod (resolve-module modname #f)))
- (save-module-excursion
- (lambda ()
- (set-current-module mod)
- (set-module-public-interface! mod mod)
- (dynamic-call (cadr modinfo) (caddr modinfo))
- ))
- #t))
- #f))
- registered-modules))
-
- (define (dynamic-maybe-call name dynobj)
- (catch #t ; could use false-if-exception here
- (lambda ()
- (dynamic-call name dynobj))
- (lambda args
- #f)))
-
- (define (dynamic-maybe-link filename)
- (catch #t ; could use false-if-exception here
- (lambda ()
- (dynamic-link filename))
- (lambda args
- #f)))
-
- (define (find-and-link-dynamic-module module-name)
- (define (make-init-name mod-name)
- (string-append "scm_init"
- (list->string (map (lambda (c)
- (if (or (char-alphabetic? c)
- (char-numeric? c))
- c
- #\_))
- (string->list mod-name)))
- "_module"))
-
- ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
- ;; and the `libname' (the name of the module prepended by `lib') in the cdr
- ;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then
- ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
- (let ((subdir-and-libname
- (let loop ((dirs "")
- (syms module-name))
- (if (null? (cdr syms))
- (cons dirs (string-append "lib" (symbol->string (car syms))))
- (loop (string-append dirs (symbol->string (car syms)) "/")
- (cdr syms)))))
- (init (make-init-name (apply string-append
- (map (lambda (s)
- (string-append "_"
- (symbol->string s)))
- module-name)))))
- (let ((subdir (car subdir-and-libname))
- (libname (cdr subdir-and-libname)))
-
- ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
- ;; file exists, fetch the dlname from that file and attempt to link
- ;; against it. If `subdir/libfoo.la' does not exist, or does not seem
- ;; to name any shared library, look for `subdir/libfoo.so' instead and
- ;; link against that.
- (let check-dirs ((dir-list %load-path))
- (if (null? dir-list)
- #f
- (let* ((dir (in-vicinity (car dir-list) subdir))
- (sharlib-full
- (or (try-using-libtool-name dir libname)
- (try-using-sharlib-name dir libname))))
- (if (and sharlib-full (file-exists? sharlib-full))
- (link-dynamic-module sharlib-full init)
- (check-dirs (cdr dir-list)))))))))
-
- (define (try-using-libtool-name libdir libname)
- (let ((libtool-filename (in-vicinity libdir
- (string-append libname ".la"))))
- (and (file-exists? libtool-filename)
- libtool-filename)))
-
- (define (try-using-sharlib-name libdir libname)
- (in-vicinity libdir (string-append libname ".so")))
-
- (define (link-dynamic-module filename initname)
- ;; Register any linked modules which have been registered on the C level
- (register-modules #f)
- (let ((dynobj (dynamic-link filename)))
- (dynamic-call initname dynobj)
- (register-modules dynobj)))
-
- (define (try-module-linked module-name)
- (init-dynamic-module module-name))
-
- (define (try-module-dynamic-link module-name)
- (and (find-and-link-dynamic-module module-name)
- (init-dynamic-module module-name))))
-;; end of deprecated section
-
-
(define autoloads-done '((guile . guile)))
(define (autoload-done-or-in-progress? p m)
'())))
(define (map-apply func list)
(map (lambda (args) (apply func args)) list))
- (define keys
+ (define keys
;; sym key quote?
'((:select #:select #t)
- (:rename #:rename #f)))
+ (:renamer #:renamer #f)))
(if (not (pair? (car spec)))
`(',spec)
`(',(car spec)
(defmacro define-module args
`(eval-case
((load-toplevel)
- (let ((m (process-define-module
+ (let ((m (process-define-module
(list ,@(compile-define-module-args args)))))
(set-current-module m)
m))
;; The guts of the use-modules macro. Add the interfaces of the named
;; modules to the use-list of the current module, in order.
+;; This function is called by "modules.c". If you change it, be sure
+;; to change scm_c_use_module as well.
+
(define (process-use-modules module-interface-args)
(for-each (lambda (mif-args)
(let ((mod-iface (apply resolve-interface mif-args)))
(or mod-iface
- (error "no such module" mif-spec))
+ (error "no such module" mif-args))
(module-use! (current-module) mod-iface)))
module-interface-args))
(list ,@(compile-interface-spec spec))))
(set-module-transformer! (current-module)
,(car (last-pair spec))))
- `((set-module-transformer! (current-module) ,spec)))
- (begin-deprecated
- (fluid-set! scm:eval-transformer (module-transformer (current-module)))))
+ `((set-module-transformer! (current-module) ,spec))))
(else
(error "use-syntax can only be used at the top level"))))
(defmacro ,@args))))))
;; Export a local variable
-;;
+
+;; This function is called from "modules.c". If you change it, be
+;; sure to update "modules.c" as well.
+
(define (module-export! m names)
(let ((public-i (module-public-interface m)))
(for-each (lambda (name)
- (begin-deprecated
- (if (not (module-local-variable m name))
- (let ((v (module-variable m name)))
- (cond
- (v
- (issue-deprecation-warning
- "Using `export' to re-export imported bindings is deprecated. Use `re-export' instead.")
- (issue-deprecation-warning
- (simple-format #f "(You just re-exported `~a' from `~a'.)"
- name (module-name m)))
- (module-define! m name (variable-ref v)))))))
(let ((var (module-ensure-local-variable! m name)))
(module-add! public-i name var)))
names)))
(load-emacs-interface))
;; Use some convenient modules (in reverse order)
-
+
(if (provided? 'regex)
(module-use! guile-user-module (resolve-interface '(ice-9 regex))))
(if (provided? 'threads)
(module-use! guile-user-module (resolve-interface '(ice-9 threads))))
;; load debugger on demand
- (module-use! guile-user-module
+ (module-use! guile-user-module
(make-autoload-interface guile-user-module
'(ice-9 debugger) '(debug)))
(module-use! guile-user-module (resolve-interface '(ice-9 session)))
(sigaction (car sig-msg)
(make-handler (cdr sig-msg))))
signals))))
-
+
;; the protected thunk.
(lambda ()
(let ((status (scm-style-repl)))
(run-hook exit-hook)
status))
-
+
;; call at exit.
(lambda ()
(map (lambda (sig-msg old-handler)
(define-module (guile-user))
-(begin-deprecated
- ;; automatic availability of this module is deprecated.
- (use-modules (ice-9 rdelim)))
-
;;; boot-9.scm ends here
HCoop / bpt / guile.git / blobdiff