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

	SET A, 0
	SET B, 1
	SET C, 10   ;; set to 10 to find the tenth fibonacci number

:test   IFE C, 0
	   SET PC, done
	
;; loop 
	SET X, A
	ADD X, B

ehaliewicz

(defun chop-1 (num tree)
  (labels ((recur (num tree start-index)
             (if (equalp 0 (length tree))  -1
                 (let* ((mid-point (truncate (/ (length tree) 2)))
                       (mid-num (elt tree mid-point)))
                   (cond
                     ((= (length tree) 0) -1)
                     ((= mid-num num) (+ mid-point start-index))
                     ((= (length tree) 1) -1)
                     ((> mid-num num) (recur num (subseq tree 0 mid-point) 0)) ;; check in first half of tree

ehaliewicz

# process() kind of parses Tadoku entries

# Character Classes
# 0. Space
# 1. Hash
# 2. Semicolon
# 3. Number
# 4. Other

ehaliewicz

(defun contains (self value)
  (labels ((recur (value current)
             (if (null current)
                 nil
                 (cond
                   ((= value current.value) t)
                   ((< value current.value) (recur value current.left))
                   (t (recur value current.right))))))
    (recur value self.root)))

ehaliewicz

;; A couple of silly macros for a language that has defmacro but no tail-recursion

;; the mutual recursion macro is even worse, because you can only really 'call' one of the functions

(defmacro recur (arg-pairs &body body)
  (let ((arg-names (mapcar #'car arg-pairs))  ;; extract loop variable names
        (arg-vals (mapcar #'cadr arg-pairs))) ;; extract start values

    ;; block to return from
    `(block nil

ehaliewicz

(defmacro flip-flop (left right)
  "Evaluates to false until the left test is satisfied.  Then evaluates to true until the right test is satisfied, etc."

  ;; create a collision-safe name for our state variable
  (let ((state-var (gensym)))
    
    ;; create a toplevel variable to keep state of flip-flop
    `(progn 
       (defvar ,state-var nil))

ehaliewicz

class Class
  
  def attr_accessor_with_default(attr_name, val)
    attr_name = attr_name.to_s
    self.class_eval("def #{attr_name}; @#{attr_name} = #{val};end")
    self.class_eval("@#{attr_name} = #{val}")
    
    self.class_eval("def #{attr_name}=(val) @#{attr_name} = val end")

  end