diff options
Diffstat (limited to 'paramlst.scm')
| -rw-r--r-- | paramlst.scm | 33 |
1 files changed, 21 insertions, 12 deletions
diff --git a/paramlst.scm b/paramlst.scm index 32fb158..fcee1c9 100644 --- a/paramlst.scm +++ b/paramlst.scm @@ -1,9 +1,9 @@ ;;; "paramlst.scm" passing parameters by name. -; Copyright 1995, 1996, 1997 Aubrey Jaffer +; Copyright 1995, 1996, 1997, 2001 Aubrey Jaffer ; -;Permission to copy this software, to redistribute it, and to use it -;for any purpose is granted, subject to the following restrictions and -;understandings. +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. ; ;1. Any copy made of this software must include this copyright notice ;in full. @@ -56,20 +56,19 @@ (every (lambda (p) (let ((good? (not (and check (not (check p)))))) - (if (not good?) - (slib:warn - (car parameter) 'parameter? p)) + (if (not good?) (slib:warn (car parameter) 'parameter? p)) good?)) (cdr parameter))) checks parameter-list) parameter-list)) (define (check-arities arity-specs parameter-list) - (and (every identity arity-specs) - (every - (lambda (arity-spec param) - ((cadr arity-spec) (cdr param))) - arity-specs parameter-list))) + (every (lambda (arity-spec param) + (cond ((not arity-spec) (slib:warn 'missing 'arity arity-specs) #f) + (((cadr arity-spec) (cdr param)) #t) + ((null? (cdr param)) (slib:warn param 'missing) #f) + (else (slib:warn param 'not (car arity-spec)) #f))) + arity-specs parameter-list)) (define (parameter-list->arglist positions arities parameter-list) (and (= (length arities) (length positions) (length parameter-list)) @@ -130,3 +129,13 @@ (set-cdr! apair (cons #t (cdr apair))))))) apairs parameters) parameter-list))) + +(define (remove-parameter pname parameter-list) + (define found? #f) + (remove-if (lambda (elt) + (cond ((not (and (pair? elt) (eqv? pname (car elt)))) #f) + (found? + (slib:error + 'remove-parameter 'multiple pname 'in parameter-list)) + (else (set! found? #t) #t))) + parameter-list)) |