[luser droog <
luser...@gmail.com>, 2017-06-13 23:28]
[...]
> I'm not sure if I've mentioned this, but don't try to view the result
> of the /many combinator. Its result is a procedure which recursively
> contains itself. So the `==` operator will overflow the execution stack
> if it attempts to print it.
This can help, I made it when I was playing with iterators, which also
use a lot of dynamic code. It's not the epytome of elegant code, but helps...
samara:~/src/misc/ps% gsnd -q
inspect.ps pc5.ps
GS>/Inspect /ProcSet findresource begin userdict begin
GS>/ppstack { inspectstack print } def
GS>
GS>(x) term many (xy) term seq ppstack
0: {z z z #1=(x) test zy #2={next {{z z #1# test zy #2# curry cvx map zy #5=()
pass combine} exec} exec sum-up} curry cvx map zy #5# pass combine zy {next
(xy) test sum-up} curry cvx map}
GS<1>%
samara:~/src/misc/ps%
inspect.ps:
%!PS-Adobe-3.0 Resource-ProcSet
%%Copyright: Public Domain
%%DocumentSuppliedResources: procset Inspect 1.0 1
%%+ procset _Inspect 1.0 1
%%EndComments
%%BeginProlog
%%BeginResource: procset _Inspect 1.0 1
% private functions
20 dict begin
/strbuffer 4000 string def
% obj -> pos
/register {
registry [ 3 -1 roll false ] eappend
registry elength 1 sub
} bind def
% obj -> pos true
% obj -> false
% also sets registered object as used
/registered {
false
registry elength 1 sub -1 0 {
dup
registry exch eget dup
0 get 4 index eq { 1 true put exch pop true exit } if
pop pop
} for
dup { 3 -1 roll } { exch } ifelse
pop
} bind def
% earray newlen ->
/eexpand {
1 index 0 get length
2 copy gt {
{
2 copy le { exit } if
2 mul
} loop
dup 65535 gt { pop 65535 } if
% aa rl nl
exch pop % aa nl
dup % aa nl nl
2 index 0 get length ge { % aa nl
1 index 0 get type /stringtype eq { string } { array } ifelse %% aa na
dup 2 index 0 get exch copy pop
0 exch put
}
{ pop pop } ifelse
}
{ pop pop pop } ifelse
} bind def
% expandable-array:[arr len] elt ->
/eappend {
exch dup aload % st: elt earray edata elen earray
exch 1 add eexpand pop
aload % e edata elen earray
4 1 roll 3 -1 roll put
dup 1 get 1 add 1 exch put
} bind def
% exparr arr
/econcat {
2 copy length exch 1 get add % aa ca ni
2 index 2 copy exch eexpand % aa ca ni aa
aload pop % aa ca ni a i
4 -1 roll putinterval % aa ni
1 exch put
} bind def
/newexparray { [ 4 array 0 ] } bind def
/newexpstring { [ 4 string 0 ] } bind def
/edata { dup 0 get exch 1 get 0 exch getinterval } bind def
/elength { 1 get } bind def
/eget { exch 0 get exch get } bind def
/eput { 2 copy 1 sub eexpand exch 0 get exch put } bind def
/dupstr { dup length string copy } bind def
% /limit default -> n
/getlimit {
exch dup where {
exch get exch pop
} {
pop
} ifelse
} bind def
/inspectarray {
dup register
newexparray dup 3 -1 roll eappend
dup 2 index xcheck { /xarr } { /arr } ifelse eappend
/InspectArrayLimit 1000 getlimit
3 -1 roll {
exch 1 sub dup 3 1 roll 0 lt { pop 1 index (...) eappend exit } if
inspectobject 2 index exch eappend
} forall
pop
edata
} bind def
/inspectdict {
dup register
newexparray dup 3 -1 roll eappend
dup /dict eappend
/InspectDictLimit 500 getlimit
3 -1 roll {
3 -1 roll 1 sub dup 4 1 roll 0 lt { pop pop 1 index (...) eappend exit } if
exch inspectobject 3 index exch eappend
inspectobject 2 index exch eappend
} forall
pop
edata
} bind def
/inspectname {
newexpstring
1 index xcheck not { dup 47 eappend } if
dup 3 -1 roll strbuffer cvs econcat
edata
} bind def
/tooctal {
8 strbuffer cvrs
newexpstring dup 92 eappend
1 index length 3 exch sub { dup 48 eappend } repeat
dup 3 -1 roll econcat
edata
} bind def
/stringescapes <<
40 (\\\()
41 (\\\))
92 (\\\\)
8 (\\b)
9 (\\t)
10 (\\n)
12 (\\f)
13 (\\r)
>> def
/inspectstring {
dup register
newexparray dup 3 -1 roll eappend
dup
newexpstring dup 40 eappend
/InspectStringLimit 500 getlimit
5 -1 roll {
exch 1 sub dup 3 1 roll 0 lt { pop 1 index (\\...) econcat exit } if
2 index exch
dup stringescapes exch known {
stringescapes exch get econcat
} {
dup dup 32 lt exch 126 gt or {
tooctal econcat
} {
eappend
} ifelse
} ifelse
} forall
pop
dup 41 eappend
edata eappend edata
} bind def
/inspectother {
strbuffer cvs dupstr
} bind def
/iscomposite {
type dup dup dup /arraytype eq
exch /packedarraytype eq or
exch /dicttype eq or
exch /stringtype eq or
} bind def
% obj
/inspectobject {
dup iscomposite {
dup rcheck not {
pop (#<noaccess>)
} {
dup registered {
exch pop
newexpstring dup 35 eappend
dup 3 -1 roll strbuffer cvs econcat
dup 35 eappend edata dupstr
} {
dup type
dup dup /arraytype eq exch /packedarraytype eq or {
pop inspectarray
} {
dup /dicttype eq {
pop inspectdict
} {
/stringtype eq {
inspectstring
} if
} ifelse
} ifelse
} ifelse
} ifelse
} {
dup type /nametype eq {
inspectname
} {
dup type /nulltype eq {
pop (null)
} {
dup type /marktype eq {
pop (--mark--)
} {
dup type /filetype eq {
pop (--file--)
} {
inspectother
} ifelse
} ifelse
} ifelse
} ifelse
} ifelse
} bind def
% expstr obj ->
/inspectinto {
dup type dup /stringtype eq {
pop econcat
} {
/arraytype eq {
inspectarrayinto
} {
pop (**????**) econcat
} ifelse
} ifelse
} bind def
/inspectarrayinto {
dup 0 get dup registry exch eget 1 get {
2 index 35 eappend
2 index exch strbuffer cvs econcat
1 index 61 eappend
} { pop } ifelse
dup 1 get dup type /stringtype eq {
exch pop econcat
} {
dup /dict eq {
pop (<<) (>>)
} {
dup /arr eq {
pop ([) (])
} {
/xarr eq {
({) (})
} {
(¿) (?)
} ifelse
} ifelse
} ifelse
% stack: espstr arr open close
3 index 3 -1 roll econcat
2 1 3 index length 1 sub {
dup 2 gt { 3 index 32 eappend } if
2 index exch get
3 index exch inspectinto
} for
3 -1 roll exch econcat
pop
} ifelse
} bind def
currentdict
end
/_Inspect exch /ProcSet defineresource pop
%%EndResource
%%BeginResource: procset Inspect 1.0 1
2 dict begin
% obj -> str
/inspect {
/_Inspect /ProcSet findresource begin
1 dict begin
/registry newexparray def
inspectobject
newexpstring dup 3 -1 roll inspectinto
edata
end
end
} bind def
/inspectstack {
/_Inspect /ProcSet findresource begin
1 dict begin
/registry newexparray def
count dup array
exch 1 add 2 1 3 -1 roll {
dup index inspectobject
2 index 3 -1 roll 2 sub 3 -1 roll put
} for
newexpstring
0 1 3 index length 1 sub {
dup 3 index exch get
exch strbuffer cvs 2 index exch econcat
1 index (: ) econcat
1 index exch inspectinto
dup 10 eappend
} for
exch pop edata
end
end
} bind def
currentdict
end
/Inspect exch /ProcSet defineresource pop
%%EndResource
%%EndProlog
--