From efd82cef82448f690b9a6b40fa0bfa7883308562 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Sat, 6 Feb 2010 13:42:32 +0100 Subject: [PATCH 1/2] Fix for role Foo[::T] does Bar[T] { ... }. --- src/Perl6/Grammar.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm index 336becc9caa..3a142c8662d 100644 --- a/src/Perl6/Grammar.pm +++ b/src/Perl6/Grammar.pm @@ -153,6 +153,7 @@ token def_module_name { [ + :my $*SCOPE := 'my'; '[' ~ ']' ]? } From 61f444ace49bc3373df0acdaa46e662178661934 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Sat, 6 Feb 2010 15:53:26 +0100 Subject: [PATCH 2/2] Stub in a very minimal EnumMap and Hash in the core setting. Fix up slurpy hash creation. Get { } and < > postcircumfixes actually calling the appropriate methods. Nothing especially useful yet, but no newly broken tests either. --- build/Makefile.in | 3 +++ src/Perl6/Actions.pm | 10 ++++------ src/binder/bind.c | 24 ++++++++++++++++-------- src/builtins/Role.pir | 6 +++--- src/cheats/postcircumfix-hash.pir | 25 +++++++++++++++++++++++++ src/core/EnumMap.pm | 22 ++++++++++++++++++++++ src/core/Hash.pm | 18 ++++++++++++++++++ src/glue/types.pir | 11 +++++++++++ 8 files changed, 102 insertions(+), 17 deletions(-) create mode 100644 src/cheats/postcircumfix-hash.pir create mode 100644 src/core/EnumMap.pm create mode 100644 src/core/Hash.pm diff --git a/build/Makefile.in b/build/Makefile.in index 09fc2cc3cb5..f012ef7a650 100644 --- a/build/Makefile.in +++ b/build/Makefile.in @@ -135,6 +135,7 @@ CHEATS_PIR = \ src/cheats/fail.pir \ src/cheats/object.pir \ src/cheats/postcircumfix-array.pir \ + src/cheats/postcircumfix-hash.pir \ src/cheats/int-ops.pir \ src/cheats/num-ops.pir \ src/cheats/str-ops.pir \ @@ -173,6 +174,8 @@ CORE_SOURCES = \ src/core/Pair.pm \ src/core/Range.pm \ src/core/RangeIter.pm \ + src/core/EnumMap.pm \ + src/core/Hash.pm \ src/core/IO.pm \ src/core/Parameter.pm \ src/core/Block.pm \ diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm index df3afc4dbe7..3d61b2536e3 100644 --- a/src/Perl6/Actions.pm +++ b/src/Perl6/Actions.pm @@ -1492,15 +1492,13 @@ method postcircumfix:sym<[ ]>($/) { } method postcircumfix:sym<{ }>($/) { - make PAST::Var.new( $.ast , :scope('keyed'), - :viviself('Undef'), - :vivibase('Hash') ); + make PAST::Op.new( $.ast, :name('!postcircumfix:<{ }>'), + :pasttype('call'), :node($/) ); } method postcircumfix:sym($/) { - make PAST::Var.new( $.ast, :scope('keyed'), - :viviself('Undef'), - :vivibase('Hash') ); + make PAST::Op.new( $.ast, :name('!postcircumfix:<{ }>'), + :pasttype('call'), :node($/) ); } method postcircumfix:sym<( )>($/) { diff --git a/src/binder/bind.c b/src/binder/bind.c index e7eda99e52a..478fb0e9585 100644 --- a/src/binder/bind.c +++ b/src/binder/bind.c @@ -14,9 +14,6 @@ Copyright (C) 2009, The Perl Foundation. /* Cache of the type ID for low level signatures. */ static INTVAL lls_id = 0; -/* Names of types we create. */ -#define PERL6_HASH "Hash" - /* Unwraps things inside a scalar reference. */ static PMC * descalarref(PARROT_INTERP, PMC *ref) { @@ -40,6 +37,17 @@ Rakudo_binding_create_array(PARROT_INTERP) { } +/* Creates a Perl 6 Hash. */ +static PMC * +Rakudo_binding_create_hash(PARROT_INTERP, PMC *storage) { + PMC *ns = Parrot_get_ctx_HLL_namespace(interp); + PMC *creator = Parrot_get_global(interp, ns, string_from_literal(interp, "&CREATE_HASH_LOW_LEVEL")); + PMC *result = PMCNULL; + Parrot_ext_call(interp, creator, "P->P", storage, &result); + return result; +} + + /* Creates a Perl 6 object of the type given by C */ static PMC * Rakudo_binding_create(PARROT_INTERP, STRING *classname) { @@ -253,7 +261,7 @@ Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, llsig_element *sig_inf } else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) { STRING *STORE = string_from_literal(interp, "!STORE"); - copy = pmc_new(interp, pmc_type(interp, string_from_literal(interp, PERL6_HASH))); + copy = Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash)); store_meth = VTABLE_find_method(interp, copy, STORE); Parrot_ext_call(interp, store_meth, "PiP", copy, value); VTABLE_setprop(interp, copy, string_from_literal(interp, "flatten"), copy); @@ -372,7 +380,7 @@ Rakudo_binding_handle_optional(PARROT_INTERP, llsig_element *sig_info, PMC *lexp return Rakudo_binding_create_array(interp); } else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) { - return pmc_new(interp, pmc_type(interp, string_from_literal(interp, PERL6_HASH))); + return Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash)); } else { return pmc_new(interp, pmc_type(interp, string_from_literal(interp, "Perl6Scalar"))); @@ -479,7 +487,7 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad, PMC *signature, * be wanting to bind positionally. */ if (!PMC_IS_NULL(named_names)) { PMC *iter = VTABLE_get_iter(interp, named_names); - named_args_copy = pmc_new(interp, pmc_type(interp, string_from_literal(interp, PERL6_HASH))); + named_args_copy = pmc_new(interp, enum_class_Hash); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); if (VTABLE_exists_keyed_str(interp, named_to_pos_cache, name)) { @@ -519,10 +527,10 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad, PMC *signature, * will by definition contain all unbound named parameters and use * that, or just create an empty one. */ PMC *slurpy = PMC_IS_NULL(named_args_copy) ? - pmc_new(interp, pmc_type(interp, string_from_literal(interp, PERL6_HASH))) : + pmc_new(interp, enum_class_Hash) : named_args_copy; bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i], - slurpy, no_nom_type_check, error); + Rakudo_binding_create_hash(interp, slurpy), no_nom_type_check, error); if (bind_fail) { if (pos_from_named) mem_sys_free(pos_from_named); diff --git a/src/builtins/Role.pir b/src/builtins/Role.pir index 3952fa3c58b..e720153ee1f 100644 --- a/src/builtins/Role.pir +++ b/src/builtins/Role.pir @@ -272,13 +272,13 @@ just here so postcircumfix:[ ] doesn't explode). .param pmc role .param pmc pos_args :slurpy .param pmc named_args :slurpy :named + $P0 = interpinfo .INTERPINFO_CURRENT_SUB + $P0 = getprop 'name', $P0 + $S0 = $P0 $I0 = isa role, 'P6role' if $I0 goto already_selected role = role.'!select'() already_selected: - $P0 = interpinfo .INTERPINFO_CURRENT_SUB - $P0 = getprop 'name', $P0 - $S0 = $P0 $P0 = role.'!pun'() .tailcall $P0.$S0(pos_args :flat, named_args :flat :named) .end diff --git a/src/cheats/postcircumfix-hash.pir b/src/cheats/postcircumfix-hash.pir new file mode 100644 index 00000000000..220deb605cb --- /dev/null +++ b/src/cheats/postcircumfix-hash.pir @@ -0,0 +1,25 @@ +=item !postcircumfix:<{ }> + +Because foreign (non-Rakudo) Parrot objects generally won't +understand the "postcircumfix:<{ }>" method, we generate +postcircumfix as a private call to this function, and this +function then delegates to the appropriate method. For PMCs +that don't have a postcircumfix:<{ }> method, we'll have to +fake it later. + +=cut + +.namespace [] +.sub '!postcircumfix:<{ }>' + .param pmc invocant + .param pmc args :slurpy + $I0 = can invocant, 'postcircumfix:<{ }>' + if $I0 goto object_method + $I0 = isa invocant, 'Mu' + if $I0 goto object_method + foreign: + die "Can't postcircumfix:<{ }> foreign objects yet." + object_method: + .tailcall invocant.'postcircumfix:<{ }>'(args :flat) +.end + diff --git a/src/core/EnumMap.pm b/src/core/EnumMap.pm new file mode 100644 index 00000000000..6a3e0765b24 --- /dev/null +++ b/src/core/EnumMap.pm @@ -0,0 +1,22 @@ +role EnumMap { + has $!storage; + + method new(*%values) { + self.bless(*, storage => pir::getattribute__PPs(%values, '$!storage')); + } + + method postcircumfix:<{ }>($key) { + Q:PIR { + .local pmc self + self = find_lex 'self' + $P0 = getattribute self, '$!storage' + $P1 = find_lex '$key' + %r = $P0[$P1] + unless null %r goto done + %r = new ['Proxy'] + setattribute %r, '$!base', $P0 + setattribute %r, '$!key', $P1 + done: + } + } +} diff --git a/src/core/Hash.pm b/src/core/Hash.pm new file mode 100644 index 00000000000..8870bdc177b --- /dev/null +++ b/src/core/Hash.pm @@ -0,0 +1,18 @@ +role Hash is EnumMap { + method postcircumfix:<{ }>($key) { + Q:PIR { + .local pmc self + self = find_lex 'self' + $P0 = getattribute self, '$!storage' + $P1 = find_lex '$key' + %r = $P0[$P1] + unless null %r goto done + %r = new ['Proxy'] + setattribute %r, '$!base', $P0 + setattribute %r, '$!key', $P1 + $P2 = get_hll_global ['Bool'], 'True' + setprop %r, 'rw', $P2 + done: + } + } +} diff --git a/src/glue/types.pir b/src/glue/types.pir index 7c3a9366c7b..d3ab411d982 100644 --- a/src/glue/types.pir +++ b/src/glue/types.pir @@ -55,6 +55,17 @@ subtyping relations, etc). .return (1) .end + +.sub '&CREATE_HASH_LOW_LEVEL' + .param pmc storage + $P0 = get_hll_global 'Hash' + $P0 = $P0.'!select'() + $P0 = $P0.'!pun'() + $P1 = $P0.'CREATE'() + $P0 = $P0.'bless'($P1, 'storage'=>storage) + .return ($P0) +.end + =back =cut