protobuf

Check-in [1bff86b4c4]
Login

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

Overview
Comment:Fixed generic serialization problems
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | chicken-5
Files: files | file ages | folders
SHA3-256: 1bff86b4c49364ebffca3987558c9db8bc710112378c002b88612f16ebd09156
User & Date: murphy 2018-08-19 02:35:48
Context
2018-08-19
02:43
Updated copyright years check-in: a732bce3c5 user: murphy tags: chicken-5
02:35
Fixed generic serialization problems check-in: 1bff86b4c4 user: murphy tags: chicken-5
02:08
Ported the egg to CHICKEN 5 check-in: 3b4b1696e6 user: murphy tags: chicken-5
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to extend/protobuf/chicken.proto.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
// Permission is hereby granted, free of charge, to any person
// obtaining a copy of this software and associated documentation
// files (the Software), to deal in the Software without restriction,
// including without limitation the rights to use, copy, modify,
// merge, publish, distribute, sublicense, and/or sell copies of the
// Software, and to permit persons to whom the Software is furnished
// to do so, subject to the following conditions:
// 
// The above copyright notice and this permission notice shall be
// included in all copies or substantial portions of the Software.
// 
// THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND,
// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
// BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
// ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
// CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
................................................................................

  optional bytes u8vector = 16;
  optional bytes s8vector = 17;
  repeated uint32 u16vector = 18 [packed = true];
  repeated sint32 s16vector = 19 [packed = true];
  repeated uint32 u32vector = 20 [packed = true];
  repeated sint32 s32vector = 21 [packed = true];
  repeated uint64 u64vector = 22 [packed = true]; // for future extensions
  repeated sint64 s64vector = 23 [packed = true]; // for future extensions
  repeated float f32vector = 24 [packed = true];
  repeated double f64vector = 25 [packed = true];
  optional bytes blob = 26;

  optional Custom custom = 13;
  optional Vector record = 14;
  optional uint64 shared = 15;
}

// Arbitrary precision real numeric value. Either n or x should be set.
message Real {
  optional sint64 numer = 1 [(extend.protobuf.max_size) = 0];
  optional sint64 denom = 2 [default = 1, (extend.protobuf.max_size) = 0];
  optional double flonum = 3;
}

// Arbitrary precision complex numeric value.







|


|







 







|
|









|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
// Permission is hereby granted, free of charge, to any person
// obtaining a copy of this software and associated documentation
// files (the Software), to deal in the Software without restriction,
// including without limitation the rights to use, copy, modify,
// merge, publish, distribute, sublicense, and/or sell copies of the
// Software, and to permit persons to whom the Software is furnished
// to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be
// included in all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND,
// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
// BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
// ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
// CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
................................................................................

  optional bytes u8vector = 16;
  optional bytes s8vector = 17;
  repeated uint32 u16vector = 18 [packed = true];
  repeated sint32 s16vector = 19 [packed = true];
  repeated uint32 u32vector = 20 [packed = true];
  repeated sint32 s32vector = 21 [packed = true];
  repeated uint64 u64vector = 22 [packed = true];
  repeated sint64 s64vector = 23 [packed = true];
  repeated float f32vector = 24 [packed = true];
  repeated double f64vector = 25 [packed = true];
  optional bytes blob = 26;

  optional Custom custom = 13;
  optional Vector record = 14;
  optional uint64 shared = 15;
}

// Arbitrary precision real numeric value. Either numer or flonum should be set.
message Real {
  optional sint64 numer = 1 [(extend.protobuf.max_size) = 0];
  optional sint64 denom = 2 [default = 1, (extend.protobuf.max_size) = 0];
  optional double flonum = 3;
}

// Arbitrary precision complex numeric value.

Changes to generic.scm.

29
30
31
32
33
34
35




36
37
38
39
40
41
42
43
44
45
46
...
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
...
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
  #f #t
  obj->ref
  ref->obj)

(define current-serialization-context
  (make-parameter #f))





(define make-serialization-context
  (let ([make-serialization-context* (rtd-constructor serialization-context)])
    (lambda vs
      (let* ([obj->ref (make-hash-table eq? eq?-hash)]
             [ref->obj (make-hash-table eqv? eqv?-hash)]
             [context (make-serialization-context* obj->ref ref->obj)])
        (do-ec (:list v (index ref) (cons context vs))
          (begin
            (hash-table-set! obj->ref v ref)
            (hash-table-set! ref->obj ref v)))
        context))))
................................................................................
       v port)]
     [(s32vector? v)
      (write-tag/type 21 'sized port)
      (write-sized
       (lambda (block port)
         (do-ec (:s32vector v block) (write-sint* v port)))
       v port)]
     #;[(u64vector? v)
      (write-tag/type 22 'sized port)
      (write-sized
       (lambda (block port)
         (do-ec (:u64vector v block) (write-uint* v port)))
       v port)]
     #;[(s64vector? v)
      (write-tag/type 23 'sized port)
      (write-sized
       (lambda (block port)
         (do-ec (:s64vector v block) (write-sint* v port)))
       v port)]
     [(f32vector? v)
      (write-tag/type 24 'sized port)
................................................................................
        [(21)
         (ensure-type 'sized type "s32vector")
         (remember!
          (read-sized
           (lambda (port)
             (s32vector-ec (:port v port read-sint*) v))
           port))]
        #;[(22)
         (ensure-type 'sized type "u64vector")
         (remember!
          (read-sized
           (lambda (port)
             (u64vector-ec (:port v port read-uint*) v))
           port))]
        #;[(23)
         (ensure-type 'sized type "s64vector")
         (remember!
          (read-sized
           (lambda (port)
             (s64vector-ec (:port v port read-sint*) v))
           port))]
        [(24)







>
>
>
>



|







 







|





|







 







|






|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
...
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
  #f #t
  obj->ref
  ref->obj)

(define current-serialization-context
  (make-parameter #f))

(define %eq?-hash
  (foreign-lambda* int ([scheme-object v] [int bound])
    "C_return((((intptr_t) v) >> C_FIXNUM_SHIFT) % bound);"))

(define make-serialization-context
  (let ([make-serialization-context* (rtd-constructor serialization-context)])
    (lambda vs
      (let* ([obj->ref (make-hash-table eq? %eq?-hash)]
             [ref->obj (make-hash-table eqv? eqv?-hash)]
             [context (make-serialization-context* obj->ref ref->obj)])
        (do-ec (:list v (index ref) (cons context vs))
          (begin
            (hash-table-set! obj->ref v ref)
            (hash-table-set! ref->obj ref v)))
        context))))
................................................................................
       v port)]
     [(s32vector? v)
      (write-tag/type 21 'sized port)
      (write-sized
       (lambda (block port)
         (do-ec (:s32vector v block) (write-sint* v port)))
       v port)]
     [(u64vector? v)
      (write-tag/type 22 'sized port)
      (write-sized
       (lambda (block port)
         (do-ec (:u64vector v block) (write-uint* v port)))
       v port)]
     [(s64vector? v)
      (write-tag/type 23 'sized port)
      (write-sized
       (lambda (block port)
         (do-ec (:s64vector v block) (write-sint* v port)))
       v port)]
     [(f32vector? v)
      (write-tag/type 24 'sized port)
................................................................................
        [(21)
         (ensure-type 'sized type "s32vector")
         (remember!
          (read-sized
           (lambda (port)
             (s32vector-ec (:port v port read-sint*) v))
           port))]
        [(22)
         (ensure-type 'sized type "u64vector")
         (remember!
          (read-sized
           (lambda (port)
             (u64vector-ec (:port v port read-uint*) v))
           port))]
        [(23)
         (ensure-type 'sized type "s64vector")
         (remember!
          (read-sized
           (lambda (port)
             (s64vector-ec (:port v port read-sint*) v))
           port))]
        [(24)

Changes to protobuf.egg.

1
2
3
4
5
6
7
8
9
10
11
12
((category data io)
 (synopsis "Protocol buffer serialization")
 (author "Thomas Chust")
 (license "BSD")
 (version "1.1.3")
 (dependencies
   srfi-4
   srfi-13
   srfi-18
   srfi-42
   srfi-69
   srfi-99)




|







1
2
3
4
5
6
7
8
9
10
11
12
((category data io)
 (synopsis "Protocol buffer serialization")
 (author "Thomas Chust")
 (license "BSD")
 (version "1.2.0")
 (dependencies
   srfi-4
   srfi-13
   srfi-18
   srfi-42
   srfi-69
   srfi-99)

Changes to srfi-4-comprehensions.scm.

43
44
45
46
47
48
49
























50
51
52
53
54
55
56
...
139
140
141
142
143
144
145


















































146
       (fx< i (u8vector-length v))
       (let ([var (u8vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:u8vector cc var arg)
     (:u8vector cc var (index i) arg)]))

























(define-syntax u16vector-of-length-ec
  (syntax-rules ()
    [(u16vector-ec size args ... expr)
     (let ([v (make-u16vector size)])
       (do-ec (:integers i) args ... (u16vector-set! v i expr)))]))

(define-syntax u16vector-ec
................................................................................
       (fx< i (s32vector-length v))
       (let ([var (s32vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:s32vector cc var arg)
     (:s32vector cc var (index i) arg)]))



















































;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;







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







 







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

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
...
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
       (fx< i (u8vector-length v))
       (let ([var (u8vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:u8vector cc var arg)
     (:u8vector cc var (index i) arg)]))

(define-syntax s8vector-of-length-ec
  (syntax-rules ()
    [(s8vector-ec size args ... expr)
     (let ([v (make-s8vector size)])
       (do-ec (:integers i) args ... (s8vector-set! v i expr)))]))

(define-syntax s8vector-ec
  (syntax-rules ()
    [(s8vector-ec args ...)
     (list->s8vector (list-ec args ...))]))

(define-syntax :s8vector
  (syntax-rules (index)
    [(:s8vector cc var (index i) arg)
     (:do cc
       (let ([v arg]))
       ([i 0])
       (fx< i (s8vector-length v))
       (let ([var (s8vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:s8vector cc var arg)
     (:s8vector cc var (index i) arg)]))

(define-syntax u16vector-of-length-ec
  (syntax-rules ()
    [(u16vector-ec size args ... expr)
     (let ([v (make-u16vector size)])
       (do-ec (:integers i) args ... (u16vector-set! v i expr)))]))

(define-syntax u16vector-ec
................................................................................
       (fx< i (s32vector-length v))
       (let ([var (s32vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:s32vector cc var arg)
     (:s32vector cc var (index i) arg)]))

(define-syntax u64vector-of-length-ec
  (syntax-rules ()
    [(u64vector-ec size args ... expr)
     (let ([v (make-u64vector size)])
       (do-ec (:integers i) args ... (u64vector-set! v i expr)))]))

(define-syntax u64vector-ec
  (syntax-rules ()
    [(u64vector-ec args ...)
     (list->u64vector (list-ec args ...))]))

(define-syntax :u64vector
  (syntax-rules (index)
    [(:u64vector cc var (index i) arg)
     (:do cc
       (let ([v arg]))
       ([i 0])
       (fx< i (u64vector-length v))
       (let ([var (u64vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:u64vector cc var arg)
     (:u64vector cc var (index i) arg)]))

(define-syntax s64vector-of-length-ec
  (syntax-rules ()
    [(s64vector-ec size args ... expr)
     (let ([v (make-s64vector size)])
       (do-ec (:integers i) args ... (s64vector-set! v i expr)))]))

(define-syntax s64vector-ec
  (syntax-rules ()
    [(s64vector-ec args ... expr)
     (blob->s64vector/shared
      (u64vector->blob/shared
       (list->u64vector (list-ec args ... (modulo expr #x10000000000000000)))))]))

(define-syntax :s64vector
  (syntax-rules (index)
    [(:s64vector cc var (index i) arg)
     (:do cc
       (let ([v arg]))
       ([i 0])
       (fx< i (s64vector-length v))
       (let ([var (s64vector-ref v i)]))
       #t
       ((fx+ i 1)))]
    [(:s64vector cc var arg)
     (:s64vector cc var (index i) arg)]))

;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;

Changes to tests/generic.scm.

129
130
131
132
133
134
135


136
137
138
139
140
141
142
143
144
145
146
    (test-group "homogeneous blobs"
      (test-invariance '#u8(1 2 3))
      (test-invariance '#s8(-1 0 +1))
      (test-invariance '#u16(1 2 3))
      (test-invariance '#s16(-1 0 +1))
      (test-invariance '#u32(1 2 3))
      (test-invariance '#s32(-1 0 +1))


      (test-invariance '#f32(1.234 5.678))
      (test-invariance '#f64(1.234 5.678))
      (test-invariance '#${983729423476237887246302}))

    (test-group "records"
      (test-invariance (make-foo 42+23i "Hallo Welt!"))
      (test-invariance (make-bar "kawumm!")))
    
    ))

;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;







>
>











129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
    (test-group "homogeneous blobs"
      (test-invariance '#u8(1 2 3))
      (test-invariance '#s8(-1 0 +1))
      (test-invariance '#u16(1 2 3))
      (test-invariance '#s16(-1 0 +1))
      (test-invariance '#u32(1 2 3))
      (test-invariance '#s32(-1 0 +1))
      (test-invariance '#u64(1 2 3))
      (test-invariance '#s64(-1 0 +1))
      (test-invariance '#f32(1.234 5.678))
      (test-invariance '#f64(1.234 5.678))
      (test-invariance '#${983729423476237887246302}))

    (test-group "records"
      (test-invariance (make-foo 42+23i "Hallo Welt!"))
      (test-invariance (make-bar "kawumm!")))
    
    ))

;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;