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

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


;; 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
      [;; 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.
       ;; It is defined outside the factory so that all LRStructs made from this factory 
       ;; share the same definition for their state.
       (define-struct LRSState (getFirst setFirst insertFirst removeFirst getRest setRest execute))]
    (lambda ()
      (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))))


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

"empty LRStruct:"
(define l1 (LRSFactory))
;;((LRStruct-getFirst l1))
((LRStruct-execute l1) LRS->list null)

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

"insertFirst 2, 3, 4, 5:"

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

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


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

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

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