;;;; range.scm
;;;; Kon Lovett, Apr 6 '06

;; Range (Oleg Kiselyov)

(module range (;export
  ;;
  (range-empty? $range-empty-tag)
  (range $range-empty-tag)
  (%range $range-empty-tag)
  ;;
  (%bshift *%bshift)
  (bshift *bshift))

  (import scheme chicken bshift-breset)

  (require-library bshift-breset)

(define-syntax range-empty?
  (syntax-rules ()
    ((_ RV) (eq? $range-empty-tag RV)) ) )

(define-syntax range
  (syntax-rules ()
    ;
    ((_ RC FROM VALUE STEP TO?)
      (bshift RC shifter
        (let loop ((state (FROM)))
          (if (TO? state) $range-empty-tag
              (begin
                (shifter (VALUE state))
                (loop (STEP state)))))))

    ; number range
    ((_ RC FROM STEP TO)
      (bshift RC shifter
        (do ((i FROM (+ i STEP)))
            ((> i TO) $range-empty-tag)
          (shifter i))))
    ;
    ((_ RC FROM TO)
      (range RC FROM 1 TO)) ) )

(define-syntax %range
  (syntax-rules ()
    ;
    ((_ RC FROM VALUE STEP TO?)
      (%bshift RC shifter
        (let loop ((state (FROM)))
          (if (TO? state) $range-empty-tag
              (begin
                (shifter (VALUE state))
                (loop (STEP state)))))))

    ; number range
    ((_ RC FROM STEP TO)
      (%bshift RC shifter
        (do ((i FROM (+ i STEP)))
            ((> i TO) $range-empty-tag)
          (shifter i))))
    ;
    ((_ RC FROM TO)
      (%range RC FROM 1 TO)) ) )

) ;module range