Define-transformation like light compiler macros
authorDavid Vazquez <davazp@gmail.com>
Sun, 16 Dec 2012 04:01:34 +0000 (04:01 +0000)
committerDavid Vazquez <davazp@gmail.com>
Sun, 16 Dec 2012 04:01:34 +0000 (04:01 +0000)
- Add progn

lispstrack.lisp
test.lisp

index 176ca35..abc1b2b 100644 (file)
       nil
       *eval-when-compilations*))
 
+
+(defmacro define-transformation (name args form)
+  `(define-compilation ,name ,args
+     (ls-compile ,form env fenv)))
+
+(define-transformation progn (&rest body)
+  `((lambda () ,@body)))
+
 ;;; aritmetic primitives
 (define-compilation + (x y)
   (concat "((" (ls-compile x env fenv) ") + (" (ls-compile y env fenv) "))"))
 (defun %compile-defmacro (name lambda)
   (push (cons name (cons 'macro lambda)) *fenv*))
 
-(defun compile-funcall (name args env fenv)
-  (format nil "~a(~{~a~^, ~})"
-          (lookup-function name fenv)
-          (mapcar (lambda (x) (ls-compile x env fenv)) args)))
-
 (defun ls-macroexpand-1 (form &optional env fenv)
   (let ((function (cdr (assoc (car form) *fenv*))))
     (if (and (listp function) (eq (car function) 'macro))
         (apply (eval (cdr function)) (cdr form))
         form)))
 
+(defun compile-funcall (function args env fenv)
+  (cond
+    ((symbolp function)
+     (format nil "~a(~{~a~^, ~})"
+             (lookup-function function fenv)
+             (mapcar (lambda (x) (ls-compile x env fenv)) args)))
+    ((and (listp function) (eq (car function) 'lambda))
+     (format nil "(~a)(~{~a~^, ~})"
+             (ls-compile function env fenv)
+             (mapcar (lambda (x) (ls-compile x env fenv)) args)))
+    (t
+     (error "Invalid function designator ~a." function))))
+
 (defun ls-compile (sexp &optional env fenv)
   (cond
     ((symbolp sexp) (lookup-variable sexp env))
index a38014b..0f19c5f 100644 (file)
--- a/test.lisp
+++ b/test.lisp
@@ -19,6 +19,8 @@
 (fsetq f (lambda (x) (+ x 10)))
 (debug (f 20))
 
+(debug ((lambda (x) x) 9999))
+
 ;;; Macros
 (debug "---MACROS---")
 
@@ -53,6 +55,7 @@
 (debug (symbol-name 'foo))
 (debug (symbol-name 'foo-bar))
 
+(debug (progn 1 2 3 123))
 
 ;;; &rest lambda-list