;;;; BASICK Interpreter

;;; Running

(define run
  (lambda (prog inputs)

    (define next-pc
      (lambda (pc)
	(define aux
	  (lambda (prog)
	    (if (= pc (caar prog))
		(caar (cdr prog))
		(aux (cdr prog)))))
	(aux prog)))

    (define run-at
      (lambda (pc env inputs)

	(define run-next
	  (lambda (env inputs)
	    (run-at (next-pc pc) env inputs)))

	(define set-var-run
	  (lambda (v val inputs)
	    (run-next (set-in-env v val env) inputs)))

	(define update-var-run
	  (lambda (f v vn)
	    (set-var-run v (f (eval-var v) (eval-vn vn)) inputs)))

	(define eval-var
	  (lambda (v)
	    (cadr (assoc v env))))

	(define eval-vn			; variable-or-number
	  (lambda (vn)
	    (cond ((number? vn) vn)
		  ((symbol? vn) (eval-var vn)))))

	(define condition-codes
	  (list (list '.gt. >)
		(list '.eq. =)
		(list '.lt. <)))

	(define eval-condition
	  (lambda (condition)
	    ((cadr (assoc (cadr condition) condition-codes))
	     (eval-vn (car condition))
	     (eval-vn (caddr condition)))))

	(let* ((statement (cdr (assoc pc prog)))
	       (keyword (car statement)))
	  (cond ((equal? keyword 'let)	; (let V = VorN)
		 (set-var-run (cadr statement)
			      (eval-vn (cadddr statement))
			      inputs))
		((equal? keyword 'read)	; (read V)
		 (if (null? inputs)
		     (set-var-run (cadr statement) basick-eof-input inputs)
		     (set-var-run (cadr statement) (car inputs) (cdr inputs))))
		((equal? keyword 'add)	; (add VorN to V)
		 (update-var-run + (cadddr statement) (cadr statement)))
		((equal? keyword 'subtract) ; (subtract VorN from V)
		 (update-var-run - (cadddr statement) (cadr statement)))
		((equal? keyword 'multiply) ; (multiply V by VorN)
		 (update-var-run * (cadr statement) (cadddr statement)))
		((equal? keyword 'divide) ; (divide V by VorN)
		 (update-var-run / (cadr statement) (cadddr statement)))
		((equal? keyword 'goto)	; (goto LINE-NUMBER)
		 (run-at (cadr statement) env inputs))
		((equal? keyword 'if) ; (if CONDITION goto LINE-NUMBER)
		 (if (eval-condition (cadr statement))
		     (run-at (cadddr statement) env inputs)
		     (run-next env inputs)))
		((equal? keyword 'return) ; (return VorN)
		 (eval-vn (cadr statement)))
		((equal? keyword 'rem)	; (rem WHATEVER ...)
		 (run-next env inputs))))))

    (run-at (caar prog) '() inputs)))

(define set-in-env
  (lambda (var val env)
    (cond ((null? env) (list (list var val)))
	  ((equal? var (caar env))
	   (cons (list var val) (cdr env)))
	  (else
	   (cons (car env)
		 (set-in-env var val (cdr env)))))))

(define basick-eof-input -1)

;;; Renumbering

(define ren
  (lambda (prog low inc)
    (let* ((n (length prog))
	   (old-nums (map car prog))
	   (new-nums (seq n low inc))
	   (num-alist (map list old-nums new-nums)))

      (define ren-num
	(lambda (old)
	  (cadr (assoc old num-alist))))

      (define ren-statement
	(lambda (s)
	  (let ((keyword (car s)))
	    (cond ((equal? keyword 'goto)
		   (list 'goto (ren-num (cadr s))))
		  ((equal? keyword 'if)
		   (list 'if (cadr s) (caddr s) (ren-num (cadddr s))))
		  (else s)))))

      (map cons
	   new-nums
	   (map ren-statement (map cdr prog))))))

(define seq
  (lambda (n low inc)
    (if (zero? n)
	()
	(cons low (seq (- n 1) (+ low inc) inc)))))