From: Karol Skocik
Subject: how to distinguish struct and classes having their names?
Date: 
Message-ID: <1127698060.801937.28620@g43g2000cwa.googlegroups.com>
Hi guys,
  I want to make a macro, which constructs instances of structures or
objects, depending on that if the input is struct of class. To be more
tangible, if I have structs and objects like this :

(defstruct s-1)
(defstruct s-2)
...

(defclass a () ())
(defclass b () ())
...

I want to have a macro "mac" which called like this :

(mac s-1 a s-2 b b s-2 ...)

will produce a list, where elements of the list are instances of
structs or classes, depending on input.

so the result will look like this :

(#S(S-1) #<A {...}> #S(S-2) ...)

-- the problem I have found is, that I dont know how to find out, that
the argument I get is name of struct or class to build the instance
with (make-arg) or (make-instance 'arg).

Thanks for some ideas!

Cheers,
  Karol

From: Wade Humeniuk
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <hhJZe.269845$HI.238066@edtnps84>
Karol Skocik wrote:
> Hi guys,
>   I want to make a macro, which constructs instances of structures or
> objects, depending on that if the input is struct of class. To be more
> tangible, if I have structs and objects like this :
> 
> (defstruct s-1)
> (defstruct s-2)
> ...
> 
> (defclass a () ())
> (defclass b () ())
> ...
> 
> I want to have a macro "mac" which called like this :
> 
> (mac s-1 a s-2 b b s-2 ...)
> 
> will produce a list, where elements of the list are instances of
> structs or classes, depending on input.
> 
> so the result will look like this :
> 
> (#S(S-1) #<A {...}> #S(S-2) ...)
> 
> -- the problem I have found is, that I dont know how to find out, that
> the argument I get is name of struct or class to build the instance
> with (make-arg) or (make-instance 'arg).
> 

In LW you can do this,

CL-USER 10 > (defstruct s-1)
S-1

CL-USER 11 > (find-class 's-1)
#<STRUCTURE-CLASS S-1 21418004>

CL-USER 12 > (typep * 'structure-class)
T

CL-USER 13 > (defclass a () ())
#<STANDARD-CLASS A 2069BE6C>

CL-USER 14 > (find-class 'a)
#<STANDARD-CLASS A 2069BE6C>

CL-USER 15 > (typep * 'standard-class)
T

CL-USER 16 >

Wade
From: Karol Skocik
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <1127702955.622528.308980@g49g2000cwa.googlegroups.com>
Thats it, perfect!
Thank you.

Karol
From: Pascal Bourguignon
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <87zmq0ld9i.fsf@thalassa.informatimago.com>
"Karol Skocik" <············@gmail.com> writes:

> Hi guys,
>   I want to make a macro, which constructs instances of structures or
> objects, depending on that if the input is struct of class. To be more
> tangible, if I have structs and objects like this :
>
> (defstruct s-1)
> (defstruct s-2)
> ...
>
> (defclass a () ())
> (defclass b () ())
> ...
>
> I want to have a macro "mac" which called like this :
>
> (mac s-1 a s-2 b b s-2 ...)
>
> will produce a list, where elements of the list are instances of
> structs or classes, depending on input.
>
> so the result will look like this :
>
> (#S(S-1) #<A {...}> #S(S-2) ...)
>
> -- the problem I have found is, that I dont know how to find out, that
> the argument I get is name of struct or class to build the instance
> with (make-arg) or (make-instance 'arg).

(subtypep (class-of (find-class 'c1)) (find-class 'standard-class))
T ;
T
[112]> (subtypep (class-of (find-class 's1)) (find-class 'standard-class))
NIL ;
T

The second result is implementation dependant, but if it returned T,
you could use make-instance for a structure type.

So:

[113]> (defun make-instances (types)
   (mapcar (lambda (type)
              (if (subtypep (class-of (find-class type))
                                      (find-class 'standard-class))
                   (make-instance type)
                   (let ((fun (intern (format nil "MAKE-~A" type))))
                     (if (fboundp fun)
                         (funcall fun)
                         (error "Not a class neither a structure ~A" type)))))
           types))
MAKE-INSTANCES
[114]> (make-instances '(s1 c1))
(#S(S1 :A NIL :B NIL) #<C1 #x206E0356>)
[115]> 

You don't really need a macro, do you?


That said, you can use defstruct with a :constructor option, so
perhaps you should use your own defstruct* macro and keep some meta
information around to be able to do it more safely.

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
Small brave carnivores
Kill pine cones and mosquitoes
Fear vacuum cleaner
From: Karol Skocik
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <1127706734.772391.173590@g44g2000cwa.googlegroups.com>
Thanks for code. I am playing with some AI stuff, and I have defined a
graph of relations, which can look like this :
GI> (defsc ((0 state-resource (1) (2) (3 -))
	(1 state-resource-cstr)
	(2 object)
	(3 - object)
	(4 var (0 resource-type))
	(5 all-different)))

which expands into this (it goes to function building graph) :

((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE))
  ((1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE)))
   (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE)))
   (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(SC-EDGE)))))
 (1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE-CSTR))
NIL)
 (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(OBJECT)) NIL)
 (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(OBJECT)) NIL)
 (4 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(VAR))
  ((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(RESOURCE-TYPE)))))
 (5 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(ALL-DIFFERENT)) NIL))

so, I think I need a macro, because I need to control evaluation of
arguments. I have a big macro like this :

(defmacro defsc ((&rest sc-nodes))
  `',(loop for sc-node in sc-nodes collect
	   (append (list (car sc-node))
		   (let* ((rest-of-form '())
			  (ac (case (second sc-node)
				('- +negative-ac+)
				('+ +positive-ac+)
				(t +neutral-ac+)))
			  (sc-attr (if (equal ac +neutral-ac+)
				       (second sc-node)
				       (third sc-node)))
			  (sc-edges (nthcdr (if (equal ac +neutral-ac+) 2 3) sc-node)))
		     (push (make-sc-element
			    :app-condition ac
			    :object (if (or (characterp sc-attr) (stringp sc-attr) (numberp
sc-attr))
					(make-sc-constant :value sc-attr)
					(funcall (constructor-function sc-attr))))
			   rest-of-form)
		     (if (null sc-edges)
			 (push nil rest-of-form)
			 (push (loop for sc-edge in sc-edges collect
				     (list (car sc-edge)
					   (let* ((edge-ac
						   (case (second sc-edge)
						     ('- +negative-ac+)
						     ('+ +positive-ac+)
						     (t +neutral-ac+)))
						  (sc-edge-attr (if (equal edge-ac +neutral-ac+)
								    (second sc-edge)
								    (third sc-edge))))
					     (make-sc-element
					      :app-condition edge-ac
					      :object (cond ((null sc-edge-attr) (make-sc-edge))
							    ((or (characterp sc-edge-attr)
								 (stringp sc-edge-attr)
								 (numberp sc-edge-attr))
							     (make-sc-constant :value sc-attr))
							    (t (funcall (constructor-function sc-edge-attr))))))))
			       rest-of-form))
		     (nreverse rest-of-form)))))

also with this before :

(defconstant +neutral-ac+ 0)
(defconstant +positive-ac+ 1)
(defconstant +negative-ac+ -1)

(defstruct sc-element
  app-condition
  object)

;; standard object on edge when no other is provided
(defstruct sc-edge)
;; char string number (not symbol!)
(defstruct sc-constant
  value)
(defstruct state-resource)
(defstruct state-resource-cstr)
(defstruct object)
(defstruct var)
(defstruct all-different)
(defstruct resource-type)

and finally with my version of the constructor creator :

(defun constructor-function (sym)
  (let ((class (find-class sym)))
    (cond ((typep class 'standard-class)
	   (lambda () (make-instance sym)))
	  ((typep class 'structure-class)
	   (let* ((struct-constructor-sym (find-symbol (concatenate 'string
"MAKE-" (symbol-name sym)))))
	     (lambda () (funcall struct-constructor-sym))))
	  (t (error "neither a structure nor a class : ~a" sym)))))

everything works, in REPL. I dont know what's the problem, I think the
macro is fine (it could be written much better, I know) - it just
produces quoted list.

But what drives me crazy for almost 2 days now, is that I can't compile
the file with this :

(defvar *sc* (defsc ((0 state-resource (1) (2) (3 -))
		     (1 state-resource-cstr)
		     (2 object)
		     (3 - object)
		     (4 var (0 resource-type))
		     (5 all-different))))

it just dies on this :
; Error: (while making load form for #S(SC-ELEMENT
;                                  :APP-CONDITION 0
;                                  :OBJECT #S(STATE-RESOURCE)))
;
; Error in function KERNEL:MAKE-STRUCTURE-LOAD-FORM: ..

WHY? I dont understand it, totally. I know that there are differences
between interpreter and compiler in CMUCL, but the macro returns just
quoted list... :-/

Karol
From: Wade Humeniuk
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <sqKZe.269918$HI.152532@edtnps84>
> 
> (defvar *sc* (defsc ((0 state-resource (1) (2) (3 -))
> 		     (1 state-resource-cstr)
> 		     (2 object)
> 		     (3 - object)
> 		     (4 var (0 resource-type))
> 		     (5 all-different))))
> 
> it just dies on this :
> ; Error: (while making load form for #S(SC-ELEMENT
> ;                                  :APP-CONDITION 0
> ;                                  :OBJECT #S(STATE-RESOURCE)))
> ;
> ; Error in function KERNEL:MAKE-STRUCTURE-LOAD-FORM: ..
> 

This code compiles just fine in LispWorks and it also compiles
the file with the above form in it.  Sounds like a bug in CMUCL.

Wade
From: Karol Skocik
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <1127711928.651175.238670@g47g2000cwa.googlegroups.com>
OK. Thats not a good news, but at least I have a answer.
Thanks,
  Karol
From: Pascal Bourguignon
Subject: Re: how to distinguish struct and classes having their names?
Date: 
Message-ID: <87psqwl5o0.fsf@thalassa.informatimago.com>
"Karol Skocik" <············@gmail.com> writes:
> OK. Thats not a good news, but at least I have a answer.

In clisp, it breaks with:

*** - FIND-CLASS: STATE-RESOURCE-CSTR does not name a class

Perhaps that's what cmucl wanted to say.

clisp gives these warnings when trying to compile your code:

[1]> (compile-file "/tmp/a.lisp")
;; Compiling file /tmp/a.lisp ...
WARNING in DEFSC in lines 32..72 :
Duplicate CASE label QUOTE : (CASE (SECOND SC-NODE) ('- +NEGATIVE-AC+) ('+ +POSITIVE-AC+) (T +NEUTRAL-AC+))
WARNING in DEFSC in lines 32..72 :
Duplicate CASE label QUOTE : (CASE (SECOND SC-EDGE) ('- +NEGATIVE-AC+) ('+ +POSITIVE-AC+) (T +NEUTRAL-AC+))
*** - EVAL: variable +NEUTRAL-AC+ has no value
The following restarts are available:
USE-VALUE      :R1      You may input a value to be used instead of +NEUTRAL-AC+.
STORE-VALUE    :R2      You may input a new value for +NEUTRAL-AC+.
ABORT          :R3      ABORT
Break 1 [2]> 

You have to use eval-when:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +neutral-ac+ 0)
  (defconstant +positive-ac+ 1)
  (defconstant +negative-ac+ -1)

  (defstruct sc-element
    app-condition
    object)

  ;; standard object on edge when no other is provided
  (defstruct sc-edge)
  ;; char string number (not symbol!)
  (defstruct sc-constant
    value)
  (defstruct state-resource)
  (defstruct state-resource-cstr)
  (defstruct object)
  (defstruct var)
  (defstruct all-different)
  (defstruct resource-type)


  (defun constructor-function (sym)
    (let ((class (find-class sym)))
      (cond ((typep class 'standard-class)
             (lambda () (make-instance sym)))
            ((typep class 'structure-class)
             (let* ((struct-constructor-sym (find-symbol (concatenate 'string
                                                           "MAKE-" (symbol-name sym)))))
               (lambda () (funcall struct-constructor-sym))))
            (t (error "neither a structure nor a class : ~a" sym)))))
  )

(defmacro defsc ((&rest sc-nodes))
  `',(loop for sc-node in sc-nodes collect
          (append (list (car sc-node))
                  (let* ((rest-of-form '())
                         (ac (case (second sc-node)
                               (- +negative-ac+)
                               (+ +positive-ac+)
                               (t +neutral-ac+)))
                         (sc-attr (if (equal ac +neutral-ac+)
                                      (second sc-node)
                                      (third sc-node)))
                         (sc-edges (nthcdr (if (equal ac +neutral-ac+) 2 3) sc-node)))
                    (push (make-sc-element
                           :app-condition ac
                           :object (if (or (characterp sc-attr) (stringp sc-attr) (numberp
                                                                                   sc-attr))
                                       (make-sc-constant :value sc-attr)
                                       (funcall (constructor-function sc-attr))))
                          rest-of-form)
                    (if (null sc-edges)
                        (push nil rest-of-form)
                        (push (loop for sc-edge in sc-edges collect
                                   (list (car sc-edge)
                                         (let* ((edge-ac
                                                 (case (second sc-edge)
                                                   (- +negative-ac+)
                                                   (+ +positive-ac+)
                                                   (t +neutral-ac+)))
                                                (sc-edge-attr (if (equal edge-ac +neutral-ac+)
                                                                  (second sc-edge)
                                                                  (third sc-edge))))
                                           (make-sc-element
                                            :app-condition edge-ac
                                            :object (cond ((null sc-edge-attr) (make-sc-edge))
                                                          ((or (characterp sc-edge-attr)
                                                               (stringp sc-edge-attr)
                                                               (numberp sc-edge-attr))
                                                           (make-sc-constant :value sc-attr))
                                                          (t (funcall (constructor-function sc-edge-attr))))))))
                              rest-of-form))
                    (nreverse rest-of-form)))))

(defvar *sc* (defsc ((0 state-resource (1) (2) (3 -))
                     (1 state-resource-cstr)
                     (2 object)
                     (3 - object)
                     (4 var (0 resource-type))
                     (5 all-different))))


compiles and correctly in clisp and sbcl:

[8]> (load(compile-file "/tmp/a.lisp"))
;; Compiling file /tmp/a.lisp ...
;; Wrote file /tmp/a.fas
0 errors, 0 warnings
;; Loading file /tmp/a.fas ...
;; Loaded file /tmp/a.fas
T
[9]> *sc*
((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE))
  ((1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE)))
   (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE)))
   (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(SC-EDGE)))))
 (1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE-CSTR)) NIL)
 (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(OBJECT)) NIL)
 (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(OBJECT)) NIL)
 (4 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(VAR))
  ((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(RESOURCE-TYPE)))))
 (5 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(ALL-DIFFERENT)) NIL))
[10]> 


In sbcl, it fails, but I think sbcl is wrong here:


* (load(compile-file "/tmp/a.lisp"))

; compiling file "/tmp/a.lisp" (written 26 SEP 2005 08:00:29 AM):
; compiling (DEFCONSTANT +NEUTRAL-AC+ ...)
; compiling (DEFCONSTANT +POSITIVE-AC+ ...)
; compiling (DEFCONSTANT +NEGATIVE-AC+ ...)
; compiling (DEFSTRUCT SC-ELEMENT ...)
; compiling (DEFSTRUCT SC-EDGE)
; compiling (DEFSTRUCT SC-CONSTANT ...)
; compiling (DEFSTRUCT STATE-RESOURCE)
; compiling (DEFSTRUCT STATE-RESOURCE-CSTR)
; compiling (DEFSTRUCT OBJECT)
; compiling (DEFSTRUCT VAR)
; compiling (DEFSTRUCT ALL-DIFFERENT)
; compiling (DEFSTRUCT RESOURCE-TYPE)
; compiling (DEFUN CONSTRUCTOR-FUNCTION ...)
; compiling (DEFMACRO DEFSC ...)
; compiling (DEFVAR *SC* ...)
; file: /tmp/a.lisp
; in: DEFVAR *SC* =>
;      DEFSC ((0 STATE-RESOURCE (1) (2) (3 -)) (1 STATE-RESOURCE-CSTR) (2 OBJECT) (3 - OBJECT) (4 VAR (0 RESOURCE-TYPE)) (5 ALL-DIFFERENT))
;     (DEFSC
;    ((0 STATE-RESOURCE (1) (2) (3 -)) (1 STATE-RESOURCE-CSTR) (2 OBJECT)
;     (3 - OBJECT) (4 VAR (0 RESOURCE-TYPE)) (5 ALL-DIFFERENT)))
; ==>
;   '((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE))
;      ((1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE)))
;       (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE)))
;       (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(SC-EDGE)))))
;     (1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE-CSTR)) NIL)
;     (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(OBJECT)) NIL)
;     (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(OBJECT)) NIL)
;     (4 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(VAR))
;      ((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(RESOURCE-TYPE)))))
;     (5 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(ALL-DIFFERENT)) NIL))
; 
; caught ERROR:
;   don't know how to dump #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE)) (default MAKE-LOAD-FORM method called).
; 
; compilation unit finished
;   caught 1 ERROR condition


; /tmp/a.fasl written
; compilation finished in 0:00:01
; loading #P"/tmp/a.fasl"
STYLE-WARNING: redefining MAKE-SC-ELEMENT in DEFUN
STYLE-WARNING: redefining MAKE-SC-EDGE in DEFUN
STYLE-WARNING: redefining MAKE-SC-CONSTANT in DEFUN
STYLE-WARNING: redefining MAKE-STATE-RESOURCE in DEFUN
STYLE-WARNING: redefining MAKE-STATE-RESOURCE-CSTR in DEFUN
STYLE-WARNING: redefining MAKE-OBJECT in DEFUN
STYLE-WARNING: redefining MAKE-VAR in DEFUN
STYLE-WARNING: redefining MAKE-ALL-DIFFERENT in DEFUN
STYLE-WARNING: redefining MAKE-RESOURCE-TYPE in DEFUN
STYLE-WARNING: redefining CONSTRUCTOR-FUNCTION in DEFUN

debugger invoked on a SB-INT:COMPILED-PROGRAM-ERROR in thread 28235: Execution of a form compiled with errors.
Form:
  ((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE)) ((1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE))) (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(SC-EDGE))) (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(SC-EDGE))))) (1 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE-CSTR)) NIL) (2 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(OBJECT)) NIL) (3 #S(SC-ELEMENT :APP-CONDITION -1 :OBJECT #S(OBJECT)) NIL) (4 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(VAR)) ((0 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(RESOURCE-TYPE))))) (5 #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(ALL-DIFFERENT)) NIL))
Compile-time-error:
  don't know how to dump #S(SC-ELEMENT :APP-CONDITION 0 :OBJECT #S(STATE-RESOURCE)) (default MAKE-LOAD-FORM method called).

Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ABORT] Exit debugger, returning to top level.

((SB-C::TOP-LEVEL-FORM (SB-IMPL::%DEFVAR (QUOTE *SC*) (UNLESS "#<...>" . "#<...>") ("#<...>" . "#<...>") "#<...>" . "#<...>")))
0] 


Structures can be printed readably so there's no impediment to storing
them in a .fasl file.


clhs defstruct

   If no :type option is supplied, and if either a :print-function or
   a :print-object option is supplied, and if no printer-name is
   supplied, then a print-object method specialized for structure-name
   is generated that calls a function that implements the default
   printing behavior for structures using #S notation; see Section
   22.1.3.12 (Printing Structures).

http://www.lispworks.com/documentation/HyperSpec/Body/22_acl.htm
http://www.lispworks.com/documentation/HyperSpec/Body/02_dhm.htm


But in anycase, you may want to extend your code to use CLOS objects
instead of structure and then there'd be no way to store objects in a
fasl file.  You'd have to generate a load-time expression instead of 
quoted dead data.

(defvar *sc* (load-time-value 
               (list (list 0 (make-sc-element ...)  ...)
                     ; or if you used classes:
                     (list 1 (make-instance 'sc-element ...) ..)
                     ...)))

So your defsc macro could generate this expression instead of
(quote (((0 ...) ...) ...))


Note: def* macros usually take as first argument a name to DEFine. So
either make it;

(DEFsc *sc* ...)
; or
(defvar *sc* (GENsc ...))


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
The mighty hunter
Returns with gifts of plump birds,
Your foot just squashed one.