1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
# Array manipulation functions.
#
#
# General one liners. Brief description:
#
# The *item functions operate on one array element.
# The *items functions operate on as many elements as there are args.
#
# Note that unlike their inbuilt counterparts, these generally accept negative
# item numbers as the distance from the top of the array, starting with -1.
#
# Let's start with some basics:
#
# getndelitems: splice the items $1- from the array and return them as a list.
# getndelindex: splice the indices $1- from the array and return them as a list.
# getnrolitems: Splice items $2- from $0, put them at the end of $1, and return them.
# itemnorm: Supporting function. Fixes/removes invalid item numbers.
#
alias itemnorm (ar,it) @:ni=numitems($ar);fe it it {@it+=0<=it?0:ni,it=0<=it&&it<ni?it:[]};return $it
alias getndelitems (ar,it) @:it=itemnorm($ar $it),:function_return=getitem($ar $it),delitems($ar $it)
alias getndelindex (ar,it) @:it=itemnorm($ar $it),:function_return=igetitem($ar $it),delitems($ar $indextoitem($ar $it))
alias getnrolitems (a1,a2,it) @:dt=:it=itemnorm($a1 $it);fe it it {setnextitem $a2 ${it=getitem($a1 $it)}};@delitems($a1 $dt);return $it
#
# Now onto some more complex functions:
#
# getmaskitem[s]: return one/all array elements matching $1-.
# getandmitem[s]: Get an' Del item[s] matching Mask ($1-) from array $0.
# getanrmitem[s]: Get an' Rol item[s] matching Mask ($2-) from array $0 to $1.
#
alias getmaskitem (ar,mask) @:it=getmatches($ar $mask);return ${getitem($ar $word($rand($#it) $it))}
alias getmaskitems (ar,mask) return $getitem($ar $getmatches($ar $mask))
alias getandmitem (ar,mask) @:it=getmatches($ar $mask);return ${getndelitems($ar $word($rand($#it) $it))}
alias getandmitems (ar,mask) return $getndelitems($ar $getmatches($ar $mask))
alias getanrmitem (a1,a2,mask) @:it=getmatches($a1 $mask);return ${getnrolitems($a1 $a2 $word($rand($#it) $it))}
alias getanrmitems (a1,a2,mask) return $getnrolitems($a1 $a2 $getmatches($a1 $mask))
#
# The set*item functions update arrays in certain potentially useful ways.
#
# The set*items functions call their set*item counterpart for each word given.
#
# setnextitem[s]: set a new array element[s] with $1- as contents.
# setranditem[s]: replace a random array element[s] with $1-
# setrmaxitem[s]: setnextitem if $1 > numitems else setranditem.
# setuniqitem[s]: setnextitem if the array item[s] doesn't already exist.
#
alias setnextitem (ar,args) return $setitem($ar $numitems($ar) $args)
alias setnextitems (ar,args) fe args foo {@foo=setitem($ar $numitems($ar) $foo)};return $args
alias setranditem (ar,args) return $setitem($ar $rand($numitems($ar)) $args)
alias setranditems (ar,args) fe args foo {@foo=setitem($ar $rand($numitems($ar)) $foo)};return $args
alias setrmaxitem (ar,it,args) @:ni=numitems($ar);return $setitem($ar ${it>ni?ni:rand($ni)} $args)
alias setrmaxitems (ar,it,args) @:ni=numitems($ar);fe args foo {@foo=setitem($ar ${it>ni?ni++:rand($ni)} $foo)};return $args
alias setuniqitem (ar,args) if (0>finditem($ar $args)){return $setitem($ar $numitems($ar) $args)}
alias setuniqitems (ar,args) fe args foo {@foo=0>finditem($ar $foo)?setitem($ar $numitems($ar) $foo):-1};return $args
#
# Delete contents matching $1- of array $0.
# If an arg isn't specified, it equates to *.
#
alias array.purge (args) {
@ :mask = []
fe ($getarrays($shift(args))) foo {
@ 1>#args ? delarray($foo) : delitems($foo $getmatches($foo $args))
}
}
#
# Load files $1- into array $0
#
alias array.read (args) {
@ :ar = shift(args)
@ :it = numitems($ar)
fe ($glob($args)) fn {
@ :fd = open($fn r)
while ((:dt = read($fd)) || !eof($fd)) {
@ usetitem($ar ${it++} $dt)
}
@ close($fd)
}
}
#
# Load files $* into arrays of the same name.
#
alias array.nread (args) {
fe ($glob($args)) fn {
@ :it = numitems($fn)
@ :fd = open($fn r)
while ((:dt = read($fd)) || !eof($fd)) {
@ usetitem($fn ${it++} $dt)
}
@ close($fd)
}
}
#
# Give a brief summary of all matching arrays, or all arrays.
alias array.stat {
fe ($getarrays($*)) foo {
echo $numitems($foo)/$#listarray($foo)/$@listarray($foo) $foo
}
}
#
# I tried to clean these up. Really I did. Just give me some time.
#
# Brief summary:
# .dump/.grep displays matching contents of matching arrays (in different ways).
# .codump/.cogrep as above but sews together multiple arrays for displaying.
# .idump/.igrep/.coidump/.coigrep sorted versions of above.
# .write/.iwrite/.nwrite/.niwrite inverse of .read, differing in the order in which lines are written.
# .flush/.iflush/.nflush/.niflush write and delete the arrays.
#
stack push alias alias
fe (dump " -banner" "[\$[-4]item \$[-2]#content \$[-3]@content] " grep " -nobanner" "") cmd banner fnord {
fe (i$cmd igetitem igetmatches $cmd getitem getmatches) foo bar baz {
alias array.$foo (arrays default *, mask default *) fe ($getarrays($arrays)) array \{echo \$numitems($array)/\$#listarray($array)/\$@listarray($array) \$array\;fe \(\$${baz}($array $mask)\) item \{@:content=${bar}($array $item)\;echo $fnord\$content\}\}\;echo $chr(2)\$#getarrays($arrays)$chr(2) arrays listed
}
}
fe (dump "\$array [\$[-4]item \$[-2]#content \$[-3]@content] " grep "") cmd fnord {
fe (coi$cmd "indextoitem($array $igetmatches" ")" co$cmd getmatches "") foo bar baz {
alias array.$foo @:array=[\$0]\;@:mk=[\$1]\;@:ar=beforew($mk $2-)\;fe \(\$${bar}($array $afterw($mk $2-))$baz\) item \{@:content=\;fe ($ar) foo {@push(content $getitem($foo $item))}\;echo $fnord\$content\}
}
}
alias alias (args) {
//alias $args
fe (write flush getmatches getitem) foo {
@ sar(gr/i$foo/$foo/args)
}
//alias $args
}
alias array.iwrite (args) {
@ :fd = open($shift(args) w)
fe ($getarrays($shift(args))) foo {
fe ($igetmatches($foo ${args?args:[*]})) bar {
@ write($fd $igetitem($foo $bar))
}
}
@ close($fd)
}
alias array.niwrite (args) {
fe ($getarrays($shift(args))) foo {
@ :fd = open($foo w)
fe ($igetmatches($foo ${args?args:[*]})) bar {
@ write($fd $igetitem($foo $bar))
}
@ close($fd)
}
}
alias array.iflush array.iwrite $*;array.purge $1-
alias array.niflush array.niwrite $*;array.purge $*
stack pop alias alias
|
