I am reading the book Practical Common Lisp. I typed the simple CD database shown in Chapter 3. See below. When I run the (add-cds) program the result is a prompt containing two prompts on top of each other (more precisely, one prompt after another, on the same line):
(add-cds)
=> Title: Artist:
Why is it doing this? The program should give me the Title: prompt first and the Artist: prompt only after I've typed in a value for Title: followed by newline. I am pretty sure that I typed in the program faithfully. How do I fix this?
(defvar *db* nil)
(defun make-cd (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defun add-record (cd) (push cd *db*))
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun prompt-for-cd ()
(make-cd
(prompt-read "Title")
(prompt-read "Artist")
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
(y-or-n-p "Ripped [y/n]")))
(defun add-cds ()
(loop (add-record (prompt-for-cd))
(if (not (y-or-n-p "Another? [y/n]: ")) (return))))
What's happening is that the newline after (add-cds) is being left in the input stream (because the REPL stops reading as soon as it sees the matching close parenthesis), so the first read-line is reading that as a blank line and returning immediately. Call clear-input before calling read-line to ignore this and wait for new input.
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(clear-input *query-io*)
(read-line *query-io*))
Related
I am working through the MP3 database example in Peter Seibel's Practical Common Lisp. Seibel demonstrates how macros can be used to shorten the code for the where function; so now, I am trying to use a macro to shorten the code for the update function. (The original version of the update function is included for reference.) When I run my code, the following error originates from the second-to-last line --
*** - CAR: TERMS is not a list
What am I doing wrong? Here is my code.
(defvar *db* nil)
(defun add-record (cd)
(push cd *db*))
(defun dump-db ()
(dolist (cd *db*)
(format t "~{~a:~10t~a~%~}~%" cd)))
(defun make-cd (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun prompt-for-cd ()
(make-cd
(prompt-read "Title")
(prompt-read "Artist")
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
(y-or-n-p "Ripped [y/n]: ")))
(defun add-cds ()
(loop (add-record (prompt-for-cd) )
(if (not (y-or-n-p "Another? [y/n]: ")) (return) )))
(defun save-db (filename)
(with-open-file (out filename
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(print *db* out))))
(defun load-db (filename)
(with-open-file (in filename)
(with-standard-io-syntax
(setf *db* (read in) ))))
(defun select (selector-fn)
(remove-if-not selector-fn *db*))
(defun make-comparison-expr (field value)
`(equal (getf cd ,field) ,value))
(defun make-comparison-list (func fields)
(loop while fields
collecting (funcall func (pop fields) (pop fields))))
(defmacro where (&rest clauses)
`#'(lambda (cd) (and ,#(make-comparison-list 'make-comparison-expr clauses))))
(defun make-update-expr (field value)
`(setf (getf row ,field) ,value))
(defmacro make-update-list (fields)
(make-comparison-list 'make-update-expr fields))
(defun update (selector-fn &rest terms)
(print (type-of terms))
(setf *db*
(mapcar
#'(lambda (row)
(when (funcall selector-fn row)
(make-update-list terms))
row)
*db*)))
;(defun update (selector-fn &key title artist rating (ripped nil ripped-p))
; (setf *db*
; (mapcar
; #'(lambda (row)
; (when (funcall selector-fn row)
; (if title (setf (getf row :title) title) )
; (if artist (setf (getf row :artist) artist) )
; (if rating (setf (getf row :rating) rating) )
; (if ripped-p (setf (getf row :ripped) ripped) ))
; row)
; *db*)))
(defun delete-rows (selector-fn)
(setf *db* (remove-if selector-fn *db*)))
;(loop (print (eval (read))))
(add-record (make-cd "Be" "Common" 9 nil))
(add-record (make-cd "Like Water for Chocolate" "Common" 9 nil))
(add-record (make-cd "Be" "Beatles" 9 nil))
(dump-db)
(update (where :artist "Common" :title "Be") :rating 8)
(dump-db)
-----Edit-----
I figured it out. The solution was to make update a macro and to make make-update-list a function. This way, make-update-list could evaluate fields at run-time and update can still abstract away some tedious if statements. Here is the updated update and make-update-list below:
(defun make-update-list (fields)
(make-comparison-list 'make-update-expr fields))
(defmacro update (selector-fn &rest terms)
`(setf *db*
(mapcar
#'(lambda (row)
(when (funcall ,selector-fn row)
,#(make-update-list terms))
row)
*db*)))
Macroexpansion of that make-update-list is done in a separate phase (called "macroexpansion phase") - which occurs around the time a piece of code is compiled or loaded; in this case we're talking about compilation / loading of update. The macro gets expanded with fields bound to the symbol terms, which (the symbol itself) is used as a value in make-comparison-list; I suppose that was not what you expected.
Note, if you go and compile the file line-by-line (C-c C-c in Emacs + SLIME), it'll tell you right during compilation of update that the macro expansion fails because "the value TERMS is not of type LIST".
Generally, think of macros as functions that take in their arguments unevaluated - i.e. a form (make-update-list foo) will get expanded with the macro parameter's fields value bound to foo. What you're trying to achieve here - code generation based on run-time values - is a bit more difficult to do.
You are trying to take the car of a symbol!
> (car 'terms)
*** - CAR: TERMS is not a list
Think of macros as a function that, when used, replaces the code with the result of the macro function everywhere it's used. At this time variables are just symbols and have no meaning besides that.
When you do (make-update-list terms) it will call the macro function with the argument fields being the symbol you passed, which is terms. Since it's a symbol it cannot be iterated like you are trying. You may iterate it at runtime when it surely is a list, but as a macro it isn't a list until you are passing it a list like (make-update-list (title artist rating ripped)).
If it is dynamic in runtime then your macro needs to expand to code that does most of its magic at runtime. Thus a macro is just a source rewriting service and should not have anything to do with what variable might be at runtime since then it has already done its thing.
Hi I am doing a condition which I just want to call a method if the condition is true, the problem is I cannot find the syntax how to create a method in C-Lisp I am new with this language here's the code.
/* I want to create a method here which i can all anytime in my condition but I am having problem with a syntax
(void method()
(print "Invalid")
)
*/
(print "Enter number")
(setq number(read())
(cond((< 1 number) (print "Okay"))
((> 1 number) /*I want to call a method here (the invalid one)*/ )
)
To create a function in common lisp you can use the defun operator:
(defun signal-error (msg)
(error msg))
Now you can call it like so:
(signal-error "This message will be signalled as the error message")
Then you can insert it in your code like this:
(print "Enter number")
(setq number (read)) ;; <- note that you made a syntax error here.
(cond ((< 1 number) (print "Okay"))
((> 1 number) (signal-error "Number is smaller than 1."))))
In your question you are asking about a method. Methods operate on classes. For example imagine you have two classes human and dog:
(defclass human () ())
(defclass dog () ())
To create a method specific for each class you use defmethod:
(defmethod greet ((thing human))
(print "Hi human!"))
(defmethod greet ((thing dog))
(print "Wolf-wolf dog!"))
Let's create two instances for each class:
(defparameter Anna (make-instance 'human))
(defparameter Rex (make-instance 'dog))
Now we can greet each living being with the same method:
(greet Anna) ;; => "Hi human"
(greet Rex) ;; => "Wolf-wolf dog!"
The process of common lisp knowing which method to execute is called "Dynamic dispatch". Basically it matches the given argument's classes to the defmethod definitions.
But I have no idea why you need methods in your code example.
Here is how I would write the code if I was you:
;; Let's wrap the code in a function so we can call it
;; as much as we want
(defun get-number-from-user ()
(print "Enter number: ")
;; wrapping the number in a lexical scope is a good
;; programming style. The number variable is not
;; needed outside the function.
(let ((number (read)))
;; Here we check if the number satisfies our condition and
;; call this function again if not.
(cond ((< number 1) (print "Number is less than 1")
(get-number-from-user))
((> number 1) (print "Ok.")))))
I would suggest you read "The Land of Lisp". It is great book for beginners.
Having simple function in Clojure
(defn command []
(loop []
(let [input (read-line)
string-tokens (string/split input #" ")
tokens (map keyword string-tokens)
cmd (first tokens)]
(cond
;; explain the commands
(= cmd :help)(do
(printf "Usage:\nsearch <term>\nquit\n")
(recur)
)
;; break the loop
(= cmd :quit) (printf "bye bye")
;; do something
(= cmd :search) (do
(printf "Searching for %s...\n" (rest string-tokens))
(recur))
;; handle unknown input
:else (do
(println "Huh?")
(recur))
)
))
)
when I use println to send string to output it works fine, but when I'm use 'printf` it looks like string is held in buffer and printed when I exit program by chosing :quit option.
I think this has something to do with do block and recursion, but without it I can't use recur as I receive "can only recur from tail position" error.
EDIT: It's not that my program is not working. I found the way to obey the problem by first use format and then println (eg. (println (format "Searching for %s...\n" (rest string-tokens)))), but such a behaviour is weird for me.
because println calls flush function, while printf doesnt. So if you add (flush) after every printf call, it will work.
(printf "Usage:\nsearch <term>\nquit\n")
(flush)
(recur)
i would propose you to rewrite the whole function the following way:
(defn command []
(loop []
(let [input (read-line)
string-tokens (clojure.string/split input #" ")
cmd (keyword (first string-tokens))
reply (case cmd
:help "Usage:\nsearch <term>\nquit"
:quit "bye bye"
:search (format "Searching for %s..." (rest string-tokens))
"Huh?")]
(println reply)
(when-not (= :quit cmd)
(recur)))))
so you can separate reply selection logic from function's output and recursion/termination logic. as a bonus you avoid repetition, and improve readability (well, imo)
I have a file (furniture.lisp) that looks basically like this (with many more entries):
(addgv :furniture 'stove
(make-instance 'stove
:pose (tf:make-pose-stamped
"map" ; frame-id
0.0
(tf:make-3d-vector -3.1 -0.9 0) ; translation/origin
(tf:euler->quaternion :az 0))))
(addgv :furniture 'drawers-cupboard
(make-instance 'cupboard
:pose (tf:make-pose-stamped
"map"
0.0
(tf:make-3d-vector -3.1 0.1 0)
(tf:euler->quaternion :az 0))))
Now, I'd like to have a function (get-locations "furniture.lisp" "locations.txt") that extracts the objects coordinates in the 3d-vector and writes its output to a file:
(location stove -3.1 -0.9 9)
(location drawers-cupboard -3.1 0.1 0)
...
I started by writing an expression that reads in the file (so far without parametrization) line by line:
(ql:quickload "split-sequence")
(with-open-file (stream "furniture.lisp")
(do ((line (read-line stream nil)
(read-line stream nil)))
((null line))
(princ (split-sequence::split-sequence #\Space line)) ; Just for demonstration
))
But I realized that I have no chance/idea to "connect" the name of the object (e.g. stove) and its coordinates. I'd need the second symbol after "(addgv " for the name and variable "distance of words" for the coordinates. So I tried to read the file into one big list:
(defun make-list-from-text (fn)
(with-open-file (stream fn)
(loop for line = (read-line stream nil nil)
while line
collect
(split-sequence::split-sequence #\Space line))))
Whereby every line is a sublist (I don't know if this substructure is a advantage, perhaps I should 'flatten' the result). Now I'm stuck. Furthermore, I have the feeling, that my approach is somehow inelegant.
EDIT:
I followed Svante's approach and finally got the desired output! Besides creating a dummy package, I also had to create dummy exports for the package (e.g. :export :make-3d-vector). Additionally,:key #'car did not work, as my list was a 'mixed' list, consisting of sublists (e.g. (make-instance ...)) and symbols (e.g. addgv). So I created a helper function:
(defun find-helper (list-or-symbol)
(if (listp list-or-symbol)
(car list-or-symbol)
list-or-symbol))
And replaced #'car by #'find-helper.
My idea would be to create a dummy tf package, then read the forms and parse whatever you need from them. Something like this (untested):
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package #:tf)
(defpackage #:tf)))
(defun extract-location-file ()
(let ((*read-eval* nil))
(with-open-file (in "furniture.lisp")
(with-open-file (out "locations.txt"
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(loop :for form := (read in nil)
:while form
:do (print (extract-location form) out)
(terpri)))))
(defun extract-location (form)
`(location ,(third form)
,#(rest (find 'tf::make-3d-vector
(find 'tf::make-pose-stamped
(find 'make-instance
form
:key #'car)
:key #'car)
:key #'car))))
Be sure not to omit to bind *read-eval* to nil.
The general way would be:
read the whole file as string (see here)
(cl-ppcre:regex-replace-all "tf::?" content ""), i.e. replace all references to package tf to avoid package-related errors
put '() around the contents
read it and assign to a variable
now you have structured data that you can process using various list-manipulating functions
Unfortunately this would be a non-portable solution:
handle the reader error
do what is necessary to fix the problem
continue
For example in LispWorks I could do something like this (just a sketch):
CL-USER 60 > (defun test ()
(handler-bind ((conditions:package-not-found-reader
(lambda (c)
(continue c)))
(conditions:simple-reader-error
(lambda (c)
(continue c))))
(read-from-string "'(foo27:bar19 bar18:foo44)")))
TEST
CL-USER 61 > (test)
(QUOTE (FOO27::BAR19 BAR18::FOO44))
It calls the continue restarts for the missing package error and then for the error that the symbol is not exported. The restarts create the package and the other one is returning a non-exported symbol...
I have not found a solution to use the Clojure REPL with Qt on the web.
Basically the problem is that the REPL hangs as soon as you call QApplication/exec in order to get the UI to display. You cannot C-c C-c back into the REPL, and closing the active Qt window seems to kill the whole Clojure process.
Now simply calling QApplication/processEvents from within an agent is not possible, unless the agent runs in exactly the same thread in which you created your Qt widgets. It took me two days to figure this out and I have seen others have the same issue/problem but without a solution.
So here is mine, in code:
(add-classpath "file:///usr/share/java/qtjambi.jar")
(ns qt4-demo
(:import (com.trolltech.qt.gui QApplication QPushButton QFont QFont$Weight)
(com.trolltech.qt.core QCoreApplication)
(java.util Timer TimerTask)
(java.util.concurrent ScheduledThreadPoolExecutor TimeUnit))
(:require swank.core))
(defn init []
(QApplication/initialize (make-array String 0)))
(def *gui-thread* (new java.util.concurrent.ScheduledThreadPoolExecutor 1))
(def *gui-update-task* nil)
(def *app* (ref nil))
(defn update-gui []
(println "Updating GUI")
(QApplication/processEvents))
(defn exec []
(.remove *gui-thread* update-gui)
(def *gui-update-task* (.scheduleAtFixedRate *gui-thread* update-gui 0 150 (. TimeUnit MILLISECONDS))))
(defn stop []
(.remove *gui-thread* update-gui)
(.cancel *gui-update-task*))
(defmacro qt4 [& rest]
`(do
(try (init) (catch RuntimeException e# (println e#)))
~#rest
))
(defmacro with-gui-thread [& body]
`(.get (.schedule *gui-thread* (fn [] (do ~#body)) (long 0) (. TimeUnit MILLISECONDS))))
(defn hello-world []
(with-gui-thread
(qt4
(let [app (QCoreApplication/instance)
button (new QPushButton "Go Clojure Go")]
(dosync (ref-set *app* app))
(doto button
(.resize 250 100)
(.setFont (new QFont "Deja Vu Sans" 18 (.. QFont$Weight Bold value)))
(.setWindowTitle "Go Clojure Go")
(.show)))))
(exec))
Basically it uses the ScheduledThreadPoolExecutor class in order to execute all Qt-code. You can use the with-gui-thread macro to make it easier to call functions from within the thread.
This makes it possible to change the Qt UI on-the-fly, without recompiling.
If you want to mess with Qt widgets from the REPL, QApplication/invokeLater or QApplication/invokeAndWait are probably what you want. You can use them in conjunction with agents. Given this:
(ns qt4-demo
(:import (com.trolltech.qt.gui QApplication QPushButton)
(com.trolltech.qt.core QCoreApplication)))
(def *app* (ref nil))
(def *button* (ref nil))
(def *runner* (agent nil))
(defn init [] (QApplication/initialize (make-array String 0)))
(defn exec [] (QApplication/exec))
(defn hello-world [a]
(init)
(let [app (QCoreApplication/instance)
button (doto (QPushButton. "Go Clojure Go") (.show))]
(dosync (ref-set *app* app)
(ref-set *button* button)))
(exec))
Then from a REPL:
qt4-demo=> (send-off *runner* hello-world)
#<Agent#38fff7: nil>
;; This fails because we are not in the Qt main thread
qt4-demo=> (.setText #*button* "foo")
QObject used from outside its own thread, object=QPushButton(0x8d0f55f0) , objectThread=Thread[pool-2-thread-1,5,main], currentThread=Thread[main,5,main] (NO_SOURCE_FILE:0)
;; This should work though
qt4-demo=> (QApplication/invokeLater #(.setText #*button* "foo"))
nil
qt4-demo=> (QApplication/invokeAndWait #(.setText #*button* "bar"))
nil
I've written about how to do this with SLIME on my blog (German) as well as on the Clojure mailing-list. The trick is to define appropriate functions on the Emacs side and tell SLIME to use those when making requests. Importantly, this frees you from having to do special incantations when invoking Qt code.
Quoting myself:
Given that we're talking Lisp here,
anyway, the solution seemed to be
obvious: Hack SLIME! So that's what I
did. The code below, when dropped
into your .emacs (at a point at which
SLIME is already fully loaded),
registers three new Emacs-Lisp
functions for interactive use. You
can bind them to whatever keys you
like, or you may even just set the
slime-send-through-qapplication
variable to t after your application
has started and not worry about key
bindings at all. Either should make
your REPL submissions and C-M-x-style
interactive evaluations indirect
through QCoreApplication/invokeAndWait.
Have fun!
(defvar slime-send-through-qapplication nil)
(defvar slime-repl-send-string-fn (symbol-function 'slime-repl-send-
string))
(defvar slime-interactive-eval-fn (symbol-function 'slime-interactive-
eval))
(defun qt-appify-form (form)
(concatenate 'string ;'
"(let [return-ref (ref nil)] "
" (com.trolltech.qt.core.QCoreApplication/invokeAndWait "
" (fn [] "
" (let [return-value (do "
form
" )] "
" (dosync (ref-set return-ref return-value))))) "
" (deref return-ref))"))
(defun slime-interactive-eval (string)
(let ((string (if slime-send-through-qapplication
(qt-appify-form string)
string)))
(funcall slime-interactive-eval-fn string)))
(defun slime-repl-send-string (string &optional command-string)
(let ((string (if slime-send-through-qapplication
(qt-appify-form string)
string)))
(funcall slime-repl-send-string-fn string command-string)))
(defun slime-eval-defun-for-qt ()
(interactive)
(let ((slime-send-through-qapplication t))
(slime-eval-defun)))
(defun slime-repl-closing-return-for-qt ()
(interactive)
(let ((slime-send-through-qapplication t))
(slime-repl-closing-return)))
(defun slime-repl-return-for-qt (&optional end-of-input)
(interactive)
(let ((slime-send-through-qapplication t))
(slime-repl-return end-of-input)))