mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-24 13:30:21 +02:00
Code Activity

No longer use module `(ice-9 slib)'.

Browse source 
Use module `(ice-9 pretty-print)'.
No longer require `pretty-print'.

(slib:error): Delete.
(match:error, match:syntax-err): Rewrite.

Thanks to Dale P. Smith.
This commit is contained in:
Thien-Thi Nguyen 2001-06-13 16:02:07 +00:00
parent b4b50361c9
commit 26d9bcd003
1 changed files with 11 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

11
ice-9/match.scm
View file

@ -42,8 +42,8 @@
;;;; If you do not wish that, delete this exception notice.
;;;;
(define-module (ice-9 match)
:use-module (ice-9 slib)
(define-module (ice-9 match)
:use-module (ice-9 pretty-print)
:export (match match-lambda match-lambda* match-define
match-let match-let* match-letrec
define-structure define-const-structure
@ -52,8 +52,6 @@
match:structure-control match:set-structure-control
match:runtime-structures match:set-runtime-structures))
(define slib:error error)
;; The original code can be found at the Scheme Repository
;;
;; http://www.cs.indiana.edu/scheme-repository/code.match.html
@ -196,10 +194,9 @@
;; End of user visible/modifiable stuff.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require (quote pretty-print))
(define match:error (lambda (val . args) (for-each pretty-print args) (slib:error "no matching clause for " val)))
(define match:error (lambda (val . args) (for-each pretty-print args) (error "no matching clause for " val)))
(define match:andmap (lambda (f l) (if (null? l) (and) (and (f (car l)) (match:andmap f (cdr l))))))
(define match:syntax-err (lambda (obj msg) (slib:error msg obj)))
(define match:syntax-err (lambda (obj msg) (error msg obj)))
(define match:disjoint-structure-tags (quote ()))
(define match:make-structure-tag (lambda (name) (if (or (eq? match:structure-control (quote disjoint)) match:runtime-structures) (let ((tag (gensym))) (set! match:disjoint-structure-tags (cons tag match:disjoint-structure-tags)) tag) (string->symbol (string-append "<" (symbol->string name) ">")))))
(define match:structure? (lambda (tag) (memq tag match:disjoint-structure-tags)))