My target is a class representing text in a document like this:
(defclass <a-class> (<base-class>)
((adv-p1-pp1 :accessor adv-p1-pp1 :initform "adv-p1-pp1"
:documentation "text adv-p1-pp1.")
(adv-p1-pp2 :accessor adv-p1-pp2 :initform "adv-p1-pp2"
:documentation "text adv-p1-pp2.")
(adv-p2-pp1 :accessor adv-p2-pp1 :initform "adv-p2-pp1"
:documentation "text adv-p2-pp1.")
(adv-p2-pp2 :accessor adv-p2-pp2 :initform "adv-p2-pp2"
:documentation "text adv-p2-pp2.")))
I want to define it like this:
(defreport <a-class> (<base-class>) "adv" ((1 2) (2 2)))
meaning:
Create class <a-class> where slots all begin with the prefix "adv", and
page 1 has 2 paragraphs, page 2 has 2 paragraphs, so create a slot for
each paragraph on each page. The slot name and the slot initform are
the same, the initform being a string, of course.
Here's what I have so far:
(defun string->slot (spec)
`(,spec :accessor ,spec :initform ,(symbol-name spec)))
(defun build-slots (prefix p pp)
`(,@(loop
for i to pp
when (< i pp) collect
(string->slot (make-symbol (concatenate 'string prefix (format nil
"-p~d-pp~d" p (1+ i))))))))
(defmacro defreport (class-name (base-name) prefix pages)
`(defclass ,class-name (,base-name)
(,@(loop
for (p pp) in pages collect
(build-slots prefix p pp)))))
This version *seems* to work (I haven't followed through after the
initial result), where I enumerate the paragraph numbers on each page:
(defun build-slots (prefix p pp)
(string->slot (make-symbol (concatenate 'string prefix (format nil
"-p~d-pp~d" p pp)))))
This means I have to call:
(defreport <a-class> (<base-class>) "adv" ((1 1) (1 2) (2 1) (2 2)))
Which loses the efficiency of counting the required slots to be created
in the first place.
There must be a better way, right? Or at least one that works? :-)
"jmckitrick" <···········@yahoo.com> writes:
> My target is a class representing text in a document like this:
>
> (defclass <a-class> (<base-class>)
> ((adv-p1-pp1 :accessor adv-p1-pp1 :initform "adv-p1-pp1"
> :documentation "text adv-p1-pp1.")
> (adv-p1-pp2 :accessor adv-p1-pp2 :initform "adv-p1-pp2"
> :documentation "text adv-p1-pp2.")
> (adv-p2-pp1 :accessor adv-p2-pp1 :initform "adv-p2-pp1"
> :documentation "text adv-p2-pp1.")
> (adv-p2-pp2 :accessor adv-p2-pp2 :initform "adv-p2-pp2"
> :documentation "text adv-p2-pp2.")))
>
> I want to define it like this:
>
> (defreport <a-class> (<base-class>) "adv" ((1 2) (2 2)))
>
> meaning:
>
> Create class <a-class> where slots all begin with the prefix "adv", and
> page 1 has 2 paragraphs, page 2 has 2 paragraphs, so create a slot for
> each paragraph on each page. The slot name and the slot initform are
> the same, the initform being a string, of course.
>
> Here's what I have so far:
>
> (defun string->slot (spec)
> `(,spec :accessor ,spec :initform ,(symbol-name spec)))
>
> (defun build-slots (prefix p pp)
> `(,@(loop
> for i to pp
> when (< i pp) collect
> (string->slot (make-symbol (concatenate 'string prefix (format nil
> "-p~d-pp~d" p (1+ i))))))))
>
> (defmacro defreport (class-name (base-name) prefix pages)
> `(defclass ,class-name (,base-name)
DEFCLASS takes a list of superclasses. You've not given any reason to
restrict it to one superclass for reports.
(defmacro defreport (class-name base-classes prefix pages)
`(defclass ,class-name ,base-classes
> (,@(loop
> for (p pp) in pages collect
> (build-slots prefix p pp)))))
>
> This version *seems* to work (I haven't followed through after the
> initial result), where I enumerate the paragraph numbers on each page:
>
> (defun build-slots (prefix p pp)
> (string->slot (make-symbol (concatenate 'string prefix
(format nil "-p~d-pp~d" p pp)))))
By default, the READTABLE-CASE is :UPCASE. Making a symbol doesn't
change the case of the symbol name given, and doesn't intern it. Why
are you giving a SYMBOL to a function that's named STRING->slot?
(defun name->slot (name)
(let ((spec (intern name)))
`(,spec :accessor ,spec :initform ,name)))
(defun build-slots (prefix p pp)
`(,@(loop
:for i :from 1 :to pp
:collect (name->slot (format nil "~A-P~A-PP~D" prefix p i)))))
Some pages are numbered in roman --> use ~A instead of ~D to allow them.
(defmacro defreport (class-name base-classes prefix pages)
`(defclass ,class-name ,base-classes
,(loop :for (p pp) :in pages
:nconc (build-slots prefix p pp))))
Compare:
[75]> (macroexpand-1 '(defreport minority-report (report mental)
"ADV" ((i 3) (ii 2) (iii 1) (1 4) (2 5) (3 1))))
(DEFCLASS MINORITY-REPORT (REPORT MENTAL)
((ADV-PI-PP1 :ACCESSOR ADV-PI-PP1 :INITFORM "ADV-PI-PP1")
(ADV-PI-PP2 :ACCESSOR ADV-PI-PP2 :INITFORM "ADV-PI-PP2")
(ADV-PI-PP3 :ACCESSOR ADV-PI-PP3 :INITFORM "ADV-PI-PP3")
(ADV-PII-PP1 :ACCESSOR ADV-PII-PP1 :INITFORM "ADV-PII-PP1")
(ADV-PII-PP2 :ACCESSOR ADV-PII-PP2 :INITFORM "ADV-PII-PP2")
(ADV-PIII-PP1 :ACCESSOR ADV-PIII-PP1 :INITFORM "ADV-PIII-PP1")
(ADV-P1-PP1 :ACCESSOR ADV-P1-PP1 :INITFORM "ADV-P1-PP1")
(ADV-P1-PP2 :ACCESSOR ADV-P1-PP2 :INITFORM "ADV-P1-PP2")
(ADV-P1-PP3 :ACCESSOR ADV-P1-PP3 :INITFORM "ADV-P1-PP3")
(ADV-P1-PP4 :ACCESSOR ADV-P1-PP4 :INITFORM "ADV-P1-PP4")
(ADV-P2-PP1 :ACCESSOR ADV-P2-PP1 :INITFORM "ADV-P2-PP1")
(ADV-P2-PP2 :ACCESSOR ADV-P2-PP2 :INITFORM "ADV-P2-PP2")
(ADV-P2-PP3 :ACCESSOR ADV-P2-PP3 :INITFORM "ADV-P2-PP3")
(ADV-P2-PP4 :ACCESSOR ADV-P2-PP4 :INITFORM "ADV-P2-PP4")
(ADV-P2-PP5 :ACCESSOR ADV-P2-PP5 :INITFORM "ADV-P2-PP5")
(ADV-P3-PP1 :ACCESSOR ADV-P3-PP1 :INITFORM "ADV-P3-PP1"))) ;
T
[76]> (macroexpand-1 '(defreport minority-report (report mental)
"adv" ((i 3) (ii 2) (iii 1) (1 4) (2 5) (3 1))))
(DEFCLASS MINORITY-REPORT (REPORT MENTAL)
((|adv-PI-PP1| :ACCESSOR |adv-PI-PP1| :INITFORM "adv-PI-PP1")
(|adv-PI-PP2| :ACCESSOR |adv-PI-PP2| :INITFORM "adv-PI-PP2")
(|adv-PI-PP3| :ACCESSOR |adv-PI-PP3| :INITFORM "adv-PI-PP3")
(|adv-PII-PP1| :ACCESSOR |adv-PII-PP1| :INITFORM "adv-PII-PP1")
(|adv-PII-PP2| :ACCESSOR |adv-PII-PP2| :INITFORM "adv-PII-PP2")
(|adv-PIII-PP1| :ACCESSOR |adv-PIII-PP1| :INITFORM "adv-PIII-PP1")
(|adv-P1-PP1| :ACCESSOR |adv-P1-PP1| :INITFORM "adv-P1-PP1")
(|adv-P1-PP2| :ACCESSOR |adv-P1-PP2| :INITFORM "adv-P1-PP2")
(|adv-P1-PP3| :ACCESSOR |adv-P1-PP3| :INITFORM "adv-P1-PP3")
(|adv-P1-PP4| :ACCESSOR |adv-P1-PP4| :INITFORM "adv-P1-PP4")
(|adv-P2-PP1| :ACCESSOR |adv-P2-PP1| :INITFORM "adv-P2-PP1")
(|adv-P2-PP2| :ACCESSOR |adv-P2-PP2| :INITFORM "adv-P2-PP2")
(|adv-P2-PP3| :ACCESSOR |adv-P2-PP3| :INITFORM "adv-P2-PP3")
(|adv-P2-PP4| :ACCESSOR |adv-P2-PP4| :INITFORM "adv-P2-PP4")
(|adv-P2-PP5| :ACCESSOR |adv-P2-PP5| :INITFORM "adv-P2-PP5")
(|adv-P3-PP1| :ACCESSOR |adv-P3-PP1| :INITFORM "adv-P3-PP1"))) ;
T
To make sure, you could force upcase with:
(defun build-slots (prefix p pp)
`(,@(loop
:for i :from 1 :to pp
:collect (name->slot (format nil ···@(~A-P~A-PP~D~)" prefix p i)))))
> This means I have to call:
>
> (defreport <a-class> (<base-class>) "adv" ((1 1) (1 2) (2 1) (2 2)))
>
> Which loses the efficiency of counting the required slots to be created
> in the first place.
Never heard of lists, or dynamically allocated vectors?
Here is how it works:
- you start with an empty list:
(defparameter *para* '())
- then, you add elements to the list:
(setf *para* (nconc *para* (list "first para")))
(setf *para* (nconc *para* (list "second para")))
(setf *para* (nconc *para* (list "third para")))
...
(setf *para* (nconc *para* (list "nth para")))
- you can also add several elements at once:
(setf *para* (nconc *para* (list "new para" "2nd new" "other new")))
- then you can see the list of elements:
*para*
- you can process them one after the other:
(dolist (item *para*)
(process item))
- etc... See chapters 14 and 17 of CLHS.
With vector, it's no more complicated, and it allows to index the
elements directly more efficiently:
- (defparameter *para* (make-array 0 :adjustable t :fill-pointer 0))
- (vector-push-extend "first para" *para*)
(vector-push-extend "second para" *para*)
(vector-push-extend "third para" *para*)
...
(vector-push-extend "nth para" *para*)
- (let ((additionnal-para (list "new para" "2nd new" "other new")))
(setf *para* (adjust-array *para*
(+ (length additionnal-para) (length *para*))))
(dolist (new-item additionnal-para)
(vector-push new-item *para*)))
- (loop :for item :across *para*
:do (proces item))
- etc... See chapters 15 and 17 of CLHS.
There's no need to count the items.
But you can use LENGTH if you need to...
> There must be a better way, right? Or at least one that works? :-)
So, you're saying that a report is made of page, and a page is made of
paragraphs? (That's somewhat strict, most documents allow a paragraph
to be flowned over several pages).
What are the keywords? report, page, paragraph.
(defclass report () ())
(defclass page () ())
(defclass paragraph () ())
What are the "have" or "made of"?
A report has several pages.
A page has several paragraph.
A paragraph has one text string.
We've seen above that a page has a page number.
Do you need to number the paragraphs too?
(defclass report ()
((pages :initarg :pages :initform '() :accessor pages)))
(defclass page ()
((paragraphs :initarg :paragraphs :initform '() :accessor paragraphs)
(number :initarg :number :accessor page-number)))
(defclass paragraph ()
((text :initarg :text :initform "" :accessor text)))
For debugging purpose, let's write some print-object methods:
(defmethod print-object ((self report) stream)
(print-unreadable-object (self stream :type t :identity t)
(dolist (page (pages self))
(print page stream))))
(defmethod print-object ((self page) stream)
(print-unreadable-object (self stream :type t :identity t)
(terpri stream)
(princ "--------------------" stream)
(princ (page-number self) stream)
(princ "--------------------" stream)
(terpri stream)
(dolist (paragraph (paragraphs self))
(print paragraph stream))))
(defmethod print-object ((self paragraph) stream)
(print-unreadable-object (self stream :type t :identity t)
(princ (text self) stream)))
Now, let's make a report:
(make-instance 'report
:pages (list
(make-instance 'page
:number "i"
:paragraphs
(list (make-instance 'paragraph
:text "This is a little report about Hao Wang's algorithm")))
(make-instance 'page
:number "1"
:paragraphs
(list (make-instance 'paragraph
:text "Hao Wang, logicien americain.")
(make-instance 'paragraph
:text
"L'algorithme en question a �t� publi� en 1960 dans l'IBM Journal,
article intitule \"Toward Mechanical Mathematics\", avec des variantes et
une extension au calcul des pr�dicats. Il s'agit ici du \"premier
programme\" de Wang, systeme \"P\".
Wang, logicien americain.")
(make-instance 'paragraph
:text
"L'article a �t� �crit en 1958, et les exp�riences effectu�es sur IBM 704
� machine � lampes, 32 k mots de 36 bits, celle�l� m�me qui vit na�tre
LISP � la m�me �poque. Le programme a �t� �crit en assembleur (Fortran
existait, mais il ne s'�tait pas encore impos�) et l'auteur estime que
\"there is very little in the program that is not straightforward\".")
(make-instance 'paragraph
:text
"Il observe que les preuves engendr�es sont \"essentiellement des arbres\",
et annonce que la machine a d�montre 220 th�or�mes du calcul des
propositions (tautologies) en 3 minutes. Il en tire argument pour la
sup�riorit� d'une approche algorithmique par rapport � une approche
heuristique comme celle du \"Logic Theorist\" de Newell, Shaw et Simon (�
partir de 1956 sur la machine JOHNNIAC de la Rand Corporation): un d�bat
qui dure encore...")
(make-instance 'paragraph
:text
"Cet algorithme a �t� popularis� par J. McCarthy, comme exemple�fanion
d'application de LISP. Il figure dans le manuel de la premi�re version
de LISP (LISP 1, sur IBM 704 justement, le manuel est dat� de Mars
1960), et il a �t� repris dans le celebre \"LISP 1.5 Programmer's Manual\"
publi� en 1962 par MIT Press, un des ma�tres�livres de l'Informatique.")))))
We can start from a list of list structure, which is easier to write
or generate. Let's write a function building the CLOS objects from
this kind of list:
(defun make-report (page-list)
(make-instance 'report
:pages (mapcar (lambda (page)
(make-instance 'page
:number (first page)
:paragraphs (mapcar (lambda (text)
(make-instance 'paragraph
:text text))
(rest page))))
page-list)))
(make-report
'(("i" ; page number
; paragraphs:
"This is a little report about Hao Wang's algorithm")
("1" ; page number
; paragraphs
"Hao Wang, logicien americain."
"L'algorithme en question a �t� publi� en 1960 dans l'IBM Journal,
article intitule \"Toward Mechanical Mathematics\", avec des variantes et
une extension au calcul des pr�dicats. Il s'agit ici du \"premier
programme\" de Wang, systeme \"P\".
Wang, logicien americain."
"L'article a �t� �crit en 1958, et les exp�riences effectu�es sur IBM 704
� machine � lampes, 32 k mots de 36 bits, celle�l� m�me qui vit na�tre
LISP � la m�me �poque. Le programme a �t� �crit en assembleur (Fortran
existait, mais il ne s'�tait pas encore impos�) et l'auteur estime que
\"there is very little in the program that is not straightforward\"."
"Il observe que les preuves engendr�es sont \"essentiellement des arbres\",
et annonce que la machine a d�montre 220 th�or�mes du calcul des
propositions (tautologies) en 3 minutes. Il en tire argument pour la
sup�riorit� d'une approche algorithmique par rapport � une approche
heuristique comme celle du \"Logic Theorist\" de Newell, Shaw et Simon (�
partir de 1956 sur la machine JOHNNIAC de la Rand Corporation): un d�bat
qui dure encore..."
"Cet algorithme a �t� popularis� par J. McCarthy, comme exemple�fanion
d'application de LISP. Il figure dans le manuel de la premi�re version
de LISP (LISP 1, sur IBM 704 justement, le manuel est dat� de Mars
1960), et il a �t� repris dans le celebre \"LISP 1.5 Programmer's Manual\"
publi� en 1962 par MIT Press, un des ma�tres�livres de l'Informatique.")))
Still no need to count anything...
--
__Pascal Bourguignon__ http://www.informatimago.com/
"Debugging? Klingons do not debug! Our software does not coddle the
weak."
Pascal Bourguignon wrote:
*** a lot of stuff! ***
> By default, the READTABLE-CASE is :UPCASE. Making a symbol doesn't
> change the case of the symbol name given, and doesn't intern it.
I wasn't sure about that. I've only somewhat experimented with intern
and make-symbol.
I've 'interned' all your code to my printer for further study.
> Why are you giving a SYMBOL to a function that's named STRING->slot?
Because when I first wrote it, it took a string?
> Never heard of lists, or dynamically allocated vectors?
There's one other detail I should mention. Each of those slots has a
string value, but that string is not the paragraph text to be used.
The string is a field for a database query that will return the
paragraph text.
I don't plan (or want) to give each slot (and by extension, database
field) a unique name. I want them named sequentially. That way, when
I pass the list ((1 5) (2 3) (3 4)) as pages, I don't need to worry
about generating the field names for the query. Better yet, since I
know the pages will start with 1 and increment, I could change it to do
this:
(defreport <adv-bgct> (<bgct>) "adv" (5 3 4))
And this would generate a class with slots:
1. Named "adv-p" + page-number + "-pp" + paragraph-number
2. Populate those slots with a string of the same contents.
So the slots (and their string contents) would be:
adv-p1-pp1, adv-p1-pp2, adv-p1-pp3, adv-p1-pp4, adv-p1-pp5,
adv-p2-pp1, adv-p2-pp2, adv-p2-pp3,
adv-p3-pp1, adv-p3-pp2, adv-p3-pp3, adv-p3-pp4
Now I can generate the report by querying the db with the contents of
each slot to get the paragraph contents.
---8<--- *** huge amount of code *** ---8<---
> Still no need to count anything...
That's the idea. I also would like to eventually automate the querying
side, where I can call a function with the prefix and page and have it
return a list of the fields from the database.
Actually, that might make the entire slot system unnecessary. The
class is needed just to specialize report generation. Building the
prefix+page+paragraph could be done dynamically and then used to query
the db without ever needing to use slots at all.
"jmckitrick" <···········@yahoo.com> writes:
> Pascal Bourguignon wrote:
>
> *** a lot of stuff! ***
>
>> By default, the READTABLE-CASE is :UPCASE. Making a symbol doesn't
>> change the case of the symbol name given, and doesn't intern it.
>
> I wasn't sure about that. I've only somewhat experimented with intern
> and make-symbol.
> I've 'interned' all your code to my printer for further study.
>
>> Why are you giving a SYMBOL to a function that's named STRING->slot?
>
> Because when I first wrote it, it took a string?
>
>> Never heard of lists, or dynamically allocated vectors?
>
> There's one other detail I should mention. Each of those slots has a
> string value, but that string is not the paragraph text to be used.
> The string is a field for a database query that will return the
> paragraph text.
>
> I don't plan (or want) to give each slot (and by extension, database
> field) a unique name. I want them named sequentially. That way, when
> I pass the list ((1 5) (2 3) (3 4)) as pages, I don't need to worry
> about generating the field names for the query. Better yet, since I
> know the pages will start with 1 and increment, I could change it to do
> this:
>
> (defreport <adv-bgct> (<bgct>) "adv" (5 3 4))
>
> And this would generate a class with slots:
> 1. Named "adv-p" + page-number + "-pp" + paragraph-number
> 2. Populate those slots with a string of the same contents.
What about sending SQL queries to know the number of pages and
paragraphs per pages?
But still, do you really need to have slots for each page and each paragraph?
> That's the idea. I also would like to eventually automate the querying
> side, where I can call a function with the prefix and page and have it
> return a list of the fields from the database.
>
> Actually, that might make the entire slot system unnecessary. The
> class is needed just to specialize report generation. Building the
> prefix+page+paragraph could be done dynamically and then used to query
> the db without ever needing to use slots at all.
Indeed, you could write a function to read the database and generate
report objects made of list of page objects made of list of paragraph
objects. Then printing the report is just a matter of sending the
right method to the report object.
If you need lazy loading, you can have proxy objects.
(defclass unloaded-page ()
((sql-query :accessor sql-query ...))
(:documentation "A proxy object for a PAGE"))
(defmethod page-number ((self unloaded-page))
(load-data self)
(page-number self))
(defmethod paragraphs ((self unloaded-page))
(load-data self)
(paragraphs self))
;; There's a pattern here, a macro could help...
(defmethod load-data ((self unloaded-page))
(let* ((query (sql-query self))
(data (execute-query query)))
(change-class self 'page
:number (first data)
:paragraphs (mapcar (function post-load-paragraph)
(rest data)))))
Note that the function post-load-paragraph can very well instanciate
unloaded-paragraph, with additionnal query to load the indivudual
paragraphs.
Since the report and paragraph classes will have unloaded-* versions,
some macrology may be in order to make it swift and nice.
--
__Pascal Bourguignon__ http://www.informatimago.com/
Nobody can fix the economy. Nobody can be trusted with their finger
on the button. Nobody's perfect. VOTE FOR NOBODY.