%!
%errordict/undefined{pstack / = countexecstack array execstack == quit}put
%errordict/typecheck{pstack / = countexecstack array execstack == quit}put
<<
/logo{
{ % a
%pstack / =
dup length 0 eq { pop exit } if
1 shift first
dup type /nametype eq {
dup arity % xs x n
3 2 roll exch shift exch % x xm xs
3 1 roll [ 3 1 roll % xs [ x xm
aload pop counttomark -1 roll % xs [ ...xm x
load 1 shift first % xs [ ... xp xa
/inputs cvx 3 -1 roll /proc cvx % xs [ ... xa inputs xp proc
4 array astore cvx % xs [ ... {xa inputs xp proc}
exec ] exch
%pstack / =
}{
exch
} ifelse
}loop
}
/forward{{dist} PS {dist = / =}}
/to{{name} PS { % xs [
%pstack
exch { % [ ... xs
%pstack / =
dup first dup type /nametype eq {
dup dup length string cvs first (:) first eq {
exch rest
}{
pop exit
} ifelse
}{
pop exit
} ifelse
} loop
%pstack / =
counttomark 1 add 1 roll ] cvx % xs {inputs}
exch [ exch { % {inputs} [ ... xs
%pstack / =
dup first dup type /nametype eq {
dup /end eq {
pop rest exit
}{
exch rest
} ifelse
}{
exch rest
} ifelse
} loop
%pstack / =
counttomark 1 add 1 roll ] cvx exch % {inputs} {proc} xs
3 1 roll 2 array astore
/name load exch
/logo where pop 3 1 roll put
[
}}

/proc{
{
{
dup length 0 eq { pop exit } if
1 shift first
%pstack / =
dup /PS eq { pop stop } if
[ exch logo ] exch
} loop
} stopped {
%pstack / =
first exec
} if
end
}
/inputs{
dup length dict begin
dup length 1 sub -1 0 { % ... a i
2 copy get % ... a i a_i
4 -1 roll def pop % ... a
} for pop % ...
}
/arity{
load first length
}
/shift{ % a n
2 copy % a n a n
0 exch getinterval 3 1 roll % a[0..n-1] a n
1 index length 1 index sub getinterval % a[0..n-1] a[n..$]
exch
}
/first{ 0 get }
/rest{ 1 1 index length 1 sub getinterval }

>>begin

{
forward 12
forward 100
5 6 7

to fd :dist
forward :dist
end
fd 47
}logo
(stack:) = pstack
quit

output:
$ alias gsq
alias gsq='gsnd -q -dNOSAFER'
$ gsq logo.ps
12

100

47

stack:
[[[]]]
[]
7 6
5 []
[]

It now does recursive evaluation of arguments before calling a function.
Extra unexpected values just trickle down to the stack. I'm still using
marks to bracket stuff on the stack, but now without creating so many arrays.
This means lots of extra stack shuffling. Finally getting the hang of counttomark.

%!
%errordict/undefined{pstack / = countexecstack array execstack == quit}put
errordict/typecheck{pstack / = countexecstack array execstack == quit}put
<<
/logo{
{ % a
dup length 0 eq { pop exit } if
logo-step
}loop
}
/logo-step{
dup rest exch first
dup isfunc {
dofunc
}{
exch
} ifelse
}
/isfunc{
dup type /nametype eq {
load
dup xcheck exch type /arraytype eq and
}{
pop false
} ifelse
}
/dofunc{
dup arity [ 4 3 roll % x n [ xs
{ % x n [ ... xs
counttomark % x n [ ... xs cnt
dup 2 add index exch 1 sub % x n [ ... xs n #...
le { exit } if
logo-step % x n [ ... ? xs
} loop % x n [ ... xs
counttomark 1 add 1 roll % x n xs [ ...
counttomark 4 add -2 roll pop % xs [ ... x
load dup rest exch first
/inputs cvx 3 -1 roll /proc cvx
%pstack / =
4 array astore cvx % xs [ ... {xa inputs xp proc}
exec % xs [ results*
%] exch
counttomark 2 add -2 roll pop % results* xs
}
/dofunc-v1{
dup arity % xs x n
3 2 roll exch shift exch % x xm xs
3 1 roll [ 3 1 roll % xs [ x xm
aload pop counttomark -1 roll % xs [ ...xm x
load dup rest exch first % xs [ ... xp xa
/inputs cvx 3 -1 roll /proc cvx % xs [ ... xa inputs xp proc
4 array astore cvx % xs [ ... {xa inputs xp proc}
exec ] exch
}

/print{{it} PS {it == / =}}
/sum{{x y} PS { x y add }}
/difference{{x y} PS { x y sub }}
/product{{x y} PS { x y mul }}
/quotient{{x y} PS { x y div }}

/to{{} PS { % xs [ . xs [
%pstack / =
exch dup rest exch first /name exch def
{ % [ ... xs
dup first dup type /nametype eq {
dup dup length string cvs first (:) first eq {
exch rest
}{ pop exit } ifelse
}{ pop exit } ifelse
} loop counttomark 1 add 1 roll ] cvx % xs {inputs}
exch [ exch { % {inputs} [ ... xs
dup first dup type /nametype eq {
dup /end eq { pop rest exit }{ exch rest } ifelse
}{ exch rest } ifelse
} loop counttomark 1 add 1 roll ] cvx exch % {inputs} {proc} xs
3 1 roll 2 array astore cvx /name load exch /logo where pop 3 1 roll put
[
}}

/proc{
{
{
dup length 0 eq { pop exit } if
dup rest exch first
dup /PS eq { pop stop } if
[ exch logo % xs [ results*
%] exch
counttomark 2 add -2 roll pop
} loop
} stopped {
first exec
} if
end
}
/inputs{
dup length dict begin
dup length 1 sub -1 0 { % ... a i
2 copy get % ... a i a_i
4 -1 roll def pop % ... a
} for pop % ...
}
/arity{
load first length
}
/compose{
1 index xcheck 3 1 roll
1 index length 1 index length add array dup 0 4 index putinterval
dup 4 -1 roll length 4 -1 roll putinterval
exch {cvx} if
}
/shift{ % a n . a[n..$] a[0..n-1]
2 copy % a n a n
0 exch getinterval 3 1 roll % a[0..n-1] a n
1 index length 1 index sub getinterval % a[0..n-1] a[n..$]
exch % a[n..$] a[0..n-1]
}
/first{ 0 get }
/rest{ 1 1 index length 1 sub getinterval }

>>begin

{
print 12
print 100
print sum 3 product 4 2
5 6 7

to fd :dist
print :dist
end
fd 47
to tup :arg
4 6
end
print tup 12
print 5
}logo
(stack:) = pstack
quit

Output:
$ gsnd -q logo.ps
12

100

11

47

6

5

stack:
4 7
6 5

On Thu, 27 Jan 2022 22:47:47 -0800 (PST)
luser droog <luser.droog@gmail.com> wrote:

> [LOGO]

Ha! Awesome! :)