;; Copyright 2002 by Stephen Wong
;; This code may be modified by permission only.

;; USE LANGUAGE LEVEL = "PRETTY BIG"

;; LRStruct (Linear Recursive Structure) is a mutable list structure
;; An LRStruct can be in one of two states, Empty or NonEmpty
;; getFirst: --> any  returns the first of the LRStruct, error if empty LRStruct
;; setFirst: any --> LRStruct  sets the first of the LRStruct, error if empty LRStruct
;; insertFirst: any --> mutates the LRS, inserting a new first, the mutated LRStruct is returned
;; removeFirst: --> mutates the LRStruct by removing the first element, error if empty LRStruct, the mutated LRStruct is returned.
;; getRest: --> LRStruct returns the rest of the LRS, error if empty LRS
;; setRest: LRStruct --> LRStruct  mutates the LRStruct to have a new rest, error if empty, the mutated LRStruct is returned.
;; execute: IAlgo any1 --> any2 accepts a visitor, empty and non-empty LRStruct's call their respective cases 
;; of the visitor, passing the LRS and the supplied parameter.
;; getState: --> LRSState private function to access the internal state of the LRStruct, DO NOT USE THIS FUNCTION!!
;; setState: LRSState --> LRStruct  private function to set the internal state of the LRStruct, returns the mutated LRStruct, DO NOT USE THIS FUNCTION!!
(define-struct LRStruct (getFirst setFirst insertFirst removeFirst getRest setRest execute getState setState))


;; LRSState defines a private abstract state of an LRStruct.    
;;Its functions are the same as in LRS, except that all the functions
;; take the host LRS as their first input parameter.
;; This definition had to be moved outside of the LRSFactory so that the 
;; LAzyLRSFactory could use it.   Scheme does not have the ability to create the 
;; "package" scoping we need.
;; DO NOT USE THIS STRUCTURE!!
(define-struct LRSState (getFirst setFirst insertFirst removeFirst getRest setRest execute))


;; Visitor to an LRStruct  (an algorithm on an LRS)
;; emptyCase: LRStruct any1 --> any2
;; neCase: LRStruct any1 --> any2
;; Note that since LRStruct is mutable, one cannot assume that the state of the LRStruct remains constant 
;; throughout a functioncall.
(define-struct IAlgo (emptyCase neCase))



;; LRSFactory: --> LRStruct
;; Factory to produce an empty LRStruct
(define (LRSFactory)
  (local
      [;; Empty LRStruct state
       (define EmptyLRSStateSingleton
         (make-LRSState
          (lambda (host) ;; getFirst
            (error 'LRStruct "An empty LRS has no first."))
          
          (lambda (host newFirst)   ;; setFirst
            (error 'LRStruct "An empty LRStruct has no first."))
          
          (lambda (host newFirst) ;; insertFirst
            (begin
              ((LRStruct-setState host) (NELRSStateFactory newFirst (LRSFactory)))
              host))
          
          (lambda (host)  ;; removeFirst
            (error 'LRStruct "An empty LRStruct has no first."))
          
          (lambda (host)  ;; getRest
            (error 'LRStruct "An empty LRStruct has no rest."))
          
          (lambda (host newRest)  ;; setRest
            (error 'LRStruct "An empty LRStruct has no rest."))
          
          (lambda (host visitor param)  ;; execute
            ((IAlgo-emptyCase visitor) host param))))
       
       ;; Factory to create a non-empty LRS state
       (define (NELRSStateFactory a-first a-rest)
         (local
             [(define this
                (local
                    [(define first a-first)
                     (define rest a-rest)]
                  (make-LRSState
                   (lambda (host)  ;; getFirst
                     first)
                   
                   (lambda (host newFirst)  ;; setFirst
                     (begin
                       (set! first newFirst)
                       host))
                   
                   (lambda (host newFirst)  ;; insertFirst
                     (begin
                       ((LRStruct-setState host) (NELRSStateFactory newFirst ((LRStruct-setState (LRSFactory)) this)))
                       host))
                   
                   (lambda (host)   ;; removeFirst
                     (begin
                       ((LRStruct-setState host) ((LRStruct-getState rest)))
                       host))
                   
                   (lambda (host)  ;; getRest
                     rest)
                   
                   (lambda (host newRest)  ;; setRest
                     (begin
                       (set! rest newRest)
                       host))
                   
                   (lambda (host visitor param)  ;; execute
                     ((IAlgo-neCase visitor) host param)))))] 
           this))
       
       ;; An initially empty LRStruct 
       (define this
         (local [(define state EmptyLRSStateSingleton)]
           (make-LRStruct
            (lambda ()    ;; getFirst
              ((LRSState-getFirst state) this))
            
            (lambda (newFirst) ;; setFirst
              ((LRSState-setFirst state) this newFirst))
            
            (lambda (data)  ;; insertFirst
              ((LRSState-insertFirst state) this data))
            
            (lambda ()   ;; remove first
              ((LRSState-removeFirst state) this))
            
            (lambda ()  ;; getRest
              ((LRSState-getRest state) this))
            
            (lambda (newRest) ;; setRest
              ((LRSState-setRest state) this newRest))
            
            (lambda (visitor param)   ;; execute
              ((LRSState-execute state) this visitor param))
            
            (lambda ()  ;; getState
              state)
            
            (lambda (newState)   ;; setState
              (begin
                (set! state newState)
                this)))))]
    this))

;;A Generator is a structure which has 
;; an initial value and an inductive function that 
;; returns the next generator
;; first: any
;; next: --> Generator
(define-struct Generator (first next))


;; LazyLRSFactory: Generator --> LRStruct
;; Returns a lazy LRStruct which uses the supplied Generator to create the list.
(define (LazyLRSFactory aGen)
  (local
      [(define lrs ((LRStruct-insertFirst (LRSFactory)) (Generator-first aGen)))
       (define lazyLRSState
         (local 
             [(define oldState ((LRStruct-getState lrs)))]  ;; decoree
           (make-LRSState
            (lambda (host) ;; getFirst
              ((LRSState-getFirst oldState) host)) ;; delegate to decoree
            
            (lambda (host newFirst)   ;; setFirst
              ((LRState-setFirst oldState) host newFirst)) ;; delegate to decoree
            
            (lambda (host newFirst) ;; insertFirst
              (begin   ;; replicate normal behavior but with this state
                ((LRStruct-setState host) ((LRStruct-getState ((LRStruct-insertFirst ((LRStruct-setState (LRSFactory)) lazyLRSState)  newFirst)))))
                host))
            
            (lambda (host)  ;; removeFirst
              (begin     ;; replicates normal behavior but more robustly
                ((LRStruct-setState host)((LRStruct-getState ((LRStruct-getRest host)))))
                host))
            
            (lambda (host)  ;; getRest
              (begin
                ((LRStruct-setState host) oldState) ;; make eager
                ((LRStruct-setRest host) (LazyLRSFactory ((Generator-next aGen))))  ;; install new rest
                ((LRStruct-getRest host)))) ;; get the new rest
            
            (lambda (host newRest)  ;; setRest
              (begin
                ((LRStruct-setState host) oldState) ;; make eager
                ((LRStruct-setRest host) newRest))) ;; delegate the call
            
            (lambda (host visitor param)  ;; execute
              ((LRSState-execute oldState) host visitor param)))))]  ;; delegate to decoree.
    (begin
      ((LRStruct-setState lrs) lazyLRSState) ;; install the lazy state.
      lrs)))


;;--------------  Visitors to a LRS --------------------------------------------

;; Visitor to convert an LRStruct into a list.
(define LRS->list
  (local
      [(define this
         (make-IAlgo
          (lambda (host param)
            empty)
          (lambda (host param)
            (cons ((LRStruct-getFirst host)) ((LRStruct-execute ((LRStruct-getRest host))) this param)))))]
    this))

;; Visitor to convert an LRStruct into a list of length n.
(define LRS->listN
  (local
      [(define this
         (make-IAlgo
          (lambda (host n)
            empty)
          (lambda (host n)
            (cond
              [(zero? n) empty]
              [(positive? n) (cons ((LRStruct-getFirst host)) ((LRStruct-execute ((LRStruct-getRest host))) this (sub1 n)))]))))]
    this))

;; Visitor to truncate a LRStruct to at most n elements
(define truncateLRS
  (local
      [(define this
         (make-IAlgo
          (lambda (emptyHost n)
            emptyHost)
          (lambda (neHost n)
            (cond
              [(zero? n)
               ((LRStruct-removeFirst ((LRStruct-setRest neHost) (LRSFactory))))]
              [(positive? n) 
               (begin
                 ((LRStruct-execute ((LRStruct-getRest neHost))) this (sub1 n))
                 neHost)]))))]
    this))



;; Visitor to get the n'th rest of a LRStruct
(define removeNLRS
  (local
      [(define this
         (make-IAlgo
          (lambda (emptyHost n)
            emptyHost)
          (lambda (neHost n)
            (cond
              [(zero? n)
               neHost]
              [(positive? n) 
               ((LRStruct-execute ((LRStruct-removeFirst neHost))) this (sub1 n))]))))]
    this))

;; Visitor to reverse a LRStruct
(define LRSreverse
  (local
      [(define helper
         (make-IAlgo
          (lambda (host host0)
            host0)
          (lambda (host host0)
            (begin
              ((LRStruct-insertFirst host0) ((LRStruct-getFirst host)))
              ((LRStruct-execute ((LRStruct-removeFirst host))) helper host0)))))]
    (make-IAlgo
     (lambda (host param)
       host)
     (lambda (host param)
       ((LRStruct-execute ((LRStruct-getRest host))) helper host))))) 

;; Visitor to left rotate an LRStruct
(define LRSRotateL
  (local
      [(define helper
         (make-IAlgo
          (lambda (host oldFirst)
            ((LRStruct-insertFirst host) oldFirst))
          (lambda (host oldFirst)
            ((LRStruct-execute ((LRStruct-getRest host))) helper oldFirst))))]
    (make-IAlgo
     (lambda (host param)
       host)
     (lambda (host param)
       (local
           [(define thisFirst ((LRStruct-getFirst host)))]
         (begin
           ((LRStruct-execute ((LRStruct-removeFirst host))) helper thisFirst)
           host)))))) 


;; Visitor to right rotate an LRStruct
(define LRSRotateR
  (local
      [(define helper
         (make-IAlgo
          (lambda (host prevHost)
            (local 
                [(define prevFirst ((LRStruct-getFirst prevHost)))]
              (begin
                ((LRStruct-removeFirst prevHost))
                prevFirst)))
          (lambda (host prevHost)
            ((LRStruct-execute ((LRStruct-getRest host))) helper host))))]
    (make-IAlgo
     (lambda (host param)
       host)
     (lambda (host param)
       ((LRStruct-insertFirst host) ((LRStruct-execute ((LRStruct-getRest host))) helper host)))))) 

;; ------------------- Test Cases ---------------------------------------------------

"When an empty box comes up (due to the (read-line)'s) just hit ENTER to continue on."
"empty LRStruct:"
(define l1 (LRSFactory))
;;((LRStruct-getFirst l1))
((LRStruct-execute l1) LRS->list null)
(read-line)

"insertFirst 1:"
((LRStruct-execute ((LRStruct-insertFirst l1) 1)) LRS->list null)
(read-line)

"insertFirst 2, 3, 4, 5, 6:"

((LRStruct-execute ((LRStruct-insertFirst ((LRStruct-insertFirst ((LRStruct-insertFirst ((LRStruct-insertFirst ((LRStruct-insertFirst l1) 2)) 3)) 4)) 5)) 6)) LRS->list null)
(read-line)

"Reverse the list:"
((LRStruct-execute ((LRStruct-execute l1) LRSreverse null)) LRS->list null)
(read-line)


"removeFirst"
((LRStruct-execute ((LRStruct-removeFirst l1))) LRS->list null)
(read-line)

"RotateL:"
((LRStruct-execute ((LRStruct-execute l1) LRSRotateL null)) LRS->list null)
(read-line)

"RotateR:"
((LRStruct-execute ((LRStruct-execute l1) LRSRotateR null)) LRS->list null)
(read-line)

"First 2 elements of l1"
((LRStruct-execute l1)LRS->listN 2)
(read-line)

"First 3 elements of l1"
((LRStruct-execute l1)LRS->listN 3)
(read-line)

;; Generator for natural numbers
(define natNumGen
  (local
      [(;; genFac: natNum --> Generator
        ;; x is the initial value to use.
        ;; returns a natural number generator
        define (genFac x)
         (make-Generator
          x     ;; first: the initial value
          (lambda ()   ;; next: next first is x+1
            (genFac (add1 x)))))]
    (genFac 0)))  ;; start off first at zero


;; Here's an infinite list of all the natural numbers
(define natNums (LazyLRSFactory natNumGen))

"First 3 elements of natNums"
((LRStruct-execute natNums)LRS->listN 3)
(read-line)

"First 30 elements of natNums"
((LRStruct-execute natNums)LRS->listN 30)
(read-line)

;; Generator for odd natural numbers
(define oddNumGen
  (local
      [;; genFac: natNum --> Generator
       ;; x is the initial value to use.
       ;; returns a Generator for every other natural number, 
       ;; starting at x
       (define (genFac x)
         (make-Generator
          x  ;; first: initial value
          (lambda () ;; next: next first is x+2
            (genFac (+ 2 x)))))]
    (genFac 1)))  ;; start off at 1 for odd numbers

;; Here's an infinite list of all the odd natural numbers
(define odds (LazyLRSFactory oddNumGen))

"First 3 elements of odds"
((LRStruct-execute odds)LRS->listN 3)
(read-line)

"First 30 elements of odds"
((LRStruct-execute odds)LRS->listN 30)
(read-line)

;; Generator for Fibonacci numbers
(define fibonacciGen
  (local
      [;; genFac: natNum natNum --> Generator
       ;; x1 is the previous Fibonacci number.
       ;; x2 is the initial Fibonacci number to use.
       ;; returns a Generator for the Fibonacci series, 
       (define (genFac x1 x2)
         (make-Generator
          x2  ;; first: initial value
          (lambda () ;; next Fibonnaci number is x1 + x2
            (genFac x2 (+ x1 x2)))))]
    (genFac 0 1)))  ;; start at 1

;; Here's an infinite list of all the positive Fibonacci numbers
(define fibs (LazyLRSFactory fibonacciGen))

"First 3 elements of Fibonacci"
((LRStruct-execute fibs)LRS->listN 3)
(read-line)

"First 30 elements of Fibonacci"
((LRStruct-execute fibs)LRS->listN 30)
(read-line)

"remove first 100 fibs (display next 15):"
((LRStruct-execute 
  ((LRStruct-execute fibs) removeNLRS 100))  
 LRS->listN 15)
(read-line)



"Truncate fibs to 10 elements:"
((LRStruct-execute 
  ((LRStruct-execute fibs) truncateLRS 10)) 
 LRS->listN 30)
(read-line)

"First 30 elements of fibs"
((LRStruct-execute fibs)LRS->listN 30)
(read-line)

"Reverse the short list of fibs:"
((LRStruct-execute ((LRStruct-execute fibs) LRSreverse null)) LRS->list null)
(read-line)



;;----------------------------------------------------------------------------
;; The following code is all support code for the prime number generator

;; natNumGenFac: natNum --> Generator
;; Factory for a generator for natural numbers
;; starting at x
(define (natNumGenFac x)
  (make-Generator
   x     ;; first: the initial value
   (lambda ()   ;; next: next first is x+1
     (natNumGenFac (add1 x)))))


;; filterMultsGenFac: natNum LRStruct --> Generator
;; Generator for filtered numbers
;; Used to generate a lazy list where all multiples of x are
;; removed from loi
(define  filterMultsGenFac 
  (local
      [;; remFirstMults:  visitor to an LRStruct to remove all the leading multiples of x from
       ;; the host.
       ;; emptyCase: LRStruct natNum   --> empty LRStruct
       ;; neCase: LRStruct natNum --> LRStruct
       ;; Returns a list with all leading multiples of x removed
       (define remFirstMults
         (make-IAlgo
          (lambda (host x)
            empty)
          (lambda (host x)
            (if (zero?  (modulo ((LRStruct-getFirst host)) x))
                ((LRStruct-execute ((LRStruct-removeFirst host))) remFirstMults x)
                host))))]
    (lambda (x loi)
      (local
          [(define newLOI ((LRStruct-execute loi) remFirstMults x))]
        (make-Generator
         ((LRStruct-getFirst newLOI))
         (lambda () 
           (filterMultsGenFac x ((LRStruct-removeFirst newLOI)))))))))

(define no3s (LazyLRSFactory (filterMultsGenFac 3 (LazyLRSFactory (natNumGenFac 1)))))
"First 10 elements of no3s"
((LRStruct-execute no3s)LRS->listN 10)

;; Generator for prime numbers
(define primeGen
  (local
      [;; genFac: natNum list-of-integers--> Generator
       ;; p is a prime number.
       ;; returns a Generator for the prime series, 
       (define (genFac loi)
         (local
             [(define p ((LRStruct-getFirst loi)))]
           (make-Generator
            p  
            (lambda () ;; next prime number
              (genFac (LazyLRSFactory (filterMultsGenFac p ((LRStruct-removeFirst loi)))))))))]
    (genFac (LazyLRSFactory (natNumGenFac 2)))))  ;; start at list of all integers >=2


(define primes (LazyLRSFactory primeGen))

"First 30 elements of primes"
((LRStruct-execute primes)LRS->listN 30)
(read-line)
"First 100 elements of primes"
((LRStruct-execute primes)LRS->listN 100)