From 519b05f5281572ef9f6f686844af25159ca5896e Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 20 Jan 2025 17:57:11 -0800
Subject: 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.
---
 autoload.c        | 16 ++++++++++
 stdlib/enum.tl    | 46 ++++++++++++++++++++++++++++
 tests/016/enum.tl | 23 ++++++++++++++
 txr.1             | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 174 insertions(+)
 create mode 100644 stdlib/enum.tl
 create mode 100644 tests/016/enum.tl

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
-- 
cgit v1.2.3