[Openmcl-devel] with-package

[Taoufik Dachraoui]

I managed to write a correct version of with-package macro, this is due to
the valuable hints and discussions, I learned a lot by being a member of
ccl thank you a lot for all your helps

here is the whole code of the mb simple file system (some bugs may be found
sorry i did not test thoroughly)

Now I would like to see why this design is wrong by showing me examples
where the system can fail

Thank you again

Taoufik

(defpackage "MB" (:export "USE" "UNUSE" "WITH-PACKAGE"))
(in-package "MB")

(defun %new-symbol (s package &optional v)
  (setf (symbol-value (intern s package)) v))

(defun %symbol-value (s &optional package)
  (if (null package)
      (symbol-value (find-symbol s))
      (symbol-value (find-symbol s package))))

(defun (setf %symbol-value) (v s &optional package)
  (if (null package)
      (setf (symbol-value (find-symbol s)) v)
      (setf (symbol-value (find-symbol s package)) v)))

(defun %import (s)
  (let ((ss (find-symbol (symbol-name s))))
    (if (not (null ss))
(progn
  (push
   (if (eq (symbol-package ss) *package*)
       (copy-symbol ss t)
       (cons (symbol-name ss) (symbol-package ss)))
   (gethash (symbol-name s) (%symbol-value "**MB-HASH-HIDDEN-SYMBOLS**")))
  (unintern ss)))
    (import s)))

(defun %unimport (s)
  (if (not (eq (symbol-package s)
       (symbol-package (find-symbol (symbol-name s)))))
      (remhash (symbol-name s)
       (gethash (symbol-name s)
(%symbol-value "**MB-HASH-HIDDEN-SYMBOLS**")))
      (progn
(unintern (find-symbol (symbol-name s)))
(let ((asym (pop (gethash (symbol-name s)
  (%symbol-value "**MB-HASH-HIDDEN-SYMBOLS**")))))
  (if (not (null asym))
      (if (consp asym)
  (%import (find-symbol (car asym) (cdr asym)))
  (let ((sym (intern (symbol-name s))))
    (setf (symbol-plist sym) (symbol-plist asym))
    (if (boundp asym) (setf (symbol-value sym) (symbol-value asym)))
    (if (fboundp asym)
(if (null (macro-function asym))
    (setf (symbol-function sym) (symbol-function asym))
    (setf (macro-function sym) (macro-function asym)))))))))))

(defun %make-package (file nickname)
  (if (null (file-write-date file))
      (error (format nil "file not found (~S)" file))
      (let ((*package*
     (if (null (find-package nickname))
 (make-package file
       :use '("CCL" "COMMON-LISP" "MB")
       :nicknames `(,nickname))
 (find-package nickname))))
(%new-symbol "**MB-PACKAGE-TIMESTAMP**" *package* (file-write-date file))
(%new-symbol "**MB-HASH-HIDDEN-SYMBOLS**" *package* (make-hash-table))
(load file))))

(defun %use (name)
  (if (and (not (eq (find-package name) *package*))
   (or (null (%symbol-value "**MB-USED-PACKAGES**"))
       (not (eq (find-package name) (car (%symbol-value
"**MB-USED-PACKAGES**"))))))
      (progn
(if (null (find-package name))
    (%make-package (format nil "~A/~A.LISP" (ccl::current-directory-name)
(string name)) name)
    (if (and (not (null (find-symbol "**MB-PACKAGE-TIMESTAMP**"
(find-package name))))
     (> (file-write-date (package-name (find-package name)))
(%symbol-value "**MB-PACKAGE-TIMESTAMP**" (find-package name))))
(%make-package (package-name (find-package name)) name)))
(if (null (find-symbol "**MB-HASH-HIDDEN-SYMBOLS**" (symbol-package name)))
    (%new-symbol "**MB-HASH-HIDDEN-SYMBOLS**" *package* (make-hash-table)))
(do-external-symbols (s (find-package name)) (%import s))
(push (find-package name) (%symbol-value "**MB-USED-PACKAGES**")))))


(defun %unuse (name)
"only unuse the last used package"
  (if (not (null (find-package name)))
      (if (eq (find-package name) (car (%symbol-value
"**MB-USED-PACKAGES**")))
  (let ((pkg (pop (%symbol-value "**MB-USED-PACKAGES**"))))
    (do-external-symbols (s pkg) (%unimport s))
    (if (not (null (find-symbol "**MB-PACKAGE-TIMESTAMP**" pkg)))
(delete-package pkg)))
  (error "cannot unuse package ~S~%" (find-package name)))))

(defmacro use (&rest names)
  `(progn
     (if (null (find-symbol "**MB-USED-PACKAGES**")) (%new-symbol
"**MB-USED-PACKAGES**" *package*))
     (dolist (name ',names) (%use name))))

(defmacro unuse (&rest names)
  (if (null names)
      `(%unuse (car (%symbol-value "**MB-USED-PACKAGES**")))
      `(dolist (name ',names) (%unuse name))))

(defmacro with-package ((&rest names) &body body)
  (let ((r (gensym)) (e (gensym)))
    `(progn
       (use , at names)
       (multiple-value-bind (,r ,e)
           (ignore-errors
             (multiple-value-list
              (eval (read-from-string
     (format nil "(progn ~{~A ~})"
     (let ((*readtable* (copy-readtable)))
       (set-macro-character #\(
    (lambda (stream char)
      (declare (ignore char))
      (let ((str "") (n 0))
(do ((c (read-char stream) (read-char stream nil 'the-end)))
    ((and (= n 0) (eq c #\))))
  (if (eq c #\() (incf n) (if (eq c #\)) (decf n)))
  (setf str (format nil "~A~A" str c)))
str)))
       ',body))))))
         (unuse ,@(reverse names))
         (if (null ,e)
             (values-list ,r)
             (error (format nil "~S" ,e)))))))



On Sat, Jan 12, 2013 at 8:58 PM, Robert Goldman <rpgoldman at sift.info> wrote:

> On 1/12/13 Jan 12 -9:30 AM, Taoufik Dachraoui wrote:
> > I am wrote a very simple package system that I am using for all my
> > developments, I wanted to add
> > the macro with-package so that I can use a package temporarily and then
> > revert to previous context
> > just before using the package.
>
> I won't presume to dictate your personal programming style.  However, I
> feel free to *suggest* that this may not work out well.
>
> The package is effectively a big, invisible global variable, and having
> the correctness of your code depend on it can make its behavior
> unpredictable and difficult to understand.
>
> This is related to the discussion of DEFPACKAGE in the spec:
>
> "It is recommended that the entire package definition is put in a single
> place, and that all the package definitions of a program are in a single
> file. This file can be loaded before loading or compiling anything else
> that depends on those packages. Such a file can be read in the
> COMMON-LISP-USER package, avoiding any initial state issues."
>
> Reading between the lines, I suggest that this recommendation is
> intended to provide a transparent, easy-to-understand interpretation of
> the packages, so that the set of accessible names, and their
> interpretations is easy for the reader of code to predict.  Pushing and
> popping available symbols tends to work against this.  It also, as has
> been pointed out, can involve the need to understand issues of
> compile-time, load-time, and execute-time evaluation.
>
> I offer an additional heuristic: if something you are doing requires
> attention to the subtleties of evaluation time, consider a different
> method.  This is only a heuristic, because there are important tasks
> that can be done well by exploiting, e.g., compile-time execution
> subtleties.  Nevertheless, it's useful to consider alternatives when
> coding.
>
> The principle is the same as when writing expository prose: avoid
> complex constructions when they are unnecessary, since making the reader
> spend a lot of effort to understand incurs a risk of misunderstanding.
>
> Again, it's your code; do what you like with it, but simpler
> constructions may serve you better in the long run.
>
> Cheers,
> r
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20130112/4fcac11c/attachment.htm>