Page 2 of 2

Re: Changing syntax within a form

Posted: Mon Sep 02, 2013 12:37 pm
by Goheeca
Since I've got to know the predicate constantp, I've made a decision to update this thread. To improve the aforementioned toy for hackers:

Code: Select all

(defun save-symbol (sym)
  (copy-symbol (find-symbol (symbol-name sym)) t))

(defun restore-symbol (sym)
  (unintern (find-symbol (symbol-name sym)))
  (import sym))

(defun replace-symbol (in-sym mode)
  (let ((sym (intern (symbol-name in-sym))))
    (setf (symbol-plist sym) (symbol-plist in-sym))
    (cond ((constantp sym) (error "~S is a constant." sym))
          ((boundp in-sym) (setf (symbol-value sym)
                                 (symbol-value in-sym)))
          ((boundp sym) (when (eq mode :substitute) (makunbound sym))))
    (cond ((special-operator-p sym) (error "~S is a special operator." sym))
          ((fboundp in-sym) (if (macro-function in-sym)
                                (setf (macro-function sym)
                                      (macro-function in-sym))
                                (progn (fmakunbound sym)
                                       (setf (symbol-function sym)
                                             (symbol-function in-sym)))))
          ((fmakunbound sym) (when (eq mode :substitute) (fmakunbound sym))))
    sym))

(defmacro rebind-from ((pckg &key (mode :substitute)) &body body)
  (unless (member mode #1='(:substitute :add))
    (error "A bad mode passed: ~S~%Available modes: ~{~S~^, ~}" mode #1#))
  (let ((backup (gensym))
        (symbols (gensym)))
    `(let ((,backup)
           (,symbols))
       (unwind-protect
	    (progn (do-external-symbols (sym (find-package ,pckg))
                     (push sym ,symbols))
                   (setf ,backup (loop for sym in ,symbols
                                    collect (save-symbol sym)
                                    do (replace-symbol sym ,mode)))
                   ,@body)
	 (loop for sym in ,backup do (restore-symbol sym))))))
It has original constraints, but now they are handled by rising an error. Further it affects symbols interned during runtime against that codewalker. However, it can be fixed with the *package* variable and then the codewalker is certainly better to use. As I say it's a toy.