|
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)