From: Raimon Grau <raimonster@gmail.com>
Date: Wed, 12 Dec 2012 00:49:47 +0000 (+0100)
Subject: refactor with macro
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=inline;h=d439d330be4452ee5e9b3863e342c3ae42ee30d7;p=jscl.git

refactor with macro
---

diff --git a/lispstrack.lisp b/lispstrack.lisp
index a0fb23b..1419eb9 100644
--- 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)))