1

在顶级 REPL 中工作时,我有时会忘记在运行的 lisp 系统中输入了哪些定义。

我使用 Clozure CL,它提供了将应用程序保存为图像的选项,我可以这样做并且可以从我离开的地方继续,但此时无法查看所有代码,除非我单独键入并保存了代码已经到 xyz 文件了。

有没有办法获取/提取/查看我输入的定义,所以我可以将它们保存为源文件?

4

4 回答 4

2

下面将提取一个包中输入的所有函数定义:

(defun get-all-symbols (&optional package)
  (let ((lst nil)
        (package (find-package package)) )
    (do-all-symbols (s lst)
      (when (fboundp s)
        (unless (and package (not (eql (symbol-package s) package)))
          (push (cons s (function-lambda-expression s)) lst) )))))

尝试类似:

(get-all-symbols *package*)
于 2016-12-01T09:08:16.603 回答
2

Common Lisp(通常)不提供任何标准方法来“恢复”编译后的定义的源代码。通常,它可以在您正在使用的任何文件或缓冲区中找到。

(正如 Leo 的回答所指出的,有Function-Lambda-Expression,可以为您提供一些函数定义。它对常量或类没有帮助,而且它并不总是有效 - 正如 CLHS 所说,“任何实现都可能合法地返回 nil作为任何函数的 lambda 表达式。” http://clhs.lisp.se/Body/f_fn_lam.htm — 他的解决方案在最常见的情况下肯定有用,但它并不像这样“一般”一。)

您可以使用一组“包装器”宏,将您传递给它们的表单存储在全局哈希表中,然后从中恢复源。写这听起来像是一个有趣的小挑战,所以下面是我尝试做这样的事情。

我的愚蠢包装解决方案

请注意,以这种方式隐藏的“源”表单不会保留阅读器宏、评论或类似内容,并且可能会defmethod以微妙的可怕方式阻塞某些事情。那是因为我盲目地只存储定义形式的键控定义——例如,defun——和第二个词。如果您将函数重新绑定为宏或泛型函数(将保存所有三个冲突的定义),它不会读取方法组合或 lambda 列表来保存各种方法,或任何其他方法,这不够聪明。你可能会做很多其他的事情——例如(SetF (FDefinition 'FOO) …)——可以绕过这些而被忽视,所以它远非“万无一失”。警告讲师

这里的宏尝试从底层表单继承文档和 lambda 列表,因此它们应该可以很好地与大多数 IDE 配合使用。他们做得很好,在史莱姆。

使用这些的一种方法是直接调用它们;例如,在您的 REPL 中,您可以直接

 My-Package> (use-package :wrap-defining-form)
 My-Package> (defun$ my-fn (x) (+ x (sqrt x)))

包中提供了一种更危险/更有趣的方式Wrap-Defining-Form.Shadowing,其中宏隐藏了真正的Common-Lisp包定义……</p>

 CL-User> (in-package :CL-USER$)
 CL-User$> (defun blah (n) (loop repeat n do (format t "~&Blah …")))

当你准备好“保存”东西时,运行(dump-definitions).

我在 SBCL 中编写并测试了它,但试图注意它应该适用于许多/大多数其他实现。特别是,我使用了一个非 ANSI 函数:SB-Introspect:Function-Lambda-List. 此处的函数Wrap-Defining-Form::Find-Function-Lambda-List将在所有包中搜索该函数的实现版本。如果它找不到一个,一切都不会丢失;但是您不会从 IDE 中获得有关包装函数的 lambda 列表的提示。(Clozure 似乎对函数有效,但对宏无效。这可能会得到改进。)

CL-USER> (describe 'defun$)
WRAP-DEFINING-FORM:DEFUN$
  [symbol]

DEFUN$ names a macro:
  Lambda-list: (NAME LAMBDA-LIST &BODY BODY)
  Documentation:
    Wrap `DEFUN' and save the original form.

    DEFUN: Define a function at top level.
  Source file: /home/brpocock/Private/wrap-defining-form.lisp
; No value

没有 Function-Lambda-List,包装器看起来像

  Lambda-list: (&REST UNKNOWN-LAMBDA-LIST)

… 这不是很有帮助。


包装定义form.lisp

编辑:在 Clozure 中调试。也发布到https://github.com/brpocock/wrap-defining-forms

;;;; Wrap--Defining-Forms
;;; -*- Lisp -*-

(defpackage wrap-defining-forms
  (:use :common-lisp)
  (:documentation "Wrap  defining forms so  that they (try to)  save the
  source code of the definition being passed.")
  (:export #:wrap-defining-form #:dump-definitions

           #:defclass$
           #:defconstant$
           #:defgeneric$
           #:define-compiler-macro$
           #:define-condition$
           #:define-method-combination$
           #:define-modify-macro$
           #:define-setf-expander$
           #:define-symbol-macro$
           #:defmacro$
           #:defmethod$
           #:defpackage$
           #:defparameter$
           #:defsetf$
           #:defstruct$
           #:deftype$
           #:defun$
           #:defvar$))

(defpackage wrap-defining-forms.shadowing
  (:documentation "Wrapped forms like DEFUN$  are exported here with the
  names   of   the    forms   that   they   wrap,    like   DEFUN,   for
  shadowing imports.")
  (:export #:defclass
           #:defconstant
           #:defgeneric
           #:define-compiler-macro
           #:define-condition
           #:define-method-combination
           #:define-modify-macro
           #:define-setf-expander
           #:define-symbol-macro
           #:defmacro
           #:defmethod
           #:defpackage
           #:defparameter
           #:defsetf
           #:defstruct
           #:deftype
           #:defun
           #:defvar)
  (:use))

;; Clozure appears  to be  “smart” and adds  Common-Lisp even  though we
;; didn't ask for it (and explicily don't want it)
#+ccl (unuse-package '(:ccl :common-lisp)
                     :wrap-defining-forms.shadowing)

(defpackage :common-lisp-user/save-defs
  (:nicknames :cl-user$)
  (:use :common-lisp :common-lisp-user)
  (:import-from :wrap-defining-forms #:dump-definitions)
  (:shadowing-import-from :wrap-defining-forms.shadowing
                          #:defclass
                          #:defconstant
                          #:defgeneric
                          #:define-compiler-macro
                          #:define-condition
                          #:define-method-combination
                          #:define-modify-macro
                          #:define-setf-expander
                          #:define-symbol-macro
                          #:defmacro
                          #:defmethod
                          #:defpackage
                          #:defparameter
                          #:defsetf
                          #:defstruct
                          #:deftype
                          #:defun
                          #:defvar))
;; Clone any other functions you may have packed into CL-User.
(with-package-iterator (next-symbol :common-lisp-user :internal)
  (loop for symbol = (next-symbol) 
        while symbol
        for sibling = (intern (symbol-name symbol) (find-package :cl-user$))
        when (and (fboundp symbol)
                  (not (fboundp sibling)))
          do (setf (fdefinition sibling) (fdefinition symbol))))
(in-package "WRAP-DEFINING-FORMS")

(defvar *definitions* (make-hash-table)
  "Copies   of    forms   defined    by   the   wrappers    created   by
  `WRAP-DEFINING-FORM' which can be stashed with `DUMP-DEFINITIONS'")

#+ccl
(defun ccl-mock-lambda-list (function)
  (if (macro-function function)
      (list '&rest 'macro-lambda-list)
      (multiple-value-bind (required optional restp
                            keywords) 
          (ccl:function-args (fdefinition function))
        (concatenate ' list
                       (loop repeat required 
                             collect (gensym "ARG-"))
                       (when (and optional (plusp optional))
                         (cons '&optional
                               (loop repeat optional
                                     collect (gensym "OPT-"))))
                       (when restp
                         (list '&rest 'rest))
                       (when (and keywords (plusp keywords))
                         (list '&key '&allow-other-keys))))))

(defun find-function-lambda-list ()
  "Find the implementation's version  of `FUNCTION-LAMBDA-LIST' if there
is  one.  That  way,  Slime  and  friends  can  still  give  the  proper
lambda-list  for the  wrapped form.  If it  can't be  found, this  will
return a stub with just a &rest-var."
  (or
   #+sbcl #'sb-introspect:function-lambda-list
   #+ccl #'ccl-mock-lambda-list
   #-(or ccl sbcl)
   (dolist (package (list-all-packages))
     (let ((sym (find-symbol "FUNCTION-LAMBDA-LIST" package)))
       (when (fboundp sym)
         (return-from find-function-lambda-list sym)))) 
   (lambda (function)
     (declare (ignore function))
     (list '&rest 'unknown-lambda-list))))

(defmacro wrap-defining-form (cl-form) 
  "Assuming  that CL-FORM  is a  symbol for  a macro  or function  which
defines something  interesting (eg, “Defun”),  this will create  a macro
with the same  name with a trailing  “$” that will save  the source tree
before passing on the form to CL-FORM.

EG:  (wrap-defining-form  defun)  provides  a  “defun$”  which  has  the
additional side effect of storing the source form in *DEFINITIONS*.

Definitions saved can be recovered by `DUMP-DEFINITIONS'.

This  is not  industrial-strength; in  particular, I  expect it  to cope
poorly with DEFMETHOD."
  (check-type cl-form symbol)
  (let ((wrapper (intern (concatenate 'string (symbol-name cl-form) "$")))
        (wrapper.shadow (intern (symbol-name cl-form) :wrap-defining-forms.shadowing))
        (wrapped-lambda-list (funcall (find-function-lambda-list) 'defun)))
    (setf (gethash cl-form *definitions*) (make-hash-table))
    `(prog1
         (defmacro ,wrapper (&whole whole ,@wrapped-lambda-list)
           (declare (ignore ,@(remove-if (lambda (form) (member form lambda-list-keywords))
                                         wrapped-lambda-list)))
           ,(concatenate 'string "Wrap `" (symbol-name cl-form) "' and save the original form." #(#\newline #\newline)
                         (symbol-name cl-form) ": " (or (documentation cl-form 'function)
                                                        "(see CLHS; no documentation here)"))
           (let ((defined (cons ',cl-form (cdr whole))))
             (setf (gethash (second whole) (gethash ',cl-form *definitions*))
                   defined)
             defined))
       (defmacro ,wrapper.shadow (&whole whole ,@wrapped-lambda-list)
         (declare (ignore ,@(remove-if (lambda (form) (member form lambda-list-keywords))
                                       wrapped-lambda-list)))
         ,(concatenate 'string "Wrap `COMMON-LISP:" (symbol-name cl-form) "' and save the original form."
                       #(#\newline #\newline)
                       (symbol-name cl-form) ": " (or (documentation cl-form 'function)
                                                      "(see CLHS; no documentation here)"))
         (let ((defined (cons ',cl-form (cdr whole))))
           (setf (gethash (second whole) (gethash ',cl-form *definitions*)) 
                 defined)
           defined)))))
(wrap-defining-form defclass)
(wrap-defining-form defconstant)
(wrap-defining-form defgeneric)
(wrap-defining-form define-compiler-macro)
(wrap-defining-form define-condition)
(wrap-defining-form define-method-combination)
(wrap-defining-form define-modify-macro)
(wrap-defining-form define-setf-expander)
(wrap-defining-form define-symbol-macro)
(wrap-defining-form defmacro)
(wrap-defining-form defmethod)
(wrap-defining-form defpackage)
(wrap-defining-form defparameter)
(wrap-defining-form defsetf)
(wrap-defining-form defstruct)
(wrap-defining-form deftype)
(wrap-defining-form defun)
(wrap-defining-form defvar)
(defun dump-definitions (&optional pathname)
  "Write  out   the  definitions  saved   by  `WRAP-DEFINING-FORM'-built
wrappers to PATHNAME (or *STANDARD-OUTPUT*)."
  (let (output
        (*print-case* :capitalize)
        ;; If writing to file, set margin at 79, but try to keep things under 72.
        (*print-right-margin* (if pathname 79 *print-right-margin*))
        (*print-miser-width* (if pathname 72 *print-miser-width*)))
    (unwind-protect
         (progn (setq output (if pathname
                                 (open pathname :direction :output
                                                :if-exists :rename
                                                :if-does-not-exist :create)
                                 *standard-output*))
                (multiple-value-bind  (sec min hr d m y) (decode-universal-time (get-universal-time))
                  (declare (ignore sec))
                  (format output
                          "~&~|~%;;; definitions as of ~d-~d-~d @ ~d:~2,'0d:
\(In-Package #:~a)
~{~{~2%~:<~W ~@_~:I~W ~:_~W~1I ~_~W~:>~}~^~|~}~%~|~%" ; from CLHS 22.2.2 SIMPLE-PPRINT-DEFUN
                          y m d hr min
                          (package-name *package*)
                          (remove-if #'null
                                     (loop for form being the hash-keys of *definitions*
                                           for defs = (gethash form *definitions*)
                                           collect (loop for definition being the hash-values of defs
                                                         collect definition))))))
      (when output (ignore-errors (close output))))))

示例使用

CL-USER> (load "wrap-defining-form.lisp")

T
CL-USER> (use-package :wrap-defining-form)
T
CL-USER> (defun$ trash-word (word) 
           (let ((s (string word)))
             (sort (remove-if-not #'alpha-char-p s) #'char<)))
WARNING: redefining COMMON-LISP-USER::TRASH-WORD in DEFUN
TRASH-WORD
CL-USER> (trash-word 'Blatherscythe)
"ABCEEHHLRSTTY"
CL-USER> (describe 'trash-word)
COMMON-LISP-USER::TRASH-WORD
  [symbol]

TRASH-WORD names a compiled function:
  Lambda-list: (WORD)
  Derived type: (FUNCTION (T) (VALUES SEQUENCE &OPTIONAL))
  Source form:
    (SB-INT:NAMED-LAMBDA TRASH-WORD
        (WORD)
      (BLOCK TRASH-WORD
        (LET ((S (STRING WORD)))
          (SORT (REMOVE-IF-NOT #'ALPHA-CHAR-P S) #'CHAR<))))
; No value

CL-USER> (macroexpand-1 '(defun$ trash-word (word) 
           (let ((s (string word)))
             (sort (remove-if-not #'alpha-char-p s) #'char<))))
(DEFUN TRASH-WORD (WORD)
  (LET ((S (STRING WORD)))
    (SORT (REMOVE-IF-NOT #'ALPHA-CHAR-P S) #'CHAR<)))
T
CL-USER>  (dump-definitions)

;;; definitions as of 2016-12-1 @ 15:23:
(In-Package #:COMMON-LISP-USER)

(Defun Trash-Word (Word)
  (Let ((S (String Word)))
    (Sort (Remove-If-Not #'Alpha-Char-P S) #'Char<)))

NIL
CL-USER> (in-package :Common-Lisp-User/Save-Defs)
#<PACKAGE "COMMON-LISP-USER/SAVE-DEFS">
CL-USER$> (defun 2+ (n) (+ 2 n))
2+
CL-USER$> (describe '2+)
COMMON-LISP-USER/SAVE-DEFS::2+
  [symbol]

2+ names a compiled function:
  Lambda-list: (N)
  Derived type: (FUNCTION (T) (VALUES NUMBER &OPTIONAL))
  Source form:
    (SB-INT:NAMED-LAMBDA 2+
        (N)
      (BLOCK 2+ (+ 2 N)))
; No value
CL-USER$> (macroexpand-1 '(defun 2+ (n) (+ 2 n)))
(COMMON-LISP:DEFUN 2+ (N) (+ 2 N))
T
CL-USER$> (documentation 'defun 'function)
"Wrap `COMMON-LISP:DEFUN' and save the original form.

DEFUN: Define a function at top level."

CL-USER$> (dump-definitions)

;;; definitions as of 2016-12-1 @ 15:32:
(In-Package #:COMMON-LISP-USER/SAVE-DEFS)


(Common-Lisp:Defun 2+ (N) (+ 2 N))

(Common-Lisp:Defun Trash-Word (Word)
  (Let ((S (String Word)))
    (Sort (Remove-If-Not #'Alpha-Char-P S) #'Char<)))

    NIL

文件备份

Dump-Definitions也将写入文件。(它设置了:If-Exists :Rename,因此您也可以拥有一级 UNDO 保护。)

     CL-USER$> (dump-definitions "saved.lisp")
     NIL
于 2016-12-01T20:49:07.887 回答
1

这是与 CCL 的交互式会话:

? (declaim (optimize (debug 3)))
NIL

以上内容在这里并不是严格要求的,但是以高调试级别进行开发并没有什么坏处。

? (defun foo (x) (+ 3 x))
FOO
? (inspect 'foo)
[0]     FOO
[1]     Type: SYMBOL
[2]     Class: #<BUILT-IN-CLASS SYMBOL>
        Function
[3]     INTERNAL in package: #<Package "COMMON-LISP-USER">
[4]     Print name: "FOO"
[5]     Value: #<Unbound>
[6]     Function: #<Compiled-function FOO #x3020004B3F7F>
[7]     Arglist: (X)
[8]     Plist: NIL
Inspect> 6
[0]     #<Compiled-function FOO #x3020004B3F7F>
[1]     Name: FOO
[2]     Arglist (analysis): (X)
[3]     Bits: 8388864
[4]     Plist: (CCL::PC-SOURCE-MAP #(17 70 15 22) CCL::FUNCTION-SYMBOL-MAP
        (#(X) . #(63 17 70)) CCL::%FUNCTION-SOURCE-NOTE ...)
[5]     Source Location: #<SOURCE-NOTE Interactive "(defun foo (x) (+ 3 x))">
Inspect 1> 5
[0]     #<SOURCE-NOTE Interactive "(defun foo (x) (+ 3 x))">
[1]     Type: SOURCE-NOTE
[2]     Class: #<STRUCTURE-CLASS SOURCE-NOTE>
[3]     SOURCE: #(40 100 101 102 117 ...)
[4]     FILENAME: NIL
[5]     FILE-RANGE: 23

您可以看到,即使在 REPL 中,并且无需运行可能还存储有关 Emacs 环境信息的 Slime,您也可以访问 FOO 的源代码。如果您知道要恢复哪个功能,则可以使用此功能。要录制您的互动会话,请遵循jkiiski 关于 DRIBBLE 的建议

于 2016-12-01T09:11:45.517 回答
1

也许您可以自己轻松地实现这样的事情:

(defun my-repl (&optional (file-path "cl-history.lisp"))
  "Saves commands to a file"
  (loop
    (with-open-file (stream file-path
                            :direction :output
                            :if-does-not-exist :create
                            :if-exists :append) 
      (print '>)
      (let ((input (read)))
        (format stream "~A~%" input)
        (print (eval input))))))

要退出内部循环,您应该键入(quit).

或者,您可以使用com.informatimago.common-lisp.interactive.interactive:repl

于 2016-12-01T08:50:03.800 回答