Using a defstruct database with remove-if-not

Question

I'm trying to adapt this defstruct example by adding the select- functions described in the book: Practical Common Lisp. I'm running the code in Emacs using the Common Lisp package. The select-by-first does not return anything. In the Lisp book, the author does not use defstruct so I must need to do something slightly different?

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

(select-by-first "steve")

The complete program:

(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")

Answer 1

There are a few basic mistakes/problems. But with only two small changes we can get your example to work in Common Lisp.

• Emacs Lisp's compatibility package for Common Lisp is not really a Common Lisp. It is generally preferable to use a real Common Lisp implementation. Emacs Lisp lacks a few basic things that are hard to emulate to make it compatible with Common Lisp - for example lexical closures.

• Minor change: I changed your example so that the database does not contain Steve Jobs twice, but Steve Jobs and Steve Ballmer.

Now, what would we need to change to make it work in Common Lisp?

• (getf employee :first-name) should really be (employee-first-name employee) . The DEFSTRUCT macro generates these accessor functions automatically. In Common Lisp you can't use GETF to access the fields of real structures.

• Your database has two objects with the name STEVE (a symbol), but you are searching for the name "steve" (a string). (equal 'steve "steve") is false. In general a symbol is not EQUAL to a string. So you should search with (select-by-first 'steve).

In LispWorks then:

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))

Answer 2

Thanks Rainer. Here's the finished code that runs in 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")