Your IP : 216.73.216.48
if (word(2 $loadinfo()) != [pf]) { load -pf $word(1 $loadinfo()); return; };
#
# Struct/Assign manipulation functions.
#
# The distinction between the two is that the assign functions operate on
# the entire alias space whereas the struct functions operate only on sub
# structures. The assign functions are typically slower per call, but since
# they do all the work in one call, they can be faster than the recursive
# struct functions.
#
# For each assign.* alias, a corresponding alias.*, but some of them have
# implicit bugs from the fact that arg lists can't yet be retrieved for stored
# aliases.
#
#
# Assign functions.
#
# Make two aliases for every alias. One for assign handling, one for alias
# handling, then make two more for forward and reverse modes.
#
stack push alias alias.ttt;
stack push alias alias.tt;
alias alias.ttt (args) {
alias $args;
@ sar(gr/assign/alias/args);
alias $args;
};
alias alias.tt (args) {
alias.ttt $args;
@ sar(gr/assign./assign.r/args);
@ sar(gr/pmatch/rpmatch/args);
@ sar(gr/;@ :list = revw($list);/;/args);
alias.ttt $args;
};
#
# Check the consistency of the internal structures. The only
# reason to use these is if an epic bug is suspected.
#
alias.ttt assign.check {
@ :oxd = xdebug(dword);
xdebug dword;
@ :omr = aliasctl(maxret 0);
@ :last = [];
@ :list = aliasctl(assign pmatch "\\[$*\\]");
fe ($list) foo {
if (uniq($last $foo)!=sort($last $foo)) {
echo assign consistancy failure: $last >= $foo;
@ last = foo;
};
};
@ aliasctl(maxret $omr);
echo Checked $#list assigns matching $*;
xdebug $oxd;
};
#
# Faster version. Tells you whether there's an error, not where it is.
#
alias.ttt assign.qcheck {
@ :oxd = xdebug(dword);
xdebug dword;
@ :omr = aliasctl(maxret 0);
@ :list = aliasctl(assign pmatch "\\[$*\\]");
@ :status = uniq($list) == sort($list) ? [passed] : [failed];
@ aliasctl(maxret $omr);
echo Checked $#list assigns matching $*: $status;
xdebug $oxd;
};
#
# Dump all assigns with name matching the given masks.
#
alias.tt assign.dump {
@ :oxd = xdebug(dword);
xdebug dword;
@ :list = aliasctl(assign pmatch "\\[$*\\]");
fe ($list) e {
echo [$aliasctl(assign getpackage $e)] $e$chr(9)$aliasctl(assign get $e);
};
@ list = #list;
xdebug $oxd;
if (functioncall()) {
return $list;
} else {
echo Dumped $list matching $*;
};
};
#
# Dump all assigns with name matching the first arg and
# contents matching the rest.
#
alias.tt assign.grep (args) {
@ :oxd = xdebug(dword);
xdebug dword;
@ :list = aliasctl(assign pmatch "\\[$shift(args)\\]");
fe ($list) e {
if (aliasctl(assign get $e) =~ args) {
echo [$aliasctl(assign getpackage $e)] $e$chr(9)$aliasctl(assign get $e);
};
};
@ list = #list;
xdebug $oxd;
if (functioncall()) {
return $list;
} else {
echo Dumped $list matching $*;
};
};
#
# Delete and reassign all matching vars. Theoretically, this is a no-op,
# however, alias.pack will destroy the arg lists of the alias.
#
alias.tt assign.pack {
@ :oxd = xdebug(dword);
xdebug dword;
do {
@ :list = aliasctl(assign $start pmatch "\\[$*\\]");
fe ($list) foo {
@ :baz = aliasctl(assign getpackage $foo);
@ aliasctl(assign set $foo $aliasctl(assign get $foo));
@ aliasctl(assign setpackage $foo $baz);
};
@ list = #list;
if (functioncall()) {
return $list;
} elsif (isdisplaying()) {
echo Packed $list matching $*;
};
} while (list && (:start += aliasctl(maxret)));
xdebug $oxd;
};
#
# Delete all matching vars.
#
alias.tt assign.purge {
if (functioncall()) {
@ :list = aliasctl(assign pmatch "\\[$*\\]");
@ :list = revw($list);
fe ($list) bar {^assign -$bar};
return $#list;
} else {
@ :oxd = xdebug(dword);
xdebug dword;
do {
@ :list = assign.purge($*);
if (isdisplaying()) {
echo Purged $list matching $*;
};
} while (list && list == aliasctl(maxret));
xdebug $oxd;
};
};
#
# Write matching assigns to a file which can then be /load'ed. Any arg lists
# in the original definition won't be saved by alias.save.
#
alias.tt assign.save {
@ :pkg = rand(0);
@ :fh = open($0 W);
@ :start = [];
@ :oxd = xdebug(dword);
xdebug dword;
do {
@ :list = aliasctl(assign $start pmatch "\\[$1-\\]");
fe list foo {
if (pkg != aliasctl(assign getpackage $foo)) {
@ write($fh PACKAGE ${pkg=aliasctl(assign getpackage $foo)});
};
@ write($fh assign $foo $sar(g/\{/\\\{/$sar(g/\}/\\\}/$aliasctl(assign get $foo))));
@ foo = 0;
};
if (functioncall()) {
break;
} elsif (isdisplaying()) {
echo Wrote $#list matching $1-;
};
@ :start += aliasctl(maxret);
} while (#list && start);
@ close($fh);
xdebug $oxd;
return $#list;
};
#
# As for .save, but write a $decode() encoded file which won't be
# damaged by certain variable contents.
#
alias.tt assign.esave {
@ :pkg = rand(0);
@ :fh = open($0 W);
@ :start = [];
@ :oxd = xdebug(dword);
xdebug dword;
do {
@ :list = aliasctl(assign $start pmatch "\\[$1-\\]");
fe list foo {
if (pkg != aliasctl(assign getpackage $foo)) {
@ write($fh PACKAGE ${pkg=aliasctl(assign getpackage $foo)});
};
@ write($fh @aliasctl\(assign set $foo \$decode\($encode($aliasctl(assign get $foo))\)\));
@ foo = 0;
};
if (functioncall()) {
break;
} elsif (isdisplaying()) {
echo Wrote $#list matching $1-;
};
@ :start += aliasctl(maxret);
} while (#list && start);
@ close($fh);
xdebug $oxd;
return $#list;
};
#
# Save the data, then delete it. Repeat until no more data exists.
# The reason the procedure is repeated is because of the aforementioned
# potential bug that .check checks for.
#
alias.tt assign.flush {
do {
@ :bar = assign.save($*);
@ :bar = assign.purge($1-);
echo Flushed $bar matching $1-;
} while (foo != (:foo = bar) || (foo && foo == aliasctl(maxret)));
};
#
# As above but use .esave.
#
alias.tt assign.eflush {
do {
@ :bar = assign.esave($*);
@ :bar = assign.purge($1-);
echo Flushed $bar matching $1-;
} while (foo != (:foo = bar) || (foo && foo == aliasctl(maxret)));
};
#
# End of /assign.* functions.
#
stack pop alias alias.tt;
stack pop alias alias.ttt;
#
# struct functions.
#
#
# Recursively erase a structure.
#
alias struct.purge {
fe ($*) foo {
^assign -$foo;
};
return ${struct.purgesub($*)+#};
};
#
# Continued.
# The third sub-loop does what the first does and should never be entered.
# It's there for company.
#
alias struct.purgesub {
fe ($*) foo {
@ :bar = aliasctl(assign match ${foo}.);
@ :bar = revw($bar);
@ :hit += #bar;
fe ($bar) baz {
^assign -$baz;
};
foreach $foo bar {
@ hit += struct.purgesub(${foo}.${bar});
};
foreach $foo bar {
^assign -${foo}.${bar};
};
};
return ${0+hit};
};
#
# Save a structure, like array.save.
#
alias struct.savefn {
@ :fd = open($0 w);
@ :hit = struct.savefd($fd $1-);
@ close($fd);
return $hit;
};
#
# Continued. Save to an FD.
#
alias struct.savefd {
@:fd=[$0];
fe ($1-) foo {
if (strlen($($foo))) {
@ write($fd assign $foo $sar(g/\{/\\\{/$sar(g/\}/\\\}/$aliasctl(assign get $foo))));
@ :hit = 1;
} else {
@ :hit = 0;
};
foreach $foo bar {
@ hit += struct.savefd($fd ${foo}.${bar});
};
};
return $hit;
};
#
# Some basic /assign handling functions.
#
# /assign.uniq won't work without the functions and data_array scripts. You need to load those manually.
#
alias assign.add (var,val) {assign $var $uniq($($var) $val);};
alias assign.addn (var,val) {assign $var $revw($uniq($revw($($var) $val)));};
alias assign.ifnul {if ([]==[$($0)]){assign $*};};
alias assign.filter {fe ($uniq($aliasctl(assign pmatch "\\[$split(, $0)\\]"))) foo {assign $foo $filter("\\[$1-\\]" $($foo))};};
alias assign.uniq (args) {
bless;
@ :num = isnumber(b10 $args) ? shift(args) : 1;
@ delarray(assign.uniq);
fe ($args) var {
@ :vars = replace(\$varx x $jot(1 $num));
fe ($($var)) $replace(varx x $jot(1 $num)) {
eval setuniqitem assign.uniq $vars;
};
assign $var $getandmitems(assign.uniq *);
};
};