From ef3be63e540ed9b5361a534cfa2cf3f8a992deef Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vsedach@gmail.com>
Date: Fri, 6 Feb 2009 22:02:19 -0700
Subject: [PATCH] Implemented 'flet' and 'labels' as PS macros.

---
 src/package.lisp       |  2 ++
 src/special-forms.lisp | 10 ++++++++++
 t/ps-tests.lisp        | 22 ++++++++++++++++++++++
 3 files changed, 34 insertions(+)

diff --git a/src/package.lisp b/src/package.lisp
index e2d21d6..e4c3d77 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -114,6 +114,8 @@
       ;; function definition
       #:defun
       #:lambda
+      #:flet
+      #:labels
 
       ;; lambda lists
       #:&key
diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index e525e8e..7ef4d26 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -383,6 +383,16 @@ lambda-list::=
     `(%js-lambda ,effective-args
       ,@effective-body)))
 
+(defpsmacro flet (fn-defs &rest body)
+  (flet ((process-fn-def (def)
+           `(var ,(car def) (lambda ,@(cdr def)))))
+    `(progn ,@(mapcar #'process-fn-def fn-defs) ,@body)))
+
+(defpsmacro labels (fn-defs &rest body)
+  (flet ((process-fn-def (def)
+           `(var ,(car def) (defun ,(car def) ,@(cdr def)))))
+    `(progn ,@(mapcar #'process-fn-def fn-defs) ,@body)))
+
 (defpsmacro defsetf-long (access-fn lambda-list (store-var) form)
   (setf (get-macro-spec access-fn *ps-setf-expanders*)
         (compile nil
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 4663c44..2889725 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -699,3 +699,25 @@ try {
                           symbol)
                       (:span :class "ticker-symbol-popup")))
   "'<SPAN CLASS=\"ticker-symbol\" TICKER-SYMBOL=\"' + symbol + '\"><A HREF=\"http://foo.com\">' + symbol + '</A><SPAN CLASS=\"ticker-symbol-popup\"/></SPAN>'")
+
+(test-ps-js flet1
+  ((lambda () (flet ((foo (x) (return (1+ x)))) (return (foo 1)))))
+  "(function () {
+    var foo = function (x) {
+        return x + 1;
+    };
+    return foo(1);
+})()")
+
+(test-ps-js labels1
+  ((lambda () (labels ((foo (x) 
+                         (return (if (=== 0 x)
+                                     0
+                                     (+ x (foo (1- x)))))))
+                (return (foo 3)))))
+  "(function () {
+    var foo = function foo(x) {
+        return 0 === x ? 0 : x + foo(x - 1);
+    };
+    return foo(3);
+})()")
-- 
2.20.1