From 7cb5a0900b5e1b4c1ecf1fe602ab9ac71ca62d77 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Sun, 3 Aug 2008 01:22:34 +0200
Subject: Add LABELS.

TAGBODY and GO work now.
---
 control-flow.lisp | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

(limited to 'control-flow.lisp')

diff --git a/control-flow.lisp b/control-flow.lisp
index a4503ab..b2c9953 100644
--- a/control-flow.lisp
+++ b/control-flow.lisp
@@ -19,7 +19,7 @@
 (in-package #:common-lisp)
 
 (export '(identity constantly complement tagbody go block return-from
-          defconstant prog prog* macrolet flet prog1 prog2))
+          defconstant prog prog* macrolet flet prog1 prog2 labels))
 
 
 (defun identity (x)
@@ -34,6 +34,16 @@
   (lambda (x) (not (funcall function x))))
 
 
+(defmacro labels ((&rest function-bindings) &body forms)
+  "Look, ma, I've defined LABELS in terms of FLET!"
+  `(flet ,(mapcar (lambda (x) `(,(first x) ())) function-bindings)
+     (%fsetq ,@(mapcan (lambda (x)
+                         `(,(first x) (lambda ,(second x) ,@(rest (rest x)))))
+                       function-bindings))
+     nil
+     ,@forms))
+
+
 (defmacro defconstant (name value &optional documentation)
   `(setq ,name ,value))
 
-- 
cgit v1.2.3