mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

pmatch: always wrap with let, even if the expression appears atomic

Browse source 
* 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'.
This commit is contained in:
Mark H Weaver 2012-02-26 15:53:11 -05:00
parent ef405f8ba7
commit e082b13b66
1 changed files with 8 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/system/base/pmatch.scm
View file

@ -1,6 +1,6 @@
;;; pmatch, a simple matcher ;;; 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) 2005,2006,2007 Oleg Kiselyov
;;; Copyright (C) 2007 Daniel P. Friedman ;;; Copyright (C) 2007 Daniel P. Friedman
;;; ;;;
@ -35,22 +35,22 @@
;;; Code: ;;; Code:
(define-module (system base pmatch) (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) (syntax-rules (else guard)
((_ (op arg ...) cs ...)
(let ((v (op arg ...)))
(pmatch v cs ...)))
((_ v) (if #f #f)) ((_ v) (if #f #f))
((_ v (else e0 e ...)) (let () e0 e ...)) ((_ v (else e0 e ...)) (let () e0 e ...))
((_ v (pat (guard g ...) e0 e ...) cs ...) ((_ v (pat (guard g ...) e0 e ...) cs ...)
(let ((fk (lambda () (pmatch v cs ...)))) (let ((fk (lambda () (pmatch1 v cs ...))))
(ppat v pat (ppat v pat
(if (and g ...) (let () e0 e ...) (fk)) (if (and g ...) (let () e0 e ...) (fk))
(fk)))) (fk))))
((_ v (pat e0 e ...) cs ...) ((_ v (pat e0 e ...) cs ...)
(let ((fk (lambda () (pmatch v cs ...)))) (let ((fk (lambda () (pmatch1 v cs ...))))
(ppat v pat (let () e0 e ...) (fk)))))) (ppat v pat (let () e0 e ...) (fk))))))
(define-syntax ppat (define-syntax ppat