From e082b13b662309021c73bae1561fb5c6d191d258 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 26 Feb 2012 15:53:11 -0500 Subject: [PATCH] pmatch: always wrap with let, even if the expression appears atomic * module/system/base/pmatch.scm (pmatch): Always wrap with 'let', even if the expression appears atomic, because in the presence of 'identifier-syntax', we cannot know what an atomic expression will later expand to. Also use '#:export-syntax' instead of '#:export' to export 'pmatch'. --- module/system/base/pmatch.scm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/module/system/base/pmatch.scm b/module/system/base/pmatch.scm index 00563f689..e9b9eb205 100644 --- a/module/system/base/pmatch.scm +++ b/module/system/base/pmatch.scm @@ -1,6 +1,6 @@ ;;; pmatch, a simple matcher -;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc +;;; Copyright (C) 2009, 2010, 2012 Free Software Foundation, Inc ;;; Copyright (C) 2005,2006,2007 Oleg Kiselyov ;;; Copyright (C) 2007 Daniel P. Friedman ;;; @@ -35,22 +35,22 @@ ;;; Code: (define-module (system base pmatch) - #:export (pmatch)) + #:export-syntax (pmatch)) -(define-syntax pmatch +(define-syntax-rule (pmatch e cs ...) + (let ((v e)) (pmatch1 v cs ...))) + +(define-syntax pmatch1 (syntax-rules (else guard) - ((_ (op arg ...) cs ...) - (let ((v (op arg ...))) - (pmatch v cs ...))) ((_ v) (if #f #f)) ((_ v (else e0 e ...)) (let () e0 e ...)) ((_ v (pat (guard g ...) e0 e ...) cs ...) - (let ((fk (lambda () (pmatch v cs ...)))) + (let ((fk (lambda () (pmatch1 v cs ...)))) (ppat v pat (if (and g ...) (let () e0 e ...) (fk)) (fk)))) ((_ v (pat e0 e ...) cs ...) - (let ((fk (lambda () (pmatch v cs ...)))) + (let ((fk (lambda () (pmatch1 v cs ...)))) (ppat v pat (let () e0 e ...) (fk)))))) (define-syntax ppat