SRFI-99

Check-in [33bbdd30f3]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Procedures to list properties of a record type
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:33bbdd30f30a7d2b84b1d8e07417a101143ec7c6
User & Date: murphy 2015-02-06 01:16:13
Context
2015-02-06
01:16
Bumped .setup version to 1.4.3 check-in: 99877f1bf6 user: murphy tags: trunk, v1.4.3
01:16
Procedures to list properties of a record type check-in: 33bbdd30f3 user: murphy tags: trunk
2014-09-05
13:57
updated release information check-in: caf415d0a0 user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to srfi-99.scm.

249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
...
309
310
311
312
313
314
315
















316
317
318
319
320
321
322

)

(module srfi-99-records-inspection
  (record? record-rtd
   rtd-name rtd-uid rtd-sealed? rtd-opaque? rtd-parent
   rtd-field-names rtd-all-field-names rtd-field-mutable?
   make-rtp)
  (import
   scheme chicken
   srfi-1 srfi-69 srfi-99-primitives srfi-99-records-procedural data-structures)

(define (record-rtd v)
  (and (record? v)
       (%get-rtd (##sys#slot v 0))))
................................................................................
    (let ((accessor (let next ((rtd (and (##sys#structure? rtd 'rtd) rtd)))
		      (if rtd
			  (hash-table-ref (%rtd-properties rtd) rtp
					  (cut next (%rtd-parent rtd)))
			  default))))
      (accessor v))))

















)

(module srfi-99-records-syntactic
  (define-record-type
   define-record-constructor
   %define-record-constructor/default
   define-record-predicate







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
...
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338

)

(module srfi-99-records-inspection
  (record? record-rtd
   rtd-name rtd-uid rtd-sealed? rtd-opaque? rtd-parent
   rtd-field-names rtd-all-field-names rtd-field-mutable?
   make-rtp rtd-properties rtd-all-properties)
  (import
   scheme chicken
   srfi-1 srfi-69 srfi-99-primitives srfi-99-records-procedural data-structures)

(define (record-rtd v)
  (and (record? v)
       (%get-rtd (##sys#slot v 0))))
................................................................................
    (let ((accessor (let next ((rtd (and (##sys#structure? rtd 'rtd) rtd)))
		      (if rtd
			  (hash-table-ref (%rtd-properties rtd) rtp
					  (cut next (%rtd-parent rtd)))
			  default))))
      (accessor v))))

(define (rtd-properties rtd)
  (if (##sys#structure? rtd 'rtd)
      (hash-table-keys (%rtd-properties rtd))
      '()))

(define (rtd-all-properties rtd)
  (let ((rtps (make-hash-table #:test eq? #:hash eq?-hash)))
    (let next ((rtd (and (##sys#structure? rtd 'rtd) rtd)))
      (if rtd
	  (begin
	    (hash-table-walk
	     (%rtd-properties rtd)
	     (lambda (rtp accessor) (hash-table-set! rtps rtp #t)))
	    (next (%rtd-parent rtd)))
	  (hash-table-keys rtps)))))

)

(module srfi-99-records-syntactic
  (define-record-type
   define-record-constructor
   %define-record-constructor/default
   define-record-predicate