From 2bcb0ee5638173cf7da5191978c044dd6097771d Mon Sep 17 00:00:00 2001
From: Stelian Ionescu <sionescu@common-lisp.net>
Date: Fri, 15 Aug 2008 16:43:18 +0200
Subject: [PATCH] Add IOLIB.UTILS package with RETURN* for a start.

Signed-off-by: Stelian Ionescu <sionescu@common-lisp.net>
---
 iolib.utils.asd        | 13 +++++++++++++
 utils/pkgdcl.lisp      | 11 +++++++++++
 utils/return-star.lisp | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 61 insertions(+)
 create mode 100644 iolib.utils.asd
 create mode 100644 utils/pkgdcl.lisp
 create mode 100644 utils/return-star.lisp

diff --git a/iolib.utils.asd b/iolib.utils.asd
new file mode 100644
index 0000000..570036b
--- /dev/null
+++ b/iolib.utils.asd
@@ -0,0 +1,13 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
+
+(asdf:defsystem :iolib.utils
+  :description "Miscellaneous IOlib utils."
+  :author "Stelian Ionescu <sionescu@common-lisp.net>"
+  :maintainer "Stelian Ionescu <sionescu@common-lisp.net>"
+  :version "0.5.4"
+  :licence "MIT"
+  :depends-on (:alexandria)
+  :pathname (merge-pathnames (make-pathname :directory '(:relative "utils"))
+                             *load-truename*)
+  :components ((:file "pkgdcl")
+               (:file "return-star" :depends-on ("pkgdcl"))))
diff --git a/utils/pkgdcl.lisp b/utils/pkgdcl.lisp
new file mode 100644
index 0000000..70972fd
--- /dev/null
+++ b/utils/pkgdcl.lisp
@@ -0,0 +1,11 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
+;;;
+;;; --- Package definition.
+;;;
+
+(in-package :common-lisp-user)
+
+(defpackage :iolib.utils
+  (:use #:common-lisp :alexandria)
+  (:export #:return* #:defun* #:defmethod* #:lambda*
+           #:defmacro* #:define-compiler-macro*))
diff --git a/utils/return-star.lisp b/utils/return-star.lisp
new file mode 100644
index 0000000..86c4a2f
--- /dev/null
+++ b/utils/return-star.lisp
@@ -0,0 +1,37 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
+;;;
+;;; --- RETURN* wrappers.
+;;;
+
+(in-package :iolib.utils)
+
+(defun wrap-body-for-return-star (body)
+  (multiple-value-bind (body declarations docstring)
+      (parse-body body :documentation t)
+    (with-gensyms (return-star-block)
+      `(,docstring ,@declarations
+        (block ,return-star-block
+          (macrolet
+              ((return* (value)
+                 `(return-from ,',return-star-block ,value)))
+            ,@body))))))
+
+(defmacro defun* (name args &body body)
+  `(,(ensure-symbol :defun)
+     ,name ,args ,@(wrap-body-for-return-star body)))
+
+(defmacro defmethod* (name args &body body)
+  `(,(ensure-symbol :defmethod)
+     ,name ,args ,@(wrap-body-for-return-star body)))
+
+(defmacro lambda* (name args &body body)
+  `(,(ensure-symbol :lambda)
+     ,name ,args ,@(wrap-body-for-return-star body)))
+
+(defmacro defmacro* (name args &body body)
+  `(,(ensure-symbol :defmacro)
+     ,name ,args ,@(wrap-body-for-return-star body)))
+
+(defmacro define-compiler-macro* (name args &body body)
+  `(,(ensure-symbol :define-compiler-macro)
+     ,name ,args ,@(wrap-body-for-return-star body)))
-- 
2.11.4.GIT