tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

define-record-type*: Add the `thunked' field definition keyword.

Browse Source 
* guix/utils.scm (define-record-type*)[make-syntactic-constructor]: Add
  a `thunked' parameter.
  (thunked-field?, field-bindings): New procedures.  Use the latter when
  generating `letrec*' bindings.
  [thunked-field?, thunked-field-accessor-name, field-spec->srfi-9,
  thunked-field-accessor-name]: New procedures.
  Use them when generating the `define-record-type' form, and to
  generated thunk field accessors, along call to
  `make-syntactic-constructor' with the new argument.
* tests/utils.scm ("define-record-type* & thunked",
  "define-record-type* & thunked & default",
  "define-record-type* & thunked & inherited"): New tests.
This commit is contained in:
Ludovic Courtès
2013-01-23 22:24:47 +01:00
parent 6798a8e485
commit bbb7a00e9a
2 changed files with 135 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
tests/utils.scm
View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -123,6 +123,55 @@
(match b (($ <foo> 1 2) #t))
(equal? b c)))))
(test-assert "define-record-type* & thunked"
(begin
(define-record-type* <foo> foo make-foo
foo?
(bar foo-bar)
(baz foo-baz (thunked)))
(let* ((calls 0)
(x (foo (bar 2)
(baz (begin (set! calls (1+ calls)) 3)))))
(and (zero? calls)
(equal? (foo-bar x) 2)
(equal? (foo-baz x) 3) (= 1 calls)
(equal? (foo-baz x) 3) (= 2 calls)))))
(test-assert "define-record-type* & thunked & default"
(begin
(define-record-type* <foo> foo make-foo
foo?
(bar foo-bar)
(baz foo-baz (thunked) (default 42)))
(let ((mark (make-parameter #f)))
(let ((x (foo (bar 2) (baz (mark))))
(y (foo (bar 2))))
(and (equal? (foo-bar x) 2)
(parameterize ((mark (cons 'a 'b)))
(eq? (foo-baz x) (mark)))
(equal? (foo-bar y) 2)
(equal? (foo-baz y) 42))))))
(test-assert "define-record-type* & thunked & inherited"
(begin
(define-record-type* <foo> foo make-foo
foo?
(bar foo-bar (thunked))
(baz foo-baz (thunked) (default 42)))
(let ((mark (make-parameter #f)))
(let* ((x (foo (bar 2) (baz (mark))))
(y (foo (inherit x) (bar (mark)))))
(and (equal? (foo-bar x) 2)
(parameterize ((mark (cons 'a 'b)))
(eq? (foo-baz x) (mark)))
(parameterize ((mark (cons 'a 'b)))
(eq? (foo-bar y) (mark)))
(parameterize ((mark (cons 'a 'b)))
(eq? (foo-baz y) (mark))))))))
;; This is actually in (guix store).
(test-equal "store-path-package-name"
"bash-4.2-p24"