protobuf

// 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.

// 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.

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

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

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

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

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

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

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

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