mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Update match's no-matching-pattern code to use "throw"

Browse source 
* module/ice-9/match.upstream.scm (match-next): Use throw, so that CPS
  can see that there's no fallthrough.
* module/ice-9/match.scm: Add a note about what to do in 3.1 to remove
  the old "error" definition.
This commit is contained in:
Andy Wingo 2020-05-17 22:12:52 +02:00
parent f32ba444dd
commit 087bb683c8
2 changed files with 10 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/ice-9/match.scm
View file

@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
;;; Copyright (C) 2010, 2011, 2012, 2020 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
@ -24,12 +24,16 @@
match-let*
match-letrec))
(define (error _ . args)
;; Error procedure for run-time "no matching pattern" errors.
(apply throw 'match-error "match" args))
;; Support for record matching.
;; For backwards compatibility with previously-compiled files, keep the
;; old definition of "error" around.
(define (error _ . args)
(apply throw 'match-error "match" args))
;; FIXME: In 3.1.x, use this new definition:
;; (define-syntax-rule (error where msg datum)
;; (throw 'match-error "match" msg datum))
(define-syntax slot-ref
(syntax-rules ()
((_ rtd rec n)

2
module/ice-9/match.upstream.scm
View file

@ -292,7 +292,7 @@
;; Here we call error in non-tail context, so that the backtrace
;; can show the source location of the failing match form.
(begin
(error 'match "no matching pattern" v)
(throw 'match-error "match" "no matching pattern" v)
#f))
;; named failure continuation
((match-next v g+s (pat (=> failure) . body) . rest)