From 73890bf51805d416936b0d1e7ef87e6fe840010e Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 9 Jul 2017 11:24:01 -0700
Subject: structs: improve access to initfun and postinitfun.

In this change, a struct type's initfun and postinitfun
become mutable. This is achieved by modeling them as
the pseudo-static-slots :initfun and :postinitfun.
Effectively these now behave as reserved names which do not
denote static slots but these special functions.

* eval.c (lookup_fun): When (meth type slot) syntax is
encountered, treat the slot names :init and :postinit
specially: retrieve these special functions instead of
accessing static slots.

* share/txr/stdlib/place.tl (sys:get-fun-getter-setter):
Similarly, when handling (meth type slot) syntax, return
the alternative getter/setter functions for the special
functions, not the static slot accessing functions.
Also, getting rid of a useless @1 here in existing code,
since (op foo @1) is equivalent to (op foo).

* share/txr/stdlib/struct.tl (sys:defmeth): Check for
the special names :init and :postinit, handling these
through the appropriate setter functions rather than
static-slot-ensure.

* struct.c (init_k, postinit_k): New keyword symbol variables.
(struct_init): Initialize init_k and postinit_k. Register
intrinsics struct-get-initfun, struct-set-initfun,
struct-get-postinitfun and struct-set-postinitfun.
* (struct_get_initfun, struct_set_initfun,
struct_get_postinitfun, struct_set_postinitfun): New
functions.
(method_name): For each struct type visited, check
whether the function is the initfun or postinitfun
and return the appropriate meth syntax if so.

* struct.h (init_k, postinit_k, struct_get_initfun,
struct_set_initfun, struct_get_postinitfun,
struct_set_postinitfun): Declared.

* txr.1: Documented. Updated description of method-name,
defmeth, and documented new functions.
---
 share/txr/stdlib/place.tl  | 9 +++++++--
 share/txr/stdlib/struct.tl | 5 ++++-
 2 files changed, 11 insertions(+), 3 deletions(-)

(limited to 'share')

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 2e15118b..90251726 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -803,8 +803,13 @@
   (tree-case sym
     ((type struct slot)
       (if (eq type 'meth)
-        (cons (op static-slot struct slot)
-              (op static-slot-set struct slot @1))
+        (caseql slot
+          (:init (cons (op struct-get-initfun struct)
+                       (op struct-set-initfun struct)))
+          (:postinit (cons (op struct-get-postinitfun struct)
+                           (op struct-set-postinitfun struct)))
+          (t (cons (op static-slot struct slot)
+                   (op static-slot-set struct slot))))
         :))
     ((type sym)
       (if (eq type 'macro)
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 8548e03a..68b86c95 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -286,7 +286,10 @@
   ^[(fun umethod) ',slot ,*bound-args])
 
 (defun sys:defmeth (type-sym name fun)
-  (static-slot-ensure type-sym name fun)
+  (caseq name
+    (:init (struct-set-initfun type-sym fun))
+    (:postinit (struct-set-postinitfun type-sym fun))
+    (t (static-slot-ensure type-sym name fun)))
   ^(meth ,type-sym ,name))
 
 (defmacro defmeth (:form form type-sym name arglist . body)
-- 
cgit v1.2.3