Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Rewrite List.{pop,push,shift,unshift} at the C# level
  • Loading branch information
@sorear
sorear committed May 30, 2011
1 parent 94d21c4 commit 0571dfc
Show file tree
Hide file tree
Showing 3 changed files with 133 additions and 60 deletions.
86 changes: 27 additions & 59 deletions lib/CORE.setting
View file
Expand Up @@ -594,13 +594,13 @@ my class Parcel is Cool {
method perl(\$self:) {
$self // return $self.typename;
my @tok;
@tok.push('$') if !$self.flattens;
@tok.push('(');
push @tok, '$' if !$self.flattens;
push @tok, '(';
loop (my $i = 0; $i < $self.elems; $i++) {
@tok.push(Q:CgOp { (fvarlist_item (cast int (obj_getnum {$i})) (unbox fvarlist (@ {$self}))) }.perl);
@tok.push(', ') unless $i == $self.elems - 1 && $i;
push @tok, Q:CgOp { (fvarlist_item (cast int (obj_getnum {$i})) (unbox fvarlist (@ {$self}))) }.perl;
push @tok, ', ' unless $i == $self.elems - 1 && $i;
}
@tok.push(')');
push @tok, ')';
@tok.join;
}
Expand Down Expand Up @@ -655,30 +655,14 @@ my class List is Cool {
method perl(\$self:) {
$self // return $self.typename;
my @tok;
@tok.push('(');
@tok.push(.perl, ', ') for @$self;
@tok.pop if @tok >= 5;
@tok.push(').list');
@tok.push('.item') if !$self.flattens;
push @tok, '(';
push @tok, .perl, ', ' for @$self;
pop @tok if @tok >= 5;
push @tok, ').list';
push @tok, '.item' if !$self.flattens;
@tok.join
}

method !shift-item() { Q:CgOp {
(vvarlist_shift (getslot items vvarlist (@ {self})))
} }
method !pop-item() { Q:CgOp {
(vvarlist_pop (getslot items vvarlist (@ {self})))
} }

method !unshift-item(\$x) { Q:CgOp {
(rnull (vvarlist_unshift (getslot items vvarlist (@ {self})) {$x}))
} }
method shift() { self ?? self!shift-item !! Any }
method pop() { (+self) ?? self!pop-item !! Any }
method eager() { +self; self }

method head() { self ??
Expand Down Expand Up @@ -719,22 +703,6 @@ my class List is Cool {
}
}

method push(\|$args) { Q:CgOp {
(letn iter (vvarlist_from_fvarlist (unbox fvarlist (@ {$args})))
targ (getslot rest vvarlist (@ {self}))
(sink (vvarlist_shift (l iter)))
(ternary (== (i 0) (vvarlist_count (l targ)))
(l targ (getslot items vvarlist (@ {self})))
(prog))
(whileloop 0 0 (iter_hasflat (l iter))
(vvarlist_push (l targ) (nsw (@ (vvarlist_shift (l iter))))))
{Nil})
} }
method unshift(*@a) {
for reverse(@a) -> $v { self!unshift-item(anon $new = $v) }
}
method kv() { my $i = 0; self.map({ $i++, $_ }) }
}

Expand Down Expand Up @@ -862,7 +830,7 @@ sub infix:<< => >>($k, Mu $v) { $k => $v }

sub reverse(*@array) {
my @acc;
while @array { @acc.push(@array.pop) }
push @acc, pop(@array) while @array;
@acc;
}

Expand Down Expand Up @@ -932,24 +900,24 @@ sub reduceop($triangle, $list, $right, $chain, $func, *@items) {
elsif $right {
gather {
while @items >= 2 {
my Mu $right ::= @items.pop;
my Mu $right ::= pop @items;
take $right;
my Mu $left = @items.pop;
@items.push($func($left,$right));
my Mu $left = pop @items;
push @items, $func($left,$right);
}
if @items {
my Mu $last ::= @items.shift;
my Mu $last ::= shift @items;
take $last;
}
}
}
else { # left assoc
gather {
if @items {
my Mu $cumu ::= @items.shift;
my Mu $cumu ::= shift @items;
take $cumu;
while @items {
my Mu $new ::= ($cumu ::= $func($cumu, @items.shift));
my Mu $new ::= ($cumu ::= $func($cumu, shift @items));
take $new;
}
}
Expand All @@ -970,17 +938,17 @@ sub reduceop($triangle, $list, $right, $chain, $func, *@items) {
}
elsif $right {
while @items >= 2 {
my Mu $r = @items.pop;
my Mu $l = @items.pop;
@items.push($func($l,$r));
my Mu $r = pop @items;
my Mu $l = pop @items;
push @items, $func($l,$r);
}
@items ?? @items[0] !! 0; # XXX identity
}
else { # left
while @items >= 2 {
my Mu $l = @items.shift;
my Mu $r = @items.shift;
@items.unshift($func($l,$r));
my Mu $l = shift @items;
my Mu $r = shift @items;
unshift @items, $func($l,$r);
}
@items ?? @items[0] !! 0; # XXX identity
}
Expand Down Expand Up @@ -1231,12 +1199,12 @@ sub hyperunary(&fun, \$obj) {
}
when 2 {
my @out;
@out.push: $( hyperunary(&fun, $_) ) for $obj.list;
push @out, $( hyperunary(&fun, $_) ) for @$obj;
return @out;
}
when 3 {
my @out;
@out.push: $( hyperunary(&fun, $_) ) for $obj.list;
push @out, $( hyperunary(&fun, $_) ) for @$obj;
return $obj.new(@out);
}
when 0 {
Expand Down Expand Up @@ -1283,7 +1251,7 @@ sub _hyper_posi($dwiml, $dwimr, $fun, $left, $right) {
die "Ran off end of non-dwimmy right" if $rend && !$dwiml && !$dwimr;
last if $lend && !$dwiml;
last if $rend && !$dwimr;
@out.push: $( hyper($dwiml, $dwimr, $fun, $lv, $rv) );
push @out, $( hyper($dwiml, $dwimr, $fun, $lv, $rv) );
$ix++;
}
@out;
Expand Down Expand Up @@ -1396,7 +1364,7 @@ my class IO {
method combine(*@paths) {
die "Sorry, paths do not form a monoid." unless @paths;
my $acc = @paths.shift.IO;
my $acc = shift(@paths).IO;
for @paths { $acc = $acc.append($_) }
$acc
}
Expand Down
88 changes: 88 additions & 0 deletions lib/Kernel.cs
View file
Expand Up @@ -1256,6 +1256,18 @@ class InvokeCallMethod : InvokeHandler {
}
}

class PushyCallMethod : PushyHandler {
string method;
public PushyCallMethod(string method) { this.method = method; }

public override Variable Invoke(Variable obj, Variable[] args) {
Variable[] rargs = new Variable[args.Length + 1];
Array.Copy(args, 0, rargs, 1, args.Length);
rargs[0] = obj;
return Kernel.RunInferior(obj.Fetch().InvokeMethod(Kernel.GetInferiorRoot(), method, rargs, null));
}
}

class CtxCallMethodUnbox<T> : ContextHandler<T> {
string method;
public CtxCallMethodUnbox(string method) { this.method = method; }
Expand Down Expand Up @@ -1465,6 +1477,58 @@ class CtxListIterator : ContextHandler<VarDeque> {
}
}

class PopList : ContextHandler<Variable> {
public override Variable Get(Variable v) {
P6any o = v.Fetch();
if (!o.IsDefined()) return Kernel.AnyMO.typeVar;
VarDeque items = (VarDeque)o.GetSlot("items");
VarDeque rest = (VarDeque)o.GetSlot("rest");
while (Kernel.IterHasFlat(rest, false))
items.Push(rest.Shift());
return (items.Count() != 0) ? items.Pop() : Kernel.AnyMO.typeVar;
}
}
class ShiftList : ContextHandler<Variable> {
public override Variable Get(Variable v) {
P6any o = v.Fetch();
if (!o.IsDefined()) return Kernel.AnyMO.typeVar;
VarDeque items = (VarDeque)o.GetSlot("items");
VarDeque rest = (VarDeque)o.GetSlot("rest");
if (items.Count() != 0)
return items.Shift();
if (Kernel.IterHasFlat(rest, false))
return rest.Shift();
return Kernel.AnyMO.typeVar;
}
}
class UnshiftList : PushyHandler {
public override Variable Invoke(Variable v, Variable[] args) {
P6any o = v.Fetch();
if (!o.IsDefined())
throw new NieczaException("Cannot push onto type object");
VarDeque iter = new VarDeque(args);
VarDeque targ = (VarDeque)o.GetSlot("items");
VarDeque st = new VarDeque();
while (Kernel.IterHasFlat(iter, true))
st.Push(Kernel.NewRWScalar(Kernel.AnyMO, iter.Shift().Fetch()));
targ.UnshiftD(st);
return v;
}
}
class PushList : PushyHandler {
public override Variable Invoke(Variable v, Variable[] args) {
P6any o = v.Fetch();
if (!o.IsDefined())
throw new NieczaException("Cannot push onto type object");
VarDeque iter = new VarDeque(args);
VarDeque targ = (VarDeque)o.GetSlot("rest");
if (targ.Count() == 0) targ = (VarDeque)o.GetSlot("items");
while (Kernel.IterHasFlat(iter, true))
targ.Push(Kernel.NewRWScalar(Kernel.AnyMO, iter.Shift().Fetch()));
return v;
}
}

class IxHashLISTSTORE : IndexHandler {
public override Variable Get(Variable lhs, Variable rhs) {
P6any lhs_o = lhs.Fetch();
Expand Down Expand Up @@ -2824,6 +2888,26 @@ public class MMDCandidateLongname {
kl.AddMethod(0, name, MakeSub(si, null));
}

private static void WrapPushy(STable kl, string name,
PushyHandler cv) {
DynBlockDelegate dbd = delegate (Frame th) {
Variable[] fullpc = UnboxAny<Variable[]>(
((Variable)th.lex1).Fetch());
Variable[] chop = new Variable[fullpc.Length - 1];
Array.Copy(fullpc, 1, chop, 0, chop.Length);
th.caller.resultSlot = cv.Invoke((Variable)th.lex0, chop);
return th.caller;
};
SubInfo si = new SubInfo("KERNEL " + kl.name + "." + name, dbd);
si.sig_i = new int[6] {
SubInfo.SIG_F_RWTRANS | SubInfo.SIG_F_POSITIONAL, 0, 0,
SubInfo.SIG_F_RWTRANS | SubInfo.SIG_F_SLURPY_PCL, 1, 0
};
si.sig_r = new object[2] { "self", "$args" };
si.param1 = cv;
kl.AddMethod(0, name, MakeSub(si, null));
}

private static SubInfo IRSI = new SubInfo("InstantiateRole", IRC);
private static Frame IRC(Frame th) {
switch (th.ip) {
Expand Down Expand Up @@ -3195,6 +3279,10 @@ class LastFrameNode {

ListMO = new STable("List");
WrapHandler1(ListMO, "at-pos", new IxListAtPos(false));
Handler_Vonly(ListMO, "pop", new PopList(), null);
Handler_Vonly(ListMO, "shift", new ShiftList(), null);
WrapPushy(ListMO, "push", new PushList());
WrapPushy(ListMO, "unshift", new UnshiftList());
Handler_PandBox(ListMO, "iterator", new CtxListIterator(),
IteratorMO);
Handler_PandBox(ListMO, "Bool", new CtxListBool(), BoolMO);
Expand Down
19 changes: 18 additions & 1 deletion lib/ObjModel.cs
View file
Expand Up @@ -68,6 +68,9 @@ public abstract class ContextHandler<T> {
public abstract class InvokeHandler {
public abstract Frame Invoke(P6any obj, Frame th, Variable[] pos, VarHash named);
}
public abstract class PushyHandler {
public abstract Variable Invoke(Variable obj, Variable[] args);
}

public abstract class IndexHandler {
public abstract Variable Get(Variable obj, Variable key);
Expand Down Expand Up @@ -429,6 +432,10 @@ public class STable {
= new CtxCallMethod("list");
public static readonly ContextHandler<Variable> CallHash
= new CtxCallMethod("hash");
public static readonly ContextHandler<Variable> CallShift
= new CtxCallMethod("shift");
public static readonly ContextHandler<Variable> CallPop
= new CtxCallMethod("pop");
public static readonly ContextHandler<P6any> CallPred
= new CtxCallMethodFetch("pred");
public static readonly ContextHandler<P6any> CallSucc
Expand Down Expand Up @@ -458,6 +465,10 @@ public class STable {
= new IxCallMethod("LISTSTORE");
public static readonly InvokeHandler CallINVOKE
= new InvokeCallMethod();
public static readonly PushyHandler CallPush
= new PushyCallMethod("push");
public static readonly PushyHandler CallUnshift
= new PushyCallMethod("unshift");

public P6how mo;

Expand All @@ -470,7 +481,8 @@ public class STable {
public LexerCache lexcache;

public ContextHandler<Variable> mro_Str, mro_Numeric, mro_Bool,
mro_defined, mro_iterator, mro_item, mro_list, mro_hash;
mro_defined, mro_iterator, mro_item, mro_list, mro_hash,
mro_shift, mro_pop;
public ContextHandler<P6any> mro_pred, mro_succ;
public ContextHandler<bool> mro_raw_Bool, mro_raw_defined;
public ContextHandler<string> mro_raw_Str;
Expand All @@ -482,6 +494,7 @@ public class STable {
mro_delete_key, mro_LISTSTORE;

public InvokeHandler mro_INVOKE;
public PushyHandler mro_push, mro_unshift;

public Dictionary<string, DispatchEnt> mro_methods;
public Dictionary<string, P6any> private_mro;
Expand Down Expand Up @@ -510,6 +523,10 @@ public class STable {
}

internal void SetupVTables() {
mro_push = _GetVT("push") as PushyHandler ?? CallPush;
mro_unshift = _GetVT("unshift") as PushyHandler ?? CallUnshift;
mro_shift = _GetVT("shift") as ContextHandler<Variable> ?? CallShift;
mro_pop = _GetVT("pop") as ContextHandler<Variable> ?? CallPop;
mro_at_key = _GetVT("at-key") as IndexHandler ?? CallAtKey;
mro_at_pos = _GetVT("at-pos") as IndexHandler ?? CallAtPos;
mro_LISTSTORE = _GetVT("LISTSTORE") as IndexHandler ?? CallLISTSTORE;
Expand Down

0 comments on commit 0571dfc

Please sign in to comment.