4.rkt

#lang racket

(provide (all-defined-out))

;; 1
(define (sequence low high stride)
  (if (> low high)
      null
      (cons low (sequence (+ low stride) high stride))))

;; 2
(define (string-append-map xs suffix)
  (map (lambda (x) (string-append x suffix)) xs))

;; 3
(define (list-nth-mod xs n)
  (if (< n 0)
      (error "list-nth-mod: negative number)")
      (if (null? xs)
          (error "list-nth-mod: empty list")
          (car (list-tail xs (remainder n (length xs)))))))

;; 4
(define (stream-for-n-steps s n)
  (if (= n 0)
      null
      (let [(pair (s))]
        (cons (car pair)
              (stream-for-n-steps (cdr pair) (- n 1))))))

;; 5
(define (funny-number-stream)
  (letrec [(f (lambda (x)
                (cons (if (= (remainder x 5) 0) (- x) x)
                      (lambda () (f (+ x 1))))))]
    (f 1)))

;; 6
(define (dan-then-dog)
  (letrec [(dan (lambda () (cons "dan.jpg" dog)))
           (dog (lambda () (cons "dog.jpg" dan)))]
    (dan)))

;; 7
(define (stream-add-zero s)
  (let [(pair (s))]
    (lambda ()
      (cons (cons 0 (car pair))
            (stream-add-zero (cdr pair))))))

;; 8
(define (cycle-lists xs ys)
  (lambda ()
    (let [(x (car xs))
          (y (car ys))]
      (cons (cons x y)
            (cycle-lists (append (cdr xs) (list x))
                         (append (cdr ys) (list y)))))))

;; 9
(define (vector-assoc v vec)
  (letrec [(f (lambda (i)
                (if (>= i (vector-length vec))
                    #f
                    (let [(val (vector-ref vec i))]
                      (if (and (pair? val) (equal? (car val) v))
                          val
                          (f (+ i 1)))))))]
    (f 0)))

;; 10
(define (cached-assoc xs n)
  (let [(cache (make-vector n #f))
        (cache-index 0)]
    (lambda (v)
      (let [(cache-hit (vector-assoc v cache))]
        (if cache-hit
            cache-hit
            (let [(val (assoc v xs))]
              (begin (vector-set! cache cache-index val)
                     (set! cache-index (remainder (+ cache-index 1) n))
                     val)))))))

;; 11
(define-syntax while-less
  (syntax-rules (do)
    [(while-less e1 do e2)
     (let [(upper-limit e1)]
       (letrec [(f (lambda ()
                     (if (<= upper-limit e2)
                         #t
                         (f))))]
         (f)))]))