Skip to content

Commit

Permalink
Now also specify the types for Perl 6 accesses
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Jan 11, 2012
1 parent 67bd4e6 commit 0c7c992
Show file tree
Hide file tree
Showing 6 changed files with 55 additions and 45 deletions.
4 changes: 2 additions & 2 deletions docs/nam.pod
View file
Original file line number Diff line number Diff line change
Expand Up @@ -858,7 +858,7 @@ Returns the raw C<stab> for a class, by CORE:: name or xref node fields.

Implements Mu.new.

=head3 getslot($name,$type,$object)
=head3 getslot($scope,$name,$type,$object)

Fetches a named slot from an object. C<$type> must be used consistantly.

Expand Down Expand Up @@ -898,7 +898,7 @@ Implements the but operator for type objects.

Mutates a boxed value in place. Use carefully!

=head3 setslot($name, obj $obj, ::T $value)
=head3 setslot($scope, $name, obj $obj, ::T $value)

Binds a slot, possibly to a native value.

Expand Down
58 changes: 29 additions & 29 deletions lib/CORE.setting
View file
Original file line number Diff line number Diff line change
Expand Up @@ -626,7 +626,7 @@ my class Capture does Positional does Associative {
has $!named;
method Parcel() {
Q:CgOp { (box Parcel (getslot positionals fvarlist (@ {self}))) }
Q:CgOp { (box Parcel (getslot Capture positionals fvarlist (@ {self}))) }
}
method perl() {
self // return self.typename;
Expand All @@ -650,7 +650,7 @@ my class Capture does Positional does Associative {
}
method list () { @(self.Parcel) }
method hash () { unitem( Q:CgOp {
(letn h (getslot named varhash (@ {self}))
(letn h (getslot Capture named varhash (@ {self}))
(ternary (== (l h) (null varhash)) {{}} (box Hash (l h))))
}) }
}
Expand Down Expand Up @@ -838,7 +838,7 @@ my class Code does Callable {
has $!outer;
has $!info;

method outer() { Q:CgOp { (ns (getslot outer frame (@ {self}))) } }
method outer() { Q:CgOp { (ns (getslot Code outer frame (@ {self}))) } }
method perl() { defined(self) ?? '{ ... }' !! self.typename }
}
Expand Down Expand Up @@ -916,15 +916,15 @@ my class IntBasedEnum is CommonEnum {
method Stringy() { defined(self) ?? self.key !! nextsame }
method _create($ix,$val) { Q:CgOp {
(letn obj (box (@ {self}) (unbox int (@ {$val.Int})))
(setslot index (@ (l obj)) {$ix.Int})
(setslot CommonEnum index (@ (l obj)) {$ix.Int})
(l obj))
} }
}
my class StrBasedEnum is CommonEnum {
method _create($ix,$val) { Q:CgOp {
(letn obj (box (@ {self}) (unbox str (@ {$val.Str})))
(setslot index (@ (l obj)) {$ix.Int})
(setslot CommonEnum index (@ (l obj)) {$ix.Int})
(l obj))
} }
}
Expand Down Expand Up @@ -1111,8 +1111,8 @@ sub _lexotic ($id, $x, \$val) {
nm (null str)
id (@ {$x})
(ternary (obj_isa (l id) (class_ref mo Label))
(prog (l fr (getslot target frame (l id)))
(l nm (getslot name str (l id))))
(prog (l fr (getslot Label target frame (l id)))
(l nm (getslot Label name str (l id))))
(ternary (obj_isa (l id) (class_ref mo Str))
(l nm (obj_getstr {$x}))
(prog)))
Expand Down Expand Up @@ -1221,7 +1221,7 @@ my class Parcel is Cool does Positional {
method Capture () {
Q:CgOp {
(letn n (obj_newblank (obj_llhow (@ {Capture})))
(setslot positionals (l n) (unbox fvarlist (@ {self})))
(setslot Capture positionals (l n) (unbox fvarlist (@ {self})))
(ns (l n)))
}
}
Expand Down Expand Up @@ -1265,8 +1265,8 @@ my class List is Cool does Positional {
method new() {
Q:CgOp {
(letn n (obj_newblank (obj_llhow (@ {self})))
(setslot items (l n) (vvarlist_new_empty))
(setslot rest (l n) (vvarlist_new_empty))
(setslot List items (l n) (vvarlist_new_empty))
(setslot List rest (l n) (vvarlist_new_empty))
(newrwlistvar (l n)))
};
}
Expand All @@ -1282,18 +1282,18 @@ my class List is Cool does Positional {
method clone() { Q:CgOp {
(letn selfo (@ {self})
new (obj_newblank (obj_llhow (l selfo)))
(setslot items (l new) (vvarlist_clone
(getslot items vvarlist (l selfo))))
(setslot rest (l new) (vvarlist_clone
(getslot rest vvarlist (l selfo))))
(setslot List items (l new) (vvarlist_clone
(getslot List items vvarlist (l selfo))))
(setslot List rest (l new) (vvarlist_clone
(getslot List rest vvarlist (l selfo))))
(newrwlistvar (l new)))
} }
method Capture () {
Q:CgOp {
(letn n (obj_newblank (obj_llhow (@ {Capture})))
(setslot positionals (l n) (vvarlist_to_fvarlist
(getslot items vvarlist (@ {self.eager}))))
(setslot Capture positionals (l n) (vvarlist_to_fvarlist
(getslot List items vvarlist (@ {self.eager}))))
(ns (l n)))
}
}
Expand All @@ -1312,7 +1312,7 @@ my class List is Cool does Positional {
method eager() { +self; self }
method head() { self ??
Q:CgOp { (vvarlist_item (i 0) (getslot items vvarlist (@ {self}))) } !!
Q:CgOp { (vvarlist_item (i 0) (getslot List items vvarlist (@ {self}))) } !!
Any
}
Expand Down Expand Up @@ -1348,9 +1348,9 @@ my class List is Cool does Positional {
my $l = @(self).eager;
Q:CgOp {
(letn n (obj_newblank (obj_llhow (@ {List})))
(setslot items (l n) (vvarlist_sort (@ {$cmp})
(getslot items vvarlist (@ {$l}))))
(setslot rest (l n) (vvarlist_new_empty))
(setslot List items (l n) (vvarlist_sort (@ {$cmp})
(getslot List items vvarlist (@ {$l}))))
(setslot List rest (l n) (vvarlist_new_empty))
(newrwlistvar (l n)))
}
}
Expand Down Expand Up @@ -1409,7 +1409,7 @@ my class List is Cool does Positional {
method plan(*@items) {
Q:CgOp {
(rnull
(vvarlist_append (getslot rest vvarlist (@ {self}))
(vvarlist_append (getslot List rest vvarlist (@ {self}))
(unbox vvarlist (@ {@items.iterator}))))
}
}
Expand Down Expand Up @@ -1484,8 +1484,8 @@ my class Hash does Associative {
method Capture () {
Q:CgOp {
(letn n (obj_newblank (obj_llhow (@ {Capture})))
(setslot positionals (l n) (fvarlist_new))
(setslot named (l n) (varhash_dup
(setslot Capture positionals (l n) (fvarlist_new))
(setslot Capture named (l n) (varhash_dup
(unbox varhash (@ {self}))))
(ns (l n)))
}
Expand Down Expand Up @@ -1560,8 +1560,8 @@ my class Enum is Cool {
Q:CgOp {
(letn n (obj_newblank (obj_llhow (@ {Capture})))
d (varhash_new)
(setslot positionals (l n) (fvarlist_new))
(setslot named (l n) (l d))
(setslot Capture positionals (l n) (fvarlist_new))
(setslot Capture named (l n) (l d))
(varhash_setindex (obj_getstr {$!key})
(l d) {$!value})
(ns (l n)))
Expand Down Expand Up @@ -1652,12 +1652,12 @@ my class Junction is Mu {
method !create($kind, $eigenstates) { Q:CgOp {
(letn ob (obj_newblank (obj_llhow (@ {self})))
(setslot kind_ (l ob) (@ {$kind}))
(setslot eigenstates_ (l ob) (@ {$eigenstates}))
(setslot Junction kind_ (l ob) (@ {$kind}))
(setslot Junction eigenstates_ (l ob) (@ {$eigenstates}))
(ns (l ob)))
} }
method !kind() { Q:CgOp { (ns (getslot kind_ obj (@ {self}))) } }
method !eigenstates() { Q:CgOp { (ns (getslot eigenstates_ obj (@ {self}))) } }
method !kind() { Q:CgOp { (ns (getslot Junction kind_ obj (@ {self}))) } }
method !eigenstates() { Q:CgOp { (ns (getslot Junction eigenstates_ obj (@ {self}))) } }
my @kinds = <all none one any>;
method perl() {
Expand Down
25 changes: 16 additions & 9 deletions lib/CodeGen.cs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -342,9 +342,9 @@ sealed class Tokens {
public static readonly MethodInfo P6any_Invoke =
P6any.GetMethod("Invoke");
public static readonly MethodInfo P6any_SetSlot =
P6any.GetMethod("SetSlot", new Type[] { String, typeof(object) });
P6any.GetMethod("SetSlot", new Type[] { STable, String, typeof(object) });
public static readonly MethodInfo P6any_GetSlot =
P6any.GetMethod("GetSlot", new Type[] { String });
P6any.GetMethod("GetSlot", new Type[] { STable, String });
public static readonly MethodInfo SubInfo_AddHint =
SubInfo.GetMethod("AddHint");
public static readonly MethodInfo Variable_Fetch =
Expand Down Expand Up @@ -2241,6 +2241,12 @@ LexInfo ResolveLex(string name, bool upf, out int uplevel, bool core) {
}
}

STable ResolvePkg(string name) {
int dummy;
LexInfo li = ResolveLex(name, false, out dummy, true);
return ((LIPackage)li).pkg;
}

// synchronize with LIDispatch.MakeDispatch
internal CpsOp MakeDispatch(string prefix) {
HashSet<string> names = new HashSet<string>();
Expand Down Expand Up @@ -2544,12 +2550,16 @@ static NamProcessor() {
return CpsOp.PolyOp(FixStr(zyg[1]),
th.Scan(zyg[2]), th.Scan(zyg[3])); };
handlers["setslot"] = delegate(NamProcessor th, object[] zyg) {
CpsOp scope = (zyg[1] is object[]) ? th.Scan(zyg[1]) :
th.cpb.eu.TypeConstant(th.ResolvePkg(JScalar.S(zyg[1])));
return CpsOp.MethodCall(Tokens.P6any_SetSlot,
th.Scan(zyg[2]), th.AnyStr(zyg[1]), th.Scan(zyg[3])); };
th.Scan(zyg[3]), scope, th.AnyStr(zyg[2]), th.Scan(zyg[4])); };
handlers["getslot"] = delegate(NamProcessor th, object[] zyg) {
Type ty = namtype(zyg[2]);
Type ty = namtype(zyg[3]);
CpsOp scope = (zyg[1] is object[]) ? th.Scan(zyg[1]) :
th.cpb.eu.TypeConstant(th.ResolvePkg(JScalar.S(zyg[1])));
return CpsOp.UnboxAny(ty, CpsOp.MethodCall(Tokens.P6any_GetSlot,
th.Scan(zyg[3]), th.AnyStr(zyg[1]))); };
th.Scan(zyg[4]), scope, th.AnyStr(zyg[2]))); };
handlers["cast"] = delegate(NamProcessor th, object[] zyg) {
Type tty = namtype(zyg[1]);
CpsOp z = th.Scan(zyg[2]);
Expand Down Expand Up @@ -2678,10 +2688,7 @@ static NamProcessor() {
if (z[2] is STable) {
m = (STable)z[2];
} else {
int dummy;
LexInfo li = th.ResolveLex(JScalar.S(z[2]),
false, out dummy, true);
m = ((LIPackage)li).pkg;
m = th.ResolvePkg(JScalar.S(z[2]));
}
if (kind == "mo")
return th.cpb.eu.TypeConstant(m);
Expand Down
2 changes: 0 additions & 2 deletions src/CgOp.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,8 +81,6 @@ method newblankhash() { CgOp.newhash }
method string_var($x) { CgOp.box('Str', CgOp.str($x)) }
method noop() { CgOp.prog() }
method rnull($p) { CgOp.prog($p, CgOp.corelex('Nil')) }
method getattr($a,$v) { CgOp.fetch(CgOp.varattr($a,$v)) }
method varattr($a,$v) { CgOp.getslot($a, 'var', $v) }

my $nextlet = 0;
method let($head,$body) {
Expand Down
2 changes: 1 addition & 1 deletion src/NieczaActions.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2617,7 +2617,7 @@ method add_attribute($/, $name, $sigil, $accessor, $type) {
$nb.set_transparent;
$nb.add_my_name('self', noinit => True);
$nb.set_signature(Sig.simple('self'));
$nb.finish(::Op::GetSlot.new(name => $name,
$nb.finish(::Op::GetSlot.new(name => $name, type => $ns,
object => ::Op::Lexical.new(name => 'self')));
$*CURLEX<!sub>.create_static_pad; # for protosub instance
my $at;
Expand Down
9 changes: 7 additions & 2 deletions src/Op.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -204,11 +204,16 @@ class CallMethod is CallLike {

class GetSlot is Op {
has $.object = die "GetSlot.object required"; # Op
has $.name = die "GetSlot.name required"; # Str
has Str $.name = die "GetSlot.name required";
has $.type = die "GetSlot.type required";
method zyg() { $.object }

method code($body) {
CgOp.varattr($.name, CgOp.fetch($.object.cgop($body)));
my $kl = CgOp.class_ref('mo', $!type);
if $!type.kind eq 'prole' {
$kl = CgOp.obj_llhow(CgOp.fetch(CgOp.scopedlex('$?CLASS')));
}
CgOp.getslot($kl, $.name, 'var', CgOp.fetch($.object.cgop($body)));
}
}

Expand Down

0 comments on commit 0c7c992

Please sign in to comment.