Leopold Toetsch <[EMAIL PROTECTED]> wrote:
[ I'd like to have that scheme in P6E2, *if* we use it ]
> Dan Sugalski <[EMAIL PROTECTED]> wrote:
>> Okay, here's a sketch of where I'm going with the initialization,
>> finalization, and fallback method locating.
> As the current init scheme isn't really flying (and not in sync with
> this proposal) here is a first hack to get it running.
>> CONSTRUCT is the method we call when we're building the object from
>> scratch. We call it on the object and if the object wants to
>> redispatch to parents, it better do so. We'll catch that it's being
>> redispatched and call the proper parent class method even if it has a
>> different name.
>> BUILD is the method we call when we're building the object. We call
>> this on *every* class in the object's hierarchy that it exists in. No
>> redispatching, it's all automatic.
> [ ... ]
>> Also, these properties are on *names*, not method PMCs. We get a
>> two-step "look up the property, then look up the method the property
>> names" thing,
> Here is a sample program:
> $ cat o.imc
> .sub _main
> $P0 = newclass "A"
> $P1 = new PerlString
> $P1 = "_new"
> setprop $P0, "BUILD", $P1
> $I0 = find_type "A"
> $P2 = new PerlString
> $P2 = "argument\n"
> .local pmc obj
> obj = new $I0, $P2
> print "done\n"
> end
> .end
> .namespace ["A"]
> .sub _new method
> .param pmc arg
> print "new\n"
> print arg
> .end
> .sub __init method
> print "init\n"
> .end
> The new scheme is currently turned on only, if the environment variable
> CALL__BUILD is set so that old code isn't broken immediately:
> $ CALL__BUILD=1 parrot o.imc
> new
> argument
> done
> $ parrot o.imc
> init
> done
> The "obj = new Iclass" can now take an optional initializer which is
> passed as first PMC arument to the BUILD or CONSTRUCT method. It's up to
> the class what this is, but we should probably define some scheme for
> HLL interoperbility.
> Comments welcome,
> leo
> --- parrot/include/parrot/objects.h Sat Apr 3 18:00:20 2004
> +++ parrot-leo/include/parrot/objects.h Tue Apr 6 10:10:56 2004
>@@ -44,6 +44,7 @@
> PMC *Parrot_remove_parent(Parrot_Interp, PMC *, PMC *);
> PMC *Parrot_multi_subclass(Parrot_Interp, PMC *, STRING *);
> void Parrot_instantiate_object(Parrot_Interp, PMC *);
> +void Parrot_instantiate_object_init(Parrot_Interp, PMC *, PMC *);
> INTVAL Parrot_object_isa(Parrot_Interp interpreter, PMC *, PMC *);
> PMC *Parrot_new_method_cache(Parrot_Interp);
> PMC *Parrot_find_method_with_cache(Parrot_Interp, PMC *, STRING *);
> --- parrot/src/objects.c Mon Apr 5 11:24:49 2004
> +++ parrot-leo/src/objects.c Tue Apr 6 10:21:56 2004
>@@ -440,6 +440,7 @@
> /* Reset the init method to our instantiation method */
> new_vtable->init = Parrot_instantiate_object;
> + new_vtable->init_pmc = Parrot_instantiate_object_init;
> new_class->vtable = new_vtable;
> /* Put our new vtable in the global table */
>@@ -458,16 +459,32 @@
> return new_type;
> }
> +static PMC*
> +get_init_meth(Parrot_Interp interpreter, PMC *class, const char * init_name)
> +{
> + PMC *prop;
> + STRING *prop_s, *meth;
> + prop_s = const_string(interpreter, init_name);
> + prop = VTABLE_getprop(interpreter, class, prop_s);
> + if (!VTABLE_defined(interpreter, prop))
> + return NULL;
> + meth = VTABLE_get_string(interpreter, prop);
> + return Parrot_find_method_with_cache(interpreter, class, meth);
> +}
> static void
> -do_initcall(Parrot_Interp interpreter, PMC* class, PMC *object)
> +do_initcall(Parrot_Interp interpreter, PMC* class, PMC *object, PMC *init)
> {
> -
> SLOTTYPE *class_data = PMC_data(class);
> PMC *classsearch_array = get_attrib_num(class_data, PCD_ALL_PARENTS);
> PMC *parent_class;
> INTVAL i, nparents;
> + int free_it;
> + /*
> + * XXX compat mode
> + */
> + if (!Parrot_getenv("CALL__BUILD", &free_it)) {
> nparents = VTABLE_elements(interpreter, classsearch_array);
> for (i = nparents - 1; i >= 0; --i) {
> parent_class = VTABLE_get_pmc_keyed_int(interpreter,
>@@ -476,12 +493,60 @@
> object, parent_class);
> }
> Parrot_base_vtables[enum_class_delegate]->init(interpreter, object);
> + }
> + else {
> + /*
> + * 1) if class has a CONSTRUCT property run it on the object
> + * no redispatch
> + */
> + PMC *meth = get_init_meth(interpreter, class, "CONSTRUCT");
> + if (meth) {
> + /* XXX S0 isn't set - create runops_method */
> + PMC *p2 = REG_PMC(2); /* preserve current self */
> + REG_PMC(2) = object;
> + if (init)
> + Parrot_runops_fromc_args_save(interpreter, meth, "vP", init);
> + else
> + Parrot_runops_fromc_save(interpreter, meth);
> + REG_PMC(2) = p2;
> + }
> + /*
> + * 2. if class has a BUILD property call it for all classes
> + * in reverse search order - this class last.
> + */
> + nparents = VTABLE_elements(interpreter, classsearch_array);
> + for (i = nparents - 1; i >= 0; --i) {
> + parent_class = VTABLE_get_pmc_keyed_int(interpreter,
> + classsearch_array, i);
> + meth = get_init_meth(interpreter, parent_class, "BUILD");
> + if (meth) {
> + PMC *p2 = REG_PMC(2); /* preserve current self */
> + REG_PMC(2) = object;
> + if (init)
> + Parrot_runops_fromc_args_save(interpreter, meth, "vP",
> + init);
> + else
> + Parrot_runops_fromc_save(interpreter, meth);
> + REG_PMC(2) = p2;
> + }
> + }
> + meth = get_init_meth(interpreter, class, "BUILD");
> + if (meth) {
> + PMC *p2 = REG_PMC(2); /* preserve current self */
> + REG_PMC(2) = object;
> + if (init)
> + Parrot_runops_fromc_args_save(interpreter, meth, "vP", init);
> + else
> + Parrot_runops_fromc_save(interpreter, meth);
> + REG_PMC(2) = p2;
> + }
> + }
> }
> /*
> =item C<void
> -Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object)>
> +Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object, PMC *init)>
> Creates a Parrot object. Takes a passed-in class PMC that has sufficient
> information to describe the layout of the object and, well, makes the
>@@ -491,9 +556,24 @@
> */
> +static void instantiate_object(Parrot_Interp, PMC *object, PMC *init);
> +
> +void
> +Parrot_instantiate_object_init(Parrot_Interp interpreter,
> + PMC *object, PMC *init)
> +{
> + instantiate_object(interpreter, object, init);
> +}
> +
> void
> Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object)
> {
> + instantiate_object(interpreter, object, NULL);
> +}
> +
> +static void
> +instantiate_object(Parrot_Interp interpreter, PMC *object, PMC *init)
> +{
> SLOTTYPE *new_object_array;
> INTVAL attrib_count;
> SLOTTYPE *class_array;
>@@ -536,7 +616,7 @@
> /* We really ought to call the class init routines here...
> * this assumes that an object isa delegate
> */
> - do_initcall(interpreter, class, object);
> + do_initcall(interpreter, class, object, init);
> }
> /*
leo
