Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Greatly increase usable range of Mu
  • Loading branch information
@sorear
sorear committed May 16, 2011
1 parent 3fd8a5d commit 2af2593
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 40 deletions.
76 changes: 38 additions & 38 deletions lib/CORE.setting
View file
Expand Up @@ -8,28 +8,28 @@ use MONKEY_TYPING;

# Fundamental types {{{
my class Mu {
method head() { @(self).head }
method head(Mu $self:) { @($self).head }
method flattens(\$self:) {
Q:CgOp { (box Bool (var_islist {$self})) }
}
method typename() { # should be ^name
Q:CgOp { (box Str (obj_typename (@ {self}))) }
method typename(Mu $self:) { # should be ^name
Q:CgOp { (box Str (obj_typename (@ {$self}))) }
}
method Str() {
my $tn := Q:CgOp { (box Str (obj_typename (@ {self}))) };
if defined(self) {
method Str(Mu $self:) {
my $tn := Q:CgOp { (box Str (obj_typename (@ {$self}))) };
if defined($self) {
$tn ~ "()<instance>"
} else {
$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() { !defined(self) }
method ACCEPTS(\$x) { defined(self) ?? self === $x !! $x.^does(self) }
method perl() { defined(self) ?? "{self.typename}.new(...)" !! self.typename }
method so() { ?self }
method not() { !self }
method succ(Mu $self:) { defined($self) ?? die("cannot increment a value of type $self.typename()") !! 1 }
method pred(Mu $self:) { defined($self) ?? die("cannot decrement a value of type $self.typename()") !! -1 }
method notdef(Mu $self:) { !defined($self) }
method ACCEPTS(Mu $self: \$x) { defined($self) ?? $self === $x !! $x.^does($self) }
method perl(Mu $self:) { defined($self) ?? "{$self.typename}.new(...)" !! $self.typename }
method so(Mu $self:) { ?$self }
method not(Mu $self:) { !$self }
method RAWCREATE(\|$vars) { Q:CgOp {
(letn ar (unbox fvarlist (@ {$vars}))
max (fvarlist_length (l ar))
Expand All @@ -42,8 +42,8 @@ my class Mu {
[l i (+ (l i) (int 2))])]
[ns (l obj)])
} }
method CREATE(*%_) { Q:CgOp { (default_new (@ {self}) (unbox varhash (@ {%_}))) } }
method new(*%_) { Q:CgOp { (default_new (@ {self}) (unbox varhash (@ {%_}))) } }
method CREATE(Mu $self: *%_) { Q:CgOp { (default_new (@ {$self}) (unbox varhash (@ {%_}))) } }
method new(Mu $self: *%_) { Q:CgOp { (default_new (@ {$self}) (unbox varhash (@ {%_}))) } }
}
my class Any is Mu {
Expand All @@ -64,8 +64,8 @@ my class Regex { ... }
my class Num { ... }
my class Str { ... }
my class Cool {
method grep($sm) { grep $sm, @(self) }
method map($func) { map $func, @(self) }
method grep(Mu $sm) { grep $sm, @(self) }
method map($func) { map $func, @(self) }
method for (&cb) {
Q:CgOp {
(rnull (letn it (unbox vvarlist (@ {self.iterator}))
Expand Down Expand Up @@ -216,7 +216,7 @@ my class Capture {
# Scalar types {{{
my class Num is Cool {
method perl() { defined(self) ?? ~self !! self.typename }
method ACCEPTS($t) { defined(self) ?? self == $t !! $t.^does(self) }
method ACCEPTS(Mu $t) { defined(self) ?? self == $t !! $t.^does(self) }
}

#TODO use a power from the standard library
Expand All @@ -231,7 +231,7 @@ sub infix:<**>($num,$power) {
}

my class Str is Cool {
method ACCEPTS($t) { defined(self) ?? self eq $t !! $t.^does(self) }
method ACCEPTS(Mu $t) { defined(self) ?? self eq $t !! $t.^does(self) }
method chars() { chars(self) }
method say() { Q:CgOp {
(prog [say (unbox str (@ {self}))]
Expand All @@ -252,17 +252,17 @@ my class Sub {
has $!info;

# Should be for Block, not Sub
method ACCEPTS($t) { defined(self) ?? (self)($t) !! $t.^does(self) }
method ACCEPTS(Mu $t) { defined(self) ?? (self)($t) !! $t.^does(self) }

method perl() { defined(self) ?? '{ ... }' !! self.typename }
}

my class ClassHOW {
method isa($obj, $type) { Q:CgOp {
method isa(Mu $obj, Mu $type) { Q:CgOp {
(box Bool (obj_isa (@ {$obj}) (obj_llhow (@ {$type}))))
} }
method does($obj, $role) { self.isa($obj, $role) } #no roles yet
method can($obj, $name) { Q:CgOp {
method does(Mu $obj, Mu $role) { self.isa($obj, $role) } #no roles yet
method can(Mu $obj, $name) { Q:CgOp {
(box Bool (_cgop obj_can (@ {$obj}) (obj_getstr {$name})))
} }
}
Expand All @@ -272,7 +272,7 @@ my class Bool is EnumType {
method Str() { self ?? "Bool::True" !! "Bool::False" }
method Stringy() { self.key }
method perl() { defined(self) ?? ~self !! self.typename }
method ACCEPTS($t) { defined(self) ?? self !! $t.^does(self) }
method ACCEPTS(Mu $t) { defined(self) ?? self !! $t.^does(self) }
method Numeric() { self ?? 1 !! 0 }
our constant True = Q:CgOp { (box Bool (bool 1)) };
our constant False = Q:CgOp { (box Bool (bool 0)) };
Expand Down Expand Up @@ -334,10 +334,10 @@ sub infix:<=>(\$a, \$b) { Q:CgOp { (prog [assign {$a} {$b}] {$a}) } }
sub chars($str) { chars($str) }
sub substr($str, $start, $len = chars($str) - $start) { substr($str, $start, $len) }
sub item($x) { $x }
sub item(Mu $x) { $x }
sub prefix:<not>($x) { not($x) }
sub defined($x) { defined($x) }
sub defined(Mu $x) { defined($x) }

# Buglet in STD: standard infix operators look custom inside the setting, and
# forget their precedence.
Expand All @@ -346,13 +346,13 @@ 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 }
sub prefix:<->($v) { -$v }
sub prefix:<+>($v) { +$v }
sub prefix:<!>($v) { !$v }
sub prefix:<~>(Mu $v) { ~$v }
sub prefix:<?>(Mu $v) { ?$v }
sub prefix:<->(Mu $v) { -$v }
sub prefix:<+>(Mu $v) { +$v }
sub prefix:<!>(Mu $v) { !$v }

sub not($v) { not($v) }
sub not(Mu $v) { not($v) }

sub infix:<x>($str, $ct) {
my $i = +$ct;
Expand Down Expand Up @@ -440,7 +440,7 @@ my class Label {
}
# XXX multi dispatch
sub _lexotic ($id, $x, $val) {
sub _lexotic ($id, $x, Mu $val) {
Q:CgOp {
(letn fr (null frame)
nm (null str)
Expand Down Expand Up @@ -496,7 +496,7 @@ sub notop(&fn) { -> \$x, \$y { !(fn($x,$y)) } }
# Array: mutable list of read-write scalar boxes

sub unitem(\$a) { Q:CgOp { (newrwlistvar (@ {$a})) } }
sub head(\$x) { for $x -> $elt { return $elt }; Any }
sub head(\$x) { for $x -> Mu $elt { return $elt }; Any }
my class Iterator {
method list () {
Expand Down Expand Up @@ -812,7 +812,7 @@ augment class Any {

my class Enum is Cool {
has $.key;
has $.value;
has Mu $.value;

method Capture () {
Q:CgOp {
Expand Down Expand Up @@ -884,7 +884,7 @@ sub _gather($fr) {

sub take(\|@pcl) { Q:CgOp { (take {@pcl.unwrap-single}) } }
sub infix:<< => >>($k, $v) { Pair.RAWCREATE("key", $k, "value", $v) }
sub infix:<< => >>($k, Mu $v) { Pair.RAWCREATE("key", $k, "value", $v) }

sub reverse(*@arr) {
my @acc;
Expand All @@ -902,7 +902,7 @@ sub invert(%h) { %h.invert }
sub keys(%h) { %h.keys }
sub values(%h) { %h.values }

sub grep($filter, *@items) { grep($filter, @items) }
sub grep(Mu $filter, *@items) { grep($filter, @items) }
sub map($callback, *@items) { map($callback, @items) }

sub sort(*@bits) { @bits.sort }
Expand All @@ -913,7 +913,7 @@ sub _array_constructor(\$parcel) { _array_constructor($parcel) }
sub _hash_constructor(\$parcel) { my $r := (anon %hash = $parcel); $r }
sub _make_capture(|$c) { $c }

sub _newtiedscalar($type, $bind, $fetch, $store) {
sub _newtiedscalar(Mu $type, $bind, $fetch, $store) {
Q:CgOp { (var_new_tied (obj_llhow (@ {$type})) (@ {$bind}) (@ {$fetch}) (@ {$store})) }
}
Expand Down
4 changes: 2 additions & 2 deletions lib/Kernel.cs
View file
Expand Up @@ -414,7 +414,7 @@ public class SubInfo {
if (rw == src.rw && islist == src.islist) {
if (!src.type.HasMRO(type)) {
if (quiet) return null;
return Kernel.Die(th, "Nominal type check failed in binding" + PName(rbase) + "; got " + src.type.name + ", needed " + type.name);
return Kernel.Die(th, "Nominal type check failed in binding " + PName(rbase) + "; got " + src.type.name + ", needed " + type.name);
}
if (src.whence != null)
Kernel.Vivify(src);
Expand Down Expand Up @@ -2340,6 +2340,7 @@ class LastFrameNode {
new CtxRawNativeDefined());
Handler_Vonly(MuMO, "Bool", new CtxBoolNativeDefined(),
new CtxRawNativeDefined());
Handler_Vonly(MuMO, "item", new CtxReturnSelfItem(), null);
MuMO.FillProtoClass(new string[] { });
MuMO.Invalidate();

Expand Down Expand Up @@ -2382,7 +2383,6 @@ class LastFrameNode {
WrapHandler1(AnyMO, "at-key", new IxAnyAtKey());
WrapHandler1(AnyMO, "at-pos", new IxAnyAtPos());
Handler_Vonly(AnyMO, "list", new CtxAnyList(), null);
Handler_Vonly(AnyMO, "item", new CtxReturnSelfItem(), null);
AnyMO.FillProtoClass(new string[] { });
AnyMO.Invalidate();

Expand Down

0 comments on commit 2af2593

Please sign in to comment.