Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

added (vicare keywords) library

  • Loading branch information...
commit 8d5f09c5baa9ac8091ee643f61a453c27ece363c 1 parent ce89e37
@marcomaggi authored
View
3  ANNOUNCE
@@ -45,7 +45,8 @@ Notes for revision 0.2d10
* Changed FASL-DIRECTORY pathname validator to accept only existent
string pathnames.
-* Added keyword objects.
+* Added keyword objects handling to the boot image. Added library
+ (vicare keywords) with facilities for keyword objects.
* BACKWARDS INCOMPATIBILITY The reader syntax:
View
197 doc/vicare.texi
@@ -14745,6 +14745,7 @@ be @code{AF_INET} or @code{AF_INET6}.
* include:: Including source files at expand time.
* errno:: More features for @code{errno}.
* words:: Exact integer predicates and constants.
+* keywords:: More facilities for keyword objects.
* readline:: Extended interface to @gnu{} Readline.
* gcc:: A toy library interface to @gcc{}.
* wtables:: Weak hashtables.
@@ -15147,6 +15148,202 @@ least--minus--1 unsigned exact integer in the 64-bit range.
@end deffn
@c page
+@node keywords
+@section More facilities for keyword objects
+
+
+Keywords are disjoint objects which can be read by @value{PRJNAME}'s
+reader in @code{#!vicare} mode, @ref{iklib reader stx}. The core
+bindings and keyword objects handling is embedded in @value{PRJNAME}'s
+boot image, but additional facilities are required to make use of
+keywords.
+
+The following bindings are exported by the library @library{vicare
+keywords}. Additionally the following bindings are reexported from
+@library{vicare}:
+
+@example
+symbol->keyword keyword->symbol
+keyword? keyword=?
+keyword-hash
+@end example
+
+
+@defun keyword->string @var{keyword}
+@defunx string->keyword @var{string}
+Convert a keyword object to and from a string object. The string is the
+name of the symbol embedded in the keyword.
+@end defun
+
+
+@deffn Syntax let-keywords @meta{input} @meta{args} @meta{allow} @meta{options-spec} @metao{form} @meta{form} ...
+@deffnx Syntax let*-keywords @meta{input} @meta{args} @meta{allow} @meta{options-spec} @metao{form} @meta{form} ...
+@deffnx Syntax letrec-keywords @meta{input} @meta{args} @meta{allow} @meta{options-spec} @metao{form} @meta{form} ...
+@deffnx Syntax letrec*-keywords @meta{input} @meta{args} @meta{allow} @meta{options-spec} @metao{form} @meta{form} ...
+@deffnx {Auxiliary Syntax} with-argument @meta{name} @meta{default} @meta{keyword}
+@deffnx {Auxiliary Syntax} without-argument @meta{name} @meta{default} @meta{keyword} @meta{when-given}
+Expand into a @func{let} like form whose bindings are configured from a
+list of arguments and options.
+
+@func{let-keywords} expands into a @func{let} syntax,
+@func{let*-keywords} expands into a @func{let*} syntax,
+@func{letrec-keywords} expands into a @func{letrec} syntax,
+@func{let-keywords} expands into a @func{let} syntax.
+
+@meta{input} must be an expression evaluating to a list of values and
+keywords; keywords must be compliant to the specification in
+@meta{options-spec}. The same keyword can be present multiple times in
+@meta{input}.
+
+@meta{args} must be an identifier which will be bound to a list of
+values from @meta{input} not matching any of the options specified in
+@meta{options-spec}.
+
+@meta{allow} must be an expression meant to evaluate to @false{} or
+true; when @false{}: keyword values in @meta{input} not matched by
+specifications in @meta{options-spec} will cause an assertion violation;
+when true: keyword values in @meta{input} not matched by specifications
+in @meta{options-spec} will be collected in @meta{args}.
+
+@meta{options-spec} must be null or a list of lists, each with the
+following formats:
+
+@example
+(with-argument @meta{name} @meta{default} @meta{keyword})
+(without-argument @meta{name} @meta{default} @meta{keyword} @meta{when-given})
+@end example
+
+@noindent
+such specifications are interpreted as follows:
+
+@itemize
+@item
+The @func{with-argument} specification describes an optional keyword
+argument with mandatory value, which must @strong{not} be a keyword
+itself.
+
+@item
+The @func{without-argument} specification describes an optional keyword
+argument with mandatory value, which must @strong{not} be a keyword
+itself.
+
+@item
+@meta{name} must be an identifier which will become the name of a
+binding in the output @func{let} like syntax.
+
+@item
+@meta{default} must be an expression which will become a the value of
+binding in the output @func{let} like syntax.
+
+@item
+@meta{keyword} must be a keyword object which can be present in
+@meta{input} to mutate the associated @meta{name} binding.
+
+@item
+For keywords with argument: when the @meta{keyword} is present in
+@meta{input}, it must be followed by a value which will become the new
+value of the corresponding @meta{name} binding.
+
+
+@item
+For keywords without argument: when the @meta{keyword} is present in
+@meta{input}, the value resulting from the evaluation of
+@meta{when-given} will become the new value of the corresponding
+@meta{name} binding.
+@end itemize
+
+We can imagine the following macro use:
+
+@example
+(let-keywords @meta{input} args #f
+ ((with-argument a 1 #:a)
+ (with-argument b 2 #:b))
+ (alpha)
+ (beta))
+@end example
+
+@noindent
+to expand to something like:
+
+@example
+(let ((a 1)
+ (b 2))
+ (let ((args @meta{options-parser}))
+ (alpha)
+ (beta)))
+@end example
+
+@noindent
+where @meta{options-parser} is a form which takes care of parsing the
+@meta{input}.
+@end deffn
+
+
+Examples:
+
+@example
+#!vicare
+(import (vicare)
+ (vicare keywords))
+
+;; options with arguments
+(let-keywords '(#:a 1 #:b 2 #:d 4) args #f
+ ((with-argument a #\a #:a)
+ (with-argument b #\b #:b)
+ (with-argument c #\c #:c)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+@result{} (1 2 #\c 4 ())
+
+;; options without arguments
+(let-keywords '(#:a #:b #:d 4) args #f
+ ((without-argument a #\a #:a #\A)
+ (without-argument b #\b #:b #\B)
+ (without-argument c #\c #:c #\C)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+@result{} (#\A #\B #\c 4 ())
+
+;; options with arguments, leftover arguments
+(let-keywords '(#:a 1 ciao #:b 2 hello #:d 4) args #f
+ ((with-argument a #\a #:a)
+ (with-argument b #\b #:b)
+ (with-argument c #\c #:c)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+@result{} (1 2 #\c 4 (ciao hello))
+
+;; no options, allow unknown
+(let-keywords '(#:a 1 #:b 2 #:d 4) args #t
+ ()
+ args)
+@result{} (#:a 1 #:b 2 #:d 4)
+
+(let-keywords '(#:a) args #f
+ ()
+ args)
+@error{} unknown option #:a
+
+(let-keywords '(#:a #:b 123) args #t
+ ((with-argument a 1 #:a)
+ (with-argument b 2 #:b))
+ args)
+@error{} option value for #:a cannot be a keyword
+
+(let-keywords '(#:a) args #t
+ ((with-argument a 1 #:a)
+ (with-argument b 2 #:b))
+ args)
+@error{} option #:a requires argument
+
+;; keywords used multiple times
+(let-keywords '(#:verbose #:verbose #:verbose) args #f
+ ((without-argument verbosity 0 #:verbose (+ 1 verbosity)))
+ verbosity)
+@result{} 3
+@end example
+
+@c page
@node readline
@section Extended interface to @gnu{} Readline
View
15 lib/Makefile.am
@@ -17,17 +17,18 @@ EXTRA_DIST = compile-all.sps \
nobase_dist_libvicare_DATA = \
vicare/errno.sls \
- vicare/platform-constants.sls \
+ vicare/flonum-formatter.sls \
+ vicare/flonum-parser.sls \
vicare/include.sls \
+ vicare/installation-configuration.sls \
+ vicare/keywords.sls \
+ vicare/platform-constants.sls \
vicare/syntactic-extensions.sls \
- vicare/flonum-parser.sls \
- vicare/flonum-formatter.sls \
+ vicare/unsafe-capi.sls \
vicare/unsafe-operations.sls \
vicare/unsafe-unicode.sls \
- vicare/unsafe-capi.sls \
- vicare/words.sls \
- vicare/installation-configuration.sls \
- vicare/weak-hashtables.sls
+ vicare/weak-hashtables.sls \
+ vicare/words.sls
if WANT_LIBFFI
nobase_dist_libvicare_DATA += vicare/ffi.sls
View
1  lib/compile-all.sps
@@ -38,6 +38,7 @@
(only (vicare flonum-parser))
(only (vicare flonum-formatter))
(only (vicare weak-hashtables))
+ (only (vicare keywords))
)
;;; end of file
View
198 lib/vicare/keywords.sls
@@ -0,0 +1,198 @@
+;;;
+;;;Part of: Vicare/Scheme
+;;;Contents: keywords utilities
+;;;Date: Sun Jul 5, 2009
+;;;
+;;;Abstract
+;;;
+;;; This library is derived from old code in Nausicaa/Scheme.
+;;;
+;;;Copyright (c) 2009, 2010, 2012 Marco Maggi <marco.maggi-ipsu@poste.it>
+;;;
+;;;This program is free software: you can redistribute it and/or modify
+;;;it under the terms of the GNU General Public License as published by
+;;;the Free Software Foundation, either version 3 of the License, or (at
+;;;your option) any later version.
+;;;
+;;;This program is distributed in the hope that it will be useful, but
+;;;WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;General Public License for more details.
+;;;
+;;;You should have received a copy of the GNU General Public License
+;;;along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;;
+
+
+#!vicare
+(library (vicare keywords)
+ (export
+ ;; reexported from (vicare)
+ symbol->keyword
+ keyword->symbol
+ keyword?
+ keyword=?
+ keyword-hash
+
+ ;; conversion with strings
+ keyword->string string->keyword
+
+ ;; function arguments
+ let-keywords let*-keywords
+ letrec-keywords letrec*-keywords
+ with-argument without-argument)
+ (import (vicare)
+ (vicare syntactic-extensions))
+
+
+;;;; arguments validation
+
+(define-argument-validation (string who obj)
+ (string? obj)
+ (assertion-violation who "expected string as argument" obj))
+
+(define-argument-validation (keyword who obj)
+ (keyword? obj)
+ (assertion-violation who "expected keyword as argument" obj))
+
+
+;;;; string utilities
+
+(define (keyword->string key)
+ (define who 'keyword->string)
+ (with-arguments-validation (who)
+ ((keyword key))
+ (symbol->string (keyword->symbol key))))
+
+(define (string->keyword str)
+ (define who 'string->keyword)
+ (with-arguments-validation (who)
+ ((string str))
+ (symbol->keyword (string->symbol str))))
+
+
+(define-syntax let-keywords
+ (syntax-rules ()
+ ((_ ?input-arguments ?args-var ?allow-unknown (?option-spec ...) ?form0 ?form ...)
+ (%let-parse-keywords ley-keywords let
+ ?input-arguments ?args-var ?allow-unknown (?option-spec ...)
+ ?form0 ?form ...))))
+
+(define-syntax let*-keywords
+ (syntax-rules ()
+ ((_ ?input-arguments ?args-var ?allow-unknown (?option-spec ...) ?form0 ?form ...)
+ (%let-parse-keywords let*-keywords let*
+ ?input-arguments ?args-var ?allow-unknown (?option-spec ...)
+ ?form0 ?form ...))))
+
+(define-syntax letrec-keywords
+ (syntax-rules ()
+ ((_ ?input-arguments ?args-var ?allow-unknown (?option-spec ...) ?form0 ?form ...)
+ (%let-parse-keywords letrec-keywords letrec
+ ?input-arguments ?args-var ?allow-unknown (?option-spec ...)
+ ?form0 ?form ...))))
+
+(define-syntax letrec*-keywords
+ (syntax-rules ()
+ ((_ ?input-arguments ?args-var ?allow-unknown (?option-spec ...) ?form0 ?form ...)
+ (%let-parse-keywords letrec*-keywords letrec*
+ ?input-arguments ?args-var ?allow-unknown (?option-spec ...)
+ ?form0 ?form ...))))
+
+(define-auxiliary-syntaxes
+ with-argument without-argument)
+
+(define-syntax %let-parse-keywords
+ (lambda (stx)
+ (define who '%let-parse-keywords)
+ (define-struct opts
+ (names defs keys))
+ (define (%parse-options-spec specs names defs keys)
+ (syntax-case specs (with-argument without-argument)
+ (()
+ (values names defs keys))
+ (((with-argument ?name ?default ?keyword) . ?specs)
+ (and (identifier? #'?name)
+ (keyword? (syntax->datum #'?keyword)))
+ (%parse-options-spec #'?specs
+ (cons #'?name names)
+ (cons #'?default defs)
+ ;;The UNQUOTE in this form is matched by
+ ;;the QUASIQUOTE in the output form.
+ #`((?keyword #f . (unquote (lambda (v) (set! ?name v)))) . #,keys)))
+ (((without-argument ?name ?default ?keyword ?when-given) . ?specs)
+ (and (identifier? #'?name)
+ (keyword? (syntax->datum #'?keyword)))
+ (%parse-options-spec #'?specs
+ (cons #'?name names)
+ (cons #'?default defs)
+ ;;The UNQUOTE in this form are matched by
+ ;;the QUASIQUOTE in the output form.
+ #`((?keyword (unquote (lambda () (set! ?name ?when-given)))
+ . (unquote (lambda (v) (set! ?name v))))
+ . #,keys)))
+ ((?wrong-spec . ?other-specs)
+ (syntax-violation who
+ "invalid option specification for keyword arguments parser"
+ (syntax->datum stx)
+ (syntax->datum #'?wrong-spec)))))
+ (syntax-case stx ()
+ ((_ ?who ?let ?input-arguments ?args-var ?allow-unknown (?option-spec ...) ?form0 ?form ...)
+ (and (identifier? #'?who)
+ (identifier? #'?let)
+ (identifier? #'?args-var))
+ (let-values (((names defs keys)
+ (%parse-options-spec #'(?option-spec ...) '() '() '())))
+ (with-syntax (((NAME ...) (reverse names))
+ ((DEFAULT ...) (reverse defs))
+ (KEYWORDS-ALIST keys))
+ #'(?let ((NAME DEFAULT) ...)
+ (let ((?args-var (%parse-keywords '?who ?input-arguments ?allow-unknown
+ (quasiquote KEYWORDS-ALIST))))
+ ?form0 ?form ...))))))))
+
+(define (%parse-keywords who input-arguments allow-unknown options-specs)
+ (let next-input-argument ((arguments input-arguments))
+ (if (null? arguments)
+ '()
+ (let ((arg (car arguments)))
+ (cond ((assp (lambda (key)
+ (keyword=? arg key))
+ options-specs)
+ => (lambda (spec)
+ (let ((without-arg-thunk (cadr spec))
+ (with-arg-closure (cddr spec)))
+ (if without-arg-thunk
+ ;;Keyword option without argument.
+ (begin
+ (without-arg-thunk)
+ (next-input-argument (cdr arguments)))
+ ;;Keyword option with argument.
+ (let ((arguments (cdr arguments)))
+ (cond ((null? arguments)
+ (assertion-violation who
+ "keyword option requires argument" arg input-arguments))
+ ((keyword? (car arguments))
+ (assertion-violation who
+ "value for keyword with argument cannot be a keyword"
+ arg (car arguments) input-arguments))
+ (else
+ (with-arg-closure (car arguments))
+ (next-input-argument (cdr arguments)))))))))
+
+ ;;Input option is an unknown keyword.
+ ((keyword? arg)
+ (if allow-unknown
+ (cons arg (next-input-argument (cdr arguments)))
+ (assertion-violation who "unknown keyword argument" arg input-arguments)))
+
+ ;;Input option is a value.
+ ((not (keyword? arg))
+ (cons arg (next-input-argument (cdr arguments)))))))))
+
+
+;;;; done
+
+)
+
+;;; end of file
View
366 tests/test-vicare-keywords.sps
@@ -25,152 +25,315 @@
;;;
-#!r6rs
+#!vicare
(import (vicare)
+ (vicare keywords)
(checks))
(check-set-mode! 'report-failed)
(check-display "*** testing Vicare keywords\n")
-(check
- (keyword? 123)
- => #f)
+;;;; syntax helpers
+
+(define-syntax catch
+ (syntax-rules ()
+ ((_ print? . ?body)
+ (guard (E ((assertion-violation? E)
+ (when print?
+ (check-pretty-print (condition-message E)))
+ (condition-irritants E))
+ (else E))
+ (begin . ?body)))))
-(check
- (let ((K (symbol->keyword 'ciao)))
- (keyword? K))
- => #t)
+
+(parametrise ((check-test-name 'objects))
+
+ (check
+ (keyword? 123)
+ => #f)
-(check
- (keyword->symbol (symbol->keyword 'ciao))
- => 'ciao)
+ (check
+ (let ((K (symbol->keyword 'ciao)))
+ (keyword? K))
+ => #t)
+
+ (check
+ (keyword->symbol (symbol->keyword 'ciao))
+ => 'ciao)
;;; --------------------------------------------------------------------
-(check
- (keyword=? (symbol->keyword 'ciao)
- (symbol->keyword 'ciao))
- => #t)
+ (check
+ (keyword=? (symbol->keyword 'ciao)
+ (symbol->keyword 'ciao))
+ => #t)
-(check
- (keyword=? (symbol->keyword 'ciao)
- (symbol->keyword 'hello))
- => #f)
+ (check
+ (keyword=? (symbol->keyword 'ciao)
+ (symbol->keyword 'hello))
+ => #f)
-(check
- (let ((K (symbol->keyword 'ciao)))
- (keyword=? K K))
- => #t)
+ (check
+ (let ((K (symbol->keyword 'ciao)))
+ (keyword=? K K))
+ => #t)
-(check
- (keyword=? (symbol->keyword 'ciao)
- 'ciao)
- => #f)
+ (check
+ (keyword=? (symbol->keyword 'ciao)
+ 'ciao)
+ => #f)
-(check
- (keyword=? 'ciao
- (symbol->keyword 'ciao))
- => #f)
+ (check
+ (keyword=? 'ciao
+ (symbol->keyword 'ciao))
+ => #f)
;;; --------------------------------------------------------------------
;;; EQ? comparison
-(check
- (eq? (symbol->keyword 'ciao)
- (symbol->keyword 'ciao))
- => #f)
+ (check
+ (eq? (symbol->keyword 'ciao)
+ (symbol->keyword 'ciao))
+ => #f)
-(check
- (eq? (symbol->keyword 'ciao)
- (symbol->keyword 'hello))
- => #f)
+ (check
+ (eq? (symbol->keyword 'ciao)
+ (symbol->keyword 'hello))
+ => #f)
-(check
- (let ((K (symbol->keyword 'ciao)))
- (eq? K K))
- => #t)
+ (check
+ (let ((K (symbol->keyword 'ciao)))
+ (eq? K K))
+ => #t)
-(check
- (eq? (symbol->keyword 'ciao)
- 'ciao)
- => #f)
+ (check
+ (eq? (symbol->keyword 'ciao)
+ 'ciao)
+ => #f)
-(check
- (eq? 'ciao
- (symbol->keyword 'ciao))
- => #f)
+ (check
+ (eq? 'ciao
+ (symbol->keyword 'ciao))
+ => #f)
;;; --------------------------------------------------------------------
;;; EQV? comparison
-(check
- (eqv? (symbol->keyword 'ciao)
- (symbol->keyword 'ciao))
- => #t)
+ (check
+ (eqv? (symbol->keyword 'ciao)
+ (symbol->keyword 'ciao))
+ => #t)
-(check
- (eqv? (symbol->keyword 'ciao)
- (symbol->keyword 'hello))
- => #f)
+ (check
+ (eqv? (symbol->keyword 'ciao)
+ (symbol->keyword 'hello))
+ => #f)
-(check
- (let ((K (symbol->keyword 'ciao)))
- (eqv? K K))
- => #t)
+ (check
+ (let ((K (symbol->keyword 'ciao)))
+ (eqv? K K))
+ => #t)
-(check
- (eqv? (symbol->keyword 'ciao)
- 'ciao)
- => #f)
+ (check
+ (eqv? (symbol->keyword 'ciao)
+ 'ciao)
+ => #f)
-(check
- (eqv? 'ciao
- (symbol->keyword 'ciao))
- => #f)
+ (check
+ (eqv? 'ciao
+ (symbol->keyword 'ciao))
+ => #f)
;;; --------------------------------------------------------------------
;;; EQUAL? comparison
-(check
- (equal? (symbol->keyword 'ciao)
- (symbol->keyword 'ciao))
- => #t)
+ (check
+ (equal? (symbol->keyword 'ciao)
+ (symbol->keyword 'ciao))
+ => #t)
-(check
- (equal? (symbol->keyword 'ciao)
- (symbol->keyword 'hello))
- => #f)
+ (check
+ (equal? (symbol->keyword 'ciao)
+ (symbol->keyword 'hello))
+ => #f)
-(check
- (let ((K (symbol->keyword 'ciao)))
- (equal? K K))
- => #t)
+ (check
+ (let ((K (symbol->keyword 'ciao)))
+ (equal? K K))
+ => #t)
-(check
- (equal? (symbol->keyword 'ciao)
- 'ciao)
- => #f)
+ (check
+ (equal? (symbol->keyword 'ciao)
+ 'ciao)
+ => #f)
-(check
- (equal? 'ciao
- (symbol->keyword 'ciao))
- => #f)
+ (check
+ (equal? 'ciao
+ (symbol->keyword 'ciao))
+ => #f)
;;; --------------------------------------------------------------------
-(check
- (keyword-hash (symbol->keyword 'ciao))
- => (symbol-hash 'ciao))
+ (check
+ (keyword-hash (symbol->keyword 'ciao))
+ => (symbol-hash 'ciao))
;;; --------------------------------------------------------------------
-(check
- (let-values (((port getter)
- (open-string-output-port)))
- (display (symbol->keyword 'ciao) port)
- (getter))
- => "#[keyword ciao]")
+ (check
+ (let-values (((port getter)
+ (open-string-output-port)))
+ (display (symbol->keyword 'ciao) port)
+ (getter))
+ => "#[keyword ciao]")
+
+ #t)
+
+
+(parametrise ((check-test-name 'arguments))
+
+ (check ;options with arguments
+ (let-keywords '(#:a 1 #:b 2 #:d 4) args #f
+ ((with-argument a #\a #:a)
+ (with-argument b #\b #:b)
+ (with-argument c #\c #:c)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+ => '(1 2 #\c 4 ()))
+
+ (check ;options without arguments
+ (let-keywords '(#:a #:b #:d 4) args #f
+ ((without-argument a #\a #:a #\A)
+ (without-argument b #\b #:b #\B)
+ (without-argument c #\c #:c #\C)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+ => '(#\A #\B #\c 4 ()))
+
+ (check ;options with arguments, leftover arguments
+ (let-keywords '(#:a 1 ciao #:b 2 hello #:d 4) args #f
+ ((with-argument a #\a #:a)
+ (with-argument b #\b #:b)
+ (with-argument c #\c #:c)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+ => '(1 2 #\c 4 (ciao hello)))
+
+ (check ;options without arguments, leftover arguments
+ (let-keywords '(#:a ciao #:b hello #:d 4) args #f
+ ((without-argument a #\a #:a #\A)
+ (without-argument b #\b #:b #\B)
+ (without-argument c #\c #:c #\C)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+ => '(#\A #\B #\c 4 (ciao hello)))
+
+;;; --------------------------------------------------------------------
+;;; allow unknown
+
+ (check ;no options
+ (let-keywords '(#:a 1 #:b 2 #:d 4) args #t
+ ()
+ args)
+ => '(#:a 1 #:b 2 #:d 4))
+
+ (check ;options with arguments, allow unknown
+ (let-keywords '(#:a 1 #:b 2 #:d 4 #:ciao 123) args #t
+ ((with-argument a #\a #:a)
+ (with-argument b #\b #:b)
+ (with-argument c #\c #:c)
+ (with-argument d #\d #:d))
+ (list a b c d args))
+ => '(1 2 #\c 4 (#:ciao 123)))
+
+;;; --------------------------------------------------------------------
+;;; errors
+
+ (check ;unknown option
+ (catch #f
+ (let-keywords '(#:a) args #f
+ ()
+ args))
+ => '(#:a (#:a)))
+
+ (check ;option requires argument
+ (catch #f
+ (let-keywords '(#:a #:b 123) args #t
+ ((with-argument a 1 #:a)
+ (with-argument b 2 #:b))
+ args))
+ => '(#:a #:b (#:a #:b 123)))
+
+ #t)
+
+
+(parametrise ((check-test-name 'syntaxes))
+
+ (check
+ (let ((a 1) (b 2) (c 3) (d 4))
+ (let-keywords '() args #f
+ ((with-argument a a #:a)
+ (with-argument b b #:b)
+ (with-argument c c #:c)
+ (with-argument d d #:d))
+ (list a b c d args)))
+ => '(1 2 3 4 ()))
+
+ (check
+ (let ((a 1) (b 2) (c 3) (d 4))
+ (let*-keywords '() args #f
+ ((with-argument a a #:a)
+ (with-argument b a #:b)
+ (with-argument c b #:c)
+ (with-argument d c #:d))
+ (list a b c d args)))
+ => '(1 1 1 1 ()))
+
+ (check
+ (let ((A 1) (B 2) (C 3) (D 4))
+ (letrec-keywords '() args #f
+ ((with-argument a A #:a)
+ (with-argument b B #:b)
+ (with-argument c C #:c)
+ (with-argument d D #:d))
+ (list a b c d args)))
+ => '(1 2 3 4 ()))
+
+ (check
+ (let ((A 1) (B 2) (C 3) (D 4))
+ (letrec*-keywords '() args #f
+ ((with-argument a A #:a)
+ (with-argument b B #:b)
+ (with-argument c C #:c)
+ (with-argument d D #:d))
+ (list a b c d args)))
+ => '(1 2 3 4 ()))
+
+ #t)
+
+
+(parametrise ((check-test-name 'examples))
+
+ (check
+ (let-keywords '() args #f
+ ((without-argument verbosity 0 #:verbose (+ 1 verbosity)))
+ verbosity)
+ => 0)
+
+ (check
+ (let-keywords '(#:verbose) args #f
+ ((without-argument verbosity 0 #:verbose (+ 1 verbosity)))
+ verbosity)
+ => 1)
+
+ (check
+ (let-keywords '(#:verbose #:verbose #:verbose) args #f
+ ((without-argument verbosity 0 #:verbose (+ 1 verbosity)))
+ verbosity)
+ => 3)
+
+ #t)
;;;; done
@@ -178,3 +341,6 @@
(check-report)
;;; end of file
+;;Local Variables:
+;;eval: (put 'catch 'scheme-indent-function 1)
+;;End:
Please sign in to comment.
Something went wrong with that request. Please try again.