I really apologize for having taken so much time too answer. But it is
really sad period. I dream of the next week hoping for a better world
;-) ....
First I should say that completely agree with the message of Brian
Denheyer and would have proposed the same cures has he did (and I
particularly agree with him that we must try to help you to avoid to
use Perl ;-)
>
>
> Note: This message is rather long. If you have not been following
> this discussion, you might want to hit the delete key now.
>
> >>>> Brian Denheyer <briand_at_deldotd.com> wites:
> >><various snippage>
> > 1. > (describe foo)
>
> STk> (describe foo) foo is a class. It's an instance of <class>
> Superclasses are:
> <object>
> Directs slots are:
> a b c d e f g
> (No direct subclass) Class Precedence List is:
> foo <object> <top>
> Class direct methods are:
> Method #[<accessor-method> 495f14]
> Generic: the setter of e
> Specializers: foo <top>
> Method #[<accessor-method> 497a8c]
> Generic: e
> Specializers: foo
> Method #[<accessor-method> 455dd4]
> Generic: the setter of d
> Specializers: foo <top>
> Method #[<accessor-method> 459eb4]
> Generic: d
> Specializers: foo
> Method #[<accessor-method> 45c758]
> Generic: the setter of c
> Specializers: foo <top>
> Method #[<accessor-method> 45e2e8]
> Generic: c
> Specializers: foo
> Method #[<accessor-method> 4629d4]
> Generic: the setter of b
> Specializers: foo <top>
> Method #[<accessor-method> 464180]
> Generic: b
> Specializers: foo
> Method #[<accessor-method> 46805c]
> Generic: the setter of a
> Specializers: foo <top>
> Method #[<accessor-method> 4690e8]
> Generic: a
> Specializers: foo
>
Yes we don't have the getter of f and g so this is not incoherent with
the fact that you have an error when you use them.
> > Also, try using > > (require "class-browser") > (class-browser)
>
> STk> (require "class-browser")
> *** Error at line 141 of file
> /usr/local/lib/stk/3.99.4/STk/Tk-meta.stklos: for-each: malformed
> list
>
No idea about that, perhaps a bug. But the previous describe seems to
show that you don't have the definitions for your accessors. So don't
spend time with that ...
>
> > 2. > > Don't specify the accessors and then create the accessor
> explicitly, > i.e.,
>
> That works.
>
I prefer that.
> > 3. > Try reversing the order of the names.
>
> Same result, except backwards. That is, the a and b accessors
> are missing.
>
Strange Strange. The value 6 is something which is really not hard
coded in STklos, I really don't understand.
> > 4. > Try using both snow and stk.
>
> This is getting stranger and stranger. Snow works - with seven
> slots. Out of curiosity I started adding more slots. When I
> added one more slot and loaded the file I got:
>
> STk> (load "foo") *** Error at line 10 of file ./foo:
> for-each: malformed list
>
> Current eval stack:
> __________________
> 0 (for-each (lambda (s) (let ((name (slot-definition-name s))
> (getter (slot-definition-getter s)) (setter
> (slot-definition-setter s)) (accessor (slot-definition-accessor
> s))) (if getter (ensure-method getter (list (quote o)) (list
> class) (quasiquote ((slot-ref o (quote (unquote name))))) env
> <accessor-method>)) (if setter (ensure-method setter (list (quote
> o) (quote v)) (list class <top>) (quasiquote ((slot-set! o (quote
> (unquote name)) v))) env <accessor-method>)) (if accessor (begin
> (ensure-method accessor (list (quote o)) (list class) (quasiquote
> ((slot-ref o (quote (unquote name))))) env <accessor-method>)
> (ensure-method (quasiquote (setter (unquote accessor))) (list
> (quote o) (quote v)) (list class <top>) (quasiquote ((slot-set! o
> (quote (unquote name)) v))) env <accessor-method>))))) slots) 1
> (let ((instance (allocate-instance class initargs))) (initialize
> instance initargs) instance) 2 (apply make metaclass :dsupers
> supers :slots slots :name name :environment env options) 3 (let
> ((old (%find-class name env #f)) (cls (apply make metaclass
> :dsupers supers :slots slots :name name :environment env
> options))) (when old (class-redefinition old cls)) (set-symbol!
> name cls env) cls) 4 (begin (ensure-class (quote foo) (quote ())
> (quote ((a :accessor a :init-keyword :a :initform #f) (b
> :accessor b :init-keyword :b :initform #f) (c :accessor c
> :init-keyword :c :initform #f) (d :accessor d :init-keyword :d
> :initform #f) (e :accessor e :init-keyword :e :initform #f) (f
> :accessor f :init-keyword :f :initform #f) (h :accessor h
> :init-keyword :h :initform #f) (g :accessor g :init-keyword :g
> :initform #f))) (ensure-metaclass (quote ()) (the-environment))
> (the-environment)) (make-undefined)) 5 (load "foo")
>
>
>
That's interesting. Can you do a "See the stack", click on the top
line of the stack, go in the listener (this should display a ";
current environment ..." in the listener window. After that go in the
listener window and ask for the value of the slots variable.
>
> > 5. > Try "building" your example one slot at a time using
> different names > for the classes and slots and see if it still
> breaks after 5 slots.
>
> Yup.
>
Perhaps it's a GC problem (I pray this is not the case). Try to launch
stk with a "-cells 100000" option. You should not have a GC...
> > 6. > I debated as to whether or not this should be the first
> thing to > try. I would delete the current install of stk,
> i.e. _delete_ > /usr/local/lib/stk, i.e. the installation
> directory, and the source > directory. Don't forget to delete the
> executables in /usr/local/bin. > Really clean it out so there are
> no previous build executables or > libraries lying around.
> Re-install the source and re-build.
>
> Done that - on two different SCO machines.
>
Argh, I should have proposed this as first but no luck here
>
> > I've probably got some more crazy ideas if the need arises. For
> one > thing, we could run your code on my linux box and I'll e-mail
> you the > results :-) Anything to avoid PERL. ;-)
>
>
> Oh, it works great on my linux box. Unfortunately, SCO is on
> all the production machines (for this project).
>
> If you have never had to build software under SCO be thankful.
> I had to change a couple of items in io.c, posix.c, and
> process.c to get it to build but I don't think it is related to
> the slot problem.
No it does not seem so; (BTW can you send me a patch for your
modifications).
Can you try the following program too (at end of mail). It traces what
the MOP function see when defining your class.
For me, I obtain:
===> slot= (a :accessor a :init-keyword :a :initform #f) g-n-s =0
===> slot= (b :accessor b :init-keyword :b :initform #f) g-n-s =1
===> slot= (c :accessor c :init-keyword :c :initform #f) g-n-s =2
===> slot= (d :accessor d :init-keyword :d :initform #f) g-n-s =3
===> slot= (e :accessor e :init-keyword :e :initform #f) g-n-s =4
===> slot= (f :accessor f :init-keyword :f :initform #f) g-n-s =5
===> slot= (g :accessor g :init-keyword :g :initform #f) g-n-s =6
name: a ==> Getter: #f Setter: #f accessor:a
name: b ==> Getter: #f Setter: #f accessor:b
name: c ==> Getter: #f Setter: #f accessor:c
name: d ==> Getter: #f Setter: #f accessor:d
name: e ==> Getter: #f Setter: #f accessor:e
name: f ==> Getter: #f Setter: #f accessor:f
name: g ==> Getter: #f Setter: #f accessor:g
-- Erick
(require "stklos")
(with-module STklos
(define (compute-getters-n-setters class slots env)
(define (compute-slot-init-function s)
(let ((init (slot-definition-init-form s)))
(and (not (unbound? init)) (make-closure `(lambda () ,init) env))))
(define (verify-accessors slot l)
(if (pair? l)
(let ((get (car l))
(set (cadr l)))
(unless (and (closure? get) (= (%procedure-arity get) 1))
(error "Bad getter closure for slot `~S' in ~S: ~S" slot class get))
(unless (and (closure? set) (= (%procedure-arity set) 2))
(error "Bad setter closure for slot `~S' in ~S: ~S" slot class set)))))
(map (lambda (s)
(let* ((s (if (pair? s) s (list s)))
(g-n-s (compute-get-n-set class s))
(name (slot-definition-name s)))
; For each slot we have '(name init-function getter setter)
; If slot, we have the simplest form '(name init-function . index)
(format #t "===> slot= ~S g-n-s =~S\n" s g-n-s)
(verify-accessors name g-n-s)
(list* name (compute-slot-init-function s) g-n-s)))
slots))
(define (compute-slot-accessors class slots env)
(for-each
(lambda (s)
(let ((name (slot-definition-name s))
(getter (slot-definition-getter s))
(setter (slot-definition-setter s))
(accessor (slot-definition-accessor s)))
(format #t "name: ~S ==> Getter: ~S Setter: ~S accessor:~S\n"
name getter setter accessor)
(when getter
(ensure-method getter (list 'o) (list class)
`((slot-ref o ',name))
env <accessor-method>))
(when setter
(ensure-method setter (list 'o 'v) (list class <top>)
`((slot-set! o ',name v))
env <accessor-method>))
(when accessor
(ensure-method accessor (list 'o) (list class)
`((slot-ref o ',name))
env <accessor-method>)
(ensure-method `(setter ,accessor) (list 'o 'v) (list class <top>)
`((slot-set! o ',name v))
env <accessor-method>))))
slots))
)
(define-class foo ()
((a :accessor a :init-keyword :a :initform #f)
(b :accessor b :init-keyword :b :initform #f)
(c :accessor c :init-keyword :c :initform #f)
(d :accessor d :init-keyword :d :initform #f)
(e :accessor e :init-keyword :e :initform #f)
(f :accessor f :init-keyword :f :initform #f)
(g :accessor g :init-keyword :g :initform #f)))
Received on Tue Apr 13 1999 - 23:01:37 CEST