mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-02 02:10:19 +02:00
Code Activity

Remove all deprecated code from Scheme files

Browse source 
* module/ice-9/boot-9.scm(symbol-property, set-symbol-property!)
(symbol-property-remove!): Remove.
* module/ice-9/boot-9.scm (make-record-type): Name must be symbol.
(record-constructor): Alias record-type-constructor.
(make-module): Require size to be zero.  Should fix this with keyword
args :/
(try-load-module): Inline definition of try-module-autoload.  Remove
try-module-autoload binding.
(make-soft-port): Add deprecation warning, so we can remove it
eventually.
* module/ice-9/save-stack.scm: Remove deprecation comment.
* module/ice-9/top-repl.scm:
* module/ice-9/threads.scm: Export instead of replace bindings.
* module/language/bytecode.scm: Remove instruction-arity et al.
* module/language/tree-il/analyze.scm: Remove deprecated
unbound-variable-analysis and macro-use-before-definition-analysis.
* module/rnrs.scm: Fix syntax-case export now that module and value
namespaces are separate.
* module/system/base/language.scm (invalidate-compilation-cache!):
Remove.
* module/system/base/language.scm (*current-language*): Remove.
This commit is contained in:
Andy Wingo 2025-05-05 11:28:05 +02:00
parent 4c2a8c1dd3
commit 96589bd303
10 changed files with 49 additions and 361 deletions
Download patch file Download diff file Expand all files Collapse all files

1
am/bootstrap.am
View file

@ -154,7 +154,6 @@ SOURCES = \
ice-9/history.scm \
ice-9/i18n.scm \
ice-9/iconv.scm \
ice-9/lineio.scm \
ice-9/list.scm \
ice-9/local-eval.scm \
ice-9/ls.scm \

82
module/ice-9/boot-9.scm
View file

@ -849,30 +849,6 @@ VALUE."
;;; {Symbol Properties}
;;;
;;; Symbol properties are something you see in old Lisp code. In most current
;;; Guile code, symbols are not used as a data structure -- they are used as
;;; keys into other data structures.
(define (symbol-property sym prop)
(let ((pair (assoc prop (symbol-pref sym))))
(and pair (cdr pair))))
(define (set-symbol-property! sym prop val)
(let ((pair (assoc prop (symbol-pref sym))))
(if pair
(set-cdr! pair val)
(symbol-pset! sym (acons prop val (symbol-pref sym))))))
(define (symbol-property-remove! sym prop)
(let ((pair (assoc prop (symbol-pref sym))))
(if pair
(symbol-pset! sym (delq! pair (symbol-pref sym))))))
;;; {Arrays}
;;;
@ -1009,6 +985,9 @@ See also: @code{array-dimensions}, @code{array-rank}."
(define* (make-record-type type-name fields #:optional printer #:key
parent uid extensible? allow-duplicate-field-names?
(opaque? (and=> parent record-type-opaque?)))
(unless (symbol? type-name)
(error "expected a symbol for record type name" type-name))
;; Pre-generate constructors for nfields < 20.
(define-syntax make-constructor
(lambda (x)
@ -1127,17 +1106,6 @@ See also: @code{array-dimensions}, @code{array-rank}."
(logior mutable (ash 1 i))
mutable))))))
(define name-sym
(cond
((symbol? type-name) type-name)
((string? type-name)
(issue-deprecation-warning
"Passing a string as a type-name to make-record-type is deprecated."
" Pass a symbol instead.")
(string->symbol type-name))
(else
(error "expected a symbol for record type name" type-name))))
(define properties
(let ((maybe-acons (lambda (k v tail)
(if v (acons k v tail) tail))))
@ -1149,7 +1117,7 @@ See also: @code{array-dimensions}, @code{array-rank}."
(cond
((and uid (hashq-ref prefab-record-types uid))
=> (lambda (rtd)
(unless (and (equal? (record-type-name rtd) name-sym)
(unless (and (equal? (record-type-name rtd) type-name)
(equal? (record-type-fields rtd) computed-fields)
(not printer)
(equal? (record-type-properties rtd) properties)
@ -1165,7 +1133,7 @@ See also: @code{array-dimensions}, @code{array-rank}."
(apply string-append
(map (lambda (f) "pw") computed-fields)))
(or printer default-record-printer)
name-sym
type-name
computed-fields
#f ; Constructor initialized below.
properties
@ -1178,7 +1146,7 @@ See also: @code{array-dimensions}, @code{array-rank}."
;; Temporary solution: Associate a name to the record type
;; descriptor so that the object system can create a wrapper
;; class for it.
(set-struct-vtable-name! rtd name-sym)
(set-struct-vtable-name! rtd type-name)
(when uid
(unless (symbol? uid)
@ -1187,24 +1155,7 @@ See also: @code{array-dimensions}, @code{array-rank}."
rtd))))
(define record-constructor
(case-lambda
((rtd)
(record-type-constructor rtd))
((rtd field-names)
(issue-deprecation-warning
"Calling `record-constructor' with two arguments (the record type"
" and a list of field names) is deprecated. Instead, call with just"
" one argument, and provide a wrapper around that constructor if"
" needed.")
(primitive-eval
`(lambda ,field-names
(make-struct/no-tail ',rtd
,@(map (lambda (f)
(if (memq f field-names)
f
#f))
(record-type-fields rtd))))))))
(define record-constructor record-type-constructor)
(define (record-predicate rtd)
(unless (record-type? rtd)
@ -2551,12 +2502,8 @@ name extensions listed in %load-extensions."
(define* (make-module #:optional (size 0) (uses '()) (binder #f))
"Create a new module, perhaps with a particular size of obarray,
initial uses list, or binding procedure."
(unless (integer? size)
(error "Illegal size to make-module." size))
(unless (zero? size)
(issue-deprecation-warning
"Passing a non-zero size argument to `make-module' is deprecated. "
"Omit the argument or pass zero instead."))
(unless (eq? size 0)
(error "Invalid size to make-module." size))
(unless (and (list? uses) (and-map module? uses))
(error "Incorrect use list." uses))
(when (and binder (not (procedure? binder)))
@ -3289,9 +3236,6 @@ deterministic."
(make-modules-in root name)))))))))))
(define (try-load-module name version)
(try-module-autoload name version))
(define (reload-module m)
"Revisit the source file corresponding to the module @var{m}."
(let ((f (module-filename m)))
@ -3543,10 +3487,7 @@ module '(ice-9 q) '(make-q q-length))}."
(define autoloads-in-progress '())
;; This function is called from scm_load_scheme_module in
;; "deprecated.c". Please do not change its interface.
;;
(define* (try-module-autoload module-name #:optional version)
(define* (try-load-module module-name #:optional version)
"Try to load a module of the given name. If it is not found, return
#f. Otherwise return #t. May raise an exception if a file is found,
but it fails to load."
@ -4735,6 +4676,9 @@ R7RS."
;;;
(define (make-soft-port pv modes)
(issue-deprecation-warning
"make-soft-port in the default environment is deprecated. Import "
"(ice-9 soft-ports) instead, which has a better interface.")
((module-ref (resolve-interface '(ice-9 soft-ports))
'deprecated-make-soft-port)
pv modes))

119
module/ice-9/lineio.scm
View file

@ -1,119 +0,0 @@
;;; installed-scm-file
;;;; Copyright (C) 1996, 1998, 2001, 2003, 2006, 2023 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 lineio)
:use-module (ice-9 rdelim)
:export (unread-string read-string lineio-port?
make-line-buffering-input-port))
(issue-deprecation-warning
"(ice-9 lineio) is deprecated. Use read-line together with
unread-string instead.")
;;; {Line Buffering Input Ports}
;;;
;;; [This is a work-around to get past certain deficiencies in the capabilities
;;; of ports. Eventually, ports should be fixed and this module nuked.]
;;;
;;; A line buffering input port supports:
;;;
;;; read-string which returns the next line of input
;;; unread-string which pushes a line back onto the stream
;;;
;;; The implementation of unread-string is kind of limited; it doesn't
;;; interact properly with unread-char, or any of the other port
;;; reading functions. Only read-string will get you back the things that
;;; unread-string accepts.
;;;
;;; Normally a "line" is all characters up to and including a newline.
;;; If lines are put back using unread-string, they can be broken arbitrarily
;;; -- that is, read-string returns strings passed to unread-string (or
;;; shared substrings of them).
;;;
;; read-string port
;; unread-string port str
;; Read (or buffer) a line from PORT.
;;
;; Not all ports support these functions -- only those with
;; 'unread-string and 'read-string properties, bound to hooks
;; implementing these functions.
;;
(define (unread-string str line-buffering-input-port)
((object-property line-buffering-input-port 'unread-string) str))
;;
(define (read-string line-buffering-input-port)
((object-property line-buffering-input-port 'read-string)))
(define (lineio-port? port)
(not (not (object-property port 'read-string))))
;; make-line-buffering-input-port port
;; Return a wrapper for PORT. The wrapper handles read-string/unread-string.
;;
;; The port returned by this function reads newline terminated lines from PORT.
;; It buffers these characters internally, and parsels them out via calls
;; to read-char, read-string, and unread-string.
;;
(define (make-line-buffering-input-port underlying-port)
(let* (;; buffers - a list of strings put back by unread-string or cached
;; using read-line.
;;
(buffers '())
;; getc - return the next character from a buffer or from the underlying
;; port.
;;
(getc (lambda ()
(if (not buffers)
(read-char underlying-port)
(let ((c (string-ref (car buffers) 0)))
(if (= 1 (string-length (car buffers)))
(set! buffers (cdr buffers))
(set-car! buffers (substring (car buffers) 1)))
c))))
(propogate-close (lambda () (close-port underlying-port)))
(self (make-soft-port (vector #f #f #f getc propogate-close) "r"))
(unread-string (lambda (str)
(and (< 0 (string-length str))
(set! buffers (cons str buffers)))))
(read-string (lambda ()
(cond
((not (null? buffers))
(let ((answer (car buffers)))
(set! buffers (cdr buffers))
answer))
(else
(read-line underlying-port 'concat)))))) ;handle-newline->concat
(set-object-property! self 'unread-string unread-string)
(set-object-property! self 'read-string read-string)
self))

3
module/ice-9/save-stack.scm
View file

@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2014
;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2014,2025
;;;; Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
@ -30,7 +30,6 @@
;;; Code:
(define-module (ice-9 save-stack)
;; Replace deprecated root-module bindings, if present.
#:export (stack-saved?
the-last-stack
save-stack))

59
module/ice-9/threads.scm
View file

@ -1,5 +1,5 @@
;;;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2006, 2010, 2011,
;;;; 2012, 2018 Free Software Foundation, Inc.
;;;; 2012, 2018, 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
@ -31,37 +31,32 @@
(define-module (ice-9 threads)
#:use-module (ice-9 match)
;; These bindings are marked as #:replace because when deprecated code
;; is enabled, (ice-9 deprecated) also exports these names.
;; (Referencing one of the deprecated names prints a warning directing
;; the user to these bindings.) Anyway once we can remove the
;; deprecated bindings, we should use #:export instead of #:replace
;; for these.
#:replace (call-with-new-thread
yield
cancel-thread
join-thread
thread?
make-mutex
make-recursive-mutex
lock-mutex
try-mutex
unlock-mutex
mutex?
mutex-owner
mutex-level
mutex-locked?
make-condition-variable
wait-condition-variable
signal-condition-variable
broadcast-condition-variable
condition-variable?
current-thread
all-threads
thread-exited?
total-processor-count
current-processor-count)
#:export (begin-thread
#:export (call-with-new-thread
yield
cancel-thread
join-thread
thread?
make-mutex
make-recursive-mutex
lock-mutex
try-mutex
unlock-mutex
mutex?
mutex-owner
mutex-level
mutex-locked?
make-condition-variable
wait-condition-variable
signal-condition-variable
broadcast-condition-variable
condition-variable?
current-thread
all-threads
thread-exited?
total-processor-count
current-processor-count
begin-thread
make-thread
with-mutex
monitor

6
module/ice-9/top-repl.scm
View file

@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;; Copyright (C) 1995-2011,2013,2019 Free Software Foundation, Inc.
;;;; Copyright (C) 1995-2011,2013,2019,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
@ -20,9 +20,7 @@
(define-module (ice-9 top-repl)
#:use-module (ice-9 top-repl)
#:use-module ((system repl repl) #:select (start-repl))
;; #:replace, as with deprecated code enabled these will be in the root env
#:replace (top-repl))
#:export (top-repl))
(define call-with-sigint
(if (not (provided? 'posix))

85
module/language/bytecode.scm
View file

@ -1,6 +1,6 @@
;;; Bytecode
;; Copyright (C) 2013, 2017, 2018, 2020 Free Software Foundation, Inc.
;; Copyright (C) 2013, 2017, 2018, 2020, 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
@ -34,89 +34,6 @@
(load-extension (string-append "libguile-" (effective-version))
"scm_init_intrinsics")
(begin-deprecated
(define (compute-instruction-arity name args)
(define (first-word-arity word)
(case word
((X32) 0)
((X8_S24) 1)
((X8_F24) 1)
((X8_C24) 1)
((X8_L24) 1)
((X8_S8_I16) 2)
((X8_S8_ZI16) 2)
((X8_S12_S12) 2)
((X8_S12_C12) 2)
((X8_S12_Z12) 2)
((X8_C12_C12) 2)
((X8_F12_F12) 2)
((X8_S8_S8_S8) 3)
((X8_S8_S8_C8) 3)
((X8_S8_C8_S8) 3)))
(define (tail-word-arity word)
(case word
((C32) 1)
((I32) 1)
((A32 AU32 AS32 AF32) 1)
((B32 BF32 BS32 BU32) 0)
((N32) 1)
((R32) 1)
((L32) 1)
((LO32) 1)
((C8_C24) 2)
((C8_S24) 2)
((C16_C16) 2)
((B1_C7_L24) 3)
((B1_X7_S24) 2)
((B1_X7_F24) 2)
((B1_X7_C24) 2)
((B1_X7_L24) 2)
((B1_X31) 1)
((X8_S24) 1)
((X8_F24) 1)
((X8_C24) 1)
((X8_L24) 1)))
(match args
((arg0 . args)
(fold (lambda (arg arity)
(+ (tail-word-arity arg) arity))
(first-word-arity arg0)
args))))
(define *macro-instruction-arities*
'((cache-current-module! . (0 . 1))
(cached-toplevel-box . (1 . 0))
(cached-module-box . (1 . 0))))
(define (compute-instruction-arities)
(issue-deprecation-warning
"`instruction-arity' is deprecated. Instead, use instruction-list directly
if needed.")
(let ((table (make-hash-table)))
(for-each
(match-lambda
;; Put special cases here.
(('jtable . _)
;; No macro-instruction.
#f)
((name op '! . args)
(hashq-set! table name
(cons 0 (compute-instruction-arity name args))))
((name op '<- . args)
(hashq-set! table name
(cons 1 (1- (compute-instruction-arity name args))))))
(instruction-list))
(for-each (match-lambda
((name . arity)
(hashq-set! table name arity)))
*macro-instruction-arities*)
table))
(define *instruction-arities* (delay (compute-instruction-arities)))
(define-public (instruction-arity name)
(hashq-ref (force *instruction-arities*) name)))
(define *intrinsic-codes*
(delay (let ((tab (make-hash-table)))
(for-each (lambda (pair)

22
module/language/tree-il/analyze.scm
View file

@ -1,6 +1,6 @@
;;; Diagnostic warnings for Tree-IL
;; Copyright (C) 2001,2008-2014,2016,2018-2023 Free Software Foundation, Inc.
;; Copyright (C) 2001,2008-2014,2016,2018-2023,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
@ -1410,26 +1410,6 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
#t))
(begin-deprecated
(define-syntax unbound-variable-analysis
(identifier-syntax
(begin
(issue-deprecation-warning
"`unbound-variable-analysis' is deprecated. "
"Use `make-use-before-definition-analysis' instead.")
(make-use-before-definition-analysis
#:enabled-warnings '(unbound-variable)))))
(define-syntax macro-use-before-definition-analysis
(identifier-syntax
(begin
(issue-deprecation-warning
"`macro-use-before-definition-analysis' is deprecated. "
"Use `make-use-before-definition-analysis' instead.")
(make-use-before-definition-analysis
#:enabled-warnings '(macro-use-before-definition)))))
(export unbound-variable-analysis
macro-use-before-definition-analysis))
(define-syntax-rule (define-analysis make-analysis
#:level level #:kind kind #:analysis analysis)
(define* (make-analysis #:key (warning-level 0) (enabled-warnings '()))

15
module/rnrs.scm
View file

@ -1,6 +1,6 @@
;;; rnrs.scm --- The R6RS composite library
;; Copyright (C) 2010, 2011, 2019 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011, 2019, 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
@ -235,14 +235,7 @@
;; (rnrs syntax-case)
make-variable-transformer syntax
;; Until the deprecated support for a unified modules and
;; bindings namespace is removed, we need to manually resolve
;; a conflict between two bindings: that of the (rnrs
;; syntax-case) module, and the imported `syntax-case'
;; binding. We do so here and below by renaming the macro
;; import.
(rename (syntax-case-hack syntax-case))
make-variable-transformer syntax syntax-case
identifier? bound-identifier=? free-identifier=?
syntax->datum datum->syntax generate-temporaries with-syntax
quasisyntax unsyntax unsyntax-splicing syntax-violation
@ -283,7 +276,5 @@
(rnrs records procedural (6))
(rnrs records syntactic (6))
(rnrs sorting (6))
;; See note above on exporting syntax-case.
(rename (rnrs syntax-case (6))
(syntax-case syntax-case-hack))
(rnrs syntax-case (6))
(rnrs unicode (6))))

18
module/system/base/language.scm
View file

@ -1,6 +1,6 @@
;;; Multi-language support
;; Copyright (C) 2001,2005,2008-2011,2013,2020 Free Software Foundation, Inc.
;; Copyright (C) 2001,2005,2008-2011,2013,2020,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
@ -65,12 +65,6 @@
(module-ref m name)
(error "no such language" name))))
(begin-deprecated
(define-public (invalidate-compilation-cache!)
(issue-deprecation-warning
"invalidate-compilation-cache is deprecated; recompile your modules")
(values)))
(define (compute-translation-order from to language-translators)
(cond
((not (language? to))
@ -97,13 +91,3 @@
"Return the default compilation environment for source language LANG."
((language-make-default-environment
(if (language? lang) lang (lookup-language lang)))))
;;;
;;; Current language
;;;
;; Deprecated; use current-language instead.
(begin-deprecated
(define-public *current-language* (parameter-fluid current-language)))