From 0a3ac81a1c1017d3c71e9eac8f0dd3407563632b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 8 Jun 2012 12:42:08 +0200
Subject: [PATCH] Update (ice-9 match) from Chibi-Scheme.

Fixes <http://bugs.gnu.org/10651>.

* module/ice-9/match.upstream.scm: Update.
---
 module/ice-9/match.scm          | 4 ++--
 module/ice-9/match.upstream.scm | 4 +++-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/module/ice-9/match.scm b/module/ice-9/match.scm
index 4b078c69f..7fd191a11 100644
--- a/module/ice-9/match.scm
+++ b/module/ice-9/match.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012 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
@@ -52,7 +52,7 @@
 ;; `match' doesn't support clauses of the form `(pat => exp)'.
 
 ;; Unmodified public domain code by Alex Shinn retrieved from
-;; the Chibi-Scheme repository, commit 876:528cdab3f818.
+;; the Chibi-Scheme repository, commit 1206:acd808700e91.
 ;;
 ;; Note: Make sure to update `match.test.upstream' when updating this
 ;; file.
diff --git a/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm
index 978655667..29f9dbe2e 100644
--- a/module/ice-9/match.upstream.scm
+++ b/module/ice-9/match.upstream.scm
@@ -210,6 +210,7 @@
 ;; performance can be found at
 ;;   http://synthcode.com/scheme/match-cond-expand.scm
 ;;
+;; 2012/05/23 - fixing combinatorial explosion of code in certain or patterns
 ;; 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
@@ -479,7 +480,8 @@
      (match-one v p . x))
     ((_ v (p . q) g+s sk fk i)
      ;; match one and try the remaining on failure
-     (match-one v p g+s sk (match-gen-or-step v q g+s sk fk i) i))
+     (let ((fk2 (lambda () (match-gen-or-step v q g+s sk fk i))))
+       (match-one v p g+s sk (fk2) i)))
     ))
 
 ;; We match a pattern (p ...) by matching the pattern p in a loop on