(define (pop stack)
(let ((var (car stack))
(ret-stack (cdr stack)))
(values var ret-stack)))
(define (push var stack)
(append (list var) stack))
(define (dup stack)
(let ((head (car stack)))
(append (list head) stack)))
(define (fact x)
(define (fact-iter n current)
(if (= n 1)
current
(fact-iter (- n 1) (* n current))))
(fact-iter x 1))
(define (rpn-func func args stack)
(if (= args 1)
(let-values (((var stack) (pop stack)))
(push (func var) stack))
(let*-values (((var1 stack) (pop stack))
((var2 stack) (pop stack)))
(push (func var1 var2) stack))))
(define (insert-into-alist key val alist)
(let ((mem? (assq key alist)))
(if mem?
(update-alist key val alist)
(append alist (list (cons key val))))))
(define (index-in-alist key alist)
(let loop ((list (list-copy alist))
(index 0))
(if (= (length list) 0)
#f
(let ((list-head-key (car (car list))))
(if (eq? list-head-key key)
index
(loop (cdr list) (+ index 1)))))))
(define (update-alist key new-val alist)
(let ((index (index-in-alist key alist)))
(list-set! alist index (list (cons key new-val)))
alist))
(define (run-func sym dict stack)
(let ((func (assq sym dict)))
(if func
((cdr func) stack dict)
(begin
(display "ERROR: symbol not in dictionary: ")
(display sym)
(newline)
stack))))
(define (swap stack)
(let ((a (car stack))
(b (cadr stack)))
(append (list b) (list a) (cddr stack))))
(define init-dict
(list (cons '$ (lambda (stack dict)
(let-values (((var stack) (pop stack)))
(display var)
(newline)
stack)))
(cons '+ (lambda (stack dict) (rpn-func + 2 stack)))
(cons '- (lambda (stack dict) (rpn-func - 2 stack)))
(cons '* (lambda (stack dict) (rpn-func * 2 stack)))
(cons '/ (lambda (stack dict) (rpn-func / 2 stack)))
(cons '% (lambda (stack dict) (rpn-func modulo 2 stack)))
(cons '! (lambda (stack dict) (rpn-func fact 1 stack)))
(cons 'dup (lambda (stack dict) (dup stack)))
(cons 'swap (lambda (stack dict) (swap stack)))
(cons 'sin (lambda (stack dict) (rpn-func sin 1 stack)))
(cons 'cos (lambda (stack dict) (rpn-func cos 1 stack)))
(cons 'tan (lambda (stack dict) (rpn-func tan 1 stack)))
(cons 'trunc (lambda (stack dict) (rpn-func truncate 1 stack)))
(cons 'ceil (lambda (stack dict) (rpn-func ceiling 1 stack)))
(cons 'floor (lambda (stack dict) (rpn-func floor 1 stack)))))
(define (user-func-from-list func)
(lambda (stack dict)
(let loop ((func func)
(stack stack))
(if (= (length func) 1)
(if (number? (car func))
(push (car func) stack)
(run-func (car func) dict stack))
(if (number? (car func))
(loop (cdr func) (push (car func) stack))
(loop (cdr func) (run-func (car func) dict stack)))))))
(define (new-func list dictionary)
(insert-into-alist (car list) (user-func-from-list (cdr list)) dictionary))
(let loop ((input (read))
(stack '())
(dict init-dict))
(cond
((number? input) (loop (read) (push input stack) dict))
((list? input) (loop (read) stack (new-func input dict)))
((symbol? input) (loop (read) (run-func input dict stack) dict))
(else (begin
(display "ERROR not valid input: ")
(display input)
(newline)
(loop (read) stack dict)))))