;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;                           STACK
;
;  Stack, implementeed using a list (in scm) and using a vector
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; Two ways to do stacks. 
;;; First uses scheme's list, and appends the old stack to the
;;; end of a list that contains the new element to be added to the stack.
;;; You could use llist if you are a masochist.
;;; The list implementation allows stack to grow without limit, but pop
;;; results in garbage. Also, overhead required for links
;;;
;;; Second technique, we use a vector, were stack grows DOWN
;;; and the top of stack is the last occupied element in the vector
;;; Disadvantage to this is that we must declare the maximum size of the
;;; stack before we go. However, its fast and does not generate garbage
;;;

(define lstack (make-record-type "lstack" '(l)))
(define make-lstack (record-constructor lstack '(l)))

(define lstack? (record-predicate lstack))

(define l (record-accessor lstack 'l))
(define l! (record-modifier lstack 'l))

(define lempty '())

(define (lempty? s)
  (null? (l s)))

(define (lpop s)
  (cond ((lempty? s) lempty)
	(t (let ((e (car (l s))))
	     (l! s (cdr (l s)))
	     e))))

(define (lpush e s)
  (l! s (append (list e) (l s)))
  (l s))

(define (ltop s)
  (cond ((lempty? s) 'empty)
	(t (car (l s)))))
  
;
;               LSTACK DEMO
;

(define ls (make-lstack '())) ; ls is an empty lstack
(lstack? ls) ; delivers t, because ls is an lstack
(lempty? ls) ; delivers t because ls is empty
(lpop ls) ; delivers '()
(lpush 1 ls) (lpush 2 ls) (lpush '+ ls); push 1 then 2 then + onto ls
(define l1 (list (lpop ls) (lpop ls) (lpop ls))) ; delivers '(+ 2 1)
(eval l1) ; delivers 3

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                           VSTACK
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define stack (make-record-type "stack" '(size vect tos)))
(define create-stack (record-constructor stack '(size vect tos)))
(define (make-stack n)
  (create-stack (- n 1) 
		(make-vector n 'unspecified) 
		-1))
;;;
;;; The stack is essentially composed of a vector, and has associated info
;;; in particular a size, and a pointer to the top of stack
;;; Initially each element of the stack is unspecified
;;;           tos points to element -1 (doesn't exist)
;;;           the stack is empty
;;;

(define stack? (record-predicate stack)); is it a stack?

(define size (record-accessor stack 'size))
(define vect (record-accessor stack 'vect))
(define tos  (record-accessor stack 'tos))

(define tos! (record-modifier stack 'tos)); is this all we can alter?

(define (empty? s)
  (= -1 (tos s)))
;;;
;;; The stack is empty if tos pointer is -1
;;;

;;; (define s (make-stack 10)) ; make a stack of 10 elements

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define (push e s)
  (cond ((= (tos s) (size s)) 'overflow)
	(#t (tos! s (+ 1 (tos s)))
	    (vector-set! (vect s) (tos s) e)
	    e)))
;;;
;;; Push a new element e onto the stack s
;;; Test that stack is not already full (overflow)
;;;

(define (top s)
  (cond ((empty? s) 'empty)
	(t (vector-ref (vect s) (tos s)))))
;;;
;;; Get the element that is top of the stack
;;; test for empty stack
;;;


(define (pop s)
  (cond ((empty? s) 'underflow)
	(t (let ((e (top s)))
	     (tos! s (- (tos s) 1))
	     e))))
;;;
;;; Get the element at the top of stack, remove it from 
;;; the stack, and deliver it as a result.
;;; Test for empty stack (underflow)
;;;

(define (show s)
  (list 'size (size s)
	'vect (vect s)
	'tos (tos s)))
;;;
;;; let me have a wee look at the stack please :)
;;; For debugging only (only!)
;;;

(define (full? s)
 'define-me)
;;;
;;; should we have a test if stack is full?
;;;

;
;               STACK DEMO
;


(define s (make-stack 10)) ; s is a stack of 10 elements
(stack? s) ; delivers t, because s is an stack
(empty? s) ; delivers t because s is empty
(pop s) ; delivers 'underflow
(push 1 s) (push 2 s) (push '+ s); push 1 then 2 then + onto s
(define e (list (pop s) (pop s) (pop s))) 
;;;
;;; delivers expression e '(+ 2 1)
;;;
(eval e) ; delivers 3

;;;
;;; EXERCISE (recommended, not compulsory)
;;;
;;; 1. Implement a simple reverse polish calculator, such that
;;; (a) pop is analog to ENTER
;;; (b) (op operator s) forms a list
;;;      (list operator (pop s) (pop s))
;;;     and then evaluates it (via eval), and pushes 
;;;     the result onto the stack, and delivers top of stack as a result
;;; (b) (fn f s) is like (b) but f is a function of 1 argument
;;;     so f may be log, tan, sin, sqrt, ...
;;; (c) you can now do calculations as follows
;;;
;;;           (push 1 s) (push 2 s) (op '+ s)
;;;           (push 3 s) (push 4 s) (op '+ s)
;;;           (op '* s) (fn 'sqrt s)
;;;   
;;;       Which is equivalent to (sqrt (* (+ 1 2) (+ 3 4)))
;;;