How to make function using class (Common Lisp) - common-lisp

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.

Related

print-method function behaves weirdly

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>

Common Lisp: Passing an object to a method

I have a problem with the behaviour of objects (class instances).
A code sample:
(defclass game-cards ()
((card-symbol :initarg :card-symbol :accessor card-symbol)
(colour :initarg :colour :accessor colour)))
(defvar *king-hearts* (make-instance 'game-cards
:card-symbol 'King
:colour 'hearts))
(defvar *ace-spades* (make-instance 'game-cards
:card-symbol 'Ace
:colour 'spades))
(defclass game-states ()
((my-cards :initarg :my-cards :accessor my-cards)
(other-cards :initarg :other-cards :accessor other-cards)))
(defparameter *state-1*
(make-instance 'game-states
:my-cards '(*king-hearts* *ace-spades*)
:other-cards ()))
(defmethod play-game ((state game-states))
(some-job (first (my-cards state))))
(defmethod some-job ((card game-cards))
(colour card))
When some-job is used with a game-cards object in the parameter list, it works like I expected.
CL-USER> (some-job *king-hearts*)
HEARTS
CL-USER>
Also this works:
CL-USER> (first (my-cards *state-1*))
*KING-HEARTS*
CL-USER>
When I try this:
(some-job (first (my-cards *state-1*)))
I get the following error message:
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::SOME-JOB (1)>
when called with arguments
(*KING-HEARTS*).
[Condition of type SIMPLE-ERROR]
When I define some-job as a function:
(defun some-job-1 (card)
(colour card))
the same behaviour occurs.
The error message is now:
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::COLOUR (1)>
when called with arguments
(*KING-HEARTS*).
[Condition of type SIMPLE-ERROR]
It seems that *king-hearts* is now not distinguished as an instance of game-cards by some-job and colour.
What is the reason? Tank you for your answers.
Quoted data is not evaluated. That's a basic Lisp evaluation rule:
CL-USER 1 > pi
3.141592653589793D0
CL-USER 2 > 'pi
PI
CL-USER 3 > '(pi pi)
(PI PI)
CL-USER 4 > (list pi pi)
(3.141592653589793D0 3.141592653589793D0)
CL-USER 5 > (list 'pi 'pi)
(PI PI)
Here PI is a symbol and not a number:
CL-USER 6 > (type-of 'pi)
SYMBOL
CL-USER 7 > (type-of pi)
DOUBLE-FLOAT
Thus we can define a method for a number:
CL-USER 8 > (defmethod square ((n number)) (* n n))
#<STANDARD-METHOD SQUARE NIL (NUMBER) 402005F60B>
CL-USER 9 > (square pi)
9.869604401089358D0
But the call for a symbol does not work, since there is only a method for a number:
CL-USER 10 > (square 'pi)
Error: No applicable methods for #<STANDARD-GENERIC-FUNCTION SQUARE 4060010C1C> with args (PI)
1 (continue) Call #<STANDARD-GENERIC-FUNCTION SQUARE 4060010C1C> again
2 (abort) Return to top loop level 0.
Type :b for backtrace or :c <option number> to proceed.
Type :bug-form "<subject>" for a bug report template or :? for other options.
We can define a method for a symbol in the debugger:
CL-USER 11 : 1 > (defmethod square ((n symbol))
(let ((n (symbol-value n)))
(* n n)))
#<STANDARD-METHOD SQUARE NIL (SYMBOL) 4020285ED3>
And then we re-invoke the call:
CL-USER 12 : 1 > :c 1
9.869604401089358D0
How to solve your problem:
Either create a list of CLOS objects using LIST
or retrieve the CLOS objects from the global variable using SYMBOL-VALUE.
The latter usually makes less sense.

Common Lisp: how to override slot accessors?

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

LispWorks program will not build as application

This is my second proper attempt at a Lisp program, as a dice-roller for Mythender (a freely distributed tabletop RPG). It has a couple of problems though:
When it's loaded I get a prompt to confirm creation of the package. Surely this file should be creating it?
When I try to build it standalone with the LispWorks application builder it gives an error saying that I am trying to invoke a CAPI function at compile-time, but I don't see where that is.
I've gotten negative comments from some lisp folks I spoke to about the (the null ()) sections which are meant to indicate a function has no return so no point leaving anything on the stack - is this proper or not? Is there a better way to do it?
Any general suggestions would also be welcome.
(defpackage :mythender (:add-use-defaults t) (:use "CAPI"))
(in-package :mythender)
(defun d6 () (the fixnum (+ 1 (random 6))))
(defun d6s (count)
(declare (type fixnum count))
(the list (loop for x from 1 to count collecting (d6))))
(defun d6over (count threshold)
(declare (type fixnum count threshold))
(the fixnum (count-if
(lambda (x) (> threshold x))
(d6s count))))
(defvar *storm* 3)
(defvar *thunder* 3)
(defvar *lightning* 0)
(declare (ftype (function) printstate))
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(the null ()))
(defun roll ()
(incf *lightning* (d6over *thunder* 3))
(incf *thunder* (d6over *storm* 3))
(the null ()))
(defun damage (threshold)
(setf *thunder* (d6over *thunder* threshold))
(the null ()))
(defun doroll (&rest args)
(roll)
(update-interface)
(the null ()))
(define-interface mythender-interface () ()
(:panes
(roll-button push-button :data "Roll" :callback #'doroll)
(damage-button push-button :data "Damage")
(storm-pane display-pane :title "Storm:" :title-position :left)
(thunder-pane display-pane :title "Thunder:" :title-position :Left)
(lightning-pane display-pane :title "Lightning:" :title-position :left))
(:layouts
(main-layout column-layout '(storm-pane thunder-pane lightning-pane buttonlayout))
(buttonlayout row-layout '(roll-button damage-button))))
(defvar *interface*)
(defun update-interface-slot (slotname value)
(declare (type string slotname) (type fixnum value))
(setf (display-pane-text (slot-value *interface* slotname)) (write-to-string value))
(the null ()))
(defun update-interface ()
(update-interface-slot 'storm-pane *storm*)
(update-interface-slot 'thunder-pane *thunder*)
(update-interface-slot 'lightning-pane *lightning*)
(the null ()))
(defun start ()
(setf *interface* (make-instance 'mythender-interface))
(display *interface*)
(the null (update-interface)))
An answer to your build problem has to wait until you tell us the build statement and the error message.
Your last question:
(declare (ftype (function) printstate))
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(the null ()))
It's known that it is a function. No need to declare that. Declaring types like that, have in plain Common Lisp only the purpose of optimization hints to the compiler, which the compiler may ignore. Only CMUCL (and derived compilers like SBCL and SCL) actually does more with declared types.
Nobody writes such code in Lisp. Better omit the types. Remember: Lisp is not a statically typed language.
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(values))
Using (values) causes the function to not return a value. That's usually preferred, not returning NIL.
If you want to actually check types in a meaningful way at runtime, then make use of ASSERT, CHECK-TYPE and/or DEFMETHOD.
(defun d6s (count)
  (declare (type fixnum count))
  (the list (loop for x from 1 to count collecting (d6))))
Is just:
(defmethod d6s ((n integer))
"Returns a list of n dice rolls."
(loop repeat n collect (d6)))
Don't forget to describe the semantics of your function in human readable form.

How do I mem-aref the output of a meta-object in CFFI

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

Resources