(require 'stdlib) ;; assembly language with registers, labels, subroutines ;; load r0 0 ;; add r0 2 ;; print r0 ;; label foo ;; add r0 2 ;; mul r0 3 ;; jump foo ;; call foo ;; return ;; compiles into an assoc list with program counter ;; ((0 load ...) ;; (1 bla ...) ;; (2 jmp 1)) (define r0 0) (define (make-vm) "return a closure with registers, stack, program-counter, &c" 'todo) (define nodes nil) (define (mknode args) (setq nodes (nconc nodes (list args)))) (define (make-program-one) (dolist (node '((load r0 0) (add r0 2) (mul r0 3) (print r0))) (mknode node))) (define (interpret-nodes nodes) (let ((node (first nodes))) (puts node) (if (null node) nil (let ((oper (first node)) (par1 (second node)) (par2 (third node))) (case oper ((load) (set par1 par2)) ((add) (set par1 (+ (symbol-value par1) par2))) ((mul) (set par1 (* (symbol-value par1) par2))) ((print) (printf "%s = %s\n" par1 (symbol-value par1))) (t (printf "unknown operator `%s'\n" oper))) (interpret-nodes (rest nodes)))))) (make-program-one) (interpret-nodes nodes) ;; implementation with closures ;; result is a new list with closures to call ;;(define (compile-net root) ;; (let ((node (assoc root nodes))) ;; (if (null node) ;; nil ;; (let ((contents (second node)) ;; (yes (third node)) ;; (no (fourth node))) ;; (if yes ;; (let ((yes-fn (compile-net yes)) ;; (no-fn (compile-net no))) ;; (lambda () ;; (printf "%s > " contents) ;; (funcall (if (eq (read) 'yes) ;; yes-fn ;; no-fn)))) ;; (lambda () contents))))))