Function LISP-通过参数搜索特定函数的程序

对于一个课程项目，我需要用lisp编写一个程序

该程序应包含最重要的lisp函数、它们的输入和输出参数以及可能的可选参数

例如：function-first、input-list、output-object（列表的第一个成员）

该计划应以两种不同的方式工作：

给程序一个函数名，它应该返回函数参数

输入函数参数，如果存在具有这些参数的函数，则应返回该函数的名称

我的问题是:

在lisp中，处理这样的任务的正确方法是什么？我想也许一棵树是一种处理它的方法？（制作一个包含所有函数和参数的树，然后编写一个处理该树的程序）

有人有比这更好的办法来完成这项任务吗？或者一些建议从哪里/如何开始？或者包含任何信息的教程

现在我有点不知道如何开始。如果您能提供任何帮助，我们将不胜感激

英语不是我的第一语言，所以我希望一切都可以理解

---

您好。

首先看一下如何准备您的通用lisp开发环境。之后，我认为你应该调查：

• 使用创建函数

诸如此类的事情。Ffter介绍了两个常见的lisp函数：

下面是一个小例子：

CL-USER> (defun my-sum (a b) "Add my-sum parameters A and B." (+ a b))
MY-SUM
CL-USER> (my-sum 2 3)
5 (3 bits, #x5, #o5, #b101)
CL-USER> (describe #'my-sum)
#<FUNCTION MY-SUM>
  [compiled function]


Lambda-list: (A B)
Derived type: (FUNCTION (T T) (VALUES NUMBER &OPTIONAL))
Documentation:
  Add my-sum parameters A and B.
Source form:
  (SB-INT:NAMED-LAMBDA MY-SUM
      (A B)
    "Add my-sum parameters A and B."
    (BLOCK MY-SUM (+ A B)))
; No values
CL-USER> (documentation 'my-sum 'function)
"Add my-sum parameters A and B."
CL-USER> (defun my-sum (a b) "Add my-sum parameters A and B." (declare (type fixnum a b)) (+ a b))
WARNING: redefining COMMON-LISP-USER::MY-SUM in DEFUN
MY-SUM
CL-USER> (describe #'my-sum)
#<FUNCTION MY-SUM>
  [compiled function]


Lambda-list: (A B)
Derived type: (FUNCTION (FIXNUM FIXNUM)
               (VALUES
                (INTEGER -9223372036854775808 9223372036854775806)
                &OPTIONAL))
Documentation:
  Add my-sum parameters A and B.
Source form:
  (SB-INT:NAMED-LAMBDA MY-SUM
      (A B)
    "Add my-sum parameters A and B."
    (DECLARE (TYPE FIXNUM A B))
    (BLOCK MY-SUM (+ A B)))
; No values

CL-USER>（取消我的总和（ab）“添加我的总和参数a和b.”（+ab））
我的总数
CL-USER>（我的总数2 3）
5（3位，#x5，#o5，#b101）
CL-USER>（描述“我的总结”）
#
[编译函数]
Lambda列表：（A B）
派生类型：（函数（T）（值编号和可选））
文档：
将我的求和参数A和B相加。
来源表格：
（SB-INT:NAMED-LAMBDA MY-SUM
（A）B）
“添加我的求和参数A和B。”
（阻止我的总和（+A B）））
; 没有价值观
CL-USER>（文档“我的总和”功能）
“添加我的求和参数A和B。”
CL-USER>（defun my sum（ab）”添加我的sum参数a和b.“（声明（键入fixnum a b））（+a b））
警告：在DEFUN中重新定义COMMON-LISP-USER:：MY-SUM
我的总数
CL-USER>（描述“我的总结”）
#
[编译函数]
Lambda列表：（A B）
派生类型：（函数（FIXNUM FIXNUM）
（价值观
（整数-9223372036854775808 9223372036854775806）
&（可选）
文档：
将我的求和参数A和B相加。
来源表格：
（SB-INT:NAMED-LAMBDA MY-SUM
（A）B）
“添加我的求和参数A和B。”
（声明（类型FIXNUM A B））
（阻止我的总和（+A B）））
; 没有价值观

最后，使用descripe输出中的字符串的最后一个技巧是：

CL-USER> (with-output-to-string (*standard-output*)
               (describe #'my-sum))
"#<FUNCTION MY-SUM>
  [compiled function]


Lambda-list: (A B)
Derived type: (FUNCTION (FIXNUM FIXNUM)
               (VALUES
                (INTEGER -9223372036854775808 9223372036854775806)
                &OPTIONAL))
Documentation:
  Add my-sum parameters A and B.
Source form:
  (SB-INT:NAMED-LAMBDA MY-SUM
      (A B)
    \"Add my-sum parameters A and B.\"
    (DECLARE (TYPE FIXNUM A B))
    (BLOCK MY-SUM (+ A B)))
"

CL-USER>（输出为字符串（*标准输出*）
（描述我的总结）
"#
[编译函数]
Lambda列表：（A B）
派生类型：（函数（FIXNUM FIXNUM）
（价值观
（整数-9223372036854775808 9223372036854775806）
&（可选）
文档：
将我的求和参数A和B相加。
来源表格：
（SB-INT:NAMED-LAMBDA MY-SUM
（A）B）
\“添加我的求和参数A和B.\”
（声明（类型FIXNUM A B））
（阻止我的总和（+A B）））
"

从表面上看，任务似乎是在内存中构建一个简单的符号数据库，可以通过两种方式进行搜索。数据库中的条目被理解为函数。“输出参数”可能被理解为一个或多个返回值。这些东西在ANSI Lisp中没有命名。对该任务的一个有用的解释是无论如何都要给返回值添加符号标签。此外，我们还可以使用类型符号作为返回值和参数。例如，cons函数的数据库条目可能如下所示：

(cons (t t) cons)   ;; function named cons takes two objects, returns a cons

(defun/recorded intern-lambda-list (lambda-list tree-node fdesc)
  ;; return the node where it was interned
  ...)

(defun/recorded lambda-list-fdescs (lambda-list tree-node)
  ;; Return a list of fdescs for a lambda list & T if there were any
  ;; or NIL & NIL if there were not (I don't think () & T is possible,
  ;; but it might be in some future version)
  ...)

类型

t

是ANSI Lisp中所有类型的超类型；它的意思是“任何价值”

这些记录的列表可以放入某个全局变量中。然后，我们编写一个名为

get params by name

的函数，以便：

(get-params-by-name 'cons) -> (t t)

还有一个：

通过参数获取名称

：

(get-names-by-params '(t t)) -> (cons)

此函数以列表形式返回所有匹配函数。多个函数可以具有此签名

诀窍是找到可选参数和rest参数的良好表示形式。它可能与语言使用的符号相同：

(list (&rest t) list)   ;; list takes rest arguments of any type, returns list

因为我们只对精确匹配感兴趣，所以不必实际解析

&rest

符号。当用户通过参数进行查询时，他们的查询对象将以相同的语法按字面意思为

（&rest t）

equal

功能可用于判断两个符号列表是否相同：

(equal '(&rest t) '(&rest t)) -> t
(equal '(t t) '(t t)) -> nil

因此，这个练习并不难：只是通过列表映射，寻找匹配项

(defun get-name-by-params (database params)
  (let ((matching-entries (remove-if-not (lambda (entry)
                                            (equal (second entry) params))
                                          database)))
    (mapcar #'first matching-entries))) ;; just the names, please

这里，函数将数据库列表作为参数，而不是引用全局变量。我们集成到其中的整个程序可以提供替代接口，但这是我们的低级查找功能

测试：

---

在作业到期之前，我会从讲师那里得到澄清，这是否是对模糊要求的正确解释。

鉴于这是一个课程项目，我将提供一个不完整的答案，让您填写空白

程序应该做什么 我对你被要求做的事情的解释是提供一个实用程序

• 给定函数名，返回其参数列表（以下称为“lambda列表”）
• 给定lambda列表，返回该lambda列表中的所有函数

因此，首先需要确定两个lambda列表是否相同。例如，作为lambda列表，

（x）

与

（y）

相同吗？是的，它是：形式参数的名称只在函数的实现中起作用，您可以使用常规参数

(defpackage :com.stackoverflow.lisp.fdesc-search
  (:use :cl)
  (:export
   #:defun/recorded
   #:record-function-description
   #:clear-recorded-functions
   #:name->lambda-list
   #:lambda-list->names))

(in-package :com.stackoverflow.lisp.fdesc-search)

;;; These define whether there is a recorder, and if not where pending
;;; records should be stashed
;;;
(defvar *function-description-recorder* nil)
(defvar *pending-function-records* '())

(defmacro defun/recorded (name lambda-list &body forms)
  "Like DEFUN but record function information."
  ;; This deals with bootstrapping by, if there is not yet a recording
  ;; function, stashing pending records in *PENDING-FUNCTION-RECORDS*,
  ;; which gets replayed into the recorder at the point it becomes
  ;; available.
  `(progn
     ;; do the DEFUN first, which ensures that the LAMBDA-LIST is OK
     (defun ,name ,lambda-list ,@forms)
     (if *function-description-recorder*
         (progn
           (dolist (p (reverse *pending-function-records*))
             (funcall *function-description-recorder*
                      (car p) (cdr p)))
           (setf *pending-function-records* '())
           (funcall *function-description-recorder*
                    ',name ',lambda-list))
       (push (cons ',name ',lambda-list)
             *pending-function-records*))
     ',name))

(defun/recorded simplify-lambda-list (ll)
  ;; Simplify a lambda list by replacing optional arguments with inits
  ;; by their names.  This does not validate the list
  (loop for a in ll
        collect (etypecase a
                  (symbol a)
                  (list (first a)))))

(defun/recorded argument-matches-p (argument prototype)
  ;; Does an argument match a prototype.
  (unless (symbolp argument)
    (error "argument ~S isn't a symbol" argument))
  (unless (symbolp prototype)
    (error "prototype ~S isn't a symbol" prototype))
  (if (find-if (lambda (k)
                 (or (eq argument k) (eq prototype k)))
               lambda-list-keywords)
      (eq argument prototype)
    t))

(defun/recorded fdescs-equivalent-p (fd1 fd2)
  ;; do FD1 & FD2 refer to the same function?
  (equal (fdesc-name fd1)
         (fdesc-name fd2)))

(defun/recorded intern-lambda-list (lambda-list tree-node fdesc)
  ;; return the node where it was interned
  ...)

(defun/recorded lambda-list-fdescs (lambda-list tree-node)
  ;; Return a list of fdescs for a lambda list & T if there were any
  ;; or NIL & NIL if there were not (I don't think () & T is possible,
  ;; but it might be in some future version)
  ...)

(defvar *lambda-list-tree* (make-lambda-list-tree-node))

(defvar *tree-nodes-by-name* (make-hash-table :test #'equal))

(defun/recorded record-function-description (name lambda-list)
  "Record information about a function called NAME with lambda list LAMBDA-LIST.
Replace any existing information abot NAME.  Return NAME."
  (let ((fdesc (make-fdesc :name name :lambda-list lambda-list)))
    ;; First of all remove any existing information
    (multiple-value-bind (node foundp) (gethash name *tree-nodes-by-name*)
      (when foundp
        (setf (lambda-list-tree-node-values node)
              (delete fdesc (lambda-list-tree-node-values node)
                      :test #'fdescs-equivalent-p))))
    (setf (gethash name *tree-nodes-by-name*)
          (intern-lambda-list lambda-list *lambda-list-tree* fdesc)))
  name)

(setf *function-description-recorder*
      #'record-function-description)

(defun/recorded clear-recorded-functions ()
  "Clear function description records.  Return no values"
  (setf *lambda-list-tree* (make-lambda-list-tree-node)
        *tree-nodes-by-name* (make-hash-table :test #'equal))
  (values))

(defun/recorded name->lambda-list (name)
  "Look up a function by name.
Return either its lambda list & T if it is found, or NIL & NIL if not."
  (multiple-value-bind (node foundp) (gethash name *tree-nodes-by-name*)
    (if foundp
        (values
         (fdesc-lambda-list
          (find-if (lambda (fd)
                     (equal (fdesc-name fd) name))
                   (lambda-list-tree-node-values node)))
         t)
      (values nil nil))))

(defun/recorded lambda-list->names (lambda-list)
  "find function names matching a lambda-list.
Return a list of name & T if there are any, or NIL & NIL if none.

Note that lambda lists are matched so that argument names do not match, and arguments with default values or presentp parameters match just on the argument."
  (multiple-value-bind (fdescs foundp) (lambda-list-fdescs lambda-list 
                                                           *lambda-list-tree*)
    (if foundp
        (values (mapcar #'fdesc-name fdescs) t)
      (values nil nil))))

> (dolist (x '(car cdr null))
    (record-function-description x '(thing)))
nil

> (dolist (x '(car cdr))
    (record-function-description `(setf ,x) '(new thing)))
nil

> (record-function-description 'cons '(car cdr))
cons

> (record-function-description 'list '(&rest args))

 > (lambda-list->names '(x))
 (null cdr
       car
       lambda-list->names
       name->lambda-list
       com.stackoverflow.lisp.fdesc-search::simplify-lambda-list)
t

> (lambda-list->names '(&rest anything))
(list)
t
 > (name->lambda-list 'cons)
 (car cdr)
 t

;;;; Storing things in trees of nodes
;;;

;;; Node protocol
;;;
;;; Nodes have values which may or may not be bound, and which may be
;;; assigned.  Things may be interned in (trees of) nodes with a
;;; value, and the value associated with a thing may be retrieved
;;; along with an indicator as to whether it is present in the tree
;;; under the root.
;;;

(defgeneric node-value (node)
  ;; the immediate value of a node
  )

(defgeneric (setf node-value) (new node)
  ;; Set the immediate value of a node
  )

(defgeneric node-value-boundp (node)
  ;; Is a node's value bound?
  )

(defgeneric intern-thing (root thing value)
  ;; intern a thing in a root, returning the value
  (:method :around (root thing value)
   ;; Lazy: this arround method just makes sure that primary methods
   ;; don't need to beother returning the value
   (call-next-method)
   value))

(defgeneric thing-value (root thing)
  ;; return two values: the value of THING in ROOT and T if is it present, or
  ;; NIL & NIL if not
  )


;;; Implementatation for STRING-TRIE-NODEs, which store strings
;;;
;;; The performance of these will be bad if large numbers of strings
;;; with characters from a large alphabet are stored: how might you
;;; fix this without making the nodes enormous?
;;;

(defclass string-trie-node ()
  ;; a node in a string trie.  This is conceptually some kind of
  ;; special case of an abstract 'node' class, but that doesn't
  ;; actually exist.
  ((children-map :accessor string-trie-node-children-map
                 :initform '())
   (value :accessor node-value)))

(defmethod node-value-boundp ((node string-trie-node))
  (slot-boundp node 'value))

(defmethod intern-thing ((root string-trie-node) (thing string) value)
  ;; intern a string into a STRING-TRIE-NODE, storing VALUE
  (let ((pmax (length thing)))
    (labels ((intern-loop (node p)
               (if (= p pmax)
                   (setf (node-value node) value)
                 (let ((next-maybe (assoc (char thing p) 
                                          (string-trie-node-children-map node)
                                          :test #'char=)))
                   (if next-maybe
                       (intern-loop (cdr next-maybe) (1+ p))
                     (let ((next (cons (char thing p)
                                       (make-instance (class-of node)))))
                       (push next (string-trie-node-children-map node))
                       (intern-loop (cdr next) (1+ p))))))))
      (intern-loop root 0))))

(defmethod thing-value ((root string-trie-node) (thing string))
  ;; Return the value associated with a string in a node & T or NIL &
  ;; NIL if there is no value for this string
  (let ((pmax (length thing)))
    (labels ((value-loop (node p)
               (if (= p pmax)
                   (if (node-value-boundp node)
                       (values (node-value node) t)
                     (values nil nil))
                 (let ((next (assoc (char thing p)
                                    (string-trie-node-children-map node)
                                    :test #'char=)))
                   (if next
                       (value-loop (cdr next) (1+ p))
                     (values nil nil))))))
      (value-loop root 0))))


;;; Draw node trees in LW
;;;

#+LispWorks
(defgeneric graph-node-tree (node))
  (:method ((node string-trie-node))
   (capi:contain
    (make-instance 'capi:graph-pane
                   :roots `((nil . ,node))
                   :children-function (lambda (e)
                                        (string-trie-node-children-map (cdr e)))
                   :edge-pane-function (lambda (pane parent child)
                                         (declare (ignore pane parent))
                                         (make-instance
                                          'capi:labelled-line-pinboard-object
                                          :text (format nil "~A" (car child))))
                   :print-function (lambda (n)
                                     (let ((node (cdr n)))
                                       (format nil "~A"
                                               (if (node-value-boundp node)
                                                   (node-value node)
                                                 ""))))))))