mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-04 16:50:25 +02:00
521662d8b7
Also deprecate the C interface. * libguile/Makefile.am: Don't install regex-posix.h. * libguile/deprecated.c: * libguile/deprecated.h: Add deprecated shims for scm_make_regexp et al. * libguile/init.c: Fix comment. * libguile/regex-posix.c: Privatize some of the implementation details. Arrange to install into (ice-9 regex) instead of default environment. * module/ice-9/deprecated.scm: Add deprecation shims. * module/ice-9/regex.scm: Add new definitions. * module/ice-9/sandbox.scm: * module/scripts/read-scheme-source.scm: * module/system/repl/server.scm: * module/texinfo/reflection.scm: * test-suite/tests/r6rs-exceptions.test: * test-suite/tests/srfi-10.test: Import (ice-9 regex).
417 lines
17 KiB
Scheme
417 lines
17 KiB
Scheme
;;;; Copyright (C) 2025 Free Software Foundation, Inc.
|
|
;;;;
|
|
;;;; This library is free software; you can redistribute it and/or
|
|
;;;; modify it under the terms of the GNU Lesser General Public
|
|
;;;; License as published by the Free Software Foundation; either
|
|
;;;; version 3 of the License, or (at your option) any later version.
|
|
;;;;
|
|
;;;; This library is distributed in the hope that it will be useful,
|
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;;; Lesser General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Lesser General Public
|
|
;;;; License along with this library; if not, write to the Free Software
|
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
;;;;
|
|
|
|
(define-module (ice-9 deprecated)
|
|
#:use-module (ice-9 hooks)
|
|
#:use-module (ice-9 guardians)
|
|
#:use-module (ice-9 object-properties)
|
|
#:use-module (ice-9 source-properties)
|
|
#:use-module (ice-9 weak-tables)
|
|
#:use-module (ice-9 arrays)
|
|
#:use-module (ice-9 scm-style-repl)
|
|
#:use-module (ice-9 promises)
|
|
#:use-module (system repl hooks)
|
|
#:use-module (system repl reader)
|
|
#:use-module (srfi srfi-14)
|
|
#:export ((make-guardian* . make-guardian)
|
|
module-observe-weak
|
|
(make-object-property* . make-object-property)
|
|
(make-weak-key-hash-table* . make-weak-key-hash-table)
|
|
(make-weak-value-hash-table* . make-weak-value-hash-table)
|
|
(make-doubly-weak-hash-table* . make-doubly-weak-hash-table)
|
|
(weak-key-hash-table?* . weak-key-hash-table?)
|
|
(weak-value-hash-table?* . weak-value-hash-table?)
|
|
(doubly-weak-hash-table?* . doubly-weak-hash-table?)
|
|
(supports-source-properties?* . supports-source-properties?)
|
|
(source-properties* . source-properties)
|
|
(set-source-properties!* . set-source-properties!)
|
|
(source-property* . source-property)
|
|
(set-source-properties* . set-source-property!)
|
|
(cons-source* . cons-source)
|
|
(array-fill!* . array-fill!)
|
|
(array-copy!* . array-copy!)
|
|
(array-copy-in-order!* . array-copy-in-order!)
|
|
(array-map!* . array-map!)
|
|
(array-for-each* . array-for-each)
|
|
(array-index-map!* . array-index-map!)
|
|
(array-equal?* . array-equal?)
|
|
(array-slice-for-each* . array-slice-for-each)
|
|
(array-slice-for-each-in-order* . array-slice-for-each-in-order)
|
|
(char-set?* . char-set?)
|
|
(char-set=* . char-set=)
|
|
(char-set<=* . char-set<=)
|
|
(char-set-hash* . char-set-hash)
|
|
(char-set-cursor* . char-set-cursor)
|
|
(char-set-ref* . char-set-ref)
|
|
(char-set-cursor-next* . char-set-cursor-next)
|
|
(end-of-char-set?* . end-of-char-set?)
|
|
(char-set-fold* . char-set-fold)
|
|
(char-set-unfold* . char-set-unfold) char-set-unfold!
|
|
(char-set-for-each* . char-set-for-each)
|
|
(char-set-map* . char-set-map)
|
|
(char-set-copy* . char-set-copy)
|
|
(char-set* . char-set)
|
|
(list->char-set* . list->char-set)
|
|
(list->char-set!* . list->char-set!)
|
|
(string->char-set* . string->char-set)
|
|
(string->char-set!* . string->char-set!)
|
|
(char-set-filter* . char-set-filter)
|
|
(char-set-filter!* . char-set-filter!)
|
|
(ucs-range->char-set* . ucs-range->char-set)
|
|
(ucs-range->char-set!* . ucs-range->char-set!)
|
|
(->char-set* . ->char-set)
|
|
(char-set-size* . char-set-size)
|
|
(char-set-count* . char-set-count)
|
|
(char-set->list* . char-set->list)
|
|
(char-set->string* . char-set->string)
|
|
(char-set-contains?* . char-set-contains?)
|
|
(char-set-every* . char-set-every)
|
|
(char-set-any* . char-set-any)
|
|
(char-set-adjoin* . char-set-adjoin)
|
|
(char-set-adjoin!* . char-set-adjoin!)
|
|
(char-set-delete* . char-set-delete)
|
|
(char-set-delete!* . char-set-delete!)
|
|
(char-set-complement* . char-set-complement)
|
|
(char-set-union* . char-set-union)
|
|
(char-set-intersection* . char-set-intersection)
|
|
(char-set-difference* . char-set-difference)
|
|
(char-set-xor* . char-set-xor)
|
|
(char-set-diff+intersection* . char-set-diff+intersection)
|
|
(char-set-complement!* . char-set-complement!)
|
|
(char-set-union!* . char-set-union!)
|
|
(char-set-intersection!* . char-set-intersection!)
|
|
(char-set-difference!* . char-set-difference!)
|
|
(char-set-xor!* . char-set-xor!)
|
|
(char-set-diff+intersection!* . char-set-diff+intersection!)
|
|
(char-set:lower-case* . char-set:lower-case)
|
|
(char-set:upper-case* . char-set:upper-case)
|
|
(char-set:title-case* . char-set:title-case)
|
|
(char-set:letter* . char-set:letter)
|
|
(char-set:digit* . char-set:digit)
|
|
(char-set:letter+digit* . char-set:letter+digit)
|
|
(char-set:graphic* . char-set:graphic)
|
|
(char-set:printing* . char-set:printing)
|
|
(char-set:whitespace* . char-set:whitespace)
|
|
(char-set:iso-control* . char-set:iso-control)
|
|
(char-set:punctuation* . char-set:punctuation)
|
|
(char-set:symbol* . char-set:symbol)
|
|
(char-set:hex-digit* . char-set:hex-digit)
|
|
(char-set:blank* . char-set:blank)
|
|
(char-set:ascii* . char-set:ascii)
|
|
(char-set:empty* . char-set:empty)
|
|
(char-set:full* . char-set:full)
|
|
(abort-hook* . abort-hook)
|
|
(before-backtrace-hook* . before-backtrace-hook)
|
|
(after-backtrace-hook* . after-backtrace-hook)
|
|
(before-error-hook* . before-error-hook)
|
|
(after-error-hook* . after-error-hook)
|
|
(before-read-hook* . before-read-hook)
|
|
(after-read-hook* . after-read-hook)
|
|
(before-eval-hook* . before-eval-hook)
|
|
(after-eval-hook* . after-eval-hook)
|
|
(before-print-hook* . before-print-hook)
|
|
(after-print-hook* . after-print-hook)
|
|
(exit-hook* . exit-hook)
|
|
(repl-reader* . repl-reader)
|
|
(make-hook* . make-hook)
|
|
(hook?* . hook?)
|
|
(hook-empty?* . hook-empty?)
|
|
(add-hook!* . add-hook!)
|
|
(remove-hook!* . remove-hook!)
|
|
(reset-hook!* . reset-hook!)
|
|
(run-hook* . run-hook)
|
|
(hook->list* . hook->list)
|
|
module-defined-hook
|
|
(make-promise* . make-promise)
|
|
(promise? . promise?)
|
|
(delay* . delay)
|
|
(force* . force)))
|
|
|
|
(define-syntax define-deprecated/stx
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
((_ mod id)
|
|
(let* ((id* (datum->syntax #'id
|
|
(symbol-append (syntax->datum #'id) '*)))
|
|
(msg (string-append
|
|
(symbol->string (syntax->datum #'id))
|
|
" in the default environment is deprecated.\n"
|
|
"Import it from " (object->string (syntax->datum #'mod))
|
|
" instead.")))
|
|
#`(define-syntax #,id*
|
|
(identifier-syntax
|
|
(begin
|
|
(issue-deprecation-warning #,msg)
|
|
#,#'id))))))))
|
|
|
|
(define-syntax define-deprecated-trampoline
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
((_ ((mod proc) . params) exp)
|
|
(let* ((proc* (datum->syntax #'proc
|
|
(symbol-append (syntax->datum #'proc) '*)))
|
|
(msg (string-append
|
|
(symbol->string (syntax->datum #'proc))
|
|
" in the default environment is deprecated.\n"
|
|
"Import it from " (object->string (syntax->datum #'mod))
|
|
" instead.")))
|
|
#`(define* (#,proc* . params)
|
|
(issue-deprecation-warning #,msg)
|
|
exp))))))
|
|
|
|
(define-syntax define-deprecated-trampolines
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
((_ mod (proc arg ...) ...)
|
|
#'(begin
|
|
(define-deprecated-trampoline ((mod proc) arg ...)
|
|
(proc arg ...))
|
|
...)))))
|
|
|
|
(define-deprecated-trampolines (ice-9 guardians)
|
|
(make-guardian))
|
|
|
|
(define* (module-observe-weak module observer-id #:optional (proc observer-id))
|
|
(issue-deprecation-warning
|
|
"module-observe-weak is deprecated. Use module-observe instead.")
|
|
(module-observe module proc))
|
|
|
|
(define-deprecated-trampolines (ice-9 object-properties)
|
|
(make-object-property)
|
|
(object-properties obj)
|
|
(set-object-properties! obj props)
|
|
(object-property obj key)
|
|
(set-object-property! obj key value))
|
|
|
|
(define-deprecated-trampoline (((ice-9 weak-tables) make-weak-key-hash-table)
|
|
#:optional (n 0))
|
|
(make-weak-key-hash-table))
|
|
(define-deprecated-trampoline (((ice-9 weak-tables) make-weak-value-hash-table)
|
|
#:optional (n 0))
|
|
(make-weak-value-hash-table))
|
|
(define-deprecated-trampoline (((ice-9 weak-tables) make-doubly-weak-hash-table)
|
|
#:optional (n 0))
|
|
(make-doubly-weak-hash-table))
|
|
|
|
(define-deprecated-trampolines (ice-9 weak-tables)
|
|
(weak-key-hash-table? x)
|
|
(weak-value-hash-table? x)
|
|
(doubly-weak-hash-table? x))
|
|
|
|
(define-deprecated-trampolines (ice-9 source-properties)
|
|
(supports-source-properties? x)
|
|
(source-properties x)
|
|
(set-source-properties! x alist)
|
|
(source-property x k)
|
|
(set-source-property! x k v)
|
|
(cons-source orig x y))
|
|
|
|
(define-deprecated-trampolines (ice-9 arrays)
|
|
(array-fill! array fill)
|
|
(array-copy! src dst)
|
|
(array-copy-in-order! src dst)
|
|
(array-index-map! array proc))
|
|
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-map!) dst proc . src*)
|
|
(apply array-map! dst proc src*))
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-for-each) proc array . arrays)
|
|
(apply array-for-each proc array arrays))
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-equal?) . arrays)
|
|
(apply array-equal? arrays))
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-slice-for-each) frame-rank proc . arrays)
|
|
(apply array-slice-for-each frame-rank proc arrays))
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-slice-for-each-in-order) frame-rank proc . arrays)
|
|
(apply array-slice-for-each-in-order frame-rank proc arrays))
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-cell-ref) array . indices)
|
|
(apply array-cell-ref array indices))
|
|
(define-deprecated-trampoline (((ice-9 arrays) array-cell-set!) array val . indices)
|
|
(apply array-cell-set! array val indices))
|
|
|
|
(define-deprecated-trampolines (ice-9 arrays)
|
|
(array-fill! array fill)
|
|
(array-copy! src dst)
|
|
(array-copy-in-order! src dst)
|
|
(array-index-map! array proc))
|
|
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set=) . char-sets)
|
|
(apply char-set= char-sets))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-hash) cs #:optional (bound 871))
|
|
(char-set-hash cs bound))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-unfold) p f g seed #:optional (base-cs (char-set)))
|
|
(char-set-unfold p f g seed base-cs))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set) . chars)
|
|
(list->char-set chars))
|
|
(define-deprecated-trampoline (((srfi srfi-14) list->char-set) list #:optional (base-cs (char-set)))
|
|
(list->char-set list base-cs))
|
|
(define-deprecated-trampoline (((srfi srfi-14) string->char-set) string #:optional (base-cs (char-set)))
|
|
(string->char-set string base-cs))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-filter) pred cs #:optional (base-cs (char-set)))
|
|
(char-set-filter pred cs base-cs))
|
|
(define-deprecated-trampoline (((srfi srfi-14) ucs-range->char-set) lower upper
|
|
#:optional error (base-cs (char-set)))
|
|
(ucs-range->char-set lower upper error base-cs))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-adjoin) cs . rest)
|
|
(apply char-set-adjoin cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-delete) cs . rest)
|
|
(apply char-set-delete cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-adjoin!) cs . rest)
|
|
(apply char-set-adjoin! cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-delete!) cs . rest)
|
|
(apply char-set-delete! cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-union) . rest)
|
|
(apply char-set-union rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-intersection) . rest)
|
|
(apply char-set-intersection rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-difference) cs . rest)
|
|
(apply char-set-difference cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-xor) . rest)
|
|
(apply char-set-xor rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-diff+intersection) cs . rest)
|
|
(apply char-set-diff+intersection cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-union!) . rest)
|
|
(apply char-set-union! rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-intersection!) . rest)
|
|
(apply char-set-intersection! rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-difference!) cs . rest)
|
|
(apply char-set-difference! cs rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-xor!) . rest)
|
|
(apply char-set-xor! rest))
|
|
(define-deprecated-trampoline (((srfi srfi-14) char-set-diff+intersection!) cs . rest)
|
|
(apply char-set-diff+intersection! cs rest))
|
|
(define-deprecated-trampolines (srfi srfi-14)
|
|
(char-set? x)
|
|
(char-set-cursor cs)
|
|
(char-set-ref cs cursor)
|
|
(char-set-cursor-next cs cursor)
|
|
(end-of-char-set? cursor)
|
|
(char-set-fold kons knil cs)
|
|
(char-set-unfold! p f g seed base-cs)
|
|
(char-set-for-each proc cs)
|
|
(char-set-map proc cs)
|
|
(char-set-copy cs)
|
|
(list->char-set! list base-cs)
|
|
(string->char-set! str base-cs)
|
|
(char-set-filter! pred cs base-cs)
|
|
(ucs-range->char-set! lower upper error base-cs)
|
|
(->char-set x)
|
|
(char-set-size cs)
|
|
(char-set-count pred cs)
|
|
(char-set->list cs)
|
|
(char-set->string cs)
|
|
(char-set-contains? cs ch)
|
|
(char-set-every pred cs)
|
|
(char-set-complement cs))
|
|
|
|
(define-syntax-rule (define-deprecated*/stx mod id ...)
|
|
(begin
|
|
(define-deprecated/stx mod id)
|
|
...))
|
|
(define-deprecated*/stx (srfi srfi-14)
|
|
;; Standard character sets
|
|
char-set:lower-case
|
|
char-set:upper-case
|
|
char-set:title-case
|
|
char-set:letter
|
|
char-set:digit
|
|
char-set:letter+digit
|
|
char-set:graphic
|
|
char-set:printing
|
|
char-set:whitespace
|
|
char-set:iso-control
|
|
char-set:punctuation
|
|
char-set:symbol
|
|
char-set:hex-digit
|
|
char-set:blank
|
|
char-set:ascii
|
|
char-set:empty
|
|
char-set:full)
|
|
|
|
(define-deprecated*/stx (system repl hooks)
|
|
before-error-hook
|
|
after-error-hook
|
|
before-read-hook
|
|
after-read-hook
|
|
before-eval-hook
|
|
after-eval-hook
|
|
before-print-hook
|
|
after-print-hook
|
|
exit-hook)
|
|
|
|
(define-deprecated*/stx (system repl reader)
|
|
repl-reader)
|
|
|
|
(define-deprecated*/stx (ice-9 scm-style-repl)
|
|
abort-hook
|
|
before-backtrace-hook
|
|
after-backtrace-hook)
|
|
|
|
(define-deprecated-trampoline (((ice-9 hooks) make-hook) #:optional arity)
|
|
(make-hook))
|
|
(define-deprecated-trampoline (((ice-9 hooks) add-hook!) hook f #:optional append?)
|
|
(add-hook! hook f #:append? append?))
|
|
(define-deprecated-trampoline (((ice-9 hooks) run-hook) hook . args)
|
|
(apply run-hook hook args))
|
|
|
|
(define-deprecated-trampolines (ice-9 hooks)
|
|
(hook? x)
|
|
(hook-empty? hook)
|
|
(remove-hook! hook proc)
|
|
(reset-hook! hook)
|
|
(hook->list hook))
|
|
|
|
(define module-defined-hook (make-hook 1))
|
|
(let ((prev (module-definition-observer)))
|
|
(module-definition-observer
|
|
(lambda (m)
|
|
(run-hook module-defined-hook m)
|
|
(prev m))))
|
|
|
|
(define-deprecated-trampolines (ice-9 promises)
|
|
(promise? x)
|
|
(make-promise thunk)
|
|
(force promise))
|
|
(define-deprecated*/stx (ice-9 promises) delay)
|
|
|
|
(cond-expand
|
|
;; FIXME: Don't include this if there is no regexp support!
|
|
((or regex guile)
|
|
(use-modules (ice-9 regex))
|
|
|
|
(define-deprecated-trampoline (((ice-9 regex) make-regexp) pat . flags)
|
|
(apply make-regexp pat flags))
|
|
(define-deprecated-trampoline (((ice-9 regex) regexp?) x)
|
|
(regexp? x))
|
|
(define-deprecated-trampoline (((ice-9 regex) regexp-exec) rx str #:optional (start 0) (flags 0))
|
|
(regexp-exec rx str start flags))
|
|
(define-deprecated*/stx (ice-9 regex)
|
|
regexp/basic
|
|
regexp/extended
|
|
regexp/icase
|
|
regexp/newline
|
|
regexp/notbol
|
|
regexp/noteol)
|
|
|
|
(export (make-regexp* . make-regexp)
|
|
(regexp?* . regexp?)
|
|
(regexp-exec* . regexp-exec)
|
|
(regexp/basic* . regexp/basic)
|
|
(regexp/extended* . regexp/extended)
|
|
(regexp/icase* . regexp/icase)
|
|
(regexp/newline* . regexp/newline)
|
|
(regexp/notbol* . regexp/notbol)
|
|
(regexp/noteol* . regexp/noteol)))
|
|
(else))
|