(require 'stdlib)

(define stack '())

(define (push val)
  (setq stack (cons val stack)))

(define (pop)
  (prog1 (top)
    (setq stack (cdr stack))))

(define (top)
  (car stack))

(define (second)
  (cadr stack))

(define (dup)
  (push (top)))

(define (add)
  (push (+ (pop) (pop))))

(define (mul)
  (push (* (pop) (pop))))

(define (cons.)
  (let ((r (cons (second) (top))))
    (pop)
    (pop)
    (push r)))

(define (def name #!rest params)
  ;; define a function
  ;; include environments.jl, put function bindings into lexical env
  )

(define (print)
  (printf "=> %s\n" (pop)))

(define (dump)
  (puts stack))

;; (operator . number-of-operands)
(define operators
  '((push . 1)
    (pop . 0)
    (dup . 0)
    (add . 0)
    (mul . 0)
    (cons. . 0)
    (print . 0)))

(define (read-eval-print program #!optional (debug nil))
  ;; TODO recursive descent parser for L(vm)?
  ;; see ruby/cons for an example, lalr.cl, semantic.el
  ;; >>> try-out in parser.jl
  "basic interpreter loop: parse program and invoke vm-functions"
  (printf "%s\n" program)
  (while program
    (when debug
      (dump))
    (unless (assoc (car program) operators)
      (error "unknown operator: %s" (car program)))
    (cond ((eq (car program) 'push)
           (funcall push (cadr program))
           (setq program (cddr program)))
          (t
           (funcall (symbol-value (car program)))
           (setq program (cdr program))))))

(define (load-program file)
  "Return a list of tokens representing the program in FILE"
  ;; TODO load program-text from file and construct program list with
  (let ((program-text "push 6\npush 7\nmul\nprint\n"))
    (read-from-string (concat "(" program-text ")"))))

;; expression evaluation
(read-eval-print '(push 3 push 4 push 5 dup mul mul add print))
;; creating a cons
(read-eval-print '(push aap push noot cons. print))
;; creating a list
(read-eval-print
 `(push aap push noot push mies push ,nil cons. cons. cons. print))
;; unknown operator
(condition-case problem
    (read-eval-print '(bork))
  (error (printf "as expected: %s\n" problem)))
;; loading from a file
(read-eval-print (load-program "foo.vm"))

;;----------------------------------------------------------------------
;; old stuff

;;(defmacro ld (reg val)
;;  `(setq ,reg ,val))

;;(defmacro add (reg val)
;;  `(setq ,reg (+ ,reg ,val)))

;;(defmacro mul (reg val)
;;  `(setq ,reg (* ,reg ,val)))

;;(defvar r1 0)
;;;;(defvar registers '[0 0 0 0])

;;(defun vtrace (lst)
;;  (while lst
;;    (puts (car lst))
;;    (eval (car lst))
;;    (puts (list 'r1 r1))
;;    (setq lst (cdr lst))))

;;(defun vrun (lst)
;;  (while lst
;;    (eval (car lst))
;;    (setq lst (cdr lst))))

;;(defun test-1 ()
;;  (let ((p '((ld r1 3)
;;             (add r1 5)
;;             (mul r1 2))))
;;    (vtrace p)))

;;;;(vtrace p1)

;;;(defun defun-plus (funcname)
;;;  (eval (list 'defun (symbol-concat (symbol-name funcname))
;;;              '(a b) '(+ a b))))

;;;(defun-plus 'foo)
;;;(foo 1 2)