+(define-compilation debug (form)
+ (concat "console.log(" (ls-compile form env fenv) ")"))
+
+(define-compilation while (pred &rest body)
+ (concat "(function(){ while("
+ (ls-compile pred env fenv)
+ "){"
+ (ls-compile-block body env fenv)
+ "}})()"))
+
+(define-compilation function (x)
+ (cond
+ ((and (listp x) (eq (car x) 'lambda))
+ (ls-compile x env fenv))
+ ((symbolp x)
+ (lookup-function x fenv))))
+
+#+common-lisp
+(defmacro eval-when-compile (&body body)
+ `(eval-when (:compile-toplevel :execute)
+ ,@body))
+
+(defvar *eval-when-compilations*)
+(define-compilation eval-when-compile (&rest body)
+ (eval (cons 'progn body))
+ nil)
+
+(defmacro define-transformation (name args form)
+ `(define-compilation ,name ,args
+ (ls-compile ,form env fenv)))
+
+(define-transformation progn (&rest body)
+ `((lambda () ,@body)))
+
+(define-transformation let (bindings &rest body)
+ `((lambda ,(mapcar 'car bindings) ,@body)
+ ,@(mapcar 'cadr bindings)))
+
+;;; A little backquote implementation without optimizations of any
+;;; kind for lispstrack.
+(defun backquote-expand-1 (form)
+ (cond
+ ((symbolp form)
+ (list 'quote form))
+ ((atom form)
+ form)
+ ((eq (car form) 'unquote)
+ (car form))
+ ((eq (car form) 'backquote)
+ (backquote-expand-1 (backquote-expand-1 (cadr form))))
+ (t
+ (cons 'append
+ (mapcar (lambda (s)
+ (cond
+ ((and (listp s) (eq (car s) 'unquote))
+ (list 'list (cadr s)))
+ ((and (listp s) (eq (car s) 'unquote-splicing))
+ (cadr s))
+ (t
+ (list 'list (backquote-expand-1 s)))))
+ form)))))
+
+(defun backquote-expand (form)
+ (if (and (listp form) (eq (car form) 'backquote))
+ (backquote-expand-1 (cadr form))
+ form))
+
+(defmacro backquote (form)
+ (backquote-expand-1 form))
+
+(define-transformation backquote (form)
+ (backquote-expand-1 form))
+
+;;; Primitives
+
+(define-compilation + (x y)
+ (concat "((" (ls-compile x env fenv) ") + (" (ls-compile y env fenv) "))"))
+
+(define-compilation - (x y)
+ (concat "((" (ls-compile x env fenv) ") - (" (ls-compile y env fenv) "))"))
+
+(define-compilation * (x y)
+ (concat "((" (ls-compile x env fenv) ") * (" (ls-compile y env fenv) "))"))