summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2025-01-20 17:57:11 -0800
committerKaz Kylheku <kaz@kylheku.com>2025-01-20 17:57:11 -0800
commit519b05f5281572ef9f6f686844af25159ca5896e (patch)
tree1ed3f04d2ed983adfccbc2998d104a0f75041281
parent2a24f429dffbc4c928d46e95ffdf3b8fe01a7eab (diff)
downloadtxr-519b05f5281572ef9f6f686844af25159ca5896e.tar.gz
txr-519b05f5281572ef9f6f686844af25159ca5896e.tar.bz2
txr-519b05f5281572ef9f6f686844af25159ca5896e.zip
New macros for enumerated constants.
* autoload.c (enum_set_entries, enum_instantiate): New static functions. (autoload_init): Register autoload of stdlib/enum module via new functions. * stdlib/enum.tl: New file. * tests/016/enum.tl: Likewise. * txr.1: Documented.
-rw-r--r--autoload.c16
-rw-r--r--stdlib/enum.tl46
-rw-r--r--tests/016/enum.tl23
-rw-r--r--txr.189
4 files changed, 174 insertions, 0 deletions
diff --git a/autoload.c b/autoload.c
index 9808c141..dd1ef410 100644
--- a/autoload.c
+++ b/autoload.c
@@ -1004,6 +1004,21 @@ static val glob_instantiate(void)
return nil;
}
+static val enum_set_entries(val fun)
+{
+ val name[] = {
+ lit("defenum"), lit("enumlet"),
+ nil
+ };
+ autoload_set(al_fun, name, fun);
+ return nil;
+}
+
+static val enum_instantiate(void)
+{
+ load(scat2(stdlib_path, lit("enum")));
+ return nil;
+}
val autoload_reg(val (*instantiate)(void),
val (*set_entries)(val))
@@ -1076,6 +1091,7 @@ void autoload_init(void)
autoload_reg(load_args_instantiate, load_args_set_entries);
autoload_reg(csort_instantiate, csort_set_entries);
autoload_reg(glob_instantiate, glob_set_entries);
+ autoload_reg(enum_instantiate, enum_set_entries);
reg_fun(intern(lit("autoload-try-fun"), system_package), func_n1(autoload_try_fun));
}
diff --git a/stdlib/enum.tl b/stdlib/enum.tl
new file mode 100644
index 00000000..0d39a5e0
--- /dev/null
+++ b/stdlib/enum.tl
@@ -0,0 +1,46 @@
+;; Copyright 2025
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright notice,
+;; this list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;; this list of conditions and the following disclaimer in the documentation
+;; and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+;; POSSIBILITY OF SUCH DAMAGE.
+
+(defun normalize-enum-pairs (f enum-pairs)
+ (let ((n 0))
+ (keep-matches (@(or (@sym @init)
+ @(with @sym init n))
+ enum-pairs)
+ (unless (bindable sym)
+ (compile-error f "~s isn't a bindable symbol" sym))
+ (unless (or (integerp init) (chrp init))
+ (compile-error f "~s must be an integer or character" init))
+ (set n (succ init))
+ ^(,sym ,init))))
+
+(defmacro defenum (:form f . enum-pairs)
+ (let ((nep (normalize-enum-pairs f enum-pairs)))
+ ^(progn ,*(mapcar (op cons 'defsymacro) nep))))
+
+(defmacro enumlet (:form f enum-pairs . body)
+ (let ((nep (normalize-enum-pairs f enum-pairs)))
+ ^(symacrolet ,nep ,*body)))
diff --git a/tests/016/enum.tl b/tests/016/enum.tl
new file mode 100644
index 00000000..b8817f4b
--- /dev/null
+++ b/tests/016/enum.tl
@@ -0,0 +1,23 @@
+(load "../common.tl")
+
+(mtest
+ (macroexpand '(defenum)) (progn)
+ (macroexpand '(defenum nil)) :error
+ (macroexpand '(defenum t)) :error
+ (macroexpand '(defenum :key)) :error
+ (macroexpand '(defenum (a "x"))) :error
+ (macroexpand '(defenum a (b "x"))) :error
+ (macroexpand '(defenum a)) (progn (defsymacro a 0))
+ (macroexpand '(defenum a b)) (progn (defsymacro a 0) (defsymacro b 1))
+ (macroexpand '(defenum a (b 2))) (progn (defsymacro a 0) (defsymacro b 2))
+ (macroexpand '(defenum (a 5) b)) (progn (defsymacro a 5) (defsymacro b 6))
+ (macroexpand '(defenum (a 5) (b 7))) (progn (defsymacro a 5) (defsymacro b 7))
+ (macroexpand '(defenum a (b #\b))) (progn (defsymacro a 0) (defsymacro b #\b))
+ (macroexpand '(defenum (a #\a) b)) (progn (defsymacro a #\a) (defsymacro b #\b))
+ (macroexpand '(defenum (a #\a) (b #\x))) (progn (defsymacro a #\a) (defsymacro b #\x))
+ (macroexpand '(defenum a b c)) (progn (defsymacro a 0) (defsymacro b 1) (defsymacro c 2)))
+
+(mtest
+ (enumlet (a b c) (list a b c)) (0 1 2)
+ (enumlet ((a 10) b c) (list a b c)) (10 11 12)
+ (enumlet ((a #\a) b c) (list a b c)) (#\a #\b #\c))
diff --git a/txr.1 b/txr.1
index 85116591..a4bf6237 100644
--- a/txr.1
+++ b/txr.1
@@ -53186,6 +53186,95 @@ which must be an integer.
.um logcount
.um bitset
+.SS* Enumerated Constants
+
+The enumerated constants module provides ways for defining
+multiple constants whose names are ranges of consecutive integers
+or characters.
+
+Enumerated constants are implemented as symbol macros.
+
+.coNP Macro @ defenum
+.synb
+.mets (defenum >> { sym | >> ( sym << value )}*)
+.syne
+.desc
+The
+.code defenum
+macro defines zero or more constants, whose names are given by the
+.meta sym
+arguments.
+
+The
+.meta sym
+arguments must be bindable symbols.
+Each argument to
+.code defenum
+must be either a
+.meta sym
+or else a two-element expression combining a
+.meta sym
+and a
+.metn value .
+The
+.meta value
+must be an integer or character object. The
+.meta value
+is not an expression subject to evaluation.
+
+If no
+.meta value
+is specified for the leftmost
+.metn sym ,
+that
+.meta sym
+is implicitly associated with the value
+.code 0
+(integer zero).
+In any other position, if no
+.meta value
+is specified for a
+.metn sym ,
+it is implicitly associated with a value one greater than
+the value of the previous
+.metn sym ,
+as computed by the
+.code succ
+function applied to that value.
+
+The
+.code defenum
+macro generates a which establishes each
+.meta sym
+as a global symbol macro (as if by
+.codn defsymacro )
+whose value is the corresponding
+.metn value .
+
+.coNP Macro @ enumlet
+.synb
+.mets (enumlet >> ({ sym | >> ( sym << value )}*) << body-form *)
+.syne
+.desc
+The arguments of
+.code enumlet
+are subject exactly the same restrictions and denote the same
+.meta sym
+and
+.meta value
+associations as those of
+.codn defenum .
+
+Whereas the
+.code defenum
+macro generates a form that binds global symbol macros, the
+.code enumlet
+macro generates a form which binds local symbol macros (as if by
+.codn symacrolet )
+and arranges for zero or more
+.metn body-form s
+to be evaluated in the scope of these symbol macros.
+
.SS* Exception Handling
An