From ef85fa953b5c5c222de90cdd00303e10cfd77c88 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 27 Jun 2017 06:56:58 -0700
Subject: ffi: new enumed type operator: enums with base type.

* ffi.c (enumed_s): New symbol variable.
(ffi_type_compile): New case for enumed type op.
(ffi_init): Initialize enumed_s.

* ffi.h (enumed_s): Declared.

* txr.1: enumed documented.
---
 ffi.c | 14 +++++++++++++-
 ffi.h |  2 +-
 txr.1 | 26 ++++++++++++++++++++++++++
 3 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/ffi.c b/ffi.c
index ca8ab24b..c4f5bcd1 100644
--- a/ffi.c
+++ b/ffi.c
@@ -123,7 +123,7 @@ val closure_s;
 
 val sbit_s, ubit_s, bit_s;
 
-val enum_s;
+val enum_s, enumed_s;
 
 val align_s;
 
@@ -3487,6 +3487,17 @@ val ffi_type_compile(val syntax)
                   lit("~a: enum name ~s must be bindable symbol or nil"),
                   self, name, nao);
       return make_ffi_type_enum(xsyntax, enums, ffi_type_lookup(int_s), self);
+    } else if (sym == enumed_s) {
+      val base_type_syntax = cadr(syntax);
+      val name = caddr(syntax);
+      val enums = cdddr(syntax);
+      val xsyntax = list(enumed_s, base_type_syntax, name, nao);
+      val base_type = ffi_type_compile(base_type_syntax);
+      if (name && !bindable(name))
+        uw_throwf(error_s,
+                  lit("~a: enum name ~s must be bindable symbol or nil"),
+                  self, name, nao);
+      return make_ffi_type_enum(xsyntax, enums, base_type, self);
     } else if (sym == align_s) {
       val align = ffi_eval_expr(cadr(syntax), nil, nil);
       ucnum al = c_num(align);
@@ -5339,6 +5350,7 @@ void ffi_init(void)
   ubit_s = intern(lit("ubit"), user_package);
   bit_s = intern(lit("bit"), user_package);
   enum_s = intern(lit("enum"), user_package);
+  enumed_s = intern(lit("enumed"), user_package);
   align_s = intern(lit("align"), user_package);
   bool_s = intern(lit("bool"), user_package);
   ffi_type_s = intern(lit("ffi-type"), user_package);
diff --git a/ffi.h b/ffi.h
index 34aca3c6..351dedb5 100644
--- a/ffi.h
+++ b/ffi.h
@@ -63,7 +63,7 @@ extern val closure_s;
 
 extern val sbit_s, ubit_s, bit_s;
 
-extern val enum_s;
+extern val enum_s, enumed_s;
 
 extern val align_s;
 
diff --git a/txr.1 b/txr.1
index 42c6bb0f..5cc0d178 100644
--- a/txr.1
+++ b/txr.1
@@ -54492,6 +54492,32 @@ that integer value itself rather than a symbol. If an integer value occurs
 which is assigned to multiple enumeration symbols, it is not specified which
 of those symbols is produced.
 
+.meIP (enumed < type < name >> {( sym << value ) | << sym }*)
+The
+.code enumed
+type operator is a generalization of
+.code enum
+which allows the base integer type of the enumeration to be specified.
+The following equivalence holds:
+
+.cblk
+  (enum n a b c ...)  <-->  (enumed int n a b c ...)
+.cble
+
+Any integer type or
+.meta typedef
+name may be specified for
+.metn type ,
+including any one of the endian types. The enumeration inherits its
+size, alignment and other foreign representation details from
+.metn type .
+
+The values associated with the enumeration symbols must be in
+the representation range of
+.metn type ,
+which is not checked until the conversion of a symbol
+through the enumeration is is attempted at run time.
+
 .meIP (struct < name >> {( slot << type )}*)
 The FFI
 .code struct
-- 
cgit v1.2.3