Re: STklos anomaly? Help!

From: Erick Gallesio <>
Date: Tue, 13 Apr 1999 22:55:44 +0200 (CEST)

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 <> 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

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)))

(define (compute-slot-accessors class slots env)
      (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>))))


(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

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST