I am getting an error "variable EQ has no value" when I run the following code. How to overcome this error?
(defun add_book(bookref title author publisher)
(setf (get bookref 'title) title)
(setf (get bookref 'author) author)
(setf (get bookref 'publisher) publisher)
(setq library (cons bookref library))
bookref)
(defun retrieve_by (property value)
(setq result nil)
(do ((L library (cdr L)))
((NULL L) result)
(cond (EQ (get (car L) property) value)
(cons (car L) result))))
Maybe better formatting and the output from the SBCL compiler will help you. See the compiler warnings. Try to consult the Lisp reference to look up the syntax of the various constructs: http://lispdoc.com
* (defun add_book(bookref title author publisher)
(setf (get bookref 'title) title)
(setf (get bookref 'author) author)
(setf (get bookref 'publisher) publisher)
(setq library (cons bookref library))
bookref)
; in: DEFUN ADD_BOOK
; (SETQ LIBRARY (CONS BOOKREF LIBRARY))
;
; caught WARNING:
; undefined variable: LIBRARY
;
; compilation unit finished
; Undefined variable:
; LIBRARY
; caught 1 WARNING condition
ADD_BOOK
* (defun retrieve_by (property value)
(setq result nil)
(do ((L library (cdr L)))
((NULL L) result)
(cond (EQ (get (car L) property) value)
(cons (car L) result))))
; in: DEFUN RETRIEVE_BY
; (COND (EQ (GET (CAR L) PROPERTY) VALUE) (CONS (CAR L) RESULT))
; --> IF COND
; ==>
; (IF CONS
; (PROGN (CAR L) RESULT)
; NIL)
;
; caught WARNING:
; undefined variable: CONS
; ==>
; (IF EQ
; (PROGN (GET (CAR L) PROPERTY) VALUE)
; (COND (CONS (CAR L) RESULT)))
;
; caught WARNING:
; undefined variable: EQ
; (DO ((L LIBRARY (CDR L)))
; ((NULL L) RESULT)
; (COND (EQ (GET (CAR L) PROPERTY) VALUE) (CONS (CAR L) RESULT)))
; --> BLOCK
; ==>
; (LET ((L LIBRARY))
; (TAGBODY
; (GO #:G1)
; #:G0
; (TAGBODY (COND (EQ # VALUE) (CONS # RESULT)))
; (PSETQ L (CDR L))
; #:G1
; (UNLESS (NULL L) (GO #:G0))
; (RETURN-FROM NIL (PROGN RESULT))))
;
; caught WARNING:
; undefined variable: LIBRARY
; (SETQ RESULT NIL)
;
; caught WARNING:
; undefined variable: RESULT
;
; compilation unit finished
; Undefined variables:
; CONS EQ LIBRARY RESULT
; caught 4 WARNING conditions
RETRIEVE_BY
*
Related
I'm encountering a worrying error in SBCL -- I suspect that it arises from pilot error, and would love some tips if you have them!
Here is the error:
Memory fault at 0x52 (pc=0x52cffa19 [code 0x52cff6d0+0x349 ID 0x86a2], fp=0x7ff37f29f6d0, sp=0x7ff37f29f698) tid 0x7ff38ca82180
The integrity of this image is possibly compromised.
Continuing with fingers crossed.
"derp"
debugger invoked on a SB-SYS:MEMORY-FAULT-ERROR in thread
#<THREAD "main thread" RUNNING {1000510083}>:
Unhandled memory fault at #x52.
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [ABORT] Exit debugger, returning to top level.
(HMAKER-II)
source: (LIST (CAR (CDR (CDR IENTRY))))
Here is the code that I'm running. It is a few connected subroutines in a larger program. The overall program takes structured text input and adds to a hash table, this subroutine takes the contents of the table and is intended to organize it back into a single structured output in the same form as the input (it's not quite finished, I've only got as far as creating a new table with modified data in order to create a well-formed output).
I'm conscious that my code is messy and can be improved -- I would appreciate pointers on improving it, but my main goal is first to fix the error before focusing in better and more efficient code.
Here you go:
(defun hmaker-launcher ()
(setf table-entries-for-hmaker (alexandria:hash-table-alist etable))
(hmaker))
(defun hmaker ()
(if (equal table-entries-for-hmaker nil)
(progn
(setf sorted-list-of-ientries (sort (alexandria:hash-table-alist itable) #'> :key #'third))
(hmaker-II)))
(setf table-entry-for-hmaker (car table-entries-for-hmaker))
(setf entry-name-for-hmaker (car table-entry-for-hmaker))
(setf entry-number (car (reverse table-entry-for-hmaker)))
(setf processed-entry-for-hmaker (cdr (reverse (cdr (cdr (reverse table-entry-for-hmaker))))))
(if (equal entry-number 8)
(progn
(setf (gethash entry-name-for-hmaker itable) (list '8 (length (car processed-entry-for-hmaker)) processed-entry-for-hmaker))
)
)
(if (equal entry-number 9)
(progn
(setf number-of-elements (list-length processed-entry-for-hmaker))
(setf (gethash entry-name-for-hmaker itable) (list '9 number-of-elements processed-entry-for-hmaker))
))
(setf table-entries-for-hmaker (cdr table-entries-for-hmaker))
(hmaker)
)
(defun hmaker-II ()
(if (equal sorted-list-of-ientries nil)
(inputter))
(setf ientry (car sorted-list-of-ientries))
(if (equal '9 (car (cdr ientry)))
(progn
(setf complexity-atom (list (car (cdr (cdr ientry)))))
(setf hmaker-complexity-list (append hmaker-complexity-list complexity-atom))
(setf (nth hmaker-recursion-counter complexity-adder) (+ (car (cdr (cdr identry))) (nth hmaker-recursion-counter complexity-adder)))
(setf (second (gethash (car ientry) itable)) complexity-adder)
(setf rel-parts (cdr (cdr (cdr ientry))))
(push "padding" rel-parts)
(hmaker-III rel-parts)
)
(defun hmaker-III (parts)
(setf parts (cdr parts))
(if (equal parts nil)
(setf sorted-list-of-ientries (cdr sorted-list-of-ientries))
(hmaker-II)
)
(setf part-in-question (car parts))
(if (equal '9 (car (cdr (part-in-question))))
(progn
(setf hmaker-recursion-counter (+ hmaker-recursion-counter 1))
(setf (nth hmaker-recursion-counter complexity-adder) (+ (car (cdr (gethash part-in-question)) (nth hmaker-recursion-counter complexity-adder))))
(setf sub-parts (cdr (cdr (gethash part-in-question itable))))
(hmaker-III sub-parts)
)
(progn
(hmaker-III parts))
)
)
Thoughts?
I want to get a function argument value, using an argument name.
The following code don't works, because symbol-value working only with global variables:
(defun test1 (&key v1)
(format t "V1: ~A~%" (symbol-value (intern "V1"))))
Is there a portable way to do this in Common Lisp?
You can use a custom environment to map strings to functions:
(use-package :alexandria)
(defvar *env* nil)
(defun resolve (name &optional (env *env*))
(if-let (entry (assoc name env :test #'string=))
(cdr entry)
(error "~s not found in ~a" name env)))
(defmacro bind (bindings env &body body)
(assert (symbolp env))
(let ((env (or env '*env*)))
(loop
for (n v) in bindings
collect `(cons ,n ,v) into fresh-list
finally
(return
`(let ((,env (list* ,#fresh-list ,env)))
,#body)))))
(defmacro call (name &rest args)
`(funcall (resolve ,name) ,#args))
For example:
(bind (("a" (lambda (u) (+ 3 u)))
("b" (lambda (v) (* 5 v))))
nil
(call "a" (call "b" 10)))
Here is another version of an explicit named-binding hack. Note this isn't well (or at all) tested, and also note the performance is not going to be great.
(defun named-binding (n)
;; Get a binding by its name: this is an error outside
;; WITH-NAMED-BINDINGS
(declare (ignore n))
(error "out of scope"))
(defun (setf named-binding) (val n)
;; Set a binding by its name: this is an error outside
;; WITH-NAMED-BINDINGS
(declare (ignore val n))
(error "out of scope"))
(defmacro with-named-bindings ((&rest bindings) &body decls/forms)
;; establish a bunch of bindings (as LET) but allow access to them
;; by name
(let ((varnames (mapcar (lambda (b)
(cond
((symbolp b) b)
((and (consp b)
(= (length b) 2)
(symbolp (car b)))
(car b))
(t (error "bad binding ~S" b))))
bindings))
(decls (loop for df in decls/forms
while (and (consp df) (eql (car df) 'declare))
collect df))
(forms (loop for dft on decls/forms
for df = (first dft)
while (and (consp df) (eql (car df) 'declare))
finally (return dft)))
(btabn (make-symbol "BTAB")))
`(let (,#bindings)
,#decls
(let ((,btabn (list
,#(mapcar (lambda (v)
`(cons ',v (lambda (&optional (val nil valp))
(if valp
(setf ,v val)
,v))))
varnames))))
(flet ((named-binding (name)
(let ((found (assoc name ,btabn)))
(unless found
(error "no binding ~S" name))
(funcall (cdr found))))
((setf named-binding) (val name)
(let ((found (assoc name ,btabn)))
(unless found
(error "no binding ~S" name))
(funcall (cdr found) val))))
(declare (inline named-binding (setf named-binding)))
,#forms)))))
And now:
> (with-named-bindings ((x 1))
(setf (named-binding 'x) 2)
(named-binding 'x))
2
Even better:
(defun amusing (x y)
(with-named-bindings ((x x) (y y))
(values #'named-binding #'(setf named-binding))))
(multiple-value-bind (reader writer) (amusing 1 2)
(funcall writer 2 'x)
(funcall reader 'x))
will work.
I am writing a function called ptyper that takes a nested list, nl. This function replaces all occurrences of a number with n and all occurrences of a symbol with s. This is what I have now:
(define (ptyper nl) (cond
((null? nl) '())
((list? nl)
(let ((ls (car nl)))
(list (ptyper ls))))
((number? (car nl))
(cons "n" (cdr nl)))
((symbol? (car nl))
(cons "s" (cdr nl)))
(else
(cons (car nl) (cdr nl)))))
I ran this test (ptyper '(2 (abc () "abc"))) but received an error that their was a contract violation. I'm not exactly sure what I'm doing wrong so if could use some help. Thanks!
Here is a possible solution with one function:
(define (ptyper nl)
(cond
((null? nl) '()) ; if the argument is an empty list, return the empty list
((list? nl) ; if the argument is a list, then
(let* ((c (car nl)) ; get its first element
(nc (cond ((number? c) "n") ; transform it for numbers
((symbol? c) "s") ; and symbols
((list? c) (ptyper c)) ; if a list recur over it
(else c)))) ; otherwise (e.g. a string) return as it is
(cons nc (ptyper (cdr nl))))) ; recursive call on the rest of the list
(else nl))) ; this should never happen for the specification,
; return the parameter or cause an error
Note that the error in your case is caused by the recursive call. When the function is called on an atom, for instance 2, first it checks for null and list?, and those checks returns false. Then it checks for (number (car nl)), but nl is equal to 2 and so car fails.
Here is a data definition for an S-expression, this models your data.
; An S-expr is one of:
; – Atom
; – SL
; An SL is one of:
; – '()
; – (cons S-expr SL)
; An Atom is one of:
; – Number
; – String
; – Symbol
We have predicates for every kind of data except Atom, so we make atom?:
;; Any -> Boolean
;; is the x an atom?
(define (atom? x)
(not (list? x)))
We follow the structure of the data to build "templates" for our functions:
(define (func sexp)
(cond
[(atom? sexp) (func-atom sexp)]
[else (func-sl sexp)]))
(define (func-sl sl)
(cond
[(empty? sl) ...]
[else (... (func (first sl)) ... (func-sl (rest sl)) ...)]))
(define (func-atom at)
(cond
[(number? at) ...]
[(string? at) ...]
[(symbol? at) ...]))
We fill in the gaps:
; Atom -> String
(define (subs-atom at)
(cond
[(number? at) "n"]
[(string? at) at]
[(symbol? at) "s"]))
; SL -> SL
(define (subs-sl sl)
(cond
[(empty? sl) sl]
[else (cons (subs-sexp (first sl))
(subs-sexp (rest sl)))]))
; S-exp -> S-exp
(define (subs-sexp sexp)
(cond
[(atom? sexp) (subs-atom sexp)]
[else (subs-sl sexp)]))
Using the interface for ptyper:
(define (ptyper nl)
(subs-sexp nl))
(ptyper '(2 (abc () "abc")))
; => '("n" ("s" () "abc"))
I'm trying to implement quicksort in CLisp, and so far I'm able to partition the list around a pivot. However, when I try to combine and recursively sort the sublists, I get either a stack overflow or an error with let, and I'm not sure what's going wrong. Here's my code:
(defun pivot (n xs)
(list (getLesser n xs) (getGreater n xs))
)
(defun getLesser (m l)
(cond
((null l) nil)
((<= m (car l)) (getLesser m (cdr l)))
(t (cons (car l) (getLesser m (cdr l)))))
)
(defun getGreater (m l)
(cond
((null l) nil)
((> m (car l)) (getGreater m (cdr l)))
(t (cons (car l) (getGreater m (cdr l)))))
)
(defun quicksort (xs)
(cond
((null xs) nil)
(t
(let (partition (pivot (car xs) xs))
(cond
((null (car partition)) (cons (quicksort (cdr partition)) nil))
((null (cdr partition)) (cons (quicksort (car partition)) nil))
(t (append (quicksort (car partition)) (quicksort (cdr partition)))))))))
My idea was to have a local variable partition that is a list of 2 lists, where car partition is the list of number less than the pivot, and cdr partition is the list of numbers greater than the pivot. Then, in the final cond construct, if there were no numbers less than the pivot I would recursively sort the 2nd list; if there were no numbers greater than the pivot I would sort the 1st list; else I would recursively sort both and append them in order. Can anyone help me out?
Compiling the file gives you hints about wrong syntax.
GNU CLISP produces these diagnostics:
$ clisp -q -c foo.lisp
;; Compiling file /tmp/foo.lisp ...
WARNING: in QUICKSORT in lines 20..28 : Illegal syntax in LET/LET*: (PIVOT (CAR XS) XS)
Ignore the error and proceed
;; Deleted file /tmp/foo.fas
There were errors in the following functions:
QUICKSORT
1 error, 1 warning
SBCL produces similar diagnostics:
$ sbcl --eval '(compile-file "foo.lisp")' --quit
This is SBCL 1.3.1.debian, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.
SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses. See the CREDITS and COPYING files in the
distribution for more information.
; compiling file "/tmp/foo.lisp" (written 08 MAY 2019 08:58:54 PM):
; compiling (DEFUN PIVOT ...)
; compiling (DEFUN GETLESSER ...)
; compiling (DEFUN GETGREATER ...)
; compiling (DEFUN QUICKSORT ...)
; file: /tmp/foo.lisp
; in: DEFUN QUICKSORT
; (LET (PARTITION (PIVOT (CAR XS) XS))
; (COND ((NULL (CAR PARTITION)) (CONS (QUICKSORT #) NIL))
; ((NULL (CDR PARTITION)) (CONS (QUICKSORT #) NIL))
; (T (APPEND (QUICKSORT #) (QUICKSORT #)))))
;
; caught ERROR:
; The LET binding spec (PIVOT (CAR XS) XS) is malformed.
;
; compilation unit finished
; caught 1 ERROR condition
; /tmp/foo.fasl written
; compilation finished in 0:00:00.021
You can then look up the expected syntax in CLHS: http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/speope_letcm_letst.html
The syntax for LET is (LET BINDINGS . BODY), where BINDINGS is a list of bindings; each binding is a (SYMBOL VALUE) list. Alternatively, a binding can just be SYMBOL, which stands for (SYMBOL NIL). Your code is:
(let (partition (pivot (car xs) xs))
...)
Let's write one binding per line and normalize all bindings as a proper list:
(let ((partition nil)
(pivot (car xs) xs)))
...)
You can see that the code:
binds partition to NIL
has a malformed second binding: there are three elements, namely pivot, (car xs) and xs, which does not match the expected (SYMBOL VALUE) syntax.
I'm new to Lisp so when I wrote the function in SBCL
(defun subst (new old l)
(cond
((null l) '())
((eq old (car l)) (cons new (cdr l)))
((cons (car l) (subst new old (cdr l))))))
it gives error SYMBOL-PACKAGE-LOCKED-ERROR,a Style-Warning and a Warning, please help to resolve it
You're trying to redefine cl:subst. According to §11.1.2.1.2 of the HyperSpec, it's undefined what happens when you try to do that. Most implementations have some sort of package lock which prevents such redefinitions. You can get around those, by unlocking the package, but it would be better in this case to either use a name other than subst (e.g., my-subst), or to define a new package, say my-cl, that shadows cl:subst and define my-cl:subst instead.
The error that SBCL gives is actually rather informative and provides a reference to the HyperSpec page that I linked to above, as well as the Chapter 11. Package Locks from the SBCL manual:
* (defun subst (new old l)
(cond
((null l) '())
((eq old (car l)) (cons new (cdr l)))
((cons (car l) (subst new old (cdr l))))))
; in: DEFUN SUBST
; (SB-INT:NAMED-LAMBDA SUBST
; (NEW OLD L)
; (BLOCK SUBST (COND ((NULL L) 'NIL) ((EQ OLD #) (CONS NEW #)) ((CONS # #)))))
; ==>
; #'(SB-INT:NAMED-LAMBDA SUBST
; (NEW OLD L)
; (BLOCK SUBST
; (COND ((NULL L) 'NIL) ((EQ OLD #) (CONS NEW #)) ((CONS # #)))))
;
; caught STYLE-WARNING:
; The definition has no &KEY arguments, but the proclamation did.
; (SUBST NEW OLD (CDR L))
;
; caught WARNING:
; recursion in known function definition
; policy=((COMPILATION-SPEED . 1) (DEBUG . 1) (INHIBIT-WARNINGS . 1)
; (SAFETY . 1) (SPACE . 1) (SPEED . 1))
; arg types=(T T T)
;
; compilation unit finished
; caught 1 WARNING condition
; caught 1 STYLE-WARNING condition
STYLE-WARNING: redefining COMMON-LISP:SUBST in DEFUN
debugger invoked on a SYMBOL-PACKAGE-LOCKED-ERROR in thread #<THREAD
"initial thread" RUNNING
{1002978E71}>:
Lock on package COMMON-LISP violated when setting fdefinition of SUBST while
in package COMMON-LISP-USER.
See also:
The SBCL Manual, Node "Package Locks"
The ANSI Standard, Section 11.1.2.1.2