source: project/release/4/srfi-27/trunk/source-registration.scm @ 35485

Last change on this file since 35485 was 35485, checked in by kon, 7 months ago

add vector & registration types

File size: 3.0 KB
Line 
1;;;; source-registration.scm
2;;;; Kon Lovett, Feb '17
3;;;; Kon Lovett, Oct '09
4
5(module source-registration
6
7(;export
8  make-source-registration
9  source-registration? check-source-registration error-source-registration
10  @source-registration-key
11  @source-registration-ref @source-registration-deref!
12  @source-registration-register!)
13
14(import scheme chicken)
15
16(use
17  (only data-structures alist-ref alist-update!)
18  (only srfi-1 alist-delete!)
19  (only type-checks define-check+error-type check-procedure check-symbol check-list))
20
21;;;
22
23(include "srfi-27-common-types")
24
25;;; Utilities
26
27(define (alist-keys alist)
28  (map car alist) )
29
30(define (alist-values alist)
31  (map cdr alist) )
32
33;;; Public
34
35(: *make-source-registration (source-registration-name alist procedure procedure procedure procedure --> source-registration))
36(: source-registration? (* -> boolean : source-registration))
37(: *source-registration-name (source-registration --> source-registration-name))
38(: *source-registration-sources (source-registration --> alist))
39(: *source-registration-sources-set! (source-registration alist -> void))
40(: @source-registration-key (source-registration --> procedure))
41(: @source-registration-ref (source-registration --> procedure))
42(: @source-registration-deref! (source-registration --> procedure))
43(: @source-registration-register! (source-registration --> procedure))
44;
45(define-record-type source-registration
46  (*make-source-registration nam srcs keys ref deref! reg!)
47  source-registration?
48  (nam    *source-registration-name)
49  (srcs   *source-registration-sources *source-registration-sources-set!)
50  (keys   @source-registration-key)
51  (ref    @source-registration-ref)
52  (deref! @source-registration-deref!)
53  (reg!   @source-registration-register!) )
54
55(define-check+error-type source-registration)
56
57;;
58
59(define (make-source-registration name sources)
60  (letrec (
61      (reg
62        (*make-source-registration
63          ;
64          (check-symbol 'make-source-registration name "name")
65          ;
66          (check-list 'make-source-registration sources "sources")
67          ;
68          (lambda ()
69            (alist-keys (*source-registration-sources reg)) )
70          ;
71          (lambda (name)
72            (alist-ref
73              (check-symbol 'source-registration-ref name)
74              (*source-registration-sources reg)
75              eq?
76              #f) )
77          ;
78          (lambda (name)
79            (*source-registration-sources-set!
80              reg
81              (alist-delete!
82                (check-symbol 'source-registration-deref! name)
83                (*source-registration-sources reg)
84                eq?)) )
85          ;
86          (lambda (name ctor)
87            (*source-registration-sources-set!
88              reg
89              (alist-update!
90                (check-symbol 'source-registration-register!! name)
91                (check-procedure 'source-registration-register! ctor)
92                (*source-registration-sources reg)
93                eq?)))) ) )
94    reg ) )
95
96) ;module source-registration
Note: See TracBrowser for help on using the repository browser.