;; -*- mode: Scheme; -*-
;;
;; This file is part of Protocol Buffers for CHICKEN
;; Copyright (c) 2018 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
;; SOFTWARE.

(define-syntax u8vector-of-length-ec
  (syntax-rules ()
    [(u8vector-ec size args ... expr)
     (let ([v (make-u8vector size)] [i 0])
       (do-ec args ...
         (begin
           (u8vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

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

(define-syntax :u8vector
  (syntax-rules (index)
    [(:u8vector cc var (index i) arg)
     (:do cc
       (let ([v arg]))
       ([i 0])
       (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)] [i 0])
       (do-ec args ...
         (begin
           (s8vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

(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)] [i 0])
       (do-ec args ...
         (begin
           (u16vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

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

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

(define-syntax s16vector-of-length-ec
  (syntax-rules ()
    [(s16vector-ec size args ... expr)
     (let ([v (make-s16vector size)] [i 0])
       (do-ec args ...
         (begin
           (s16vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

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

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

(define-syntax u32vector-of-length-ec
  (syntax-rules ()
    [(u32vector-ec size args ... expr)
     (let ([v (make-u32vector size)] [i 0])
       (do-ec args ...
         (begin
           (u32vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

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

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

(define-syntax s32vector-of-length-ec
  (syntax-rules ()
    [(s32vector-ec size args ... expr)
     (let ([v (make-s32vector size)] [i 0])
       (do-ec args ...
         (begin
           (s32vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

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

(define-syntax :s32vector
  (syntax-rules (index)
    [(:s32vector cc var (index i) arg)
     (:do cc
       (let ([v arg]))
       ([i 0])
       (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)] [i 0])
       (do-ec args ...
         (begin
           (u64vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

(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)] [i 0])
       (do-ec args ...
         (begin
           (s64vector-set! v i expr)
           (set! i (+ i 1))))
       v)]))

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