Использование базы данных defstruct с функцией remove-if-not - PullRequest
Новая
       39

Использование базы данных defstruct с функцией remove-if-not

1 голос
/ 02 февраля 2010

Я пытаюсь адаптировать этот пример defstruct , добавив функции select- , описанные в книге: Practical Common Lisp .Я запускаю код в Emacs, используя пакет Common Lisp. select-by-first ничего не возвращает.В книге о Лиспе автор не использует defstruct, поэтому мне нужно сделать что-то немного другое? 

(defun <strong>select-by-first</strong> (first-name)
  (remove-if-not
    #'(lambda (employee)
        (equal (getf employee :first-name) first-name))
    *emp-db*))

(select-by-first "steve")

Полная программа: 

(require 'cl)
;; http://mypage.iu.edu/~colallen/lp/node56.html
;; http://www.gigamonkeys.com/book/practical-a-simple-database.html
;;
(defvar *emp-db* nil)
(defun add-record (emp) (push emp *emp-db*))

(defstruct employee
   age
   first-name
   last-name
   sex
   children)

(add-record (make-employee))

(add-record (make-employee
               :age 34
               :last-name 'farquharson
               :first-name 'alice
               :sex 'female))

(add-record (make-employee
               :age 43
               :last-name 'jobs
               :first-name 'steve
               :sex 'male))

(add-record (make-employee
               :age 53
               :last-name 'ballmer
               :first-name 'steve
               :sex 'male))

(defun select-by-first (first-name)
  (remove-if-not
    #'(lambda (employee)
        (equal (getf employee :first-name) first-name))
    *emp-db*))

(select-by-first "steve")

Ответы [ 2 ]

4 голосов
/ 02 февраля 2010

Есть несколько основных ошибок / проблем. Но только с двумя небольшими изменениями мы можем заставить ваш пример работать в Common Lisp.

  • Пакет совместимости Emacs Lisp для Common Lisp на самом деле не является Common Lisp. Обычно предпочтительнее использовать настоящую реализацию Common Lisp. В Emacs Lisp отсутствуют некоторые базовые вещи, которые трудно эмулировать, чтобы сделать его совместимым с Common Lisp - например, лексические замыкания (обновление 2014 года, последняя версия GNU Emacs теперь также поддерживает лексические замыкания).

  • Незначительные изменения: я изменил ваш пример, чтобы база данных содержала не Стив Джобс дважды, а Стив Джобс и Стив Баллмер.

Теперь, что нам нужно изменить, чтобы он работал в Common Lisp?

  • (getf employee: имя-имя) действительно должно быть (сотрудник-имя-сотрудник). Макрос DEFSTRUCT генерирует эти функции доступа автоматически. В Common Lisp вы не можете использовать GETF для доступа к полям реальных структур.

  • В вашей базе данных есть два объекта с именем STEVE (символ), но вы ищете имя «steve» (строка). (равный 'Стив "Стив") является ложным. В общем, символ не равен строке. Таким образом, вы должны искать с (выбор за первым 'Стив).

В LispWorks тогда: 

CL-USER 11 > (select-by-first "steve")
NIL

CL-USER 12 > (select-by-first 'steve)
(#S(EMPLOYEE :AGE 53 :FIRST-NAME STEVE :LAST-NAME BALLMER :SEX MALE
             :CHILDREN NIL) 
 #S(EMPLOYEE :AGE 43 :FIRST-NAME STEVE :LAST-NAME JOBS :SEX MALE
             :CHILDREN NIL))
1 голос
/ 03 февраля 2010

Спасибо, Райнер. Вот готовый код, который работает в Emacs. 

#!/usr/bin/emacs --script

;; Derived from code on these sites:
;;
;; http://mypage.iu.edu/~colallen/lp/node56.html
;; http://www.gigamonkeys.com/book/practical-a-simple-database.html
;;
(require 'cl)
(defvar *emp-db* nil)
(defun add-record (emp) (push emp *emp-db*))

(defstruct employee age first-name last-name sex children)

(add-record (make-employee))

(add-record (make-employee :age 34
      :last-name 'farquharson
      :first-name 'alice
      :sex 'female))

(add-record (make-employee :age 43
      :last-name 'jobs
      :first-name 'steve
      :sex 'male))

(add-record (make-employee :age 53
      :last-name 'ballmer
      :first-name 'steve
      :sex 'male))

(defun select-by-first (first-name)
  (remove-if-not
   #'(lambda (employee)
       (equal (employee-first-name employee) first-name))
   *emp-db*))

(defun select-by-last (last-name)
  (remove-if-not
   #'(lambda (employee)
       (equal (employee-last-name employee) last-name))
   *emp-db*))

(princ "Employees with the first name Steve:\n")
(princ "  ") 
(princ (select-by-first 'steve))
(princ "\n")
(princ "Employees with the last name Jobs:\n")
(princ "  ")
(princ (select-by-last 'jobs))
(princ "\n")
...