I came across some strange behaviour when trying to customize the print-object function of a CLOS object. The function does generate the intended string, but it appears outside the object definition (i.e. <OBJECT-NAME > followed by the string I wanted after the > character). The skeleton code below reproduces the issue:
(defclass object () ;;; Define some object...
((element-count
:initarg :element-count
:accessor n)
(first-element
:initform nil
:accessor 1st)
(last-element
:initform nil
:accessor end)))
(defmethod print-object ((obj object) stream) ;;; ...and then its print-object method
(print-unreadable-object (obj stream :type t))
(with-accessors ((first 1st)
(last end)
(n n))
obj
(format stream " ~[empty~:;:elements ~:*~d :content ~:*(~[~;~a~;~a ~a~:;~a ... ~a~])~]"
n first last)))
The output strings appear thus:
(defvar o1 (make-instance 'object :element-count 0)) => #<OBJECT > empty
(defvar o2 (make-instance 'object :element-count 1)) => #<OBJECT > :elements 1 :content (NIL)
(defvar o3 (make-instance 'object :element-count 2)) => #<OBJECT > :elements 2 :content (NIL NIL)
(defvar o4 (make-instance 'object :element-count 10)) => #<OBJECT > :elements 10 :content (NIL ... NIL)
I don't understand this output. Per the docs, printing outside the space shouldn't ever happen. Or should it? Well, over to you! By the way, I'm using SBCL on Portacle in Windows.
You misplaced parens - print-unreadable-object creates an environment which should encompass the whole print-object body:
(defclass airplane () ((tail-number :initarg tail :accessor plane-tail)))
(defmethod print-object ((plane airplane) stream)
(print-unreadable-object (plane stream :type t)
(princ (plane-tail plane) stream)))
(make-instance 'airplane 'tail 1234)
==> #<AIRPLANE 1234>
Related
I'm new to lisp (i'm experimenting with sbcl and ccl), i came across the use of car and cdr that can be chained arbitrarily within a single function call like (caddr).
I was wandering how one would write functions that behave like this...
Say for example i'd like my-eval to eval the input s-exp 3 times if i invoke it like (my-evaaal '(+ 2 1))
I've hacked my way around with a macro like
(my-ev $$$$ '(...)) where the behavior is dictated by the number of '$' in the first argument by transforming it into char sequence (coerce (symbol-name x) 'list) and the evaluate and recurse until the list is nil...
basic need:
;; if
(defvar *foo* 1)
(eval '*foo*) ;; => 1
(eval ''*foo*) ;; => *foo*
(eval '''*foo*) ;; => '*foo*
;; then
(eval (eval (eval '''*foo*))) ;; => 1
desired syntax
(my-eval '''*foo*) ;; => '*foo*
(my-evaal '''*foo*) ;; => *foo*
(my-evaaal '''foo) ;; => 1
Functions like CAAR, CADR are just regular functions; you can define a macro to help you define them easily if you want to.
Macros
(defpackage :so (:use :cl :ppcre))
(in-package :so)
(defmacro eval%% (count form)
(case count
(0 form)
(1 `(eval ,form))
(t (check-type count (integer 2))
`(eval%% ,(1- count) (eval ,form)))))
For example, the following :
(eval%% 3 '''most-positive-fixnum)
expands successively as:
(EVAL%% 2 (EVAL '''MOST-POSITIVE-FIXNUM))
(EVAL%% 1 (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
(EVAL (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
Then, you can define custom eval functions as follows, or even with another macro:
(defun evaal (x) (eval%% 2 x))
(defun evaaal (x) (eval%% 3 x))
Handler and restarts
Alternatively, note that you can catch calls to undefined functions:
(block nil
(handler-bind ((undefined-function
(lambda (e)
(return
(values (cell-error-name e)
(compute-restarts e))))))
(evaaaaaal 'a)))
=> EVAAAAAAL
(#<RESTART CONTINUE {7FD5F5F8CE43}> #<RESTART USE-VALUE {7FD5F5F8CE03}>
#<RESTART SB-KERNEL::RETURN-VALUE {7FD5F5F8CDC3}>
#<RESTART SB-KERNEL::RETURN-NOTHING {7FD5F5F8CD83}>
#<RESTART SWANK::RETRY {7FD5F5F8DA13}> #<RESTART ABORT {7FD5F5F8DEC3}>
#<RESTART ABORT {7FD5F5F8EB03}>)
You can also use the standard USE-VALUE restart to provide a different function to call:
(defun multi-eval-handler (condition)
(let ((name (cell-error-name condition)))
(when (eq (symbol-package name) (find-package :so))
(register-groups-bind ((#'length count)) ("EV\(A+\)L" (string name))
(invoke-restart 'use-value (make-repeated-evaluator count))))))
You need an auxiliary function that computes an evaluation N times:
(defun make-repeated-evaluator (count)
(case count
(0 #'identity)
(1 #'eval)
(t (check-type count (integer 2))
(lambda (form)
(loop
for value = form then (eval value)
repeat count
finally (return value))))))
For example:
(funcall (make-repeated-evaluator 3)
'''most-positive-fixnum)
=> 4611686018427387903
And then, you can have arbitrarily long eval functions:
(handler-bind ((undefined-function #'multi-eval-handler))
(evaaaaaaaaaaaaaal '''''''''''''0))
Now, if you compile the code, you'll have warnings at compile-time about the unknown function, when then you can muffle warnings.
I'd like to control the way the values are saved in slots and what is returned when I read a slot. Here is my class definition:
(defclass object ()
((name :accessor name-access
:initform 'noname
:initarg :name)
(value :accessor value-access
:initform 10
:initarg :value)))
I create the object this way:
(setf obj1 (make-instance 'object))
This is the way how I get the value of the slot name:
(name-access obj1)
And how I set a new value:
(setf (name-access obj1) 'realname)
What is the right way to override this accessor function (or method) in order to be able to make some changes to the object (on write) and to control the returned value?
Thank you.
You can just manually define the methods for getting and setting the slots:
(defclass foo ()
((name :initform 'noname
:initarg :name)))
(defgeneric name-access (foo)
(:method ((foo foo))
(format t "~&Getting name.~%")
(slot-value foo 'name)))
(defgeneric (setf name-access) (name foo)
(:method (name (foo foo))
(format t "~&Setting a new name.~%")
(setf (slot-value foo 'name) name)))
(defparameter *foo* (make-instance 'foo))
(name-access *foo*)
; Getting name.
;=> NONAME
(setf (name-access *foo*) 'some-name)
; Setting a new name.
;=> SOME-NAME
(name-access *foo*)
; Getting name.
;=> SOME-NAME
The book Practical Common Lisp goes through these in chapter 17. You should read that.
You can extend the accessor methods defined by DEFCLASS:
CL-USER 66 > (defclass object ()
((name :accessor name-access
:initform 'noname
:initarg :name)
(value :accessor value-access
:initform 10
:initarg :value)))
#<STANDARD-CLASS OBJECT 4220014953>
Writing, using a :before method:
CL-USER 67 > (defmethod (setf name-access) :before (new-value (o1 object))
(print "hi"))
#<STANDARD-METHOD (SETF NAME-ACCESS) (:BEFORE) (T OBJECT) 40202283BB>
Reading, with an :around method:
CL-USER 68 > (defmethod name-access :around ((o1 object))
(let ((name (call-next-method)))
(values name (length (symbol-name name)))))
#<STANDARD-METHOD NAME-ACCESS (:AROUND) (OBJECT) 4020061213>
Example:
CL-USER 69 > (let ((o1 (make-instance 'object)))
(setf (name-access o1) 'foobar)
(name-access o1))
"hi" ; side effect
FOOBAR ; return value 1
6 ; return value 2
I have this function scalar which is a wrapper of the 2 function definitions commented above it.
My ? is how do I mem-aref the output of (scalar 1 2 3 4), which is #<CV-SCALAR {10044559D3}>
I think #<CV-SCALAR {10044559D3}> is called a Meta-Object
;; Scalar* cv_create_Scalar(double val0, (double val1, double val2, double val3)
(defcfun ("cv_create_Scalar" %scalar) scalar
(val0 :double)
(val1 :double)
(val2 :double)
(val3 :double))
(define-foreign-type scalar ()
((garbage-collect :reader garbage-collect :initform nil :initarg
:garbage-collect))
(:actual-type :pointer)
(:simple-parser scalar))
(defclass cv-scalar ()
((c-pointer :reader c-pointer :initarg :c-pointer)))
(defmethod translate-to-foreign ((lisp-value cv-scalar) (c-type scalar))
(c-pointer lisp-value))
(defmethod translate-from-foreign (c-pointer (c-type scalar))
(let ((scalar (make-instance 'cv-scalar :c-pointer c-pointer)))
(when (garbage-collect c-type)
(tg:finalize scalar (lambda () (del-scalar c-pointer))))
scalar))
If you defclass and defmethods are defined as above you run (mem-aref (c-pointer a) :int 1) to mem-aref the return-value
I need to make a function make-numbers which make an instance of class numbers:
(defclass numbers ()
((x :initform 0)
(y :initform 0)))
Imput should be li this:(make-numbers 2 8)
I started: (defun make-numbers (new-x new-y) (...., but I don't know how continue. I Have tried it all the day, no result. Finally, I need to count this two numbers.
Do you have any idea? Thanks.
I would suggest you add :initarg keywords for your slots:
(defclass numbers ()
((x :initform 0 :initarg :x)
(y :initform 0 :initarg :y)))
Then invoke make-instance from your function:
(defun make-numbers (new-x new-y)
(make-instance 'numbers :x new-x :y new-y))
That way, you won't have to use setf on slot-value to initialize the slots of your instance.
My first LTK-application. Trying to execute function with argument from entry-field.
(defpackage :test
(:use :cl
:ltk))
(in-package :test)
(defun main()
(with-ltk ()
(let* ((f (make-instance 'frame
:height 200
:width 300))
(e (make-instance 'entry
:master f
))
(b (make-instance 'button
:master f
:text "Go"
:command (test (text e)))))
(wm-title *tk* "Test")
(pack f)
(pack e :side :left)
(pack b :side :left)
(configure f :borderwidth 3)
(configure f :relief :sunken))))
(defun test (str)
(format t "String: ~a" str))
Why function execute just once, when source is launched? And then - any actions.
If you want to pass a callback, use (lambda () ...), i.e. in your code:
...
(b (make-instance 'button
:master f
:text "Go"
:command (lambda () (test (text e))))))
Otherwise, your (test (text e)) is executed at the time of make-instance call, before the object is initialized.
It's easier to spot this problems, if you turn on debug output: (setf ltk:*debug-tk* t)