Skip to content
Permalink
Browse files

Allow parameterization of Bag/BagHash

  • Loading branch information...
lizmat committed Jan 14, 2019
1 parent 9b77459 commit fe38bdba62e90e5bd23a15b3d5b8c4d2aa9b5f4c
Showing with 114 additions and 75 deletions.
  1. +11 −4 src/core/Bag.pm6
  2. +23 −17 src/core/BagHash.pm6
  3. +27 −20 src/core/Baggy.pm6
  4. +4 −4 src/core/Iterable.pm6
  5. +45 −28 src/core/Rakudo/QuantHash.pm6
  6. +4 −2 src/core/set_addition.pm6
@@ -2,6 +2,10 @@ my class Bag does Baggy {
has ValueObjAt $!WHICH;
has Int $!total;

method ^parameterize(Mu \base, Mu \type) {
Rakudo::Internals.PARAMETERIZE-KEYOF(base,type)
}

#--- introspection methods
multi method WHICH(Bag:D: --> ValueObjAt:D) {
nqp::if(
@@ -34,18 +38,21 @@ my class Bag does Baggy {

#--- interface methods
multi method STORE(Bag:D: *@pairs, :$INITIALIZE! --> Bag:D) {
(my $iterator := @pairs.iterator).is-lazy
(my \iterator := @pairs.iterator).is-lazy
?? Failure.new(
X::Cannot::Lazy.new(:action<initialize>,:what(self.^name)))
X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))
)
!! self.SET-SELF(Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet), $iterator))
nqp::create(Rakudo::Internals::IterationSet),iterator,self.keyof
))
}
multi method STORE(Bag:D: \objects, \values, :$INITIALIZE! --> Bag:D) {
self.SET-SELF(
Rakudo::QuantHash.ADD-OBJECTS-VALUES-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet),
objects.iterator,
values.iterator
values.iterator,
self.keyof
)
)
}
@@ -1,13 +1,19 @@
my class BagHash does Baggy {

method ^parameterize(Mu \base, Mu \type) {
Rakudo::Internals.PARAMETERIZE-KEYOF(base,type)
}

#--- interface methods
multi method STORE(BagHash:D: *@pairs --> BagHash:D) {
nqp::if(
(my $iterator := @pairs.iterator).is-lazy,
Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
(my \iterator := @pairs.iterator).is-lazy,
Failure.new(
X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))
),
self.SET-SELF(
Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet), $iterator
nqp::create(Rakudo::Internals::IterationSet),iterator,self.keyof
)
)
)
@@ -17,17 +23,19 @@ my class BagHash does Baggy {
Rakudo::QuantHash.ADD-OBJECTS-VALUES-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet),
objects.iterator,
values.iterator
values.iterator,
self.keyof
)
)
}
multi method AT-KEY(BagHash:D: \k) is raw {
my \type := self.keyof;
Proxy.new(
FETCH => {
nqp::if(
$!elems && nqp::existskey($!elems,(my $which := k.WHICH)),
nqp::istrue($!elems)
&& nqp::existskey($!elems,(my $which := k.WHICH)),
nqp::getattr(nqp::atkey($!elems,$which),Pair,'$!value'),
0
)
},
STORE => -> $, Int() $value {
@@ -53,20 +61,18 @@ my class BagHash does Baggy {
),
nqp::if(
$value > 0, # new
nqp::bindkey(
$!elems,
$which,
Pair.new(k,nqp::decont($value))
Rakudo::QuantHash.BIND-TO-TYPED-BAG(
$!elems, $which, k, nqp::decont($value), type
)
)
),
nqp::if( # no hash allocated yet
$value > 0,
nqp::bindkey(
nqp::bindattr(self,::?CLASS,'$!elems',
nqp::create(Rakudo::Internals::IterationSet)),
k.WHICH,
Pair.new(k,nqp::decont($value))
Rakudo::QuantHash.BIND-TO-TYPED-BAG(
nqp::bindattr(self,BagHash,'$!elems',
nqp::create(Rakudo::Internals::IterationSet)
),
k.WHICH, k, nqp::decont($value), type
)
)
)
@@ -118,8 +124,8 @@ my class BagHash does Baggy {
method clone() {
nqp::if(
$!elems && nqp::elems($!elems),
nqp::create(BagHash).SET-SELF(Rakudo::QuantHash.BAGGY-CLONE($!elems)),
nqp::create(BagHash)
nqp::create(self).SET-SELF(Rakudo::QuantHash.BAGGY-CLONE($!elems)),
nqp::create(self)
)
}

@@ -93,14 +93,14 @@ my role Baggy does QuantHash {

#--- object creation methods

# helper sub to create Bag from iterator, check for laziness
sub create-from-iterator(\type, \iterator --> Baggy:D) {
# helper method to create Bag from iterator, check for laziness
method !create-from-iterator(\type, \iterator --> Baggy:D) {
nqp::if(
iterator.is-lazy,
Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what(type.^name))),
nqp::create(type).SET-SELF(
Rakudo::QuantHash.ADD-ITERATOR-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet), iterator
nqp::create(Rakudo::Internals::IterationSet),iterator,self.keyof
)
)
)
@@ -110,7 +110,7 @@ my role Baggy does QuantHash {
multi method new(Baggy:_: \value --> Baggy:D) {
nqp::if(
nqp::istype(value,Iterable) && nqp::not_i(nqp::iscont(value)),
create-from-iterator(self, value.iterator),
self!create-from-iterator(self, value.iterator),
nqp::stmts(
nqp::bindkey(
(my $elems := nqp::create(Rakudo::Internals::IterationSet)),
@@ -122,7 +122,7 @@ my role Baggy does QuantHash {
)
}
multi method new(Baggy:_: **@args) {
create-from-iterator(self, @args.iterator)
self!create-from-iterator(self, @args.iterator)
}

method new-from-pairs(Baggy:_: *@pairs --> Baggy:D) {
@@ -131,7 +131,7 @@ my role Baggy does QuantHash {
Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what(self.^name))),
nqp::create(self).SET-SELF(
Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet),iterator
nqp::create(Rakudo::Internals::IterationSet),iterator,self.keyof
)
)
)
@@ -330,22 +330,29 @@ my role Baggy does QuantHash {
multi method perl(Baggy:D: --> Str:D) {
nqp::if(
$!elems && nqp::elems($!elems),
nqp::concat(
nqp::concat(
'(',
nqp::join(',',
Rakudo::QuantHash.RAW-VALUES-MAP(self, {
nqp::stmts(
(my \pairs := nqp::join(',',
Rakudo::QuantHash.RAW-VALUES-MAP(self, {
nqp::concat(
nqp::concat(
nqp::concat(
nqp::getattr($_,Pair,'$!key').perl,
'=>'
),
nqp::getattr($_,Pair,'$!value').perl
)
})
nqp::getattr($_,Pair,'$!key').perl,
'=>'
),
nqp::getattr($_,Pair,'$!value').perl
)
})
)),
nqp::if(
nqp::eqaddr(self.keyof,Mu),
nqp::concat(
nqp::concat('(',pairs),
nqp::concat(').',self.^name)
),
nqp::concat(
nqp::concat(self.^name,'.new-from-pairs('),
nqp::concat(pairs,')')
)
),
nqp::concat(').',self.^name)
)
),
nqp::if(
nqp::eqaddr(self,bag()),
@@ -157,13 +157,13 @@ my role Iterable {

sub BAGGIFY(\iterable, \type) {
nqp::if(
(my $iterator := iterable.flat.iterator).is-lazy,
(my \iterator := iterable.flat.iterator).is-lazy,
Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what(type.^name))),
nqp::if(
nqp::elems(my $elems := Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet),$iterator
nqp::elems(my \elems := Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet),iterator,Mu
)),
nqp::create(type).SET-SELF($elems),
nqp::create(type).SET-SELF(elems),
nqp::if(
nqp::eqaddr(type,Bag),
bag(),
@@ -600,22 +600,37 @@ my class Rakudo::QuantHash {
)
}

method ADD-ITERATOR-TO-BAG(\elems,Mu \iterator) {
# bind the given which/object/value to the given IterationSet,
# check object for given type
method BIND-TO-TYPED-BAG(
\elems, Mu \which, Mu \object, Int:D \value, Mu \type
--> Nil) {
nqp::if(
nqp::istype(object,type),
nqp::bindkey(elems,which,Pair.new(object,value)),
X::TypeCheck::Binding.new(
got => object.WHAT,
expected => type
).throw
)
}

method ADD-ITERATOR-TO-BAG(\elems, Mu \iterator, Mu \type) {
nqp::stmts(
nqp::until(
nqp::eqaddr(
(my $pulled := nqp::decont(iterator.pull-one)),
(my \pulled := nqp::decont(iterator.pull-one)),
IterationEnd
),
nqp::if(
nqp::existskey(elems,(my $WHICH := $pulled.WHICH)),
nqp::existskey(elems,(my \which := pulled.WHICH)),
nqp::stmts(
(my $pair := nqp::atkey(elems,$WHICH)),
nqp::bindattr($pair,Pair,'$!value',
nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1)
(my \pair := nqp::atkey(elems,which)),
nqp::bindattr(pair,Pair,'$!value',
nqp::add_i(nqp::getattr(pair,Pair,'$!value'),1)
)
),
nqp::bindkey(elems,$WHICH,Pair.new($pulled,1))
self.BIND-TO-TYPED-BAG(elems, which, pulled, 1, type)
)
),
elems
@@ -775,7 +790,7 @@ my class Rakudo::QuantHash {

# Add to given IterationSet with baggy semantics the values of the given
# iterator while checking for Pairs with numeric values.
method ADD-PAIRS-TO-BAG(\elems,Mu \iterator) {
method ADD-PAIRS-TO-BAG(\elems, Mu \iterator, Mu \type) {
nqp::stmts(
nqp::until(
nqp::eqaddr(
@@ -806,15 +821,12 @@ my class Rakudo::QuantHash {
nqp::getattr($pair,Pair,'$!value') + $value
)
),
nqp::bindkey( # new, create new Pair
self.BIND-TO-TYPED-BAG( # new, create new Pair
elems,
$which,
nqp::p6bindattrinvres(
nqp::clone($pulled),
Pair,
'$!value',
$value
)
nqp::getattr($pulled,Pair,'$!key'),
$value,
type
)
)
),
@@ -834,8 +846,9 @@ my class Rakudo::QuantHash {
nqp::getattr($pair,Pair,'$!value') + 1
)
),
nqp::bindkey( # new, create new Pair
elems,$which,Pair.new($pulled,1))
self.BIND-TO-TYPED-BAG( # new, create new Pair
elems, $which, $pulled, 1, type
)
)
)
),
@@ -846,37 +859,41 @@ my class Rakudo::QuantHash {
# Add to given IterationSet with baggy semantics the values of the two
# given iterators where the first iterator supplies objects, and the
# second supplies values.
method ADD-OBJECTS-VALUES-TO-BAG(\elems,Mu \objects, Mu \values) is raw {
method ADD-OBJECTS-VALUES-TO-BAG(
\elems, Mu \objects, Mu \values, Mu \type
) is raw {
nqp::until(
nqp::eqaddr((my \object := objects.pull-one),IterationEnd),
nqp::if(
(my \value := values.pull-one.Int) > 0,
nqp::bindkey(elems,object.WHICH,Pair.new(object,value))
self.BIND-TO-TYPED-BAG( # new, create new Pair
elems, object.WHICH, object, value, type
)
)
);
elems
}

# Take the given IterationSet with baggy semantics, and add the other
# IterationSet with setty semantics to it. Return the given IterationSet.
method ADD-SET-TO-BAG(\elems,Mu \set) {
method ADD-SET-TO-BAG(\elems, Mu \set) {
nqp::stmts(
nqp::if(
set && nqp::elems(set),
nqp::stmts(
(my $iter := nqp::iterator(set)),
(my \iter := nqp::iterator(set)),
nqp::while(
$iter,
iter,
nqp::if(
nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
nqp::existskey(elems,nqp::iterkey_s(nqp::shift(iter))),
nqp::stmts(
(my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
nqp::bindattr($pair,Pair,'$!value',
nqp::getattr($pair,Pair,'$!value') + 1
(my \pair := nqp::atkey(elems,nqp::iterkey_s(iter))),
nqp::bindattr(pair,Pair,'$!value',
nqp::getattr(pair,Pair,'$!value') + 1
)
),
nqp::bindkey(elems,nqp::iterkey_s($iter),
Pair.new(nqp::iterval($iter), 1)
nqp::bindkey(elems,nqp::iterkey_s(iter),
Pair.new(nqp::iterval(iter), 1)
)
)
)
@@ -133,9 +133,11 @@ multi sub infix:<(+)>(Iterable:D $a, Iterable:D $b) {
Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
nqp::create(Rakudo::Internals::IterationSet),
$a.iterator
$a.iterator,
Mu
),
$b.iterator
$b.iterator,
Mu
)
)
}

0 comments on commit fe38bdb

Please sign in to comment.
You can’t perform that action at this time.