Skip to content

Commit

Permalink
Make ++ more polymorphic, use .succ, support Bool
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Feb 17, 2011
1 parent 5538226 commit a938d4c
Show file tree
Hide file tree
Showing 4 changed files with 47 additions and 12 deletions.
5 changes: 2 additions & 3 deletions TODO
View file
Expand Up @@ -29,9 +29,8 @@ EASY

Fudge and run your favorite spectest file.

Stuff spectests are blocking on: "is readonly", "[+]", "++ on Bool",
"&ucfirst", "Block", "&prefix:<\>", "*.notdef", "Bool.key", "&hash",
".join without argument", "?| et al failing to take Mu and return Bool",
Stuff spectests are blocking on: "is readonly", "[+]",
"Block", "&prefix:<\>", "&hash",
"writable $_", "closure for", "ranges of chars", "gather for", "%",
"unless", "my regex / <&foo>", "m//",

Expand Down
4 changes: 1 addition & 3 deletions lib/Builtins.cs
View file
Expand Up @@ -252,9 +252,7 @@ public class Builtins {

public static Variable PostIncrement(Variable v) {
IP6 o1 = NominalCheck("$x", Kernel.AnyMO, v);
double d = o1.mo.mro_raw_defined.Get(v) ?
o1.mo.mro_raw_Numeric.Get(v) : 0;
AssignV(v, Kernel.BoxRaw<double>(d + 1, Kernel.NumMO));
AssignV(v, o1.mo.mro_succ.Get(v));
return Kernel.NewROScalar(o1);
}

Expand Down
34 changes: 34 additions & 0 deletions lib/Kernel.cs
View file
Expand Up @@ -792,6 +792,15 @@ class CtxCallMethod : ContextHandler<Variable> {
}
}

class CtxCallMethodFetch : ContextHandler<IP6> {
string method;
public CtxCallMethodFetch(string method) { this.method = method; }

public override IP6 Get(Variable obj) {
return Kernel.RunInferior(obj.Fetch().InvokeMethod(Kernel.GetInferiorRoot(), method, new Variable[] { obj }, null)).Fetch();
}
}

class CtxJustUnbox<T> : ContextHandler<T> {
public override T Get(Variable obj) {
return Kernel.UnboxAny<T>(obj.Fetch());
Expand Down Expand Up @@ -887,6 +896,16 @@ class CtxBoolNativeDefined : ContextHandler<Variable> {
}
}

class CtxNumSuccish : ContextHandler<IP6> {
double amt;
public CtxNumSuccish(double amt) { this.amt = amt; }
public override IP6 Get(Variable obj) {
IP6 o = obj.Fetch();
double v = (o is BoxObject<double>) ? Kernel.UnboxAny<double>(o):0;
return Kernel.BoxRaw(v + amt, Kernel.NumMO);
}
}

class CtxRawNativeNum2Str : ContextHandler<string> {
public override string Get(Variable obj) {
return Kernel.UnboxAny<double>(obj.Fetch()).ToString();
Expand Down Expand Up @@ -1106,6 +1125,10 @@ public struct AttrInfo {
= new CtxCallMethod("list");
public static readonly ContextHandler<Variable> CallHash
= new CtxCallMethod("hash");
public static readonly ContextHandler<IP6> CallPred
= new CtxCallMethodFetch("pred");
public static readonly ContextHandler<IP6> CallSucc
= new CtxCallMethodFetch("succ");
public static readonly ContextHandler<string> RawCallStr
= new CtxCallMethodUnbox<string>("Str");
public static readonly ContextHandler<bool> RawCallBool
Expand Down Expand Up @@ -1150,6 +1173,7 @@ public struct AttrInfo {
loc_Numeric, mro_Bool, loc_Bool, mro_defined, loc_defined,
mro_iterator, loc_iterator, mro_item, loc_item, mro_list,
loc_list, mro_hash, loc_hash;
public ContextHandler<IP6> loc_pred, loc_succ, mro_pred, mro_succ;
public ContextHandler<bool> mro_raw_Bool, loc_raw_Bool, mro_raw_defined,
loc_raw_defined;
public ContextHandler<string> mro_raw_Str, loc_raw_Str;
Expand Down Expand Up @@ -1245,6 +1269,10 @@ public List<DynMetaObject> superclasses
mro_list = CallList;
if (m.Key == "hash")
mro_hash = CallHash;
if (m.Key == "pred")
mro_pred = CallPred;
if (m.Key == "succ")
mro_succ = CallSucc;
if (m.Key == "at-key")
mro_at_key = CallAtKey;
if (m.Key == "at-pos")
Expand All @@ -1263,6 +1291,8 @@ public List<DynMetaObject> superclasses
if (k.loc_item != null) mro_item = k.loc_item;
if (k.loc_list != null) mro_list = k.loc_list;
if (k.loc_hash != null) mro_hash = k.loc_hash;
if (k.loc_pred != null) mro_pred = k.loc_pred;
if (k.loc_succ != null) mro_succ = k.loc_succ;
if (k.loc_to_clr != null) mro_to_clr = k.loc_to_clr;
if (k.loc_INVOKE != null) mro_INVOKE = k.loc_INVOKE;
if (k.loc_Numeric != null) mro_Numeric = k.loc_Numeric;
Expand Down Expand Up @@ -2314,6 +2344,8 @@ class LastFrameNode {
NumMO.loc_raw_Str = new CtxRawNativeNum2Str();
NumMO.loc_raw_Bool = new CtxNum2Bool();
NumMO.loc_Bool = new CtxBoxify<bool>(NumMO.loc_raw_Bool, BoolMO);
NumMO.loc_succ = new CtxNumSuccish(+1);
NumMO.loc_pred = new CtxNumSuccish(-1);
NumMO.FillProtoClass(new string[] { });
WrapHandler0(NumMO, "Bool", NumMO.loc_Bool);
WrapHandler0(NumMO, "Str", NumMO.loc_Str);
Expand All @@ -2339,6 +2371,8 @@ class LastFrameNode {
MuMO.loc_hash = DynMetaObject.CallHash;
MuMO.loc_list = DynMetaObject.CallList;
MuMO.loc_item = DynMetaObject.CallItem;
MuMO.loc_pred = DynMetaObject.CallPred;
MuMO.loc_succ = DynMetaObject.CallSucc;
MuMO.FillProtoClass(new string[] { });
WrapHandler0(MuMO, "Bool", MuMO.loc_Bool);
WrapHandler0(MuMO, "defined", MuMO.loc_defined);
Expand Down
16 changes: 10 additions & 6 deletions lib/SAFE.setting
View file
Expand Up @@ -20,6 +20,8 @@ my class Mu {
$tn ~ "()"
}
}
method succ() { defined(self) ?? die("cannot increment a value of type $.typename") !! 1 }
method pred() { defined(self) ?? die("cannot decrement a value of type $.typename") !! -1 }
method notdef() { !self.defined }
method ACCEPTS(\$x) { defined(self) ?? self === $x !! $x.^does(self) }
method perl() { defined(self) ?? self.Str !! self.typename }
Expand Down Expand Up @@ -179,6 +181,8 @@ my class Num is Cool {
method Bool() { Q:CgOp {
(box Bool (compare != (double 0) (unbox num (@ {self}))))
} }
method pred() { (self // 0) - 1 }
method succ() { (self // 0) + 1 }
method Numeric() { self }
method ACCEPTS($t) { defined(self) ?? self == $t !! $t.^does(self) }
}
Expand Down Expand Up @@ -302,10 +306,10 @@ sub defined($x) { defined($x) }
# Buglet in STD: standard infix operators look custom inside the setting, and
# forget their precedence.
sub prefix:<-->($v is rw) { $v = (($v // 0) - 1); $v }
sub prefix:<++>($v is rw) { $v = (($v // 0) + 1); $v }
sub postfix:<-->($v is rw) { my $old = $v; $v = (($v // 0) - 1); $old }
sub postfix:<++>($v is rw) { my $old = $v; $v = (($v // 0) + 1); $old }
sub prefix:<-->($v is rw) { $v = $v.pred; $v }
sub prefix:<++>($v is rw) { $v = $v.succ; $v }
sub postfix:<-->($v is rw) { my $old = $v; $v = $v.pred; $old }
sub postfix:<++>($v is rw) { my $old = $v; $v = $v.succ; $old }
sub prefix:<~>($v) { ~$v }
sub prefix:<?>($v) { ?$v }
Expand Down Expand Up @@ -337,8 +341,8 @@ sub infix:<eq>($s1, $s2) { $s1 eq $s2 }
sub infix:<ne>($s1, $s2) { $s1 ne $s2 }
sub lc($s) { (~$s).lc }
sub uc($s) { (~$s).uc }
sub lcfirst($o) { my $s = ~$o; lc(substr($o,0,1)) ~ substr($o,1) }
sub ucfirst($o) { my $s = ~$o; uc(substr($o,0,1)) ~ substr($o,1) }
sub lcfirst($o) { my $s = ~$o; lc(substr($s,0,1)) ~ substr($s,1) }
sub ucfirst($o) { my $s = ~$o; uc(substr($s,0,1)) ~ substr($s,1) }
# this one is horribly wrong and only handles the ref eq case.
sub infix:<===>($l,$r) { Q:CgOp {
(box Bool (compare == (@ {$l}) (@ {$r})))
Expand Down

0 comments on commit a938d4c

Please sign in to comment.