1#lang racket/base
2(require "../common/contract.rkt"
3         "../host/linklet.rkt"
4         "write-linklet.rkt"
5         "correlated-linklet.rkt")
6
7(provide linklet-directory?
8         linklet-bundle?
9
10         hash->linklet-directory
11         hash->linklet-bundle
12
13         linklet-directory->hash
14         linklet-bundle->hash)
15
16(struct linklet-directory (ht)
17  #:property prop:custom-write (lambda (ld port mode)
18                                 (write-linklet-directory ld
19                                                          (correlated-linklet-directory? ld)
20                                                          linklet-directory->hash
21                                                          linklet-bundle->hash
22                                                          port)))
23
24(struct linklet-bundle (ht)
25  #:property prop:custom-write (lambda (b port mode)
26                                 (write-linklet-bundle b
27                                                       (correlated-linklet-bundle? b)
28                                                       linklet-bundle->hash
29                                                       port)))
30
31(define/who (hash->linklet-directory ht)
32  (check who (lambda (ht)
33               (and (not (impersonator? ht))
34                    (hash? ht)
35                    (immutable? ht)
36                    (hash-eq? ht)))
37         #:contract "(and/c hash? hash-eq? immutable? (not/c impersonator?))"
38         ht)
39  (for ([(k v) (in-hash ht)])
40    (cond
41      [(not k)
42       (unless (linklet-bundle? v)
43         (raise-arguments-error who
44                                "value for #f key is not a linklet bundle"
45                                "value" v))]
46      [(symbol? k)
47       (unless (linklet-directory? v)
48         (raise-arguments-error who
49                                "value for symbol key is not a linklet directory"
50                                "value" v))]
51      [else
52       (raise-arguments-error who
53                              "key in given hash is not #f or a symbol"
54                              "key" k)]))
55  (linklet-directory ht))
56
57(define/who (hash->linklet-bundle ht)
58  (check who (lambda (ht)
59               (and (not (impersonator? ht))
60                    (hash? ht)
61                    (immutable? ht)
62                    (hash-eq? ht)))
63         #:contract "(and/c hash? hash-eq? immutable? (not/c impersonator?))"
64         ht)
65  (for ([k (in-hash-keys ht)])
66    (unless (or (symbol? k) (fixnum? k))
67      (raise-arguments-error who
68                             "key in given hash is not a symbol or fixnum"
69                             "key" k)))
70  (linklet-bundle ht))
71
72(define/who (linklet-directory->hash ld)
73  (check who linklet-directory? ld)
74  (linklet-directory-ht ld))
75
76(define/who (linklet-bundle->hash ld)
77  (check who linklet-bundle? ld)
78  (linklet-bundle-ht ld))
79
80;; ----------------------------------------
81
82;; If there are no values that satisfy `linklet?`, then
83;; assume that we have `correlated-linklet?` values.
84
85(define (correlated-linklet-directory? ld)
86  (for/and ([(k v) (in-hash (linklet-directory->hash ld))])
87    (cond
88      [(not k) (correlated-linklet-bundle? v)]
89      [(symbol? k) (correlated-linklet-directory? v)]
90      [else #t])))
91
92(define (correlated-linklet-bundle? b)
93  (for/and ([(k v) (in-hash (linklet-bundle->hash b))])
94    (not (linklet? v))))
95