In favor of explicit argument
Shiro Kawai
(09 Aug 2020 01:33 UTC)
|
Re: In favor of explicit argument
Lassi Kortela
(09 Aug 2020 06:46 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(09 Aug 2020 09:27 UTC)
|
Re: In favor of explicit argument
Adam Nelson
(10 Aug 2020 22:25 UTC)
|
Re: In favor of explicit argument
Shiro Kawai
(10 Aug 2020 23:46 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(11 Aug 2020 07:58 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(11 Aug 2020 01:29 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(11 Aug 2020 07:17 UTC)
|
Re: In favor of explicit argument
Jim Rees
(11 Aug 2020 16:45 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(11 Aug 2020 16:57 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(12 Aug 2020 02:20 UTC)
|
Re: In favor of explicit argument
John Cowan
(12 Aug 2020 02:49 UTC)
|
Re: In favor of explicit argument
Arthur A. Gleckler
(12 Aug 2020 03:23 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(12 Aug 2020 13:29 UTC)
|
Re: In favor of explicit argument Marc Nieper-Wißkirchen (12 Aug 2020 19:46 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(13 Aug 2020 00:40 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(13 Aug 2020 07:18 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(14 Aug 2020 01:24 UTC)
|
Re: In favor of explicit argument
Adam Nelson
(13 Aug 2020 01:13 UTC)
|
Re: In favor of explicit argument
John Cowan
(13 Aug 2020 01:53 UTC)
|
Re: In favor of explicit argument
Adam Nelson
(13 Aug 2020 03:09 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(13 Aug 2020 03:16 UTC)
|
Re: In favor of explicit argument
John Cowan
(13 Aug 2020 03:31 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(13 Aug 2020 08:04 UTC)
|
Re: In favor of explicit argument
Jim Rees
(13 Aug 2020 18:24 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(13 Aug 2020 20:05 UTC)
|
Re: In favor of explicit argument
John Cowan
(14 Aug 2020 02:41 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(14 Aug 2020 06:34 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(14 Aug 2020 13:30 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(14 Aug 2020 14:08 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(15 Aug 2020 22:56 UTC)
|
Re: In favor of explicit argument
Marc Nieper-Wißkirchen
(16 Aug 2020 07:55 UTC)
|
Re: In favor of explicit argument
Alex Shinn
(14 Aug 2020 02:29 UTC)
|
At the end of this email is a patch for a quick-and-dirty implementation of "define-keyword" for Chibi. Please see the file lib/chibi/keyword-test.sld to see how it is used. (define-keyword <id> <name>) binds <id> to auxiliary syntax identified by the symbol <name>. -- Marc commit a61d1fe5f36e7f53f990df8eceb3dc7ad89d16cb Author: Marc Nieper-Wißkirchen <xxxxxx@nieper-wisskirchen.de> Date: Wed Aug 12 21:40:40 2020 +0200 Implement define-keyword diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index 13d776ed..28812f37 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -297,6 +297,14 @@ sexp sexp_env_push_op (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp name, return SEXP_VOID; } +#if SEXP_USE_RENAME_BINDINGS +sexp sexp_env_rename_op (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp key, sexp value) { + sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env); + sexp_assert_type(ctx, sexp_idp, SEXP_SYMBOL, key); + return sexp_env_rename (ctx, env, key, value); +} +#endif + sexp sexp_core_code_op (sexp ctx, sexp self, sexp_sint_t n, sexp c) { sexp_assert_type(ctx, sexp_corep, SEXP_CORE, c); return sexp_make_fixnum(sexp_core_code(c)); @@ -726,6 +734,9 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char sexp_define_foreign(ctx, env, "env-syntactic?-set!", 2, sexp_env_syntactic_set_op); sexp_define_foreign(ctx, env, "env-define!", 3, sexp_env_define_op); sexp_define_foreign(ctx, env, "env-push!", 3, sexp_env_push_op); +#if SEXP_USE_RENAME_BINDINGS + sexp_define_foreign(ctx, env, "env-push-rename!", 3, sexp_env_rename_op); +#endif sexp_define_foreign(ctx, env, "core-code", 1, sexp_core_code_op); sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size); sexp_define_foreign(ctx, env, "immutable?", 1, sexp_immutablep_op); diff --git a/lib/chibi/ast.sld b/lib/chibi/ast.sld index 2856f656..dac80aeb 100644 --- a/lib/chibi/ast.sld +++ b/lib/chibi/ast.sld @@ -32,7 +32,7 @@ bytecode-name bytecode-literals bytecode-source port-line port-line-set! port-source? port-source?-set! extend-env env-parent env-parent-set! env-lambda env-lambda-set! - env-define! env-push! env-syntactic? env-syntactic?-set! core-code + env-define! env-push! env-push-rename! env-syntactic? env-syntactic?-set! core-code type-name type-cpl type-parent type-slots type-num-slots type-printer type-printer-set! object-size object->integer integer->immediate gc gc-usecs gc-count diff --git a/lib/chibi/keyword-test.sld b/lib/chibi/keyword-test.sld new file mode 100644 index 00000000..d39824ee --- /dev/null +++ b/lib/chibi/keyword-test.sld @@ -0,0 +1,27 @@ +(define-library (chibi keyword-test) + (export run-tests) + (import (scheme base) (chibi keyword) (chibi test)) + (begin + (define (run-tests) + (test-begin "keyword") + + (test-group "define-syntax literals" + (define-keyword foo foo) + (define-keyword bar foo) + (define-keyword baz bar) + + (define-syntax foo? + (syntax-rules (foo) + ((_ foo) #t) + ((_ _) #f))) + + (test-assert (foo? foo)) + (test-assert (foo? bar)) + (test-not (foo? baz))) + + (test-group "standard auxiliary syntax" + (define-keyword otherwise else) + (test-assert (cond + (otherwise #t)))) + + (test-end)))) diff --git a/lib/chibi/keyword.scm b/lib/chibi/keyword.scm new file mode 100644 index 00000000..fb45ac3d --- /dev/null +++ b/lib/chibi/keyword.scm @@ -0,0 +1,37 @@ +(define keywords (make-hash-table eq?)) + +(define (set-keyword! name) + (hash-table-set! keywords name (env-cell (current-environment) name))) + +;; Intern the keywords defined in (chibi). +(set-keyword! '_) +(set-keyword! '=>) +(set-keyword! '...) +(set-keyword! 'else) +(set-keyword! 'unquote) +(set-keyword! 'unquote-splicing) + +(define (hash-table-intern! ht key failure) + (hash-table-ref ht key (lambda () + (let ((res (failure))) + (hash-table-set! ht key res) + res)))) + +(define (intern-keyword! name mac-env) + (hash-table-intern! keywords name + (lambda () + (cons + name + (make-macro + (lambda (expr use-env mac-env) + (error "invalid use of auxiliary syntax" + name)) + mac-env))))) + +(%define-syntax define-keyword + (lambda (expr use-env mac-env) + (let ((_begin (make-syntactic-closure mac-env '() 'begin)) + (id (cadr expr)) + (name (strip-syntactic-closures (car (cddr expr))))) + (env-push-rename! use-env id (intern-keyword! name mac-env)) + `(,_begin)))) diff --git a/lib/chibi/keyword.sld b/lib/chibi/keyword.sld new file mode 100644 index 00000000..26434fbb --- /dev/null +++ b/lib/chibi/keyword.sld @@ -0,0 +1,6 @@ +(define-library (chibi keyword) + (export define-keyword) + (import (chibi) + (chibi ast) + (srfi 69)) + (include "keyword.scm")) diff --git a/tests/lib-tests.scm b/tests/lib-tests.scm index 8a200931..035751ab 100644 --- a/tests/lib-tests.scm +++ b/tests/lib-tests.scm @@ -46,6 +46,7 @@ (rename (chibi io-test) (run-tests run-io-tests)) (rename (chibi iset-test) (run-tests run-iset-tests)) (rename (chibi json-test) (run-tests run-json-tests)) + (rename (chibi keyword-test) (run-tests run-keyword-tests)) (rename (chibi log-test) (run-tests run-log-tests)) (rename (chibi loop-test) (run-tests run-loop-tests)) (rename (chibi match-test) (run-tests run-match-tests)) @@ -111,6 +112,7 @@ (run-io-tests) (run-iset-tests) (run-json-tests) +(run-keyword-tests) (run-log-tests) (run-loop-tests) (run-match-tests)