refactor with macro

diff --git a/lispstrack.lisp b/lispstrack.lisp
index a0fb23b..1419eb9 100644 (file)
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -1,21 +1,4 @@
-(defun ls-compile (sexp &optional env)
-  (cond
-    ((symbolp sexp) (format nil "V_~a" sexp))
-    ((integerp sexp) (format nil " ~a " sexp))
-    ((stringp sexp) (format nil " \"~a\" " sexp))
-    ; list
-    ((case (first sexp)
-       (if (format nil "((~a)? (~a) : (~a))"
-                  (ls-compile (second sexp))
-                  (ls-compile (third sexp))
-                  (ls-compile (fourth sexp))))
-       (lambda (concat "(function ("
-               (format nil "~{V_~a~^, ~}" (second sexp))
-               "){ "
-               (ls-compile-block (cddr sexp) env)
-               "})
-"))                    ; (function (params) { body })
-       (t nil)))))
+;;; Utils
 
 ;;; simplify me, please
 (defun concat (&rest strs)
@@ -23,14 +6,47 @@
           strs
           :initial-value ""))
 
-(defun ls-compile-block (sexps env)
-  (format nil
-         "~{~#[~; return ~a;~:;~a;~%~]~}"
-         (mapcar #'(lambda (x)
-                     (ls-compile x env))
-                 sexps)))
+;;; Compiler
 
-(defparameter *env* '())
+(defvar *compilations* nil)
+
+(defmacro define-compilation (name args &body body)
+  `(push (list ',name (lambda (env ,@args) ,@body))
+         *compilations*))
+
+(define-compilation if (condition true false)
+  (format nil "((~a)? (~a) : (~a))"
+          (ls-compile condition env)
+          (ls-compile true env)
+          (ls-compile false env)))
 
+(define-compilation lambda (args &rest body)
+  (concat "(function ("
+          (format nil "~{V_~a~^, ~}" args)
+          "){ "
+          (ls-compile-block body env)
+          "})
+"))
 
+(defparameter *env* '())
 (defparameter *env-fun* '())
+
+(defun ls-compile (sexp &optional env)
+  (cond
+    ((symbolp sexp) (format nil "V_~a" sexp))
+    ((integerp sexp) (format nil " ~a " sexp))
+    ((stringp sexp) (format nil " \"~a\" " sexp))
+    ; list
+    ((listp sexp)
+     (let ((compiler-func (second (assoc (car sexp) *compilations*))))
+       (if compiler-func
+           (apply compiler-func env (cdr sexp))
+           ;; funcall
+           )))))
+
+(defun ls-compile-block (sexps env)
+  (format nil
+    "~{~#[~; return ~a;~:;~a;~%~]~}"
+    (mapcar #'(lambda (x)
+                     (ls-compile x env))
+                 sexps)))