* Added #:allow- and #:forbid-duplicate-keys and a check for this
* getarg accepts only thunks for a default * Test new stuff, and better macros for testing svn: r1137 original commit: 241595659742c38a5bab24b88a77187a52dc6ea2
This commit is contained in:
Eli Barzilay
parent
1709b4c0f4
commit
55a73f404d
|
|
@ -5,20 +5,36 @@
|
|||
(begin-for-syntax ; -> configuration for lambda/kw
|
||||
;; must appear at the end, each with exactly one variable
|
||||
(define rest-like-kwds '(#:rest #:body #:rest-keys #:all-keys #:other-keys))
|
||||
;; also in the end, without variable, cannot have contradictions
|
||||
(define allow-other-keys-kwds '(#:allow-other-keys #:forbid-other-keys))
|
||||
(define allow-body-kwds '(#:allow-body #:forbid-body))
|
||||
;; using any of these allows access to additional keys or to body, making the
|
||||
;; default be to allow other keys or body
|
||||
(define other-keys-accessing '(#:rest #:rest-keys #:all-keys #:other-keys))
|
||||
(define body-accessing '(#:rest #:body #:rest-keys)))
|
||||
;; mode keys are in the end, without variable, cannot have contradictions
|
||||
;; each descriptor for #:allow-kwd and #:forbid-kwd is
|
||||
;; (kwd-sym (forcer ...) (enabler ...))
|
||||
;; `forcer' is a rest-like keyword that forces the mode, `enabler' is a
|
||||
;; rest-like keyword that makes it on by default
|
||||
(define mode-keyword-specs
|
||||
'((other-keys (#:other-keys) (#:rest #:rest-keys #:all-keys))
|
||||
(duplicate-keys () (#:rest #:all-keys))
|
||||
(body (#:body) (#:rest #:rest-keys))))
|
||||
;; precomputed mode keyword stuff
|
||||
(define processed-keyword-specs
|
||||
(map (lambda (ks)
|
||||
(let* ([k (car ks)]
|
||||
[make (lambda (str)
|
||||
(string->keyword
|
||||
(string-append str (symbol->string k))))])
|
||||
(list* k (make "allow-") (make "forbid-") (cdr ks))))
|
||||
mode-keyword-specs))
|
||||
(define mode-keywords
|
||||
(apply append (map (lambda (ks) (list (cadr ks) (caddr ks)))
|
||||
processed-keyword-specs))))
|
||||
|
||||
(provide lambda/kw)
|
||||
(define-syntax (lambda/kw stx)
|
||||
;; --------------------------------------------------------------------------
|
||||
;; easy syntax errors
|
||||
(define original-formals #f)
|
||||
(define (serror sub fmt . args)
|
||||
(raise-syntax-error #f (apply format fmt args) stx sub))
|
||||
(raise-syntax-error
|
||||
#f (apply format fmt args) stx (or sub original-formals)))
|
||||
;; contents of syntax
|
||||
(define (syntax-e* x) (if (syntax? x) (syntax-e x) x))
|
||||
;; turns formals into a syntax list
|
||||
|
|
@ -69,32 +85,29 @@
|
|||
[var (serror #'var "not a valid ~a spec" #:key)]))
|
||||
;; --------------------------------------------------------------------------
|
||||
;; helpers for process-vars
|
||||
(define (get-mode mode k k-stx formals keys)
|
||||
(cond [(null? keys)
|
||||
(serror k-stx "cannot use without #:key arguments")]
|
||||
[(pair? (cdar formals))
|
||||
(serror (cadar formals) "identifier following mode keyword ~a" k)]
|
||||
[(and mode (not (eq? k mode)))
|
||||
(serror k-stx "contradicting mode keywords")]
|
||||
[else k]))
|
||||
(define (process-mode mode rests allow enablers)
|
||||
(if mode
|
||||
(eq? mode allow)
|
||||
(ormap (lambda (k) (and (assq k rests) #t)) enablers)))
|
||||
(define ((process-mode modes rests) processed-spec)
|
||||
(let ([allow (memq (cadr processed-spec) modes)]
|
||||
[forbid (memq (caddr processed-spec) modes)])
|
||||
(cond
|
||||
[(and allow forbid)
|
||||
(serror #f "contradicting #:...-~a keywords" (car processed-spec))]
|
||||
[(ormap (lambda (k) (assq k rests)) (cadddr processed-spec))
|
||||
=> ; forced?
|
||||
(lambda (r)
|
||||
(when forbid (serror #f "cannot ~s with ~s" (car forbid) (car r)))
|
||||
#t)]
|
||||
[allow #t]
|
||||
[forbid #f]
|
||||
[else (ormap (lambda (k) (and (assq k rests) #t)) ; suggested?
|
||||
(car (cddddr processed-spec)))])))
|
||||
;; --------------------------------------------------------------------------
|
||||
;; test variables
|
||||
(define (process-vars vars opts keys0 rests other-keys-mode body-mode
|
||||
. only-vars?)
|
||||
(define (process-vars vars opts keys0 rests modes . only-vars?)
|
||||
(define (gensym x)
|
||||
(car (generate-temporaries (list x))))
|
||||
(let*-values
|
||||
([(only-vars?) (and (pair? only-vars?) (car only-vars?))]
|
||||
[(opts keys0) (values (map process-opt opts) (map process-key keys0))]
|
||||
[(other-keys-mode body-mode)
|
||||
(values (process-mode other-keys-mode
|
||||
rests #:allow-other-keys other-keys-accessing)
|
||||
(process-mode body-mode
|
||||
rests #:allow-body body-accessing))]
|
||||
[(rest body rest-keys all-keys other-keys)
|
||||
(apply values
|
||||
(map (lambda (k) (cond [(assq k rests) => cdr] [else #f]))
|
||||
|
|
@ -107,6 +120,9 @@
|
|||
(values (or rest (gensym #'rest))
|
||||
(or body (gensym #'body))
|
||||
(or other-keys (gensym #'other-keys)))]
|
||||
[(other-keys-mode duplicate-keys-mode body-mode)
|
||||
(apply values (map (process-mode modes rests)
|
||||
processed-keyword-specs))]
|
||||
;; turn (<id> <key> <default>) keys to (<id> <default>)
|
||||
[(keys)
|
||||
(with-syntax ([r rest*])
|
||||
|
|
@ -131,7 +147,8 @@
|
|||
=> (lambda (d) (serror d "duplicate argument name"))]
|
||||
[else (values vars opts keys rest rest* body body* body-spec
|
||||
rest-keys all-keys other-keys other-keys*
|
||||
other-keys-mode body-mode (map cadr keys0))])))
|
||||
other-keys-mode duplicate-keys-mode body-mode
|
||||
(map cadr keys0))])))
|
||||
;; --------------------------------------------------------------------------
|
||||
;; parses formals, returns list of normal vars, optional var specs, key var
|
||||
;; specs, an alist of rest-like kw+vars, and a mode for allowing other keys
|
||||
|
|
@ -148,24 +165,20 @@
|
|||
[opts (pop-formals #:optional)]
|
||||
[keys (pop-formals #:key)])
|
||||
;; now get all rest-like vars
|
||||
(let loop ([formals formals]
|
||||
[rests '()]
|
||||
[other-keys-mode #f]
|
||||
[body-mode #f])
|
||||
(let loop ([formals formals] [rests '()] [modes '()])
|
||||
(if (null? formals)
|
||||
(apply process-vars vars opts keys rests other-keys-mode body-mode
|
||||
only-vars?)
|
||||
(apply process-vars vars opts keys rests modes only-vars?)
|
||||
(let* ([k-stx (caar formals)]
|
||||
[k (syntax-e* k-stx)])
|
||||
(cond [(memq k '(#:optional #:key))
|
||||
(serror k-stx "misplaced ~a" k)]
|
||||
[(memq k allow-other-keys-kwds)
|
||||
(loop (cdr formals) rests
|
||||
(get-mode other-keys-mode k k-stx formals keys)
|
||||
body-mode)]
|
||||
[(memq k allow-body-kwds)
|
||||
(loop (cdr formals) rests other-keys-mode
|
||||
(get-mode body-mode k k-stx formals keys))]
|
||||
[(memq k mode-keywords)
|
||||
(cond [(null? keys)
|
||||
(serror k-stx "cannot use without #:key arguments")]
|
||||
[(pair? (cdar formals))
|
||||
(serror (cadar formals)
|
||||
"identifier following mode keyword ~a" k)]
|
||||
[else (loop (cdr formals) rests (cons k modes))])]
|
||||
[(not (memq k rest-like-kwds))
|
||||
(serror k-stx "unknown meta keyword")]
|
||||
[(assq k rests)
|
||||
|
|
@ -178,7 +191,7 @@
|
|||
(serror k-stx "cannot use without #:key arguments")]
|
||||
[else (loop (cdr formals)
|
||||
(cons (cons k (cadar formals)) rests)
|
||||
other-keys-mode body-mode)]))))))
|
||||
modes)]))))))
|
||||
;; --------------------------------------------------------------------------
|
||||
;; generates the actual body
|
||||
(define (generate-body formals expr)
|
||||
|
|
@ -197,8 +210,9 @@
|
|||
all-keys ; keyword-vals without body
|
||||
other-keys ; unprocessed keyword-vals
|
||||
other-keys* ; always an id
|
||||
allow-other-keys? ; allowing other keys?
|
||||
allow-body? ; allowing body after keys?
|
||||
allow-other-keys? ; allowing other keys?
|
||||
allow-duplicate-keys? ; allowing duplicate keys?
|
||||
allow-body? ; allowing body after keys?
|
||||
keywords) ; list of mentioned keywords
|
||||
(parse-formals formals))
|
||||
(define name
|
||||
|
|
@ -234,43 +248,52 @@
|
|||
[expr expr]
|
||||
[all-keys* all-keys]
|
||||
[other-keys* other-keys*]
|
||||
[rest-keys* rest-keys])
|
||||
(with-syntax ([loop-vars
|
||||
#`([body* rest*]
|
||||
#,@(if all-keys #`([all-keys* '()]) '())
|
||||
#,@(if others? #`([other-keys* '()]) '()))]
|
||||
[next-loop
|
||||
#`(loop (cddr body*)
|
||||
#,@(if all-keys
|
||||
#`((list* (cadr body*) (car body*)
|
||||
all-keys*))
|
||||
'())
|
||||
#,@(if others?
|
||||
#`((if (memq (car body*) 'keywords)
|
||||
other-keys*
|
||||
(list* (cadr body*) (car body*)
|
||||
other-keys*)))
|
||||
'()))]
|
||||
[expr
|
||||
(if (or all-keys others?)
|
||||
#`(let* (#,@(if all-keys
|
||||
#'([all-keys* (reverse! all-keys*)])
|
||||
'())
|
||||
#,@(if others?
|
||||
#'([other-keys* (reverse! other-keys*)])
|
||||
'())
|
||||
#,@(cond [(and other-keys rest-keys)
|
||||
#'([rest-keys*
|
||||
(append other-keys* body*)])]
|
||||
[rest-keys ; can destroy other-keys
|
||||
#'([rest-keys*
|
||||
(append! other-keys* body*)])]
|
||||
[else '()]))
|
||||
expr)
|
||||
#'expr)])
|
||||
[rest-keys* rest-keys]
|
||||
[seen-keys #'seen-keys])
|
||||
(with-syntax
|
||||
([loop-vars
|
||||
#`([body* rest*]
|
||||
#,@(if all-keys #`([all-keys* '()]) '())
|
||||
#,@(if others? #`([other-keys* '()]) '())
|
||||
#,@(if allow-duplicate-keys? '() #`([seen-keys '()])))]
|
||||
[next-loop
|
||||
#`(loop (cddr body*)
|
||||
#,@(if all-keys
|
||||
#`((list* (cadr body*) (car body*) all-keys*))
|
||||
'())
|
||||
#,@(if others?
|
||||
#`((if (memq (car body*) 'keywords)
|
||||
other-keys*
|
||||
(list* (cadr body*) (car body*) other-keys*)))
|
||||
'())
|
||||
#,@(if allow-duplicate-keys?
|
||||
'()
|
||||
#`((if (and (memq (car body*) seen-keys)
|
||||
(memq (car body*) 'keywords))
|
||||
(error* 'name "duplicate keyword: ~e"
|
||||
(car body*))
|
||||
(cons (car body*) seen-keys)))))]
|
||||
[expr
|
||||
(if (or all-keys others?)
|
||||
#`(let* (#,@(if all-keys
|
||||
#'([all-keys* (reverse! all-keys*)])
|
||||
'())
|
||||
#,@(if others?
|
||||
#'([other-keys* (reverse! other-keys*)])
|
||||
'())
|
||||
#,@(cond [(and other-keys rest-keys)
|
||||
#'([rest-keys*
|
||||
(append other-keys* body*)])]
|
||||
[rest-keys ; can destroy other-keys
|
||||
#'([rest-keys*
|
||||
(append! other-keys* body*)])]
|
||||
[else '()]))
|
||||
expr)
|
||||
#'expr)])
|
||||
(with-syntax ([next-loop
|
||||
(if allow-other-keys?
|
||||
#'next-loop
|
||||
;;!!!
|
||||
#'(if (memq (car body*) 'keywords)
|
||||
next-loop
|
||||
(error* 'name "unknown keyword: ~e"
|
||||
|
|
@ -325,7 +348,8 @@
|
|||
(syntax/loc stx (letrec ([name (case-lambda . clauses)]) name))))]))
|
||||
(syntax-case stx ()
|
||||
[(_ formals expr0 expr ...)
|
||||
(generate-body #'formals #'(let () expr0 expr ...))]))
|
||||
(begin (set! original-formals #'formals)
|
||||
(generate-body #'formals #'(let () expr0 expr ...)))]))
|
||||
|
||||
(provide define/kw)
|
||||
(define-syntax (define/kw stx)
|
||||
|
|
@ -334,25 +358,23 @@
|
|||
[(_ (name . args) body0 body ...)
|
||||
(syntax/loc stx (_ name (lambda/kw args body0 body ...)))]))
|
||||
|
||||
;; raise an proper exception
|
||||
;; raise an appropriate exception
|
||||
(define (error* who fmt . args)
|
||||
(raise (make-exn:fail:contract
|
||||
(string->immutable-string
|
||||
(apply format (string-append "~a: " fmt) who args))
|
||||
(current-continuation-marks))))
|
||||
|
||||
;; Keyword searching utility (note: no errors for odd length)
|
||||
;; keyword searching utility (note: no errors for odd length)
|
||||
(provide getarg)
|
||||
(define (getarg args keyword . not-found)
|
||||
(let loop ([args args])
|
||||
(cond [(or (null? args) (null? (cdr args)) (not (keyword? (car args))))
|
||||
(and (pair? not-found)
|
||||
(let ([x (car not-found)])
|
||||
(if (procedure? x) (x) x)))]
|
||||
(and (pair? not-found) ((car not-found)))]
|
||||
[(eq? (car args) keyword) (cadr args)]
|
||||
[else (loop (cddr args))])))
|
||||
|
||||
;; a private version of getarg that is always used with simple values
|
||||
;; a private version of getarg that is used with simple values
|
||||
(define (getarg* args keyword . not-found)
|
||||
(let loop ([args args])
|
||||
(cond [(or (null? args) (null? (cdr args)) (not (keyword? (car args))))
|
||||
|
|
|
|||
|
|
@ -5,249 +5,321 @@
|
|||
|
||||
(require (lib "kw.ss"))
|
||||
|
||||
(let ([t test])
|
||||
(let ()
|
||||
(define-syntax t
|
||||
(syntax-rules (=> <= :rt-err: :st-err:)
|
||||
[(t E => :rt-err:) (err/rt-test E)]
|
||||
[(t E => :st-err:) (syntax-test #'E)]
|
||||
[(t (f x ...) => res) (test res f x ...)]
|
||||
[(t R => E more ...) (begin (t R => E) (t more ...))]
|
||||
[(t R <= E more ...) (t E => R more ...)]))
|
||||
|
||||
;; make sure that lambda/kw behaves as lambda
|
||||
(t 1 (lambda/kw () 1))
|
||||
(t 1 (lambda/kw (x) 1) 0)
|
||||
(t '() (lambda/kw x x))
|
||||
(t '(1 2) (lambda/kw x x) 1 2)
|
||||
(t '(1 2) (lambda/kw (x . xs) xs) 0 1 2)
|
||||
(t ((lambda/kw () 1)) => 1
|
||||
((lambda/kw (x) 1) 0) => 1
|
||||
((lambda/kw x x)) => '()
|
||||
((lambda/kw x x) 1 2) => '(1 2)
|
||||
((lambda/kw (x . xs) xs) 0 1 2) => '(1 2))
|
||||
;; even with keywords
|
||||
(t #:x (lambda/kw () #:x))
|
||||
(t #:x (lambda/kw (x) #:x) #:y)
|
||||
(t '(#:x #:y) (lambda/kw x x) #:x #:y)
|
||||
(t '(#:x #:y) (lambda/kw (x . xs) xs) #:z #:x #:y)
|
||||
(t ((lambda/kw () #:x)) => #:x
|
||||
((lambda/kw (x) #:x) #:y) => #:x
|
||||
((lambda/kw x x) #:x #:y) => '(#:x #:y)
|
||||
((lambda/kw (x . xs) xs) #:z #:x #:y) => '(#:x #:y))
|
||||
|
||||
;; just using #:rest is the same as a dot
|
||||
(let ([f (lambda/kw (#:rest r) r)])
|
||||
(t '() f)
|
||||
(t '(1) f 1)
|
||||
(t '(1 2) f 1 2))
|
||||
(t (f) => '()
|
||||
(f 1) => '(1)
|
||||
(f 1 2) => '(1 2)))
|
||||
(let ([f (lambda/kw (x #:rest r) r)])
|
||||
(t '() f 0)
|
||||
(t '(1) f 0 1)
|
||||
(t '(1 2) f 0 1 2))
|
||||
(t (f 0) => '()
|
||||
(f 0 1) => '(1)
|
||||
(f 0 1 2) => '(1 2)))
|
||||
|
||||
;; using only optionals
|
||||
(t 0 procedure-arity (lambda/kw (#:optional) 0))
|
||||
(t '(3 1 2) procedure-arity (lambda/kw (x #:optional y z) 0))
|
||||
(t (procedure-arity (lambda/kw (#:optional) 0)) => 0
|
||||
(procedure-arity (lambda/kw (x #:optional y z) 0)) => '(3 1 2))
|
||||
(let ([f (lambda/kw (x #:optional y) (list x y))])
|
||||
(t '(0 #f) f 0)
|
||||
(t '(0 1) f 0 1))
|
||||
(t (f 0) => '(0 #f)
|
||||
(f 0 1) => '(0 1)))
|
||||
(let ([f (lambda/kw (x #:optional [y 0]) (list x y))])
|
||||
(t '(0 0) f 0)
|
||||
(t '(0 1) f 0 1))
|
||||
(t (f 0) => '(0 0)
|
||||
(f 0 1) => '(0 1)))
|
||||
(let ([f (lambda/kw (x #:optional [y x]) (list x y))])
|
||||
(t '(0 0) f 0)
|
||||
(t '(0 1) f 0 1))
|
||||
(t (f 0) => '(0 0)
|
||||
(f 0 1) => '(0 1)))
|
||||
(let ([f (lambda/kw (x #:optional [y x] [z x]) (list x y z))])
|
||||
(t '(0 0 0) f 0)
|
||||
(t '(0 1 0) f 0 1)
|
||||
(t '(0 1 2) f 0 1 2))
|
||||
(t (f 0) => '(0 0 0)
|
||||
(f 0 1) => '(0 1 0)
|
||||
(f 0 1 2) => '(0 1 2)))
|
||||
(let ([f (lambda/kw (x #:optional [y x] [z y]) (list x y z))])
|
||||
(t '(0 0 0) f 0)
|
||||
(t '(0 1 1) f 0 1)
|
||||
(t '(0 1 2) f 0 1 2))
|
||||
(t (f 0) => '(0 0 0)
|
||||
(f 0 1) => '(0 1 1)
|
||||
(f 0 1 2) => '(0 1 2)))
|
||||
|
||||
;; keywords: basic stuff
|
||||
(let ([f (lambda/kw (#:key x [y 1] [z #:zz #:z]) (list x y z))])
|
||||
(t '(#f 1 #:z) f)
|
||||
(t '(#:zz 1 #:zzz) f #:zz #:zzz #:zz 123 #:x #:zz))
|
||||
(let ([f (lambda/kw (#:key x [y 1] [z #:zz #:z] #:allow-duplicate-keys)
|
||||
(list x y z))])
|
||||
(t (f) => '(#f 1 #:z)
|
||||
(f #:zz #:zzz #:zz 123 #:x #:zz) => '(#:zz 1 #:zzz)))
|
||||
;; keywords: default-expr scope
|
||||
(let ([f (lambda/kw (#:key x y) (list x y))])
|
||||
(t '(#f #f) f)
|
||||
(t '(1 #f) f #:x 1)
|
||||
(t '(#f 2 ) f #:y 2)
|
||||
(t '(1 2 ) f #:x 1 #:y 2)
|
||||
(t '(1 2 ) f #:x 1 #:y 2 #:y 3 #:x 4))
|
||||
(let ([f (lambda/kw (#:key x y #:allow-duplicate-keys) (list x y))])
|
||||
(t '(#f #f) <= (f)
|
||||
'(1 #f) <= (f #:x 1)
|
||||
'(#f 2 ) <= (f #:y 2)
|
||||
'(1 2 ) <= (f #:x 1 #:y 2)
|
||||
'(1 2 ) <= (f #:x 1 #:y 2 #:y 3 #:x 4)))
|
||||
(let ([f (lambda/kw (#:key x [y x]) (list x y))])
|
||||
(t '(1 1 ) f #:x 1)
|
||||
(t '(#f 2 ) f #:y 2)
|
||||
(t '(1 2 ) f #:x 1 #:y 2))
|
||||
(t '(1 1 ) <= (f #:x 1)
|
||||
'(#f 2 ) <= (f #:y 2)
|
||||
'(1 2 ) <= (f #:x 1 #:y 2)))
|
||||
(let ([f (lambda/kw (#:key x [y x] [z x]) (list x y z))])
|
||||
(t '(1 1 1 ) f #:x 1)
|
||||
(t '(#f 1 #f) f #:y 1)
|
||||
(t '(#f #f 1 ) f #:z 1))
|
||||
(t '(1 1 1 ) <= (f #:x 1)
|
||||
'(#f 1 #f) <= (f #:y 1)
|
||||
'(#f #f 1 ) <= (f #:z 1)))
|
||||
(let ([f (lambda/kw (#:key x [y x] [z y]) (list x y z))])
|
||||
(t '(1 1 1 ) f #:x 1)
|
||||
(t '(#f 1 1 ) f #:y 1)
|
||||
(t '(#f #f 1 ) f #:z 1))
|
||||
(t '(1 2) (let ([y 1]) (lambda/kw (#:key [x y] [y (add1 x)]) (list x y))))
|
||||
(t '(1 2) (let ([x 1]) (lambda/kw (#:key [x x] [y (add1 x)]) (list x y))))
|
||||
(t '(1 1 1 ) <= (f #:x 1)
|
||||
'(#f 1 1 ) <= (f #:y 1)
|
||||
'(#f #f 1 ) <= (f #:z 1)))
|
||||
(t
|
||||
((let ([y 1]) (lambda/kw (#:key [x y] [y (add1 x)]) (list x y)))) => '(1 2)
|
||||
((let ([x 1]) (lambda/kw (#:key [x x] [y (add1 x)]) (list x y)))) => '(1 2))
|
||||
;; keywords: default-expr evaluation
|
||||
(t 1 (lambda/kw (#:key [x 1]) x))
|
||||
(t "1" (lambda/kw (#:key [x "1"]) x))
|
||||
(t 1 (lambda/kw (#:key [x '1]) x))
|
||||
(t ''1 (lambda/kw (#:key [x ''1]) x))
|
||||
(t '(add1 1) (lambda/kw (#:key [x '(add1 1)]) x))
|
||||
(t + (lambda/kw (#:key [x +]) x))
|
||||
(t ((lambda/kw (#:key [x 1]) x)) => 1
|
||||
((lambda/kw (#:key [x "1"]) x)) => "1"
|
||||
((lambda/kw (#:key [x '1]) x)) => 1
|
||||
((lambda/kw (#:key [x ''1]) x)) => ''1
|
||||
((lambda/kw (#:key [x '(add1 1)]) x)) => '(add1 1)
|
||||
((lambda/kw (#:key [x +]) x)) => +)
|
||||
(let ([f (lambda ()
|
||||
(let ([y 1]) (lambda/kw (#:key [x (begin (set! y 3) 2)]) y)))])
|
||||
(t 3 (f))
|
||||
(t 1 (f) #:x 1))
|
||||
(t ((f)) => 3
|
||||
((f) #:x 1) => 1))
|
||||
(let ([f (lambda ()
|
||||
(let ([y 1])
|
||||
(let-syntax ([z (syntax-id-rules () [_ (begin (set! y 3) 2)])])
|
||||
(lambda/kw (#:key [x z]) y))))])
|
||||
(t 3 (f))
|
||||
(t 1 (f) #:x 1))
|
||||
(t ((f)) => 3
|
||||
((f) #:x 1) => 1))
|
||||
;; keywords: make sure that getarg stops at end of keyword part
|
||||
(let ([f (lambda/kw (#:key x y #:body b) (list x y b))])
|
||||
(t '(#f #f (2 #:x 1)) f 2 #:x 1)
|
||||
(t '(#f #f (2 3 #:x 1)) f 2 3 #:x 1))
|
||||
(t (f) => '(#f #f ())
|
||||
(f 2) => '(#f #f (2))
|
||||
(f 2 #:x 1) => '(#f #f (2 #:x 1))
|
||||
(f 2 3 #:x 1) => '(#f #f (2 3 #:x 1))))
|
||||
|
||||
;; exotic extras
|
||||
(let ([f (lambda/kw (#:key a b #:rest r) r)])
|
||||
(t '(1 2 3) f 1 2 3)
|
||||
(t '(#:a 1 1 2 3) f #:a 1 1 2 3)
|
||||
(t '(#:a 1 #:a 2 1 2 3) f #:a 1 #:a 2 1 2 3)
|
||||
(t '(#:b 2 1 2 3) f #:b 2 1 2 3)
|
||||
(t '(#:a 1 #:b 2 1 2 3) f #:a 1 #:b 2 1 2 3)
|
||||
(t '(#:a 1 #:b 2 #:c 3 1 2 3) f #:a 1 #:b 2 #:c 3 1 2 3))
|
||||
(let ([f (lambda/kw (#:key a b #:rest r #:allow-duplicate-keys) r)])
|
||||
(t (f 1 2 3) => '(1 2 3)
|
||||
(f #:a 1 1 2 3) => '(#:a 1 1 2 3)
|
||||
(f #:a 1 #:a 2 1 2 3) => '(#:a 1 #:a 2 1 2 3)
|
||||
(f #:b 2 1 2 3) => '(#:b 2 1 2 3)
|
||||
(f #:a 1 #:b 2 1 2 3) => '(#:a 1 #:b 2 1 2 3)
|
||||
(f #:a 1 #:b 2 #:c 3 1 2 3) => '(#:a 1 #:b 2 #:c 3 1 2 3)))
|
||||
(let ([f (lambda/kw (#:key a b #:body r) r)])
|
||||
(t '(1 2 3) f 1 2 3)
|
||||
(t '(1 2 3) f #:a 1 1 2 3)
|
||||
(t '(1 2 3) f #:a 1 #:a 2 1 2 3)
|
||||
(t '(1 2 3) f #:b 2 1 2 3)
|
||||
(t '(1 2 3) f #:a 1 #:b 2 1 2 3))
|
||||
(t (f 1 2 3) => '(1 2 3)
|
||||
(f #:a 1 1 2 3) => '(1 2 3)
|
||||
(f #:a 1 #:a 2 1 2 3) => :rt-err:
|
||||
(f #:b 2 1 2 3) => '(1 2 3)
|
||||
(f #:a 1 #:b 2 1 2 3) => '(1 2 3)))
|
||||
(let ([f (lambda/kw (#:key a b #:other-keys r) r)])
|
||||
(t '() f)
|
||||
(t '() f #:a 1 #:b 2)
|
||||
(t '() f #:a 1 #:a 2 #:b 3)
|
||||
(t '(#:c 3) f #:a 1 #:b 2 #:c 3)
|
||||
(t '(#:d 4 #:c 3) f #:d 4 #:a 1 #:b 2 #:c 3)
|
||||
(t '(#:d 4 #:c 3 #:c 33) f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33)
|
||||
(t '(#:d 4 #:c 3 #:c 33) f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33))
|
||||
(t (f) => '()
|
||||
(f #:a 1 #:b 2) => '()
|
||||
(f #:a 1 #:b 2 #:c 3) => '(#:c 3)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3) => '(#:d 4 #:c 3)
|
||||
;; #:c is not a specified key, so it is allowed to repeat
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33) => '(#:d 4 #:c 3 #:c 33)
|
||||
(f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33) => '(#:d 4 #:c 3 #:c 33)))
|
||||
(let ([f (lambda/kw (#:key a b #:other-keys r #:allow-duplicate-keys) r)])
|
||||
(t (f) => '()
|
||||
(f #:a 1 #:b 2) => '()
|
||||
(f #:a 1 #:a 2 #:b 3) => '()
|
||||
(f #:a 1 #:b 2 #:c 3) => '(#:c 3)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3) => '(#:d 4 #:c 3)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33) => '(#:d 4 #:c 3 #:c 33)
|
||||
(f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33) => '(#:d 4 #:c 3 #:c 33)))
|
||||
(let ([f (lambda/kw (#:key a b #:rest-keys r) r)])
|
||||
(t '() f)
|
||||
(t '(1 2) f 1 2)
|
||||
(t '() f #:a 1 #:b 2)
|
||||
(t '(1 2) f #:a 1 #:b 2 1 2)
|
||||
(t '() f #:a 1 #:a 2 #:b 3)
|
||||
(t '(1 2) f #:a 1 #:a 2 #:b 3 1 2)
|
||||
(t '(#:c 3) f #:a 1 #:b 2 #:c 3)
|
||||
(t '(#:c 3 1 2) f #:a 1 #:b 2 #:c 3 1 2)
|
||||
(t '(#:d 4 #:c 3) f #:d 4 #:a 1 #:b 2 #:c 3)
|
||||
(t '(#:d 4 #:c 3 1 2) f #:d 4 #:a 1 #:b 2 #:c 3 1 2)
|
||||
(t '(#:d 4 #:c 3 #:c 33) f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33)
|
||||
(t '(#:d 4 #:c 3 #:c 33 1 2) f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33 1 2)
|
||||
(t '(#:d 4 #:c 3 #:c 33) f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33)
|
||||
(t '(#:d 4 #:c 3 #:c 33 1 2) f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33 1 2)
|
||||
)
|
||||
(t (f) => '()
|
||||
(f 1 2) => '(1 2)
|
||||
(f #:a 1 #:b 2) => '()
|
||||
(f #:a 1 #:b 2 1 2) => '(1 2)
|
||||
(f #:a 1 #:b 2 #:c 3) => '(#:c 3)
|
||||
(f #:a 1 #:b 2 #:c 3 1 2) => '(#:c 3 1 2)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3) => '(#:d 4 #:c 3)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 1 2) => '(#:d 4 #:c 3 1 2)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33) => '(#:d 4 #:c 3 #:c 33)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33 1 2) => '(#:d 4 #:c 3 #:c 33 1 2)
|
||||
(f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33) => '(#:d 4 #:c 3 #:c 33)
|
||||
(f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33 1 2) => '(#:d 4 #:c 3 #:c 33 1 2)))
|
||||
(let ([f (lambda/kw (#:key a b #:rest-keys r #:allow-duplicate-keys) r)])
|
||||
(t (f) => '()
|
||||
(f 1 2) => '(1 2)
|
||||
(f #:a 1 #:b 2) => '()
|
||||
(f #:a 1 #:b 2 1 2) => '(1 2)
|
||||
(f #:a 1 #:a 2 #:b 3) => '()
|
||||
(f #:a 1 #:a 2 #:b 3 1 2) => '(1 2)
|
||||
(f #:a 1 #:b 2 #:c 3) => '(#:c 3)
|
||||
(f #:a 1 #:b 2 #:c 3 1 2) => '(#:c 3 1 2)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3) => '(#:d 4 #:c 3)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 1 2) => '(#:d 4 #:c 3 1 2)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33) => '(#:d 4 #:c 3 #:c 33)
|
||||
(f #:d 4 #:a 1 #:b 2 #:c 3 #:c 33 1 2) => '(#:d 4 #:c 3 #:c 33 1 2)
|
||||
(f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33) => '(#:d 4 #:c 3 #:c 33)
|
||||
(f #:d 4 #:a 1 #:c 3 #:b 2 #:c 33 1 2) => '(#:d 4 #:c 3 #:c 33 1 2)))
|
||||
(let ([f (lambda/kw (x #:key a b #:all-keys r) r)])
|
||||
(t '() f 1)
|
||||
(t '(#:a 1 #:b 2) f 1 #:a 1 #:b 2)
|
||||
(t '(#:a 1 #:a 2 #:b 3) f 1 #:a 1 #:a 2 #:b 3)
|
||||
(t '(#:a 1 #:b 2 #:c 3) f 1 #:a 1 #:b 2 #:c 3)
|
||||
(t '(#:d 4 #:a 1 #:b 2 #:c 3) f 1 #:d 4 #:a 1 #:b 2 #:c 3)
|
||||
(t '(#:d 4 #:a 1 #:b 2 #:c 3 #:c 33) f 1 #:d 4 #:a 1 #:b 2 #:c 3 #:c 33)
|
||||
(t '(#:d 4 #:a 1 #:c 3 #:b 2 #:c 33) f 1 #:d 4 #:a 1 #:c 3 #:b 2 #:c 33)
|
||||
(err/rt-test (f 1 #:a 2 3))
|
||||
(err/rt-test (f 1 #:a 2 3 4))
|
||||
)
|
||||
(t (f 1) => '()
|
||||
(f 1 #:a 1 #:b 2) => '(#:a 1 #:b 2)
|
||||
(f 1 #:a 1 #:a 2 #:b 3) => '(#:a 1 #:a 2 #:b 3)
|
||||
(f 1 #:a 1 #:b 2 #:c 3) => '(#:a 1 #:b 2 #:c 3)
|
||||
(f 1 #:d 4 #:a 1 #:b 2 #:c 3) => '(#:d 4 #:a 1 #:b 2 #:c 3)
|
||||
(f 1 #:d 4 #:a 1 #:b 2 #:c 3 #:c 33) => '(#:d 4 #:a 1 #:b 2 #:c 3 #:c 33)
|
||||
(f 1 #:d 4 #:a 1 #:c 3 #:b 2 #:c 33) => '(#:d 4 #:a 1 #:c 3 #:b 2 #:c 33)
|
||||
(f 1 #:a 2 3) => :rt-err:
|
||||
(f 1 #:a 2 3 4) => :rt-err:))
|
||||
;; check when other keys are allowed
|
||||
(err/rt-test ((lambda/kw (#:key a #:body r) r) #:a 1 #:b 2))
|
||||
(err/rt-test ((lambda/kw (#:key a) a) #:a 1 #:b 2))
|
||||
(t 1 (lambda/kw (#:key a #:rest r) a) #:a 1 #:b 2)
|
||||
(t 1 (lambda/kw (#:key a #:rest-keys r) a) #:a 1 #:b 2)
|
||||
(t 1 (lambda/kw (#:key a #:allow-other-keys) a) #:a 1 #:b 2)
|
||||
(err/rt-test ((lambda/kw (#:key a #:rest r #:forbid-other-keys) a) #:a 1 #:b 2))
|
||||
(t :rt-err: <= ((lambda/kw (#:key a #:body r) r) #:a 1 #:b 2)
|
||||
:rt-err: <= ((lambda/kw (#:key a) a) #:a 1 #:b 2)
|
||||
1 <= ((lambda/kw (#:key a #:rest r) a) #:a 1 #:b 2)
|
||||
1 <= ((lambda/kw (#:key a #:rest-keys r) a) #:a 1 #:b 2)
|
||||
1 <= ((lambda/kw (#:key a #:allow-other-keys) a) #:a 1 #:b 2)
|
||||
:rt-err: <= ((lambda/kw (#:key a #:rest r #:forbid-other-keys) a) #:a 1 #:b 2))
|
||||
;; check when duplicate keys are allowed
|
||||
(t :rt-err: <= ((lambda/kw (#:key a #:body r) r) #:a 1 #:a 2)
|
||||
:rt-err: <= ((lambda/kw (#:key a) a) #:a 1 #:a 2)
|
||||
1 <= ((lambda/kw (#:key a #:rest r) a) #:a 1 #:a 2)
|
||||
:rt-err: <= ((lambda/kw (#:key a #:rest-keys r) a) #:a 1 #:a 2)
|
||||
1 <= ((lambda/kw (#:key a #:allow-duplicate-keys) a) #:a 1 #:a 2)
|
||||
:rt-err: <= ((lambda/kw (#:key a #:rest r #:forbid-duplicate-keys) a) #:a 1 #:a 2))
|
||||
;; check when body is allowed
|
||||
(err/rt-test ((lambda/kw (#:key a #:all-keys r) r) #:a 1 #:b 2 3))
|
||||
(err/rt-test ((lambda/kw (#:key a #:all-keys r) r) #:a 1 #:b 2 3 4))
|
||||
(err/rt-test ((lambda/kw (#:key a #:other-keys r) r) #:a 1 #:b 2 3))
|
||||
(err/rt-test ((lambda/kw (#:key a #:other-keys r) r) #:a 1 #:b 2 3 4))
|
||||
(t '(#:a 1 #:b 2 3) (lambda/kw (#:key a #:rest r) r) #:a 1 #:b 2 3)
|
||||
(t '(#:a 1 #:b 2 3 4) (lambda/kw (#:key a #:rest r) r) #:a 1 #:b 2 3 4)
|
||||
(t '(3) (lambda/kw (#:key a #:body r) r) #:a 1 3)
|
||||
(t '(3 4) (lambda/kw (#:key a #:body r) r) #:a 1 3 4)
|
||||
(t '(3) (lambda/kw (#:key a #:body r) r) #:a 1 #:a 2 3)
|
||||
(t '(3 4) (lambda/kw (#:key a #:body r) r) #:a 1 #:a 2 3 4)
|
||||
(err/rt-test ((lambda/kw (#:key a #:body r #:forbid-body) r) #:a 1 3))
|
||||
(t '(#:a 1 #:b 2) (lambda/kw (#:key a #:all-keys r #:allow-body) r) #:a 1 #:b 2 3)
|
||||
(err/rt-test ((lambda/kw (#:key x y) (list x y)) #:x))
|
||||
(err/rt-test ((lambda/kw (#:key x y) (list x y)) #:x 1 #:x))
|
||||
(err/rt-test ((lambda/kw (#:key x y) (list x y)) #:x #:x #:x))
|
||||
(t :rt-err: <= ((lambda/kw (#:key a #:all-keys r) r) #:a 1 #:b 2 3)
|
||||
:rt-err: <= ((lambda/kw (#:key a #:all-keys r) r) #:a 1 #:b 2 3 4)
|
||||
:rt-err: <= ((lambda/kw (#:key a #:other-keys r) r) #:a 1 #:b 2 3)
|
||||
:rt-err: <= ((lambda/kw (#:key a #:other-keys r) r) #:a 1 #:b 2 3 4)
|
||||
'(#:a 1 #:b 2 3) <= ((lambda/kw (#:key a #:rest r) r) #:a 1 #:b 2 3)
|
||||
'(#:a 1 #:b 2 3 4) <= ((lambda/kw (#:key a #:rest r) r) #:a 1 #:b 2 3 4))
|
||||
(let ([f (lambda/kw (#:key a #:body r) r)])
|
||||
(t '(3) <= (f #:a 1 3)
|
||||
'(3 4) <= (f #:a 1 3 4)
|
||||
:rt-err: <= (f #:a 1 #:a 2 3)
|
||||
:rt-err: <= (f #:a 1 #:a 2 3 4)))
|
||||
(let ([f (lambda/kw (#:key a #:body r #:allow-duplicate-keys) r)])
|
||||
(t '(3) <= (f #:a 1 3)
|
||||
'(3 4) <= (f #:a 1 3 4)
|
||||
'(3) <= (f #:a 1 #:a 2 3)
|
||||
'(3 4) <= (f #:a 1 #:a 2 3 4)))
|
||||
(t '(#:a 1 #:b 2) <= ((lambda/kw (#:key a #:all-keys r #:allow-body) r)
|
||||
#:a 1 #:b 2 3)
|
||||
:rt-err: <= ((lambda/kw (#:key x y) (list x y)) #:x)
|
||||
:rt-err: <= ((lambda/kw (#:key x y) (list x y)) #:x 1 #:x)
|
||||
:rt-err: <= ((lambda/kw (#:key x y) (list x y)) #:x #:x #:x))
|
||||
|
||||
;; optionals and keys
|
||||
(let ([f (lambda/kw (#:optional a b #:key c d) (list a b c d))])
|
||||
(t '(#f #f #f #f) f)
|
||||
(t '(1 #f #f #f) f 1)
|
||||
(t '(1 2 #f #f) f 1 2)
|
||||
(t '(#:c #:d #f #f) f #:c #:d)
|
||||
(t '(#:c 1 #f #f) f #:c 1)
|
||||
(t '(1 2 #:d #f) f 1 2 #:c #:d)
|
||||
(t '(#:c #:d #:d #f) f #:c #:d #:c #:d)
|
||||
(t '(#:c 1 #:d #f) f #:c 1 #:c #:d))
|
||||
(t '(#f #f #f #f) <= (f)
|
||||
'(1 #f #f #f) <= (f 1)
|
||||
'(1 2 #f #f) <= (f 1 2)
|
||||
'(#:c #:d #f #f) <= (f #:c #:d)
|
||||
'(#:c 1 #f #f) <= (f #:c 1)
|
||||
'(1 2 #:d #f) <= (f 1 2 #:c #:d)
|
||||
'(#:c #:d #:d #f) <= (f #:c #:d #:c #:d)
|
||||
'(#:c 1 #:d #f) <= (f #:c 1 #:c #:d)))
|
||||
|
||||
;; multi-level arg lists with #:body specs
|
||||
(let ([f (lambda/kw (#:key x y #:body (z)) (list x y z))])
|
||||
(t '(#f #f 3) f 3)
|
||||
(t '(#f 2 3) f #:y 2 3)
|
||||
(err/rt-test (f #:y 2))
|
||||
(err/rt-test (f #:y 2 3 4)))
|
||||
(t (f 3) => '(#f #f 3)
|
||||
(f #:y 2 3) => '(#f 2 3)
|
||||
(f #:y 2) => :rt-err:
|
||||
(f #:y 2 3 4) => :rt-err:))
|
||||
(let ([f (lambda/kw (#:key x y #:body (z . r)) (list x y z r))])
|
||||
(t '(#f #f 3 ()) f 3)
|
||||
(t '(#f 2 3 ()) f #:y 2 3)
|
||||
(err/rt-test (f #:y 2))
|
||||
(t '(#f 2 3 (4)) f #:y 2 3 4))
|
||||
(t (f 3) => '(#f #f 3 ())
|
||||
(f #:y 2 3) => '(#f 2 3 ())
|
||||
(f #:y 2) => :rt-err:
|
||||
(f #:y 2 3 4) => '(#f 2 3 (4))))
|
||||
(let ([f (lambda/kw (#:key x y #:body (a #:key (xx #:x #f) (yy #:y #f)
|
||||
#:allow-duplicate-keys)
|
||||
#:allow-duplicate-keys)
|
||||
(list x y a xx yy))])
|
||||
(t '(1 #f 2 3 #f) <= (f #:x 1 2 #:x 3)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x #:x 33)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x #:x 33)))
|
||||
(let ([f (lambda/kw (#:key x y #:body (a #:key (xx #:x #f) (yy #:y #f)
|
||||
#:allow-duplicate-keys))
|
||||
(list x y a xx yy))])
|
||||
(t '(1 #f 2 3 #f) <= (f #:x 1 2 #:x 3)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x)
|
||||
:rt-err: <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x #:x 33)
|
||||
:rt-err: <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x #:x 33)))
|
||||
(let ([f (lambda/kw (#:key x y #:body (a #:key (xx #:x #f) (yy #:y #f))
|
||||
#:allow-duplicate-keys)
|
||||
(list x y a xx yy))])
|
||||
(t '(1 #f 2 3 #f) <= (f #:x 1 2 #:x 3)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x)
|
||||
'(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x)
|
||||
:rt-err: <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x #:x 33)
|
||||
:rt-err: <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x #:x 33)))
|
||||
(let ([f (lambda/kw (#:key x y #:body (a #:key (xx #:x #f) (yy #:y #f)))
|
||||
(list x y a xx yy))])
|
||||
(t '(1 #f 2 3 #f) f #:x 1 2 #:x 3)
|
||||
(t '(1 #:x 2 3 #:x) f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x #:x 33))
|
||||
(t '(1 #f 2 3 #f) <= (f #:x 1 2 #:x 3))
|
||||
(t '(1 #:x 2 3 #:x) <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x))
|
||||
(t :rt-err: <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x))
|
||||
(t :rt-err: <= (f #:x 1 #:y #:x 2 #:x 3 #:y #:x #:x 33))
|
||||
(t :rt-err: <= (f #:x 1 #:y #:x #:x 11 2 #:x 3 #:y #:x #:x 33)))
|
||||
|
||||
;; make sure that internal definitions work
|
||||
(let ([f (lambda/kw (#:key x) (define xx x) xx)])
|
||||
(t #f f)
|
||||
(t 1 f #:x 1))
|
||||
(t #f <= (f)
|
||||
1 <= (f #:x 1)))
|
||||
|
||||
;; test syntax errors
|
||||
(t :st-err: <= (lambda/kw (x #:blah y) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest) 1)
|
||||
:st-err: <= (lambda/kw (x #:key k #:key o) 1)
|
||||
:st-err: <= (lambda/kw (x #:key k #:optional o) 1)
|
||||
:st-err: <= (lambda/kw (x #:optional k #:optional o) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest r #:optional o) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest r #:forbid-other-keys #:allow-other-keys) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest r #:allow-other-keys #:forbid-other-keys) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest r1 #:rest r2) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest r1 r2) 1)
|
||||
:st-err: <= (lambda/kw (x #:body b) 1)
|
||||
:st-err: <= (lambda/kw (x x) 1)
|
||||
:st-err: <= (lambda/kw (x #:optional [x 1]) 1)
|
||||
:st-err: <= (lambda/kw (x #:key [x 1]) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest x) 1)
|
||||
:st-err: <= (lambda/kw (x #:body x) 1)
|
||||
:st-err: <= (lambda/kw (x #:optional 3) 1)
|
||||
:st-err: <= (lambda/kw (x #:optional "3") 1)
|
||||
:st-err: <= (lambda/kw (x #:optional [(x) 3]) 1)
|
||||
:st-err: <= (lambda/kw (x #:key 3) 1)
|
||||
:st-err: <= (lambda/kw (x #:key "3") 1)
|
||||
:st-err: <= (lambda/kw (x #:key [(y) 3]) 1)
|
||||
:st-err: <= (lambda/kw (x #:key [x]) 1)
|
||||
:st-err: <= (lambda/kw (x #:key [y 1 2]) 1)
|
||||
:st-err: <= (lambda/kw (x #:key [y #:y 1 2]) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest 3) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest "3") 1)
|
||||
:st-err: <= (lambda/kw (x #:rest (x)) 1)
|
||||
:st-err: <= (lambda/kw (x #:body 3) 1)
|
||||
:st-err: <= (lambda/kw (x #:key y #:body 3) 1)
|
||||
:st-err: <= (lambda/kw (x #:body "3") 1)
|
||||
:st-err: <= (lambda/kw (x #:key y #:body "3") 1)
|
||||
:st-err: <= (lambda/kw (x #:body (x)) 1)
|
||||
:st-err: <= (lambda/kw (x #:body x #:allow-other-keys) 1)
|
||||
:st-err: <= (lambda/kw (x #:optional ()) 1)
|
||||
:st-err: <= (lambda/kw (x #:optional (x y z)) 1)
|
||||
:st-err: <= (lambda/kw (x #:other-keys z) 1)
|
||||
:st-err: <= (lambda/kw (x #:rest-keys z) 1)
|
||||
:st-err: <= (lambda/kw (x #:all-keys z) 1)
|
||||
:st-err: <= (lambda/kw (x #:key y #:allow-other-keys z) 1)
|
||||
:st-err: <= (lambda/kw (x #:key y #:forbid-body z) 1)
|
||||
:st-err: <= (lambda/kw (x #:key y #:allow-body #:rest r #:forbid-body) 1)
|
||||
:st-err: <= (lambda/kw (x #:key y #:forbid-other-keys #:rest r #:allow-other-keys) 1)
|
||||
:st-err: <= (lambda/kw (x #:key y z #:body (x)) x)
|
||||
:st-err: <= (lambda/kw (#:key a #:body r #:forbid-body) r)
|
||||
:st-err: <= (lambda/kw (#:key a #:other-keys r #:forbid-other-keys) r))
|
||||
|
||||
)
|
||||
|
||||
;; test syntax errors
|
||||
(let ([st syntax-test])
|
||||
(st #'(lambda/kw (x #:blah y) 1))
|
||||
(st #'(lambda/kw (x #:rest) 1))
|
||||
(st #'(lambda/kw (x #:key k #:key o) 1))
|
||||
(st #'(lambda/kw (x #:key k #:optional o) 1))
|
||||
(st #'(lambda/kw (x #:optional k #:optional o) 1))
|
||||
(st #'(lambda/kw (x #:rest r #:optional o) 1))
|
||||
(st #'(lambda/kw (x #:rest r #:forbid-other-keys #:allow-other-keys) 1))
|
||||
(st #'(lambda/kw (x #:rest r #:allow-other-keys #:forbid-other-keys) 1))
|
||||
(st #'(lambda/kw (x #:rest r1 #:rest r2) 1))
|
||||
(st #'(lambda/kw (x #:rest) 1))
|
||||
(st #'(lambda/kw (x #:rest r1 r2) 1))
|
||||
(st #'(lambda/kw (x #:body b) 1))
|
||||
(st #'(lambda/kw (x x) 1))
|
||||
(st #'(lambda/kw (x #:optional [x 1]) 1))
|
||||
(st #'(lambda/kw (x #:key [x 1]) 1))
|
||||
(st #'(lambda/kw (x #:rest x) 1))
|
||||
(st #'(lambda/kw (x #:body x) 1))
|
||||
(st #'(lambda/kw (x #:optional 3) 1))
|
||||
(st #'(lambda/kw (x #:optional "3") 1))
|
||||
(st #'(lambda/kw (x #:optional [(x) 3]) 1))
|
||||
(st #'(lambda/kw (x #:key 3) 1))
|
||||
(st #'(lambda/kw (x #:key "3") 1))
|
||||
(st #'(lambda/kw (x #:key [(y) 3]) 1))
|
||||
(st #'(lambda/kw (x #:key [x]) 1))
|
||||
(st #'(lambda/kw (x #:key [y 1 2]) 1))
|
||||
(st #'(lambda/kw (x #:key [y #:y 1 2]) 1))
|
||||
(st #'(lambda/kw (x #:rest 3) 1))
|
||||
(st #'(lambda/kw (x #:rest "3") 1))
|
||||
(st #'(lambda/kw (x #:rest (x)) 1))
|
||||
(st #'(lambda/kw (x #:body 3) 1))
|
||||
(st #'(lambda/kw (x #:key y #:body 3) 1))
|
||||
(st #'(lambda/kw (x #:body "3") 1))
|
||||
(st #'(lambda/kw (x #:key y #:body "3") 1))
|
||||
(st #'(lambda/kw (x #:body (x)) 1))
|
||||
(st #'(lambda/kw (x #:body x #:allow-other-keys) 1))
|
||||
(st #'(lambda/kw (x #:optional ()) 1))
|
||||
(st #'(lambda/kw (x #:optional (x y z)) 1))
|
||||
(st #'(lambda/kw (x #:other-keys z) 1))
|
||||
(st #'(lambda/kw (x #:rest-keys z) 1))
|
||||
(st #'(lambda/kw (x #:all-keys z) 1))
|
||||
(st #'(lambda/kw (x #:key y #:allow-other-keys z) 1))
|
||||
(st #'(lambda/kw (x #:key y #:forbid-body z) 1))
|
||||
(st #'(lambda/kw (x #:key y #:allow-body #:rest r #:forbid-body) 1))
|
||||
(st #'(lambda/kw (x #:key y #:forbid-other-keys #:rest r #:allow-other-keys) 1))
|
||||
(st #'((lambda/kw (x #:key y z #:body (x)) x) 1)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user