(def 'list)
(set list (lambda x x))

(def 'define)
(mac 'define)
(set define
     (lambda (var val)
       (list 'begin
	     (list 'def (list 'quote var))
	     (list 'set var val))))

(mac 'defmac)
(define defmac
  (lambda (var val)
    (list 'begin
	  (list 'define var val)
	  (list 'mac (list 'quote var)))))

(define nilp
  (lambda (x)
    (= x nil)))

(define caar
  (lambda (x)
    (car (car x))))

(define cadr
  (lambda (x)
    (car (cdr x))))

(define cdar
  (lambda (x)
    (cdr (car x))))

(define cddr
  (lambda (x)
    (cdr (cdr x))))

(defmac cond
  (lambda clauses
    (if (nilp clauses)
	nil
      (list 'if (car (car clauses))
	    (cons 'begin (cdr (car clauses)))
	    (cons 'cond (cdr clauses))))))

(define length
  (lambda (x)
    (if (nilp x)
	0
      (+ 1 (length (cdr x))))))

(define map
  (lambda (f x)
    (if (nilp x)
	nil
      (cons (f (car x))
	    (map f (cdr x))))))

(define not
  (lambda (x) (if x nil t)))

(defmac and
  (lambda x
    (if (nilp x)
	t
      (list 'if (car x)
	    (cons 'and (cdr x))
	    nil))))

(defmac or
  (lambda x
    (if (nilp x)
	nil
      (list 'if (car x)
	    t
	    (cons 'or (cdr x))))))

(define append
  (lambda (x y)
    (cond
     ((nilp x) y)
     ((nilp y) x)
     (t (cons (car x)
	      (append (cdr x) y))))))

(define startswith
  (lambda (x sym)
    (= (car x) sym)))

(define atomp
  (lambda (x)
    (or (nilp x) (numberp x) (symbolp x) (stringp x))))

(define qq
  (lambda (x)
    (cond
     ((atomp x)
      (list 'quote x))
     ((startswith x 'quote)
      (list 'list ''quote (qq (car (cdr x)))))
     ((startswith x 'unquote)
      (car (cdr x)))
     ((startswith x 'quasiquote)
      (qq (qq (car (cdr x)))))
     ((and (consp (car x))
	   (startswith (car x) 'unquotesplicing))
      (list 'append (car (cdr (car x))) (qq (cdr x))))
     (t
      (list 'cons (qq (car x)) (qq (cdr x)))))))

(defmac quasiquote qq)

(define first car)

(define second
  (lambda (x)
    (car (cdr x))))

(define third
  (lambda (x)
    (car (cdr (cdr x)))))

(define fourth
  (lambda (x)
    (car (cdr (cdr (cdr x))))))

(define singlep
  (lambda (x)
    (and (consp x)
	 (= (cdr x) nil))))

(define maketruelist
  (lambda (x)
    (cond
     ((nilp x) nil)
     ((consp x) (cons (car x) (maketruelist (cdr x))))
     (t (list x)))))

(define dottedp
  (lambda (x)
    (cond
     ((nilp x)
      nil)
     ((consp x)
      (dottedp (cdr x)))
     (t t))))

(defmac letrec
  (lambda (bindings . body)
    `(let ,(map (lambda (v) (list (car v) nil)) bindings)
       ,@(map (lambda (v) `(set .,v)) bindings)
       .,body)))

(define namedlet
  (lambda (name init body)
    `(letrec ((,name (lambda ,(map car init)
		       .,body)))
	     (,name .,(map second init)))))

(define simplelet
  (lambda (bindings body)
    `((lambda ,(map car bindings) .,body)
      .,(map (lambda (x) (car (cdr x))) bindings))))

(defmac let
  (lambda (head . rest)
    (if (symbolp head)
	(namedlet head (car rest) (cdr rest))
      (simplelet head rest))))

(define reverse
  (lambda (x)
    (let loop ((acc nil)
	       (tail x))
	 (if (nilp tail)
	     acc
	   (loop (cons (car tail) acc)
		 (cdr tail))))))

(define last
  (lambda (x)
    (let loop ((tail x))
	 (cond
	  ((nilp tail) nil)
	  ((nilp (cdr tail)) tail)
	  ((consp (cdr tail))
	   (loop (cdr tail)))
	  (t tail)))))

(defmac when
  (lambda (p . body)
    `(if ,p (begin .,body) nil)))

(defmac unless
  (lambda (p . body)
    `(if ,p nil (begin .,body))))

(defmac dolist
  (lambda (binder . body)
    `(let ((f (lambda (,(car binder))
		.,body)))
       (let loop ((tail ,(second binder)))
	    (unless (nilp tail)
	      (f (car tail))
	      (loop (cdr tail)))))))

(defmac dotimes
  (lambda (binder . body)
    `(let ((f (lambda (,(car binder))
		.,body))
	   (n ,(second binder)))
       (let loop ((i 0))
	    (when (< i n)
	      (f i)
	      (loop (+ i 1)))))))

(define nth
  (lambda (n x)
    (cond
     ((nilp x) (throw "nth: index out of range"))
     ((= n 0) (car x))
     (t (nth (- n 1) (cdr x))))))

(define member
  (lambda (item items)
    (and items
	 (or (startswith items item)
	     (member item (cdr items))))))

;;; alists

(define slot
  (lambda (ob tag)
    (cond
     ((nilp ob)
      nil)
     ((startswith (car ob) tag)
      (car ob))
     (t
      (slot (cdr ob) tag)))))

(define get
  (lambda (ob tag)
    (let ((s (slot ob tag)))
      (if s (second s) nil))))

(define lookup
  (lambda (ob msg)
    (if (atomp msg)
	(get ob msg)
      (if (consp msg)
	  (apply (get ob (car msg))
		 (cdr msg))
	(throw (strcat "lookup: bad msg: "
		       (write msg)))))))

(define cascade
  (lambda (ob msgs)
    (if (nilp msgs)
	ob
      (cascade (lookup ob (car msgs))
	       (cdr msgs)))))

(defmac _
  (lambda (ob . msgs)
    `(cascade ,ob
	      (list .,(map (lambda (msg)
			     (if (symbolp msg)
				 `',msg
			       `(list ',(car msg)
				      .,(cdr msg))))
			   msgs)))))

(defmac new
  (lambda pairs
    `(list .,(map (lambda (pair)
		    `(list ',(car pair) ,(second pair)))
		  pairs))))

(defmac clone
  (lambda (proto . pairs)
    `(append (new .,pairs) ,proto)))

;; TODO optimize this using gensym
(defmac set_
  (lambda (ob tag value)
    `(if (slot ,ob ',tag)
	 (begin
	  (setcdr (slot ,ob ',tag) (list ,value))
	  ,ob)
       (set ,ob (cons (list ',tag ,value) ,ob)))))

;;; messaging

(defmac send
  (lambda (pid msg)
    `(sendmsg ,pid (list ',(car msg) .,(cdr msg)))))

;;; startup

(define load
  (lambda (name)
    (log (strcat "loading " name ".fasl"))
    (http 'get (strcat name ".fasl"))
    (receive
     ((response code text)
      (when (= code 200)
	(dolist (e (fromjson text))
	  ((boxfn e))))))))

(load "compile")
(load "text")
(load "debug")
(load "repl")
(load "pong")
(load "complex")
(load "tile")
(load "game")
(load "arcade")

(startrepl)
(startarcade)

(focus 'pause)
