nspace.el

;;; nspace.el --- Pseudo-namespaces

;; Copyright (C) 2013 Ian Eure

;; Author: Ian Eure <[email protected]>
;; Keywords: lisp, data

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(defvar *ns* nil
  "The current namespace")

(defun nspace-normalize (nsspec)
  "Turn NSSPEC into a namespace string."
  (cond ((stringp nsspec) nsspec)
        ((symbolp nsspec) (symbol-name nsspec))
        (t (error (format "Unknown nssspec `%s'" nsspec)))))

(defun nspace-symbols (nsspec)
  "Return a list of pseudo-namespace symbols."
  (let ((syms)
        (prefix (nspace-normalize nsspec)))
    (mapatoms
     (lambda (sym)
       (let ((name (symbol-name sym)))
         (when (string-match-p (concat "^" prefix "/") name)
           (push sym syms)))))
    syms))

(defun nspace-make-function-thunk (method)
  "Make a thunk macro for namespace NS method METHOD."
  (let* ((name (symbol-name method))
         (ns (car (split-string name "/")))
         (bare (intern (substring name (1+ (length ns))))))
    `(,bare (&rest args) ,(list 'backquote (list method ',@args)))))

(defun nspace-make-symbol-thunk (sym)
  "Make a symbol-macrolet definition for namespace NS symbol SYM."
  (let* ((name (symbol-name sym))
         (ns (car (split-string name "/")))
         (bare (intern (substring name (1+ (length ns))))))
    (list bare sym)))

(defun nspace-make-thunks (ns)
  "Return namespace function / symbol thunks.

   Returns a list of (SYM-THUNKS FUN-THUNKS)."
  (let ((syms (nspace-symbols ns)))
    (list (mapcar 'nspace-make-symbol-thunk (remove-if 'functionp syms))
          (mapcar 'nspace-make-function-thunk
                  (remove-if-not 'functionp syms)))))

(defmacro with-ns (ns &rest body)
  "Execute BODY in the context of namespace NS.

   Any function with a prefix of `NS/' will be aliased to its non
   nspace-qualified name while BODY is evaluated."
  (let* ((symfuncs (nspace-make-thunks ns))
         (syms (car symfuncs))
         (funcs (cadr symfuncs)))
    `(let ((*ns* ',ns))
       (macrolet ,funcs
         (symbol-macrolet ,syms
           ,@body)))))

(provide 'nspace)
;;; nspace.el ends here