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)

Re: In favor of explicit argument Marc Nieper-Wißkirchen 12 Aug 2020 19:46 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)