;;; CHICKEN Transducers - Transducers for working with foldable data types.
;;;
;;; Copyright (c) 2023 Jeremy Steward
;;;
;;; 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 "AS IS", 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-library (transducers numbers)
  (import (scheme base)
          (scheme case-lambda)
          (transducers base))

  (cond-expand
    (chicken-5
      (import (chicken type)
              (rename (chicken fixnum)
                      (fx= fx=?)
                      (fx< fx<?)
                      (fx<= fx<=?)
                      (fx> fx>?)
                      (fx>= fx>=?))
              (only (check-errors) define-check+error-type)
              (only type-checks-numbers check-number check-fixnum)))
    (else
      (error "Transducers does not yet support this R7RS Scheme implementation.")))

  (include-library-declarations "src/transducers.numbers.exports.scm")

  (begin
    ;; A record type that describes a numeric range of some variety.
    ;;
    ;; This can be a half-open interval of the form [start end), or just an
    ;; infinite counter.
    (define-record-type <numeric-range>
      ;; Constructor for the numeric-range type
      (make-numeric-range count start step)

      ;; Predicate to see if a type is a numeric-range
      numeric-range?

      ;; The count (number of total values output) in the range.
      (count numeric-range-count)

      ;; The starting value of the range.
      (start numeric-range-start)

      ;; The step between each value in the range.
      (step numeric-range-step))

    (define-check+error-type numeric-range numeric-range?)

    ;; A transducer aware folding operation over numeric ranges.
    (define (range-fold f sentinel range)
      (check-numeric-range 'range-fold range 'range)
      (let ((max-count (numeric-range-count range))
            (step (numeric-range-step range)))
        (let loop ((collector sentinel)
                   (number (numeric-range-start range))
                   (count 0))
          (if (< count max-count)
            (let ((result (f collector number)))
              (if (reduced? result)
                (unwrap result)
                (loop result
                      (+ number step)
                      (fx+ count 1))))
            collector))))

    ;; A transducer aware folding operation over numeric ranges that only contain fixnums.
    (define (fixnum-range-fold f sentinel range)
      (check-numeric-range 'fixnum-range-fold range 'range)
      (check-fixnum 'fixnum-range-fold
                    (numeric-range-count range))
      (check-fixnum 'fixnum-range-fold
                    (numeric-range-start range))
      (check-fixnum 'fixnum-range-fold
                    (numeric-range-step range))
      (let ((max-count (numeric-range-count range))
            (step (numeric-range-step range)))
        (let loop ((collector sentinel)
                   (number (numeric-range-start range))
                   (count 0))
          (if (fx<? count max-count)
            (let ((result (f collector number)))
              (if (reduced? result)
                (unwrap result)
                (loop result
                      (fx+ number step)
                      (fx+ count 1))))
            collector))))

    (cond-expand
      (chicken-5
        (: range (number number --> (struct <numeric-range>)))))
    (define (range start end)
      (check-number 'range start 'start)
      (check-number 'range end 'end)
      (make-numeric-range (- end start) start 1))

    (cond-expand
      (chicken-5
        (: iota (number #!optional number number --> (struct <numeric-range>)))))
    (define iota
      (case-lambda
        ((count) (iota count 0 1))
        ((count start) (iota count start 1))
        ((count start step)
         (check-number 'iota count 'count)
         (check-number 'iota start 'start)
         (check-number 'iota step 'step)
         (make-numeric-range count start step))))

    (cond-expand
      (chicken-5
        (: counter (number #!optional number --> (struct <numeric-range>)))))
    (define counter
      (case-lambda
        ((start) (counter start 1))
        ((start step)
         (check-number 'counter start 'start)
         (check-number 'counter step 'step)
         (make-numeric-range +inf.0 start step))))

    ;; A transducer that flattens ranges within a transduction
    (define-flatten-transducer flatten-range numeric-range? range-fold)

    ;; A transducer that chains a range onto a transduction
    (define-chain-transducer chain-range range-fold)

    ;; A transducer that interleaves the contents of a range
    (define-interleave-transducer
      interleave-range
      (lambda (coll) (cons 0 (numeric-range-start coll)))
      (lambda (coll s)
        (fx>? (car s) (numeric-range-count coll)))
      (lambda (_ s) (cdr s))
      (lambda (coll s) (cons (fx+ (car s) 1)
                             (+ (cdr s)
                                (numeric-range-step coll)))))

    ;; A transducer that zips the contents of a range
    (define-zip-transducer
      zip-range
      (lambda (coll) (cons 0 (numeric-range-start coll)))
      (lambda (coll s)
        (fx>? (car s) (numeric-range-count coll)))
      (lambda (_ s) (cdr s))
      (lambda (coll s) (cons (fx+ (car s) 1)
                             (+ (cdr s)
                                (numeric-range-step coll))))))

  ;; End-of-module
  )