records: Add support for delayed fields.

* guix/records.scm (make-syntactic-constructor): Add #:delayed
  parameter.
  [delayed-field?]: New procedure.
  [wrap-field-value]: Use it.
  (define-record-type*)[delayed-field?, wrapped-field?]: New procedures.
  [thunked-field-accessor-name]: Rename to...
  [wrapped-field-accessor-name]: ... this.
  [field-spec->srfi-9]: Change 'thunked' to 'wrapped'.
  [delayed-field-accessor-definition]: New procedure.
  Compute delayed-field accessors and emit them.  Pass #:delayed to
  'make-syntactic-constructor'.
* tests/records.scm ("define-record-type* & delayed",
  "define-record-type* & delayed & default",
  "define-record-type* & delayed & inherited"): New tests.

1 files changed, 46 insertions, 1 deletions

diff --git a/tests/records.scm b/tests/records.scm
index e90d33d15d..a00e38db7d 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -139,6 +139,51 @@
              (parameterize ((mark (cons 'a 'b)))
                (eq? (foo-baz y) (mark))))))))
 
+(test-assert "define-record-type* & delayed"
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar (delayed)))
+
+    (let* ((calls 0)
+           (x     (foo (bar (begin (set! calls (1+ calls)) 3)))))
+      (and (zero? calls)
+           (equal? (foo-bar x) 3) (= 1 calls)
+           (equal? (foo-bar x) 3) (= 1 calls)
+           (equal? (foo-bar x) 3) (= 1 calls)))))
+
+(test-assert "define-record-type* & delayed & default"
+  (let ((mark #f))
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar (delayed) (default mark)))
+
+    (let ((x (foo)))
+      (set! mark 42)
+      (and (equal? (foo-bar x) 42)
+           (begin
+             (set! mark 7)
+             (equal? (foo-bar x) 42))))))
+
+(test-assert "define-record-type* & delayed & inherited"
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar (delayed))
+      (baz foo-baz (delayed)))
+
+    (let* ((m 1)
+           (n #f)
+           (x (foo (bar m) (baz n)))
+           (y (foo (inherit x) (baz 'b))))
+      (set! n 'a)
+      (and (equal? (foo-bar x) 1)
+           (eq? (foo-baz x) 'a)
+           (begin
+             (set! m 777)
+             (equal? (foo-bar y) 1))              ;promise was already forced
+           (eq? (foo-baz y) 'b)))))
+
 (test-assert "define-record-type* & missing initializers"
   (catch 'syntax-error
     (lambda ()