Help language development. Donate to The Perl Foundation
#!/usr/bin/env raku # This script reads the lib/Array/Sorted/Util.rakumod file, and # generates the necessary code for the native versions of the # utility functions, and writes them back to the file. # always use highest version of Raku use v6.*; my $generator = $*PROGRAM-NAME; my $generated = DateTime.now.gist.subst(/\.\d+/,''); my $start = '#- start of generated part of '; my $idpos = $start.chars; my $idchars = 3; my $end = '#- end of generated part of '; # slurp the whole file and set up writing to it my $filename = "lib/Array/Sorted/Util.rakumod"; my @lines = $filename.IO.lines; $*OUT = $filename.IO.open(:w); # for all the lines in the source that don't need special handling while @lines { my $line := @lines.shift; # nothing to do yet unless $line.starts-with($start) { say $line; next; } # found header my $type = $line.substr($idpos,$idchars); die "Don't know how to handle $type" unless $type eq "int" | "num" | "str"; say $start ~ $type ~ " candidates -----------------------------------"; say "#- Generated on $generated by $generator"; say "#- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE"; # skip the old version of the code while @lines { last if @lines.shift.starts-with($end); } # set up template values my %mapper = postfix => $type.substr(0,1), type => $type, Type => $type.tclc, nullval => $type eq 'str' ?? '""' !! $type eq 'num' ?? '0e0' !! '0' ; # spurt the role say Q:to/SOURCE/.subst(/ '#' (\w+) '#' /, -> $/ { %mapper{$0} }, :g).chomp; my #type# @delete_#postfix#; #------------------------------------------------------------------------------- # Publicly visible #type# candidates my multi sub finds(array[#type#] \a, #Type#:D $needle) { finds_#postfix#(a, $needle) } my multi sub finds(array[#type#] \a, #Type#:D $needle, :&cmp!) { finds_#postfix#_cmp(a, $needle, &cmp) } my multi sub inserts(array[#type#] \a, #Type#:D $needle, NotFound :$pos!) { inserts_#postfix#(a, $needle, $pos, True) } my multi sub inserts(array[#type#] \a, #Type#:D $needle, :$force) { inserts_#postfix#(a, $needle, finds_#postfix#(a, $needle), $force.Bool) } my multi sub inserts(array[#type#] \a, #Type#:D $needle, **@also, NotFound :$pos!) { inserts_#postfix#(a, $needle, $pos, True); insert-also($pos, @also) } my multi sub inserts(array[#type#] \a, #Type#:D $needle, **@also, :$force) { nqp::eqaddr((my $i := inserts(a, $needle, :$force)),Nil) ?? $i !! insert-also($i, @also) } my multi sub inserts(array[#type#] \a, #Type#:D $needle, :&cmp!, :$force) { inserts_#postfix#(a, $needle, finds_#postfix#_cmp(a, $needle, &cmp), $force.Bool) } my multi sub inserts(array[#type#] \a, #Type#:D $needle, **@also, :&cmp = &[cmp], :$force) { nqp::eqaddr((my $i := inserts_#postfix#(a, $needle, :&cmp, :$force)),Nil) ?? $i !! insert-also($i, @also) } my multi sub deletes(array[#type#] \a, #Type#:D $needle) { nqp::if( nqp::istype((my $i := finds_#postfix#(a, $needle)),NotFound), Nil, nqp::stmts( nqp::splice(a,@delete_#postfix#,$i,1), $needle ) ) } my multi sub deletes(array[#type#] \a, #Type#:D $needle, **@also) { nqp::if( nqp::istype((my $i := finds_#postfix#(a, $needle)),NotFound), Nil, nqp::stmts( nqp::splice(a,@delete_#postfix#,$i,1), delete-also($i, @also), $needle ) ) } my multi sub deletes(array[#type#] \a, #Type#:D $needle, :&cmp!) { nqp::if( nqp::istype( (my $i := finds_#postfix#_cmp(a, $needle, &cmp)), NotFound ), Nil, nqp::stmts( nqp::splice(a,@delete_#postfix#,$i,1), $needle ) ) } my multi sub deletes(array[#type#] \a, #Type#:D $needle, **@also, :&cmp!) { nqp::if( nqp::istype((my $i := finds_#postfix#_cmp(a, $needle, &cmp)),NotFound), Nil, nqp::stmts( nqp::splice(a,@delete_#postfix#,$i,1), delete-also($i, @also), $needle ) ) } #------------------------------------------------------------------------------- # Actual #type# workhorses my sub finds_#postfix#(array[#type#] \a, #type# $needle) { my int $start; my int $end = nqp::sub_i(nqp::elems(a),1); my int $i = nqp::div_i(nqp::elems(a),2); nqp::while( nqp::isge_i($i,$start) && nqp::isle_i($i,$end), # not done yet nqp::if( (my int $cmp = nqp::cmp_#postfix#($needle,nqp::atpos_#postfix#(a,$i))), nqp::if( # not same nqp::islt_i($cmp,0), nqp::stmts( # needle is less ($end = nqp::sub_i($i,1)), ($i = nqp::div_i( nqp::add_i($start,nqp::add_i($end,1)), 2 )) ), nqp::if( # needle is more nqp::islt_i($i,$end), nqp::stmts( # still before end ($start = nqp::add_i($i,1)), ($i = nqp::div_i( nqp::add_i($start,nqp::add_i($end,1)), 2 )) ), (return nqp::box_i(nqp::add_i($end,1),NotFound)) ) ), nqp::stmts( # needle found nqp::while( # find first occurrence nqp::isge_i(($i = nqp::sub_i($i,1)),0) && nqp::iseq_#postfix#($needle,nqp::atpos_#postfix#(a,$i)), nqp::null ), (return nqp::add_i($i,1)) ) ) ); # before or after the array nqp::box_i($i,NotFound) } my sub finds_#postfix#_cmp(array[#type#] \a, #type# $needle, &cmp) { my int $start; my int $end = nqp::sub_i(nqp::elems(a),1); my int $i = nqp::div_i(nqp::elems(a),2); nqp::while( nqp::isge_i($i,$start) && nqp::isle_i($i,$end), # not done yet nqp::if( nqp::eqaddr( (my $cmp := cmp($needle,nqp::atpos_#postfix#(a,$i))), Order::Less ), nqp::stmts( # needle is less ($end = nqp::sub_i($i,1)), ($i = nqp::div_i( nqp::add_i($start,nqp::add_i($end,1)), 2 )) ), nqp::if( nqp::eqaddr($cmp,Order::More), nqp::if( # needle is more nqp::islt_i($i,$end), nqp::stmts( # still before end ($start = nqp::add_i($i,1)), ($i = nqp::div_i( nqp::add_i($start,nqp::add_i($end,1)), 2 )) ), (return nqp::box_i(nqp::add_i($end,1),NotFound)) ), nqp::stmts( # found needle nqp::while( # find first occurrence nqp::isge_i(($i = nqp::sub_i($i,1)),0) && nqp::iseq_#postfix#($needle,nqp::atpos_#postfix#(a,$i)), nqp::null ), (return nqp::add_i($i,1)) ) ) ) ); # before or after the array nqp::box_i($i,NotFound) } my sub inserts_#postfix#(array[#type#] \a, #type# $needle, Int:D $i, int $force) { my #type# @insert = $needle; nqp::if( nqp::istype($i,NotFound), nqp::stmts( # not found nqp::splice(a,@insert,$i,0), nqp::box_i($i,Int) ), nqp::if( # found $force, nqp::stmts( # force insertion (my int $j = $i), nqp::while( # insert after last nqp::islt_i(($j = nqp::add_i($j,1)),nqp::elems(a)) && nqp::iseq_#postfix#($needle,nqp::atpos_#postfix#(a,$j)), nqp::null ), nqp::splice(a,@insert,$j,0), $j ) ) ) } SOURCE # we're done for this role say "#- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE"; say $end ~ $type ~ " candidates -------------------------------------"; } # close the file properly $*OUT.close; # vim: expandtab shiftwidth=4