From a938d4ca23f32615f99fa0db2f829ba6484962dc Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Wed, 16 Feb 2011 23:12:32 -0800 Subject: [PATCH] Make ++ more polymorphic, use .succ, support Bool --- TODO | 5 ++--- lib/Builtins.cs | 4 +--- lib/Kernel.cs | 34 ++++++++++++++++++++++++++++++++++ lib/SAFE.setting | 16 ++++++++++------ 4 files changed, 47 insertions(+), 12 deletions(-) diff --git a/TODO b/TODO index 8f844e1f..f1f8225c 100644 --- a/TODO +++ b/TODO @@ -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//", diff --git a/lib/Builtins.cs b/lib/Builtins.cs index 045a856e..eae103ea 100644 --- a/lib/Builtins.cs +++ b/lib/Builtins.cs @@ -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(d + 1, Kernel.NumMO)); + AssignV(v, o1.mo.mro_succ.Get(v)); return Kernel.NewROScalar(o1); } diff --git a/lib/Kernel.cs b/lib/Kernel.cs index ad9738d6..a59c47c2 100644 --- a/lib/Kernel.cs +++ b/lib/Kernel.cs @@ -792,6 +792,15 @@ class CtxCallMethod : ContextHandler { } } + class CtxCallMethodFetch : ContextHandler { + 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 : ContextHandler { public override T Get(Variable obj) { return Kernel.UnboxAny(obj.Fetch()); @@ -887,6 +896,16 @@ class CtxBoolNativeDefined : ContextHandler { } } + class CtxNumSuccish : ContextHandler { + double amt; + public CtxNumSuccish(double amt) { this.amt = amt; } + public override IP6 Get(Variable obj) { + IP6 o = obj.Fetch(); + double v = (o is BoxObject) ? Kernel.UnboxAny(o):0; + return Kernel.BoxRaw(v + amt, Kernel.NumMO); + } + } + class CtxRawNativeNum2Str : ContextHandler { public override string Get(Variable obj) { return Kernel.UnboxAny(obj.Fetch()).ToString(); @@ -1106,6 +1125,10 @@ public struct AttrInfo { = new CtxCallMethod("list"); public static readonly ContextHandler CallHash = new CtxCallMethod("hash"); + public static readonly ContextHandler CallPred + = new CtxCallMethodFetch("pred"); + public static readonly ContextHandler CallSucc + = new CtxCallMethodFetch("succ"); public static readonly ContextHandler RawCallStr = new CtxCallMethodUnbox("Str"); public static readonly ContextHandler RawCallBool @@ -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 loc_pred, loc_succ, mro_pred, mro_succ; public ContextHandler mro_raw_Bool, loc_raw_Bool, mro_raw_defined, loc_raw_defined; public ContextHandler mro_raw_Str, loc_raw_Str; @@ -1245,6 +1269,10 @@ public List 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") @@ -1263,6 +1291,8 @@ public List 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; @@ -2314,6 +2344,8 @@ class LastFrameNode { NumMO.loc_raw_Str = new CtxRawNativeNum2Str(); NumMO.loc_raw_Bool = new CtxNum2Bool(); NumMO.loc_Bool = new CtxBoxify(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); @@ -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); diff --git a/lib/SAFE.setting b/lib/SAFE.setting index b39569df..24deaf76 100644 --- a/lib/SAFE.setting +++ b/lib/SAFE.setting @@ -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 } @@ -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) } } @@ -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 } @@ -337,8 +341,8 @@ sub infix:($s1, $s2) { $s1 eq $s2 } sub infix:($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})))