ehaliewicz

(defun interpret-lambda (expr &optional env)
  (etypecase expr
    (symbol (let ((res (assoc expr env))) (if res (cdr res) (error "Unbound symbol"))))
    (list (case (car expr)
            (lambda (list (car (second expr)) (third expr) env))
            (otherwise
             (let ((rand (interpret-lambda (second expr) env))
                   (rator (interpret-lambda (first expr) env)))
               (interpret-lambda
                (cadr rator)

ehaliewicz

(ql:quickload "lispbuilder-sdl")
(ql:quickload "lispbuilder-sdl-gfx")

(deftype triplet () '(unsigned-byte 16))

(defmacro pixel-to-cell (val) `(/ ,val *cell-size*))
(defmacro cell-to-col (val) `(floor ,val 3))

(defmacro pixel-to-col (val) `(cell-to-col (pixel-to-cell ,val)))

ehaliewicz

;; load a regex library
(ql:quickload "cl-ppcre")

;; utility functions

;; concatenate any number of any type of object into a string
(defun mkstr (&rest args)
  (with-output-to-string (s)
    (dolist (a args) (princ a s))))

ehaliewicz

;; Instructions

;; SET A B    (set mem[a] to immediate value B)
;; XOR A B    (set mem[a] to mem[b] XOR mem[b])
;; AND A B    (set mem[a] to (and mem[a] mem[b]))
;; OR  A B    (set mem[a] to (or mem[a] mem[b]))
;; RANDOM A   (set mem[a] to 0 or 1)
;; JMP A      (jump to instruction A)
;; JZ A B     (jump to instruction A if memory slot B is zero)
;; HALT       (halt program)

ehaliewicz

(defun mkstr (&rest args)
  (with-output-to-string (s)
    (dolist (a args) (princ a s))))

(defun symb (&rest args)
  (values (intern (apply #'mkstr args))))

(defparameter *class-table* (make-hash-table :test #'equal))

ehaliewicz

(defun fib (x)
  (if (< x 2) x (+ (fib (- x 2))
                   (fib (- x 1)))))


(time (fib 10))
=> 1x10^4 cycles

(time (fib 20))
=> 1x10^6 cycles

ehaliewicz

              ;; 'val is the register where the return value of compiling goes
              ;; 'next is the requested type of compiler linkage, how the compiler will finish off the compiled code
              
              ;; 'return linkage returns to the state on top of the stack (to return from a function)
              ;; 'next linkage just continues onto whatever is the next instruction after the compiled instructions
              ;; any other linkage assumes a label,
              ;; i.e. (compile '(+ 1 2 3) 'val 'end) assumes 'end is a label somewhere,and jumps to it after calculating (+ 1 2 3)              

(statements (ec-compile '(+ 1 2 3) 'val 'next))   ;; compile without inlining/open-coding
=>

ehaliewicz

GENLISP> (gen-eval)
GEN-Eval: (+ 1 2)

;;  total-stack-pushes: 6 maximum-stack-depth: 5
;;  instructions executed: 86 execution time:     0.05 seconds

=> 3
GEN-Eval: (compile (+ 1 2))

;;  total-stack-pushes: 0 maximum-stack-depth: 0

ehaliewicz

;; compile-and-go creates a VM, compiles the given expression,
;; and runs the resulting assembly as the first expression in the vm REPL

(compile-and-go '(define (compiled-tail-recursive-fib n)
                     (define (fib-iter a b count)
                        (if (= count 0)
                            b
                            (fib-iter (+ a b) a (-  count 1))))
                     (fib-iter 1 0 n)))
 

ehaliewicz

(eval-when (:load-toplevel :execute :compile-toplevel)
  (defun mkstr (&rest args)
    (with-output-to-string (s)
      (dolist (a args) (princ a s))))

  (defun symb (&rest args)
    (values (intern (apply #'mkstr args)))))