Skip to content

Commit

Permalink
Merge branch 'master' of https://github.com/rakudo/rakudo into proble…
Browse files Browse the repository at this point in the history
…m-solving-3
  • Loading branch information
vrurg committed Jun 3, 2019
2 parents bc093fa + 719eefd commit 7a0bfd4
Show file tree
Hide file tree
Showing 5 changed files with 213 additions and 168 deletions.
6 changes: 3 additions & 3 deletions lib/MoarVM/Profiler.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,9 @@ class Callee does OnHash[<
}

# additional accessor logic
method file(--> Str:D) {
%!hash<file> // %!hash.BIND-KEY("file",'')
}
method name(--> Str:D) {
%!hash<name> // %!hash.BIND-KEY("name",'')
}
Expand Down Expand Up @@ -247,9 +250,6 @@ class Callee does OnHash[<
?? "Was {@done.join(', ')} and $last.\n"
!! "Was $last.\n";
}
else {
$gist ~= ".\n";
}
}
else {
if $.inlined_entries -> $_ {
Expand Down
52 changes: 20 additions & 32 deletions src/core/List.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -176,26 +176,10 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP
}

method is-lazy() {
nqp::unless(
nqp::isconcrete($!current-iter) && $!current-iter.is-lazy,
nqp::if(
nqp::isconcrete($!future),
nqp::stmts( # Check $!future to determine if any element is lazy
(my \iter := nqp::iterator($!future)),
nqp::while(
iter
&& nqp::can((my $cur := nqp::shift(iter)),'is-lazy')
&& nqp::isfalse($cur.is-lazy),
nqp::null
),
nqp::if(
iter,
True, # did not did do all iterations, so lazy
$cur.is-lazy # check last one, could be non-lazy
)
),
False
)
nqp::if(
nqp::isconcrete($!current-iter),
$!current-iter.is-lazy,
False
)
}
}
Expand Down Expand Up @@ -1144,16 +1128,20 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP
)
}

method reverse(List:D: --> Seq:D) is nodal {
nqp::if(
self.is-lazy, # reifies
Failure.new(X::Cannot::Lazy.new(:action<reverse>)),
Seq.new(nqp::if(
$!reified,
Rakudo::Iterator.ReifiedListReverse($!reified),
Rakudo::Iterator.Empty
))
)
method reverse(List:D: --> List:D) is nodal {
self.is-lazy # reifies
?? Failure.new(X::Cannot::Lazy.new(:action<reverse>))
!! $!reified
?? nqp::stmts(
(my \src := nqp::clone(nqp::getattr(self,List,'$!reified'))),
(my \dst := nqp::create(src.WHAT)),
nqp::while(
nqp::elems(src),
nqp::push(dst,nqp::pop(src))
),
nqp::p6bindattrinvres(nqp::create(self),List,'$!reified',dst)
)
!! nqp::create(self)
}

method rotate(List:D: Int(Cool) $rotate = 1) is nodal {
Expand Down Expand Up @@ -1697,8 +1685,8 @@ multi sub infix:<xx>(Mu \x, Int:D $n) is pure {
}

proto sub reverse(|) {*}
multi sub reverse(@a --> Seq:D) { @a.reverse }
multi sub reverse(+@a --> Seq:D) { @a.reverse }
multi sub reverse(@a) { @a.reverse }
multi sub reverse(+@a) { @a.reverse }

proto sub rotate($, $?, *%) {*}
multi sub rotate(@a) { @a.rotate }
Expand Down
246 changes: 170 additions & 76 deletions src/core/Rakudo/Internals/JSON.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -61,96 +61,190 @@ my class Rakudo::Internals::JSON {
$text;
}

method to-json($obj is copy, Bool :$pretty = True, Int :$level = 0, Int :$spacing = 2, Bool :$sorted-keys = False) {
return $obj ?? 'true' !! 'false' if $obj ~~ Bool;

return 'null' if not $obj.defined;

if $obj ~~ Exception {
return $.to-json($obj.^name => Hash.new(
(message => nqp::can($obj,"message") ?? $obj.message !! Nil),
$obj.^attributes.grep(*.has_accessor).map: {
with .name.substr(2) -> $attr {
$attr => (
(.defined and not $_ ~~ Real|Positional|Associative)
?? .Str !! $_
) given $obj."$attr"()
}
}
), :$pretty, :$level, :$spacing, :$sorted-keys);
}

# Handle allomorphs like IntStr.new(0, '') properly.
return $obj.Int.Str if $obj ~~ Int;
return $.to-json($obj.Rat, :$pretty, :$level, :$spacing, :$sorted-keys) if $obj ~~ RatStr;

if $obj ~~ Rat {
my $result = $obj.Str;
unless $obj.contains(".") {
return $result ~ ".0";
method to-json(
\obj,
Bool :$pretty = True,
Int :$level = 0,
int :$spacing = 2,
Bool :$sorted-keys = False,
) {

my str @out;
my str $spaces = ' ' x $spacing;
my str $comma = ",\n" ~ $spaces x $level;

#-- helper subs from here, with visibility to the above lexicals

sub pretty-positional(\positional --> Nil) {
$comma = nqp::concat($comma,$spaces);
nqp::push_s(@out,'[');
nqp::push_s(@out,nqp::substr($comma,1));

for positional.list {
jsonify($_);
nqp::push_s(@out,$comma);
}
return $result;
}
nqp::pop_s(@out); # lose last comma

if $obj ~~ Num {
# Allomorph support for NumStr, too.
$obj = $obj.Num;
if $obj === NaN || $obj === -Inf || $obj === Inf {
return $obj.Str;
} else {
my $result = $obj.Str;
unless $result.contains("e") {
return $result ~ "e0";
}
return $result;
}
$comma = nqp::substr($comma,0,nqp::sub_i(nqp::chars($comma),$spacing));
nqp::push_s(@out,nqp::substr($comma,1));
nqp::push_s(@out,']');
}

return "\"" ~ str-escape(~$obj) ~ "\"" if $obj ~~ Str|Version;

return "$obj" if $obj ~~ Dateish;
return "{$obj.DateTime.Str}" if $obj ~~ Instant;
sub pretty-associative(\associative --> Nil) {
$comma = nqp::concat($comma,$spaces);
nqp::push_s(@out,'{');
nqp::push_s(@out,nqp::substr($comma,1));
my \pairs := $sorted-keys
?? associative.sort(*.key)
!! associative.list;

for pairs {
jsonify(.key);
nqp::push_s(@out,": ");
jsonify(.value);
nqp::push_s(@out,$comma);
}
nqp::pop_s(@out); # lose last comma

if $obj ~~ Seq {
$obj = $obj.cache
$comma = nqp::substr($comma,0,nqp::sub_i(nqp::chars($comma),$spacing));
nqp::push_s(@out,nqp::substr($comma,1));
nqp::push_s(@out,'}');
}

my int $lvl = $level;
my Bool $arr = $obj ~~ Positional;
my str $out ~= $arr ?? '[' !! '{';
my $spacer := sub {
$out ~= "\n" ~ (' ' x $lvl*$spacing) if $pretty;
};

$lvl++;
$spacer();
if $arr {
for @($obj) -> $i {
$out ~= $.to-json($i, :level($level+1), :$spacing, :$pretty, :$sorted-keys) ~ ',';
$spacer();
sub unpretty-positional(\positional --> Nil) {
nqp::push_s(@out,'[');
my int $before = nqp::elems(@out);
for positional.list {
jsonify($_);
nqp::push_s(@out,",");
}
nqp::pop_s(@out) if nqp::elems(@out) > $before; # lose last comma
nqp::push_s(@out,']');
}
else {
my @keys = $obj.keys;

if ($sorted-keys) {
@keys = @keys.sort;
sub unpretty-associative(\associative --> Nil) {
nqp::push_s(@out,'{');
my \pairs := $sorted-keys
?? associative.sort(*.key)
!! associative.list;

my int $before = nqp::elems(@out);
for pairs {
jsonify(.key);
nqp::push_s(@out,": ");
jsonify(.value);
nqp::push_s(@out,$comma);
}
nqp::pop_s(@out) if nqp::elems(@out) > $before; # lose last comma
nqp::push_s(@out,'}');
}

sub jsonify(\obj --> Nil) {

with obj {

for @keys -> $key {
$out ~= "\"" ~
($key ~~ Str ?? str-escape($key) !! $key) ~
"\": " ~
$.to-json($obj{$key}, :level($level+1), :$spacing, :$pretty, :$sorted-keys) ~
',';
$spacer();
# basic ones
when Bool {
nqp::push_s(@out,obj ?? "true" !! "false");
}
when IntStr {
jsonify(.Int);
}
when RatStr {
jsonify(.Rat);
}
when NumStr {
jsonify(.Num);
}
when Str {
nqp::push_s(@out,'"');
nqp::push_s(@out,str-escape(obj));
nqp::push_s(@out,'"');
}

# numeric ones
when Int {
nqp::push_s(@out,.Str);
}
when Rat {
nqp::push_s(@out,.contains(".") ?? $_ !! "$_.0")
given .Str;
}
when FatRat {
nqp::push_s(@out,.contains(".") ?? $_ !! "$_.0")
given .Str;
}
when Num {
if nqp::isnanorinf($_) {
nqp::push_s(
@out,
$*JSON_NAN_INF_SUPPORT ?? obj.Str !! "null"
);
}
else {
nqp::push_s(@out,.contains("e") ?? $_ !! $_ ~ "e0")
given .Str;
}
}

# iterating ones
when Seq {
jsonify(.cache);
}
when Positional {
$pretty
?? pretty-positional($_)
!! unpretty-positional($_);
}
when Associative {
$pretty
?? pretty-associative($_)
!! unpretty-associative($_);
}

# rarer ones
when Dateish {
nqp::push_s(@out,qq/"$_"/);
}
when Instant {
nqp::push_s(@out,qq/"{.DateTime}"/)
}
when Version {
jsonify(.Str)
}

# also handle exceptions here
when Exception {
jsonify(obj.^name => Hash.new(
(message => nqp::can(obj,"message")
?? obj.message !! Nil
),
obj.^attributes.grep(*.has_accessor).map: {
with .name.substr(2) -> $attr {
$attr => (
(.defined and not $_ ~~ Real|Positional|Associative)
?? .Str !! $_
) given obj."$attr"()
}
}
));
}

# huh, what?
default {
jsonify( { 0 => 'null' } );
}
}
else {
nqp::push_s(@out,'null');
}
}
$out .=subst(/',' \s* $/, '');
$lvl--;
$spacer();
$out ~= $arr ?? ']' !! '}';
return $out;

#-- do the actual work

jsonify(obj);
nqp::join("",@out)
}

my $ws := nqp::list_i;
Expand Down
Loading

0 comments on commit 7a0bfd4

Please sign in to comment.