From 94f4c8d867c8d63c80911087a270f22f740b38f7 Mon Sep 17 00:00:00 2001 From: jnthn Date: Thu, 20 Aug 2009 23:47:29 +0200 Subject: [PATCH] Get traits on variables working more along the lines of the way discussed on #perl6 (spec will want tweaks). We now invoke the trait with a ContainerDeclarand object, which contains various information about the declaration. At the moment, we ain't applying the tratis only once ever - that will come in the future lexicals refactor. --- src/classes/AttributeDeclarand.pir | 13 +++++++- src/classes/ContainerDeclarand.pir | 11 ++++++- src/parser/actions.pm | 22 ++++++++++++-- src/pmc/mutablevar.pmc | 49 +++++++++++++++--------------- src/pmc/objectref_pmc.template | 14 --------- src/setting/traits.pm | 2 +- 6 files changed, 67 insertions(+), 44 deletions(-) diff --git a/src/classes/AttributeDeclarand.pir b/src/classes/AttributeDeclarand.pir index b6c4cbb4ef1..8db0374abb4 100644 --- a/src/classes/AttributeDeclarand.pir +++ b/src/classes/AttributeDeclarand.pir @@ -11,7 +11,7 @@ describe a declaration of an attribute container in a class. =cut -.namespace [] +.namespace ['AttributeDeclarand'] .sub '' :anon :load :init .local pmc p6meta @@ -19,6 +19,17 @@ describe a declaration of an attribute container in a class. p6meta.'new_class'('AttributeDeclarand', 'parent'=>'ContainerDeclarand', 'attr'=>'$!how') .end +.sub 'new' :method + .param pmc container :named('container') + .param pmc name :named('name') + .param pmc how :named('how') + $P0 = new ['ContainerDeclarand'] + setattribute $P0, '$!container', container + setattribute $P0, '$!name', name + setattribute $P0, '$!how', how + .return ($P0) +.end + .sub 'how' :method $P0 = getattribute self, '$!how' .return ($P0) diff --git a/src/classes/ContainerDeclarand.pir b/src/classes/ContainerDeclarand.pir index 04d4c263e13..6724801e5a1 100644 --- a/src/classes/ContainerDeclarand.pir +++ b/src/classes/ContainerDeclarand.pir @@ -11,7 +11,7 @@ describe a declaration of a container. =cut -.namespace [] +.namespace ['ContainerDeclarand'] .sub '' :anon :load :init .local pmc p6meta @@ -19,6 +19,15 @@ describe a declaration of a container. p6meta.'new_class'('ContainerDeclarand', 'parent'=>'Any', 'attr'=>'$!container $!name') .end +.sub 'new' :method + .param pmc container :named('container') + .param pmc name :named('name') + $P0 = new ['ContainerDeclarand'] + setattribute $P0, '$!container', container + setattribute $P0, '$!name', name + .return ($P0) +.end + .sub 'container' :method $P0 = getattribute self, '$!container' .return ($P0) diff --git a/src/parser/actions.pm b/src/parser/actions.pm index b37338c736e..850f4e52548 100644 --- a/src/parser/actions.pm +++ b/src/parser/actions.pm @@ -1818,11 +1818,18 @@ method scope_declarator($/) { # We'll make a block for calling other handles, which'll be # thunked. my $trait_stmts := PAST::Stmts.new(); - emit_traits($var, $trait_stmts, PAST::Var.new( :name('$_'), :scope('lexical') )); + emit_traits($var, $trait_stmts, PAST::Op.new( + :pasttype('callmethod'), :name('new'), + PAST::Var.new( :name('AttributeDeclarand'), :scope('package'), :namespace(list()) ), + PAST::Var.new( :name('$_'), :scope('lexical'), :named('container') ), + PAST::Val.new( :value($var.name()), :named('name') ), + PAST::Var.new( :name('$how'), :scope('lexical'), :named('how') ) + )); if +@($trait_stmts) > 0 { my $trait_block := PAST::Block.new( :blocktype('declaration'), PAST::Var.new( :name('$_'), :scope('parameter') ), + PAST::Var.new( :name('$how'), :scope('parameter') ), $trait_stmts ); $trait_block.named('traits'); @@ -1844,7 +1851,16 @@ method scope_declarator($/) { $viviself ) )); - emit_traits($var, $var.viviself(), $init_reg); + + # Trait and type handling. + $init_reg.named('container'); + my $declarand := PAST::Op.new( + :pasttype('callmethod'), :name('new'), + PAST::Var.new( :name('ContainerDeclarand'), :scope('package'), :namespace(list()) ), + $init_reg, + PAST::Val.new( :value($var.name()), :named('name') ) + ); + emit_traits($var, $var.viviself(), $declarand); if $type { if $var ne '$' && $var ne '@' && $var ne '%' && $var ne '' { $/.panic("Cannot handle typed variables with sigil " ~ $var); @@ -1852,7 +1868,7 @@ method scope_declarator($/) { $var.viviself.push(PAST::Op.new( :pasttype('call'), :name('trait_mod:of'), - $init_reg, + $declarand, $type )); } diff --git a/src/pmc/mutablevar.pmc b/src/pmc/mutablevar.pmc index cd1b0928319..e86445776a2 100644 --- a/src/pmc/mutablevar.pmc +++ b/src/pmc/mutablevar.pmc @@ -49,37 +49,38 @@ pmclass MutableVAR need_ext dynpmc group perl6_group { PMC_data(SELF) = NULL; } - VTABLE PMC *find_method(STRING *method_name) { + VTABLE PMC* getprop(STRING *prop_name) { PMC *scalar; - PMC *mro; - INTVAL elements, i; GET_ATTR_scalar(INTERP, SELF, scalar); + return VTABLE_getprop(INTERP, scalar, prop_name); + } + + METHOD INTVAL readonly() { + STRING *s_ro = string_from_literal(INTERP, "readonly"); + PMC *ro, *scalar; + INTVAL res; + + GET_ATTR_scalar(INTERP, SELF, scalar); + ro = VTABLE_getprop(INTERP, scalar, s_ro); + res = PMC_IS_NULL(ro) ? 0 : VTABLE_get_bool(INTERP, ro); + RETURN(INTVAL res); + } - /* We can't get Parrot do dispatch this for us as usual, because it - * calls VTABLE_namespace, which delegates to what the mutable - * contains. We want to call on the container. */ - mro = scalar->vtable->mro; - elements = VTABLE_elements(INTERP, mro); - for (i = 0; i < elements; i++) { - PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP, mro, i); - PMC * const ns = cur_class->vtable->_namespace; - - if (!PMC_IS_NULL(ns)) { - PMC * const method = VTABLE_get_pmc_keyed_str(interp, ns, method_name); - if (!PMC_IS_NULL(method)) { - /* Found method. If it's an NCI, we return a BoundNCI, to - * make sure we call with the scalar invocant. */ - return method; - } - } - } - return PMCNULL; + METHOD INTVAL rw() { + INTVAL ro, rw; + (INTVAL ro) = PCCINVOKE(INTERP, SELF, "readonly"); + rw = ro ? 0 : 1; + RETURN (INTVAL rw); } - VTABLE PMC* getprop(STRING *prop_name) { + METHOD PMC *of(PMC *type) { PMC *scalar; GET_ATTR_scalar(INTERP, SELF, scalar); - return VTABLE_getprop(INTERP, scalar, prop_name); + if (!PMC_IS_NULL(type)) + VTABLE_setprop(interp, scalar, CONST_STRING(interp, "type"), type); + else + type = VTABLE_getprop(interp, scalar, CONST_STRING(interp, "type")); + RETURN (PMC *type); } } diff --git a/src/pmc/objectref_pmc.template b/src/pmc/objectref_pmc.template index 2677f174f91..0fc7fc3692e 100644 --- a/src/pmc/objectref_pmc.template +++ b/src/pmc/objectref_pmc.template @@ -115,18 +115,4 @@ pmclass ObjectRef need_ext dynpmc group perl6_group { /* VTABLE PMC * setprop() */ /* VTABLE PMC * delprop() */ /* VTABLE PMC * getprops() */ - - METHOD INTVAL readonly() { - STRING *s_ro = string_from_literal(INTERP, "readonly"); - PMC *ro = VTABLE_getprop(INTERP, SELF, s_ro); - INTVAL res = PMC_IS_NULL(ro) ? 0 : VTABLE_get_bool(INTERP, ro); - RETURN(INTVAL res); - } - - METHOD INTVAL rw() { - INTVAL ro, rw; - (INTVAL ro) = PCCINVOKE(INTERP, SELF, "readonly"); - rw = ro ? 0 : 1; - RETURN (INTVAL rw); - } } diff --git a/src/setting/traits.pm b/src/setting/traits.pm index bb9836cd731..ce12e5a0d36 100644 --- a/src/setting/traits.pm +++ b/src/setting/traits.pm @@ -126,7 +126,7 @@ multi trait_mod:(ContainerDeclarand $c, Object $type is rw) { given $c.container { when Array { $_ does Positional[$type] } when Hash { $_ does Associative[$type] } - default { .of($type) } + default { VAR($_).of($type) } } }