;;; CHICKEN Transducers - Transducers for working with foldable data types.
;;;
;;; Copyright (c) 2022 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.

(module (transducers numbers) ()
  (import (scheme))
  (import (chicken base)
          (chicken fixnum)
          (chicken module)
          (chicken type)
          (check-errors)
          (only type-checks-numbers
                check-fixnum)
          (transducers base))

  (export <numeric-range>
          numeric-range?
          range
          counter
          iota
          range-fold
          fixnum-range-fold
          chain-range
          flatten-range
          interleave-range
          zip-range)

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

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

  (: iota (number #!optional number number --> (struct <numeric-range>)))
  (define (iota count #!optional (start 0) (step 1))
    (check-number 'iota count 'count)
    (check-number 'iota start 'start)
    (check-number 'iota step 'step)
    (make-numeric-range count start step))

  (: counter (number #!optional number --> (struct <numeric-range>)))
  (define (counter start #!optional (step 1))
    (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) (numeric-range-start coll))
    (lambda (coll s) (>= s (numeric-range-count coll)))
    (lambda (_ s) s)
    (lambda (coll s) (+ s (numeric-range-step coll))))

  ;; A transducer that zips the contents of a range
  (define-zip-transducer
    zip-range
    (lambda (coll) (numeric-range-start coll))
    (lambda (coll s) (>= s (numeric-range-count coll)))
    (lambda (_ s) s)
    (lambda (coll s) (+ s (numeric-range-step coll))))

  ;; End-of-module
  )