module/ice-9/deprecated.scm

   1 ;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010 Free Software Foundation, Inc.
   2 ;;;;
   3 ;;;; This library is free software; you can redistribute it and/or
   4 ;;;; modify it under the terms of the GNU Lesser General Public
   5 ;;;; License as published by the Free Software Foundation; either
   6 ;;;; version 3 of the License, or (at your option) any later version.
   7 ;;;;
   8 ;;;; This library is distributed in the hope that it will be useful,
   9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;;;; Lesser General Public License for more details.
  12 ;;;;
  13 ;;;; You should have received a copy of the GNU Lesser General Public
  14 ;;;; License along with this library; if not, write to the Free Software
  15 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16 ;;;;
  17
  18 (define-module (ice-9 deprecated)
  19   #:export (substring-move-left! substring-move-right!
  20             dynamic-maybe-call dynamic-maybe-link
  21             try-module-linked try-module-dynamic-link
  22             list* feature? eval-case unmemoize-expr
  23             $asinh
  24             $acosh
  25             $atanh
  26             $sqrt
  27             $abs
  28             $exp
  29             $log
  30             $sin
  31             $cos
  32             $tan
  33             $asin
  34             $acos
  35             $atan
  36             $sinh
  37             $cosh
  38             $tanh
  39             closure?
  40             %nil
  41             @bind
  42             bad-throw
  43             error-catching-loop
  44             error-catching-repl
  45             scm-style-repl
  46             apply-to-args
  47             has-suffix?
  48             scheme-file-suffix
  49             get-option
  50             for-next-option
  51             display-usage-report
  52             transform-usage-lambda
  53             collect
  54             assert-repl-silence
  55             assert-repl-print-unspecified
  56             assert-repl-verbosity
  57             set-repl-prompt!
  58             set-batch-mode?!
  59             repl
  60             pre-unwind-handler-dispatch
  61             default-pre-unwind-handler
  62             handle-system-error
  63             stack-saved?
  64             the-last-stack
  65             save-stack)
  66
  67   #:replace (module-ref-submodule module-define-submodule!))
  68
  69
  70 ;;;; Deprecated definitions.
  71
  72 (define substring-move-left! substring-move!)
  73 (define substring-move-right! substring-move!)
  74
  75 \f
  76 ;; This method of dynamically linking Guile Extensions is deprecated.
  77 ;; Use `load-extension' explicitly from Scheme code instead.
  78
  79 (define (split-c-module-name str)
  80   (let loop ((rev '())
  81              (start 0)
  82              (pos 0)
  83              (end (string-length str)))
  84     (cond
  85      ((= pos end)
  86       (reverse (cons (string->symbol (substring str start pos)) rev)))
  87      ((eq? (string-ref str pos) #\space)
  88       (loop (cons (string->symbol (substring str start pos)) rev)
  89             (+ pos 1)
  90             (+ pos 1)
  91             end))
  92      (else
  93       (loop rev start (+ pos 1) end)))))
  94
  95 (define (convert-c-registered-modules dynobj)
  96   (let ((res (map (lambda (c)
  97                     (list (split-c-module-name (car c)) (cdr c) dynobj))
  98                   (c-registered-modules))))
  99     (c-clear-registered-modules)
 100     res))
 101
 102 (define registered-modules '())
 103
 104 (define (register-modules dynobj)
 105   (set! registered-modules
 106         (append! (convert-c-registered-modules dynobj)
 107                  registered-modules)))
 108
 109 (define (warn-autoload-deprecation modname)
 110   (issue-deprecation-warning
 111    "Autoloading of compiled code modules is deprecated."
 112    "Write a Scheme file instead that uses `load-extension'.")
 113   (issue-deprecation-warning
 114    (simple-format #f "(You just autoloaded module ~S.)" modname)))
 115
 116 (define (init-dynamic-module modname)
 117   ;; Register any linked modules which have been registered on the C level
 118   (register-modules #f)
 119   (or-map (lambda (modinfo)
 120             (if (equal? (car modinfo) modname)
 121                 (begin
 122                   (warn-autoload-deprecation modname)
 123                   (set! registered-modules (delq! modinfo registered-modules))
 124                   (let ((mod (resolve-module modname #f)))
 125                     (save-module-excursion
 126                      (lambda ()
 127                        (set-current-module mod)
 128                        (set-module-public-interface! mod mod)
 129                        (dynamic-call (cadr modinfo) (caddr modinfo))
 130                        ))
 131                     #t))
 132                 #f))
 133           registered-modules))
 134
 135 (define (dynamic-maybe-call name dynobj)
 136   (catch #t                             ; could use false-if-exception here
 137          (lambda ()
 138            (dynamic-call name dynobj))
 139          (lambda args
 140            #f)))
 141
 142 (define (dynamic-maybe-link filename)
 143   (catch #t                             ; could use false-if-exception here
 144          (lambda ()
 145            (dynamic-link filename))
 146          (lambda args
 147            #f)))
 148
 149 (define (find-and-link-dynamic-module module-name)
 150   (define (make-init-name mod-name)
 151     (string-append "scm_init"
 152                    (list->string (map (lambda (c)
 153                                         (if (or (char-alphabetic? c)
 154                                                 (char-numeric? c))
 155                                             c
 156                                             #\_))
 157                                       (string->list mod-name)))
 158                    "_module"))
 159
 160   ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
 161   ;; and the `libname' (the name of the module prepended by `lib') in the cdr
 162   ;; field.  For example, if MODULE-NAME is the list (inet tcp-ip udp), then
 163   ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
 164   (let ((subdir-and-libname
 165          (let loop ((dirs "")
 166                     (syms module-name))
 167            (if (null? (cdr syms))
 168                (cons dirs (string-append "lib" (symbol->string (car syms))))
 169                (loop (string-append dirs (symbol->string (car syms)) "/")
 170                      (cdr syms)))))
 171         (init (make-init-name (apply string-append
 172                                      (map (lambda (s)
 173                                             (string-append "_"
 174                                                            (symbol->string s)))
 175                                           module-name)))))
 176     (let ((subdir (car subdir-and-libname))
 177           (libname (cdr subdir-and-libname)))
 178
 179       ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'.  If that
 180       ;; file exists, fetch the dlname from that file and attempt to link
 181       ;; against it.  If `subdir/libfoo.la' does not exist, or does not seem
 182       ;; to name any shared library, look for `subdir/libfoo.so' instead and
 183       ;; link against that.
 184       (let check-dirs ((dir-list %load-path))
 185         (if (null? dir-list)
 186             #f
 187             (let* ((dir (in-vicinity (car dir-list) subdir))
 188                    (sharlib-full
 189                     (or (try-using-libtool-name dir libname)
 190                         (try-using-sharlib-name dir libname))))
 191               (if (and sharlib-full (file-exists? sharlib-full))
 192                   (link-dynamic-module sharlib-full init)
 193                   (check-dirs (cdr dir-list)))))))))
 194
 195 (define (try-using-libtool-name libdir libname)
 196   (let ((libtool-filename (in-vicinity libdir
 197                                        (string-append libname ".la"))))
 198     (and (file-exists? libtool-filename)
 199          libtool-filename)))
 200
 201 (define (try-using-sharlib-name libdir libname)
 202   (in-vicinity libdir (string-append libname ".so")))
 203
 204 (define (link-dynamic-module filename initname)
 205   ;; Register any linked modules which have been registered on the C level
 206   (register-modules #f)
 207   (let ((dynobj (dynamic-link filename)))
 208     (dynamic-call initname dynobj)
 209     (register-modules dynobj)))
 210
 211 (define (try-module-linked module-name)
 212   (init-dynamic-module module-name))
 213
 214 (define (try-module-dynamic-link module-name)
 215   (and (find-and-link-dynamic-module module-name)
 216        (init-dynamic-module module-name)))
 217
 218 \f
 219 (define (list* . args)
 220   (issue-deprecation-warning "'list*' is deprecated.  Use 'cons*' instead.")
 221   (apply cons* args))
 222
 223 (define (feature? sym)
 224   (issue-deprecation-warning
 225    "`feature?' is deprecated.  Use `provided?' instead.")
 226   (provided? sym))
 227
 228 (define-macro (eval-case . clauses)
 229   (issue-deprecation-warning
 230    "`eval-case' is deprecated.  Use `eval-when' instead.")
 231   ;; Practically speaking, eval-case only had load-toplevel and else as
 232   ;; conditions.
 233   (cond
 234    ((assoc-ref clauses '(load-toplevel))
 235     => (lambda (exps)
 236          ;; the *unspecified so that non-toplevel definitions will be
 237          ;; caught
 238          `(begin *unspecified* . ,exps)))
 239    ((assoc-ref clauses 'else)
 240     => (lambda (exps)
 241          `(begin *unspecified* . ,exps)))
 242    (else
 243     `(begin))))
 244
 245 ;; The strange prototype system for uniform arrays has been
 246 ;; deprecated.
 247 (read-hash-extend
 248  #\y
 249  (lambda (c port)
 250    (issue-deprecation-warning
 251     "The `#y' bitvector syntax is deprecated.  Use `#*' instead.")
 252    (let ((x (read port)))
 253      (cond
 254       ((list? x)
 255        (list->bitvector
 256         (map (lambda (x)
 257                (cond ((zero? x) #f)
 258                      ((eqv? x 1) #t)
 259                      (else (error "invalid #y element" x))))
 260              x)))
 261       (else
 262        (error "#y needs to be followed by a list" x))))))
 263
 264 (define (unmemoize-expr . args)
 265   (issue-deprecation-warning
 266    "`unmemoize-expr' is deprecated. Use `unmemoize-expression' instead.")
 267   (apply unmemoize-expression args))
 268
 269 (define ($asinh z) (asinh z))
 270 (define ($acosh z) (acosh z))
 271 (define ($atanh z) (atanh z))
 272 (define ($sqrt z) (sqrt z))
 273 (define ($abs z) (abs z))
 274 (define ($exp z) (exp z))
 275 (define ($log z) (log z))
 276 (define ($sin z) (sin z))
 277 (define ($cos z) (cos z))
 278 (define ($tan z) (tan z))
 279 (define ($asin z) (asin z))
 280 (define ($acos z) (acos z))
 281 (define ($atan z) (atan z))
 282 (define ($sinh z) (sinh z))
 283 (define ($cosh z) (cosh z))
 284 (define ($tanh z) (tanh z))
 285
 286 (define (closure? x)
 287   (issue-deprecation-warning
 288    "`closure?' is deprecated. Use `procedure?' instead.")
 289   (procedure? x))
 290
 291 (define %nil #nil)
 292
 293 ;;; @bind is used by the old elisp code as a dynamic scoping mechanism.
 294 ;;; Please let the Guile developers know if you are using this macro.
 295 ;;;
 296 (define-syntax @bind
 297   (lambda (x)
 298     (define (bound-member id ids)
 299       (cond ((null? ids) #f)
 300             ((bound-identifier=? id (car ids)) #t)
 301             ((bound-member (car ids) (cdr ids)))))
 302
 303     (issue-deprecation-warning
 304      "`@bind' is deprecated. Use `with-fluids' instead.")
 305
 306     (syntax-case x ()
 307       ((_ () b0 b1 ...)
 308        #'(let () b0 b1 ...))
 309       ((_ ((id val) ...) b0 b1 ...)
 310        (and-map identifier? #'(id ...))
 311        (if (let lp ((ids #'(id ...)))
 312              (cond ((null? ids) #f)
 313                    ((bound-member (car ids) (cdr ids)) #t)
 314                    (else (lp (cdr ids)))))
 315            (syntax-violation '@bind "duplicate bound identifier" x)
 316            (with-syntax (((old-v ...) (generate-temporaries #'(id ...)))
 317                          ((v ...) (generate-temporaries #'(id ...))))
 318              #'(let ((old-v id) ...
 319                      (v val) ...)
 320                  (dynamic-wind
 321                    (lambda ()
 322                      (set! id v) ...)
 323                    (lambda () b0 b1 ...)
 324                    (lambda ()
 325                      (set! id old-v) ...)))))))))
 326
 327 (define (module-ref-submodule module name)
 328   (or (hashq-ref (module-submodules module) name)
 329       (and (module-submodule-binder module)
 330            ((module-submodule-binder module) module name))
 331       (let ((var (module-local-variable module name)))
 332         (and (variable-bound? var)
 333              (module? (variable-ref var))
 334              (begin
 335                (warn "module" module "not in submodules table")
 336                (variable-ref var))))))
 337
 338 (define (module-define-submodule! module name submodule)
 339   (let ((var (module-local-variable module name)))
 340     (if (and var (variable-bound? var) (not (module? (variable-ref var))))
 341         (warn "defining module" module ": not overriding local definition" var)
 342         (module-define! module name submodule)))
 343   (hashq-set! (module-submodules module) name submodule))
 344
 345 ;; Define (%app) and (%app modules), and have (app) alias (%app). This
 346 ;; side-effects the-root-module, both to the submodules table and (through
 347 ;; module-define-submodule! above) the obarray.
 348 ;;
 349 (let ((%app (make-module 31)))
 350   (set-module-name! %app '(%app))
 351   (module-define-submodule! the-root-module '%app %app)
 352   (module-define-submodule! the-root-module 'app %app)
 353   (module-define-submodule! %app 'modules (resolve-module '() #f)))
 354
 355 ;; Allow code that poked %module-public-interface to keep on working.
 356 ;;
 357 (set! module-public-interface
 358       (let ((getter module-public-interface))
 359         (lambda (mod)
 360           (or (getter mod)
 361               (cond
 362                ((and=> (module-local-variable mod '%module-public-interface)
 363                        variable-ref)
 364                 => (lambda (iface)
 365                      (issue-deprecation-warning
 366 "Setting a module's public interface via munging %module-public-interface is
 367 deprecated. Use set-module-public-interface! instead.")
 368                      (set-module-public-interface! mod iface)
 369                      iface))
 370                (else #f))))))
 371
 372 (set! set-module-public-interface!
 373       (let ((setter set-module-public-interface!))
 374         (lambda (mod iface)
 375           (setter mod iface)
 376           (module-define! mod '%module-public-interface iface))))
 377
 378 (define (bad-throw key . args)
 379   (issue-deprecation-warning
 380    "`bad-throw' in the default environment is deprecated.
 381 Find it in the `(ice-9 scm-style-repl)' module instead.")
 382   (apply (@ (ice-9 scm-style-repl) bad-throw) key args))
 383
 384 (define (error-catching-loop thunk)
 385   (issue-deprecation-warning
 386    "`error-catching-loop' in the default environment is deprecated.
 387 Find it in the `(ice-9 scm-style-repl)' module instead.")
 388   ((@ (ice-9 scm-style-repl) error-catching-loop) thunk))
 389
 390 (define (error-catching-repl r e p)
 391   (issue-deprecation-warning
 392    "`error-catching-repl' in the default environment is deprecated.
 393 Find it in the `(ice-9 scm-style-repl)' module instead.")
 394   ((@ (ice-9 scm-style-repl) error-catching-repl) r e p))
 395
 396 (define (scm-style-repl)
 397   (issue-deprecation-warning
 398    "`scm-style-repl' in the default environment is deprecated.
 399 Find it in the `(ice-9 scm-style-repl)' module instead, or
 400 better yet, use the repl from `(system repl repl)'.")
 401   ((@ (ice-9 scm-style-repl) scm-style-repl)))
 402
 403
 404 ;;; Apply-to-args had the following comment attached to it in boot-9, but it's
 405 ;;; wrong-headed: in the mentioned case, a point should either be a record or
 406 ;;; multiple values.
 407 ;;;
 408 ;;; apply-to-args is functionally redundant with apply and, worse,
 409 ;;; is less general than apply since it only takes two arguments.
 410 ;;;
 411 ;;; On the other hand, apply-to-args is a syntacticly convenient way to
 412 ;;; perform binding in many circumstances when the "let" family of
 413 ;;; of forms don't cut it.  E.g.:
 414 ;;;
 415 ;;;     (apply-to-args (return-3d-mouse-coords)
 416 ;;;       (lambda (x y z)
 417 ;;;             ...))
 418 ;;;
 419
 420 (define (apply-to-args args fn)
 421   (issue-deprecation-warning
 422    "`apply-to-args' is deprecated. Include a local copy in your program.")
 423   (apply fn args))
 424
 425 (define (has-suffix? str suffix)
 426   (issue-deprecation-warning
 427    "`has-suffix?' is deprecated. Use `string-suffix?' instead (args reversed).")
 428   (string-suffix? suffix str))
 429
 430 (define scheme-file-suffix
 431   (lambda ()
 432     (issue-deprecation-warning
 433      "`scheme-file-suffix' is deprecated. Use `%load-extensions' instead.")
 434     ".scm"))
 435
 436 \f
 437
 438 ;;; {Command Line Options}
 439 ;;;
 440
 441 (define (get-option argv kw-opts kw-args return)
 442   (issue-deprecation-warning
 443    "`get-option' is deprecated. Use `(ice-9 getopt-long)' instead.")
 444   (cond
 445    ((null? argv)
 446     (return #f #f argv))
 447
 448    ((or (not (eq? #\- (string-ref (car argv) 0)))
 449         (eq? (string-length (car argv)) 1))
 450     (return 'normal-arg (car argv) (cdr argv)))
 451
 452    ((eq? #\- (string-ref (car argv) 1))
 453     (let* ((kw-arg-pos (or (string-index (car argv) #\=)
 454                            (string-length (car argv))))
 455            (kw (symbol->keyword (substring (car argv) 2 kw-arg-pos)))
 456            (kw-opt? (member kw kw-opts))
 457            (kw-arg? (member kw kw-args))
 458            (arg (or (and (not (eq? kw-arg-pos (string-length (car argv))))
 459                          (substring (car argv)
 460                                     (+ kw-arg-pos 1)
 461                                     (string-length (car argv))))
 462                     (and kw-arg?
 463                          (begin (set! argv (cdr argv)) (car argv))))))
 464       (if (or kw-opt? kw-arg?)
 465           (return kw arg (cdr argv))
 466           (return 'usage-error kw (cdr argv)))))
 467
 468    (else
 469     (let* ((char (substring (car argv) 1 2))
 470            (kw (symbol->keyword char)))
 471       (cond
 472
 473        ((member kw kw-opts)
 474         (let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
 475                (new-argv (if (= 0 (string-length rest-car))
 476                              (cdr argv)
 477                              (cons (string-append "-" rest-car) (cdr argv)))))
 478           (return kw #f new-argv)))
 479
 480        ((member kw kw-args)
 481         (let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
 482                (arg (if (= 0 (string-length rest-car))
 483                         (cadr argv)
 484                         rest-car))
 485                (new-argv (if (= 0 (string-length rest-car))
 486                              (cddr argv)
 487                              (cdr argv))))
 488           (return kw arg new-argv)))
 489
 490        (else (return 'usage-error kw argv)))))))
 491
 492 (define (for-next-option proc argv kw-opts kw-args)
 493   (issue-deprecation-warning
 494    "`for-next-option' is deprecated. Use `(ice-9 getopt-long)' instead.")
 495   (let loop ((argv argv))
 496     (get-option argv kw-opts kw-args
 497                 (lambda (opt opt-arg argv)
 498                   (and opt (proc opt opt-arg argv loop))))))
 499
 500 (define (display-usage-report kw-desc)
 501   (issue-deprecation-warning
 502    "`display-usage-report' is deprecated. Use `(ice-9 getopt-long)' instead.")
 503   (for-each
 504    (lambda (kw)
 505      (or (eq? (car kw) #t)
 506          (eq? (car kw) 'else)
 507          (let* ((opt-desc kw)
 508                 (help (cadr opt-desc))
 509                 (opts (car opt-desc))
 510                 (opts-proper (if (string? (car opts)) (cdr opts) opts))
 511                 (arg-name (if (string? (car opts))
 512                               (string-append "<" (car opts) ">")
 513                               ""))
 514                 (left-part (string-append
 515                             (with-output-to-string
 516                               (lambda ()
 517                                 (map (lambda (x) (display (keyword->symbol x)) (display " "))
 518                                      opts-proper)))
 519                             arg-name))
 520                 (middle-part (if (and (< (string-length left-part) 30)
 521                                       (< (string-length help) 40))
 522                                  (make-string (- 30 (string-length left-part)) #\ )
 523                                  "\n\t")))
 524            (display left-part)
 525            (display middle-part)
 526            (display help)
 527            (newline))))
 528    kw-desc))
 529
 530 (define (transform-usage-lambda cases)
 531   (issue-deprecation-warning
 532    "`display-usage-report' is deprecated. Use `(ice-9 getopt-long)' instead.")
 533   (let* ((raw-usage (delq! 'else (map car cases)))
 534          (usage-sans-specials (map (lambda (x)
 535                                     (or (and (not (list? x)) x)
 536                                         (and (symbol? (car x)) #t)
 537                                         (and (boolean? (car x)) #t)
 538                                         x))
 539                                   raw-usage))
 540          (usage-desc (delq! #t usage-sans-specials))
 541          (kw-desc (map car usage-desc))
 542          (kw-opts (apply append (map (lambda (x) (and (not (string? (car x))) x)) kw-desc)))
 543          (kw-args (apply append (map (lambda (x) (and (string? (car x)) (cdr x))) kw-desc)))
 544          (transmogrified-cases (map (lambda (case)
 545                                       (cons (let ((opts (car case)))
 546                                               (if (or (boolean? opts) (eq? 'else opts))
 547                                                   opts
 548                                                   (cond
 549                                                    ((symbol? (car opts))  opts)
 550                                                    ((boolean? (car opts)) opts)
 551                                                    ((string? (caar opts)) (cdar opts))
 552                                                    (else (car opts)))))
 553                                             (cdr case)))
 554                                     cases)))
 555     `(let ((%display-usage (lambda () (display-usage-report ',usage-desc))))
 556        (lambda (%argv)
 557          (let %next-arg ((%argv %argv))
 558            (get-option %argv
 559                        ',kw-opts
 560                        ',kw-args
 561                        (lambda (%opt %arg %new-argv)
 562                          (case %opt
 563                            ,@ transmogrified-cases))))))))
 564
 565 \f
 566
 567 ;;; {collect}
 568 ;;;
 569 ;;; Similar to `begin' but returns a list of the results of all constituent
 570 ;;; forms instead of the result of the last form.
 571 ;;;
 572
 573 (define-syntax collect
 574   (lambda (x)
 575     (issue-deprecation-warning
 576      "`collect' is deprecated. Define it yourself.")
 577     (syntax-case x ()
 578       ((_) #''())
 579       ((_ x x* ...)
 580        #'(let ((val x))
 581            (cons val (collect x* ...)))))))
 582
 583
 584 \f
 585
 586 (define (assert-repl-silence v)
 587   (issue-deprecation-warning
 588    "`assert-repl-silence' has moved to `(ice-9 scm-style-repl)'.")
 589   ((@ (ice-9 scm-style-repl) assert-repl-silence) v))
 590
 591 (define (assert-repl-print-unspecified v)
 592   (issue-deprecation-warning
 593    "`assert-repl-print-unspecified' has moved to `(ice-9 scm-style-repl)'.")
 594   ((@ (ice-9 scm-style-repl) assert-repl-print-unspecified) v))
 595
 596 (define (assert-repl-verbosity v)
 597   (issue-deprecation-warning
 598    "`assert-repl-verbosity' has moved to `(ice-9 scm-style-repl)'.")
 599   ((@ (ice-9 scm-style-repl) assert-repl-verbosity) v))
 600
 601 (define (set-repl-prompt! v)
 602   (issue-deprecation-warning
 603    "`set-repl-prompt!' is deprecated. Use `repl-default-prompt-set!' from
 604 the `(system repl common)' module.")
 605   ((@ (system repl common) repl-default-prompt-set!) v))
 606
 607 (define (set-batch-mode?! arg)
 608   (cond
 609    (arg
 610     (issue-deprecation-warning
 611      "`set-batch-mode?!' is deprecated. Use `ensure-batch-mode!' instead.")
 612     (ensure-batch-mode!))
 613    (else
 614     (issue-deprecation-warning
 615      "`set-batch-mode?!' with an argument of `#f' is deprecated. Use the
 616 `*repl-level*' fluid instead.")
 617     #t)))
 618
 619 (define (repl read evaler print)
 620   (issue-deprecation-warning
 621    "`repl' is deprecated. Define it yourself.")
 622   (let loop ((source (read (current-input-port))))
 623     (print (evaler source))
 624     (loop (read (current-input-port)))))
 625
 626 (define (pre-unwind-handler-dispatch key . args)
 627   (issue-deprecation-warning
 628    "`pre-unwind-handler-dispatch' is deprecated. Use
 629 `default-pre-unwind-handler' from `(ice-9 scm-style-repl)' directly.")
 630   (apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
 631
 632 (define (default-pre-unwind-handler key . args)
 633   (issue-deprecation-warning
 634    "`default-pre-unwind-handler' is deprecated. Use it from
 635 `(ice-9 scm-style-repl)' if you need it.")
 636   (apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
 637
 638 (define (handle-system-error key . args)
 639   (issue-deprecation-warning
 640    "`handle-system-error' is deprecated. Use it from
 641 `(ice-9 scm-style-repl)' if you need it.")
 642   (apply (@ (ice-9 scm-style-repl) handle-system-error) key args))
 643
 644 (define-syntax stack-saved?
 645   (make-variable-transformer
 646    (lambda (x)
 647      (issue-deprecation-warning
 648       "`stack-saved?' is deprecated. Use it from
 649 `(ice-9 save-stack)' if you need it.")
 650      (syntax-case x (set!)
 651        ((set! id val)
 652         (identifier? #'id)
 653         #'(set! (@ (ice-9 save-stack) stack-saved?) val))
 654        (id
 655         (identifier? #'id)
 656         #'(@ (ice-9 save-stack) stack-saved?))))))
 657
 658 (define-syntax the-last-stack
 659   (lambda (x)
 660     (issue-deprecation-warning
 661      "`the-last-stack' is deprecated. Use it from `(ice-9 save-stack)'
 662 if you need it.")
 663     (syntax-case x ()
 664       (id
 665        (identifier? #'id)
 666        #'(@ (ice-9 save-stack) the-last-stack)))))
 667
 668 (define (save-stack . args)
 669   (issue-deprecation-warning
 670    "`save-stack' is deprecated. Use it from `(ice-9 save-stack)' if you need
 671 it.")
 672   (apply (@ (ice-9 save-stack) save-stack) args))