mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Update (ice-9 match) from Chibi-Scheme.
* module/ice-9/match.scm (match): Remove macro. * module/ice-9/match.upstream.scm: Update from Chibi-Scheme, which fixes <http://debbugs.gnu.org/9567>. * test-suite/tests/match.test.upstream: Likewise.
This commit is contained in:
parent
0129130439
commit
b92bbfff1a
3 changed files with 7 additions and 23 deletions
|
@ -52,27 +52,8 @@
|
|||
;; `match' doesn't support clauses of the form `(pat => exp)'.
|
||||
|
||||
;; Unmodified public domain code by Alex Shinn retrieved from
|
||||
;; the Chibi-Scheme repository, commit 833:6daa2971f3fe.
|
||||
;; the Chibi-Scheme repository, commit 876:528cdab3f818.
|
||||
;;
|
||||
;; Note: Make sure to update `match.test.upstream' when updating this
|
||||
;; file.
|
||||
(include-from-path "ice-9/match.upstream.scm")
|
||||
|
||||
;; Patch to work around <http://debbugs.gnu.org/9567>.
|
||||
(define-syntax match
|
||||
(syntax-rules ()
|
||||
((match)
|
||||
(match-syntax-error "missing match expression"))
|
||||
((match atom)
|
||||
(match-syntax-error "no match clauses"))
|
||||
((match (app ...) (pat . body) ...)
|
||||
(let ((v (app ...)))
|
||||
(match-next v ((app ...) (set! (app ...))) (pat . body) ...)))
|
||||
((match #(vec ...) (pat . body) ...)
|
||||
(let ((v #(vec ...)))
|
||||
(match-next v (v (set! v)) (pat . body) ...)))
|
||||
((match atom (pat . body) ...)
|
||||
(let ((v atom))
|
||||
(match-next v (atom (set! atom)) (pat . body) ...)))
|
||||
))
|
||||
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
;;;; match.scm -- portable hygienic pattern matcher
|
||||
;;;; -*- coding: utf-8 -*-
|
||||
;;;; match.scm -- portable hygienic pattern matcher -*- coding: utf-8 -*-
|
||||
;;
|
||||
;; This code is written by Alex Shinn and placed in the
|
||||
;; Public Domain. All warranties are disclaimed.
|
||||
|
@ -211,6 +210,8 @@
|
|||
;; performance can be found at
|
||||
;; http://synthcode.com/scheme/match-cond-expand.scm
|
||||
;;
|
||||
;; 2011/09/25 - fixing bug when directly matching an identifier repeated in
|
||||
;; the pattern (thanks to Stefan Israelsson Tampe)
|
||||
;; 2011/01/27 - fixing bug when matching tail patterns against improper lists
|
||||
;; 2010/09/26 - adding `..1' patterns (thanks to Ludovic Courtès)
|
||||
;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns
|
||||
|
@ -269,7 +270,8 @@
|
|||
(let ((v #(vec ...)))
|
||||
(match-next v (v (set! v)) (pat . body) ...)))
|
||||
((match atom (pat . body) ...)
|
||||
(match-next atom (atom (set! atom)) (pat . body) ...))
|
||||
(let ((v atom))
|
||||
(match-next v (atom (set! atom)) (pat . body) ...)))
|
||||
))
|
||||
|
||||
;; MATCH-NEXT passes each clause to MATCH-ONE in turn with its failure
|
||||
|
|
|
@ -27,6 +27,7 @@
|
|||
(test "duplicate symbols pass" 'ok (match '(ok . ok) ((x . x) x)))
|
||||
(test "duplicate symbols fail" 'ok (match '(ok . bad) ((x . x) 'bad) (else 'ok)))
|
||||
(test "duplicate symbols samth" 'ok (match '(ok . ok) ((x . 'bad) x) (('ok . x) x)))
|
||||
(test "duplicate symbols bound" 3 (let ((a '(1 2))) (match a ((and (a 2) (1 b)) (+ a b)) (_ #f))))
|
||||
|
||||
(test "ellipses" '((a b c) (1 2 3))
|
||||
(match '((a . 1) (b . 2) (c . 3))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue