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

;; 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

;; 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

(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

(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

;; compiles untyped lambda calculus to portable C
;; syntax
;; (lambda x x) - lambda abstraction
;; (x y)        - lambda combination (assuming x and y are bound)



;; map of function names to declarations
;; kept separate from the rest of the C code because they need to be forward-declared
(defvar *lambda-map* nil)

ehaliewicz

#include "stdio.h"
#include "stdlib.h"

typedef struct {
  void* apply_func;  // pointer to function apply this closure w/ correct number of args and free-vars
  void* func;        // pointer to lifted function that implements this closure
  int num_freevars;  // number of bound variables (for GC use)
  char* str;         // string representation of this function
  void* forwarded;   // forward pointer (for GC use)
  void* args[];      // bound variables

ehaliewicz

// interpret lambda calculus in a few lines (^:
#include "stdio.h"
#include "stdlib.h"
#include "ctype.h"
#include "string.h"
#include "setjmp.h"

typedef enum {
  APPLICATION, LAMBDA, SYMBOL
} type;

ehaliewicz

// compile lambda calculus in a few lines (^:
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <setjmp.h>


// syntax tree structures and utility functions

ehaliewicz

(defun compile-bf (program)
  (let ((loop-stack (list)))
    (let ((translated (loop for char across program appending
			   (case char
			     (#\> '((incf pointer)))
			     (#\< '((decf pointer)))
			     (#\+ '((incf (aref memory (wrap-pointer pointer)))))
			     (#\- '((decf (aref memory (wrap-pointer pointer)))))
			     (#\. '((format t "~a" (code-char (aref memory (wrap-pointer pointer))))))
			     (#\, '((setf (aref memory (wrap-pointer pointer)) (char-code (read-char)))))