Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Use new contexts in part of setting
  • Loading branch information
@sorear
sorear committed Nov 21, 2010
1 parent 83891ca commit fc0abe9
Show file tree
Hide file tree
Showing 4 changed files with 43 additions and 42 deletions.
68 changes: 33 additions & 35 deletions lib/SAFE.setting
View file
Expand Up @@ -131,7 +131,7 @@ my class Str is Cool {
method ACCEPTS($t) { self eq $t }
method Bool () { self ne "" }
method chars() { Q:CgOp {
(box Num (cast num (str_length (unbox str (@ (l self))))))
(box Num (cast num (str_length (unbox str (@ {self})))))
} }
method say() { Q:CgOp {
(prog [say (unbox str (@ {self}))]
Expand All @@ -140,8 +140,8 @@ my class Str is Cool {
} }
method substr($from, $len) { Q:CgOp {
(box Str (str_substring [unbox str (@ {self})]
[cast int (unbox num (@ {$from.Numeric}))]
[cast int (unbox num (@ {$len.Numeric}))]))
[cast int (obj_getnum {$from})]
[cast int (obj_getnum {$len})]))
} }
method dump() { '"' ~ self ~ '"' }
}
Expand Down Expand Up @@ -188,65 +188,65 @@ sub infix:<~>(\|$bits) { Q:CgOp {
max (fvarlist_length (l ar))
[whileloop 0 0 (< (l i) (l max)) (prog
[strbuf_append (l buf)
(unbox str (@ (methodcall (fvarlist_item (l i) (l ar)) Str)))]
(obj_getstr (fvarlist_item (l i) (l ar)))]
[l i (+ (l i) (int 1))])]
[box Str (strbuf_seal (l buf))])
} }
sub infix:<+>($l,$r) { Q:CgOp {
(box Num (+ (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Num (+ (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<->($l,$r) { Q:CgOp {
(box Num (- (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Num (- (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<*>($l,$r) { Q:CgOp {
(box Num (* (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Num (* (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:</>($l,$r) { Q:CgOp {
(box Num (/ (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Num (/ (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<< < >>($l,$r) { Q:CgOp {
(box Bool (< (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Bool (< (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<< > >>($l,$r) { Q:CgOp {
(box Bool (> (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Bool (> (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<< <= >>($l,$r) { Q:CgOp {
(box Bool (<= (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Bool (<= (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<< >= >>($l,$r) { Q:CgOp {
(box Bool (>= (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Bool (>= (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<< == >>($l,$r) { Q:CgOp {
(box Bool (== (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Bool (== (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<< != >>($l,$r) { Q:CgOp {
(box Bool (!= (unbox num (@ {$l.Numeric})) (unbox num (@ {$r.Numeric}))))
(box Bool (!= (obj_getnum {$l}) (obj_getnum {$r})))
} }
sub infix:<max>($a,$b) { $a < $b ?? $b !! $a }
sub infix:<min>($a,$b) { $a > $b ?? $b !! $a }

sub warn($str) { Q:CgOp {
(prog [note (unbox str (@ {$str.Str}))]
(prog [note (obj_getstr {$str})]
[box Bool (bool 1)]
)
} }
sub say(*@obj) { @obj.join('').say }
sub note(*@text) { Q:CgOp { (rnull (note (unbox str (@ {@text.join('').Str})))) } }
sub note(*@text) { Q:CgOp { (rnull (note (obj_getstr {@text.join('')}))) } }

sub exit($status = 0) { Q:CgOp {
(rnull [exit (cast int (unbox num (@ {$status.Numeric})))])
(rnull [exit (cast int (obj_getnum {$status}))])
} }
sub infix:<=>(\$a, \$b) { Q:CgOp { (prog [assign {$a} {$b}] {$a}) } }
Expand All @@ -258,8 +258,8 @@ sub substr($str, $start, $len = $str.chars - $start) {
sub item($x) { $x }
sub prefix:<not>($x) { $x.not }
sub defined($x) { $x.defined }
sub prefix:<not>($x) { $x ?? False !! True }
sub defined($x) { Q:CgOp { (obj_asdef {$x}) } }
# Buglet in STD: standard infix operators look custom inside the setting, and
# forget their precedence.
Expand All @@ -268,10 +268,10 @@ 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) { $v.Str } # should be Stringy
sub prefix:<?>($v) { $v.Bool }
sub prefix:<~>($v) { Q:CgOp { (obj_asstr {$v}) } } # should be Stringy
sub prefix:<?>($v) { Q:CgOp { (obj_asbool {$v}) } }
sub prefix:<->($v) { 0 - $v }
sub prefix:<+>($x) { $x.Numeric }
sub prefix:<+>($x) { Q:CgOp { (obj_asnum {$x}) } }
sub prefix:<!>($v) { $v ?? False !! True }

Expand All @@ -286,7 +286,7 @@ sub infix:<x>($str, $ct) {
}

sub infix:<leg>($s1, $s2) {
Q:CgOp { (box Num (cast num (strcmp (unbox str (@ {$s1.Str})) (unbox str (@ {$s2.Str}))))) }
Q:CgOp { (box Num (cast num (strcmp (obj_getstr {$s1}) (obj_getstr {$s2})))) }
}
sub infix:<ge>($s1, $s2) { ($s1 leg $s2) >= 0 }
Expand All @@ -295,12 +295,10 @@ sub infix:<le>($s1, $s2) { ($s1 leg $s2) <= 0 }
sub infix:<lt>($s1, $s2) { ($s1 leg $s2) < 0 }

sub infix:<eq>($l,$r) { Q:CgOp {
(box Bool (compare == (unbox str (@ {$l.Str}))
(unbox str (@ {$r.Str}))))
(box Bool (compare == (obj_getstr {$l}) (obj_getstr {$r})))
} }
sub infix:<ne>($l,$r) { Q:CgOp {
(box Bool (compare != (unbox str (@ {$l.Str}))
(unbox str (@ {$r.Str}))))
(box Bool (compare != (obj_getstr {$l}) (obj_getstr {$r})))
} }
# this one is horribly wrong and only handles the ref eq case.
sub infix:<===>($l,$r) { Q:CgOp {
Expand All @@ -322,18 +320,18 @@ my class CallFrame {
method caller() { Q:CgOp {
(letn c (frame_caller (cast frame (@ {self})))
(ternary
(!= (letvar c) (null frame))
(ns (letvar c))
(!= (l c) (null frame))
(ns (l c))
{Any}))
} }
method file() { Q:CgOp { (box Str (frame_file
(cast frame (@ (l self))))) } }
(cast frame (@ {self})))) } }
method line() { Q:CgOp { (box Num (cast num (frame_line
(cast frame (@ (l self)))))) } }
(cast frame (@ {self}))))) } }
method hints($var) { Q:CgOp { (frame_hint (cast frame (@ (l self)))
(unbox str (@ (l $var)))) } }
method hints($var) { Q:CgOp { (frame_hint (cast frame (@ {self}))
(obj_getstr {$var})) } }
}

sub caller() { Q:CgOp { (ns (frame_caller (frame_caller (callframe)))) } }
Expand Down Expand Up @@ -528,7 +526,7 @@ my class List is Cool {
} }
method !item-at-pos($ix) { Q:CgOp {
(vvarlist_item (cast int (unbox num (@ {$ix}))) (getslot items vvarlist (@ {self})))
(vvarlist_item (cast int (obj_getnum {$ix})) (getslot items vvarlist (@ {self})))
} }

method !pop-item() { Q:CgOp {
Expand All @@ -548,7 +546,7 @@ my class List is Cool {
} }

method !fill ($count) { Q:CgOp {
(letn ct (cast int (unbox num (@ {$count})))
(letn ct (cast int (obj_getnum {$count}))
items (getslot items vvarlist (@ {self}))
rest (getslot rest vvarlist (@ {self}))
(whileloop 0 0
Expand Down
2 changes: 1 addition & 1 deletion perf/ctxmark.pl
View file
@@ -1,2 +1,2 @@
my $i = 0;
$i++ until $i == 1000000;
$i++ until $i == 10000000;
10 changes: 7 additions & 3 deletions src/CgOp.pm
View file
Expand Up @@ -260,10 +260,14 @@ use warnings;
"Get:m,$type", letvar('!var')));
}

sub obj_getnum { _context('Double', 'raw_Numeric', $_[0]) }
sub obj_getnum { _context('Double', 'raw_Numeric', $_[0]) }
sub obj_getbool { _context('Boolean', 'raw_Bool', $_[0]) }
sub obj_getdef { _context('Boolean', 'raw_defined', $_[0]) }
sub obj_getstr { _context('String', 'raw_Str', $_[0]) }
sub obj_getdef { _context('Boolean', 'raw_defined', $_[0]) }
sub obj_getstr { _context('String', 'raw_Str', $_[0]) }
sub obj_asnum { _context('Variable', 'Numeric', $_[0]) }
sub obj_asbool { _context('Variable', 'Bool', $_[0]) }
sub obj_asdef { _context('Variable', 'defined', $_[0]) }
sub obj_asstr { _context('Variable', 'Str', $_[0]) }

sub newboundvar {
rawscall('Kernel.NewBoundVar', bool($_[0] || $_[1]), bool($_[1]),
Expand Down
5 changes: 2 additions & 3 deletions src/RxOp.pm
View file
Expand Up @@ -139,7 +139,7 @@ use CgOp;

sub code {
my ($self, $body) = @_;
CgOp::rxbprim('Exact', CgOp::unbox('str', CgOp::fetch(CgOp::methodcall($self->ops->cgop($body), "Str"))));
CgOp::rxbprim('Exact', CgOp::obj_getstr($self->ops->cgop($body)));
}

sub lad { $_[0]->param ? ['Param', $_[0]->param] : ['Imp'] }
Expand Down Expand Up @@ -809,8 +809,7 @@ use CgOp;

sub code {
my ($self, $body) = @_;
CgOp::ncgoto('backtrack', CgOp::unbox('bool', CgOp::fetch(
CgOp::methodcall($self->block->cgop($body), "Bool"))));
CgOp::ncgoto('backtrack', CgOp::obj_getbool($self->block->cgop($body)));
}

sub lad {
Expand Down

0 comments on commit fc0abe9

Please sign in to comment.