[Guile-commits] 04/07: Deprecate two-arg `record-constructor'

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f7b4055b16336aa5af8b48f53c0267c9d7182c2e
Author: Andy Wingo <address@hidden>
Date:   Tue Oct 22 13:59:33 2019 +0200

    Deprecate two-arg `record-constructor'
    
    * module/ice-9/boot-9.scm (record-constructor): Deprecate the two-arg
      form.
---
 module/ice-9/boot-9.scm | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index cbe8b5e..2e6adde 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1282,17 +1282,24 @@ VALUE."
       (struct-ref obj (+ 1 vtable-offset-user))
       (error 'not-a-record-type obj)))
 
-(define* (record-constructor rtd #:optional field-names)
-  (if (not field-names)
-      (struct-ref rtd (+ 2 vtable-offset-user))
-      (primitive-eval
-       `(lambda ,field-names
-          (make-struct/no-tail ',rtd
-                               ,@(map (lambda (f)
-                                        (if (memq f field-names)
-                                            f
-                                            #f))
-                                      (record-type-fields rtd)))))))
+(define record-constructor
+  (case-lambda
+   ((rtd)
+    (struct-ref rtd (+ 2 vtable-offset-user)))
+   ((rtd field-names)
+    (issue-deprecation-warning
+     "Calling `record-constructor' with two arguments (the record type"
+     " and a list of field names) is deprecated.  Instead, call with just"
+     " one argument, and provide a wrapper around that constructor if"
+     " needed.")
+    (primitive-eval
+     `(lambda ,field-names
+        (make-struct/no-tail ',rtd
+                             ,@(map (lambda (f)
+                                      (if (memq f field-names)
+                                          f
+                                          #f))
+                                    (record-type-fields rtd))))))))
           
 (define (record-predicate rtd)
   (lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))