(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 (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)) (define funcs-file "your-funcs") (define (list-as-string list) (parameterize ((current-output-port (open-output-string))) (write list) (get-output-string (current-output-port)))) (define (add-user-func list user-funcs file) (let ((func-to-add (list-as-string list))) (parameterize ((current-output-port (open-output-file file))) (let ((new-user-funcs (string-append user-funcs func-to-add "\n"))) (display new-user-funcs) (close-output-port (current-output-port)) new-user-funcs)))) (define (load-funcs-from-file-dict file dict) (with-input-from-file file (lambda () (let loop ((input (read)) (dict dict)) (if (eof-object? input) dict (loop (read) (new-func input dict))))))) (define (load-funcs-from-file-str file) (with-input-from-file file (lambda () (let loop ((next-str (read-string 10)) (str "")) (if (eof-object? next-str) str (loop (read-string 10) (string-append str next-str))))))) (let loop ((input (read)) (stack '()) (dict (load-funcs-from-file-dict funcs-file init-dict)) (user-funcs (load-funcs-from-file-str funcs-file))) (cond ((number? input) (loop (read) (push input stack) dict user-funcs)) ((list? input) (let ((user-funcs (add-user-func input user-funcs funcs-file))) (loop (read) stack (new-func input dict) user-funcs))) ((symbol? input) (loop (read) (run-func input dict stack) dict user-funcs)) (else (begin (display "ERROR not valid input: ") (display input) (newline) (loop (read) stack dict)))))