From b3c74b4c0d7f584c66930f04e4c86734423946d4 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Tue, 3 Jan 2012 20:33:43 -0800 Subject: [PATCH] Add PATTERN-CONTAINS-DUPLICATES? --- src/compiler/base/pmlook.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/compiler/base/pmlook.scm b/src/compiler/base/pmlook.scm index 15bd2f90d..0c8d24902 100644 --- a/src/compiler/base/pmlook.scm +++ b/src/compiler/base/pmlook.scm @@ -85,6 +85,20 @@ USA. vars))) (else vars)))) +(define (pattern-contains-duplicates? pattern) + (not (let loop ((pattern pattern) + (vars '())) + (if (pair? pattern) + ;; Cheat: we know pattern variables are pairs + (if (eq? (car pattern) pattern-variable-tag) + (if (memq (pattern-variable-name pattern) vars) + #f ; found a duplicate + (cons (pattern-variable-name pattern) vars)) + (let ((vars1 (loop (car pattern) vars))) + (and vars1 + (loop (cdr pattern) vars1)))) + vars)))) + (define-integrable (make-pattern-variable name) (cons pattern-variable-tag name)) -- 2.25.1