From c71b335b330873d13a215f7f2463dcb4bebbee1b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 8 Sep 2008 18:19:54 +0000 Subject: [PATCH] Add DISQUALIFY keyword. --- v7/src/runtime/structure-parser.scm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/v7/src/runtime/structure-parser.scm b/v7/src/runtime/structure-parser.scm index 21e78f427..bad16206d 100644 --- a/v7/src/runtime/structure-parser.scm +++ b/v7/src/runtime/structure-parser.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: structure-parser.scm,v 14.2 2008/09/08 04:44:45 cph Exp $ +$Id: structure-parser.scm,v 14.3 2008/09/08 18:19:54 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -429,6 +429,16 @@ USA. ,(make-win vals lose) (,lose)))))) +(define-pattern-compiler '(DISQUALIFY EXPRESSION FORM) 'ANY + (lambda (pattern context env) + ((get-context-method 'TRANSFORM-VALS context) + (compile-pattern (caddr pattern) context env) + (lambda (make-win vals lose) + `(IF (NOT ,(call-out (close-syntax (cadr pattern) env) + vals)) + ,(make-win vals lose) + (,lose)))))) + (define-pattern-compiler '(TRANSFORM EXPRESSION FORM) 'ANY (lambda (pattern context env) ((get-context-method 'TRANSFORM-VALS context) -- 2.25.1