protobuf

Check-in [1bff86b4c4]
Login

Check-in [1bff86b4c4]

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

Overview
Comment:Fixed generic serialization problems
Downloads: Tarball | ZIP 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.751
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
Unified Diff Ignore Whitespace Patch
Changes to extend/protobuf/chicken.proto.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
// This file is part of Protocol Buffers for CHICKEN
// Copyright (c) 2013 by Thomas Chust.  All rights reserved.
//
// 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










|


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
// This file is part of Protocol Buffers for CHICKEN
// Copyright (c) 2013 by Thomas Chust.  All rights reserved.
//
// 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
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

  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.







|
|









|







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

  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
  #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))))







>
>
>
>



|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
  #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))))
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
       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)







|





|







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
       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)
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
        [(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)







|






|







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
        [(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
       (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







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







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
       (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
139
140
141
142
143
144
145


















































146
       (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: ;;







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

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 (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
    (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!")))







>
>







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
    (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!")))