I like it. It's really really similar to what I've done. I'm not sure
if I think the term "mixin" is appropriate here (what are you mixing
in to what, anyway?) and I definitely don't like the new slot
accessors, but those aren't really important issues. Will default
constructors remain? I hope they do. Am I right to think that : first2
{ first second } get-slots ; ? Also, does construct make blank copies
of the slots that are delegated to another class? And is it possible
to directly access the object(s) that are delegated to? In my
implementation, I made it so that it's possible to distinguish an
instance of a tuple to something that just delegates to a tuple. Do
you think this might be a good idea? (The actual tuple was in the
class with the name of the tuple, and the delegating tuples had
"-slots" appended.)On 8/1/07, Slava Pestov <[EMAIL PROTECTED]> wrote: > An example can be found at http://wee-url.com/responder/pastebin/show- > paste?n=219. > > Changes from the current object system: > > - Slot access is redone. See the example. > - Single inheritance among tuple classes: this way tuple slots can be > inherited. > - Multiple inheritance of 'mixins': this way method implementations > can be inherited. > - This is very rough code and is not fully debugged or very clean at > all! > - It will be a while before any of these features actually make it > into the object system in the core. > > Dan, Eduardo, please give feedback! :-) > > -------8<------ > > USING: arrays classes kernel math namespaces parser quotations > sequences slots tuples tuples.private words vocabs ; > IN: new-obj-sys > > : mixin-instance? ( class classes -- ? ) > over [ > 2dup memq? [ > 2drop t > ] [ > >r superclass r> mixin-instance? > ] if > ] [ > 2drop f > ] if ; > > : mixin-predicate-quot ( class -- quot ) > "members" word-prop [ >r class r> mixin-instance? ] curry ; > > : define-mixin ( word -- ) > dup V{ } clone "members" set-word-prop > dup define-class > dup predicate-word over mixin-predicate-quot > define-predicate ; > > : add-instance ( class mixin -- ) > tuck "members" word-prop push define-class ; > > : MIXIN: CREATE define-mixin ; parsing > > : INSTANCE: scan-word scan-word add-instance ; parsing > > : simple-slot-word ( name -- ) > append "slot-access" create ; > > : simple-reader-word ( name -- word ) > ">>" simple-slot-word ; > > : simple-writer-word ( name -- word ) > ">>" swap simple-slot-word ; > > : simple-change-word ( name -- word ) > "change-" swap simple-slot-word ; > > : define-change-word ( word name -- ) > [ > [ over >r >r ] % > dup simple-reader-word , > [ r> call r> ] % > simple-writer-word , > ] [ ] make define-inline ; > > : simple-slot ( name # -- spec ) > >r object bootstrap-word over r> f f <slot-spec> > over simple-reader-word over set-slot-spec-reader > over simple-writer-word over set-slot-spec-writer > >r dup simple-change-word swap define-change-word r> ; > > : new-simple-slots ( slots base -- specs ) > over length [ + ] map-with [ simple-slot ] 2map ; > > : initial-offset superclass "slot-names" word-prop length 4 + ; > > : define-custom-slots ( class slots -- ) > 2dup "slot-names" set-word-prop > over initial-offset new-simple-slots > 2dup delegate-slot-spec add* "slots" set-word-prop > define-slots ; > > : subclass? ( sub super -- ? ) > 2dup eq? [ > 2drop t > ] [ > >r superclass r> subclass? > ] if ; > > : custom-predicate ( class -- ) > dup predicate-word over [ >r class r> subclass? ] curry > define-predicate ; > > : define-custom-class ( class superclass slots -- ) > >r dupd "superclass" set-word-prop r> > 2dup check-shape > >r dup custom-predicate > dup define-class > r> define-custom-slots ; > > : CLASS: > CREATE ";" parse-tokens > 0 over ?nth "<" = [ > dup second search swap 2 tail > ] [ > \ tuple bootstrap-word swap > ] if define-custom-class ; parsing > > : get-slots ( tuple seq -- ... ) > [ execute ] each-with ; > > : set-slots ( ... tuple seq -- ) > <reversed> [ > dup array? [ first2 swapd ] when execute > ] each-with ; > > : new-tuple-size > dup { f tuple } memq? [ > drop 2 > ] [ > dup superclass new-tuple-size > swap "slot-names" word-prop length + > ] if ; > > : construct ( ... seq class -- tuple ) > dup new-tuple-size <tuple> [ swap set-slots ] keep ; > > : boa-construct ( ... class -- tuple ) > dup "slots" word-prop 1 tail-slice > [ slot-spec-writer ] map > swap construct ; > > "slot-access" create-vocab drop > > ------------------------------------------------------------------------- > This SF.net email is sponsored by: Splunk Inc. > Still grepping through log files to find problems? Stop. > Now Search log events and configuration files using AJAX and a browser. > Download your FREE copy of Splunk now >> http://get.splunk.com/ > _______________________________________________ > Factor-talk mailing list > [email protected] > https://lists.sourceforge.net/lists/listinfo/factor-talk > ------------------------------------------------------------------------- This SF.net email is sponsored by: Splunk Inc. Still grepping through log files to find problems? Stop. Now Search log events and configuration files using AJAX and a browser. Download your FREE copy of Splunk now >> http://get.splunk.com/ _______________________________________________ Factor-talk mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/factor-talk
