On Wednesday, March 15, 2023 at 2:46:26 AM UTC-5, David Newall wrote:
> On 14/3/23 11:05, luser droog wrote:
> > The variable arguments are interpolated in reverse order (ie. the
> > normal top-of-stack down-ward way). I'm not sure how useful it
> > actually is. Should it take an array for the variable arguments and
> > take them left-to-right?
> I love this game! :-)
>
> Here's a slightly different implementation that uses search instead of
> testing each character.

Very cool. That ought to run faster and use less memory.

[snip]
> dup/stringtype eq { pop exit } if
> dup/nametype eq { pop (/) exch dup length string cvs exit } if
> dup/operatortype eq 1 index/integertype eq or 1 index/realtype eq or
> { pop 20 string cvs exit }
> if
> dup/booleantype eq { pop {(true)}{(false)} ifelse exit } if
> dup/marktype eq { pop (MARK) exit } if
> dup/nulltype eq { pop (-) exit } if
> dup/savetype eq { pop (-save-) exit } if
> dup/filetype eq { pop (-file-) exit } if
> dup/fonttype eq { pop (-font-) exit } if
> dup/gstatetype eq { pop (-gstate-) exit } if
> /sprintf_element cvx errordict/typecheck get exec

I'd be tempted to pull these out into a separate dictionary.

/_sprintf_dict <<
/stringtype{ pop exit }
/nametype{ pop (/) exch dup length string cvs exit }
...
/default{ pop (-unsupported-type-) exit }
>> def

{
...
//_sprintf_dict 1 index type 2 copy known not {pop/default} if get exec
...
}

Another bonus is that you could implement `==` quite easily if a `sprintf`
like this were available.

/== { (%) sprintf print } def

On Thursday, March 23, 2023 at 10:54:51 AM UTC-5, luser droog wrote:
> On Wednesday, March 15, 2023 at 2:46:26 AM UTC-5, David Newall wrote:
> > On 14/3/23 11:05, luser droog wrote:
> > > The variable arguments are interpolated in reverse order (ie. the
> > > normal top-of-stack down-ward way). I'm not sure how useful it
> > > actually is. Should it take an array for the variable arguments and
> > > take them left-to-right?
> > I love this game! :-)
> >
> > Here's a slightly different implementation that uses search instead of
> > testing each character.
> Very cool. That ought to run faster and use less memory.
>

A little further inspiration. I first wanted to bust it up into smaller re-usable
functions. This has the disadvantage of creating and discarding more
intermediate arrays, but oh well. Then I re-tooled it to use search instead
of going char by char, but now it uses more intermediate data.

/sprintf2 {
format
join
} def

/format { % ... obj (format%string) format [(f)(o)(r)(m)(a)(t)(obj*)(s)(t)(r)(i)(n)(g)]
[ exch
{
dup (%) eq { pop snag convert } if
} foreach
]
} def

/foreach { % array|string proc foreach - % array[1]|string[1] proc ?
2 dict begin {proc src}{exch def}forall
0 1 /src load length 1 sub ({ % i
//src exch 1 getinterval
//proc exec
}) cvx exec end for
} def

/snag {
counttomark 2 add -1 roll
} def

/join { % [(a){b)(c)] join (abc)
0 1 index {
length add
} forall % src dst-length
1 index 0 get type /stringtype eq {string}{array} ifelse
exch % dst src
0 exch {
3 copy putinterval
length add
} forall
pop
} def

/convert /convert2 cvx def

/convert1 {
256 string cvs
} def

/convert-dict <<
/stringtype { }
/arraytype { ([ ) exch { convert ( ) } forall (]) }
/default { 256 string cvs }
>> def
/convert2 {
//convert-dict 1 index type 2 copy known not { pop /default } if get exec
} def

/sprintf3 {
(%) split
[ exch
{ dup (%) eq { pop snag convert } if } forall
]
join
} def

/split { % (s.t.r.i.n.g) (.) split [(s)(.)(t)(.)(r)(.)(i)(.)(n)(.)(g)]
[ 3 1 roll
{
search not { exit } if % [ ,,, (t.r.i.n.g) (.) (s)
3 1 roll dup 3 1 roll % [ ... (s) (.) (t.r.i.n.g) (.)
} loop
]
} def

/a 25 def
/b /B def

b a (format % %) sprintf
pstack % => (format 25 B)
clear

b a (format % %) sprintf2
pstack % => (format 25 B)
clear

[1 2 3] b a (format % % %) sprintf3
pstack % => (format 25 B [ 1 2 3 ])

On Thursday, March 23, 2023 at 11:16:01 PM UTC-5, luser droog wrote:
> On Thursday, March 23, 2023 at 10:54:51 AM UTC-5, luser droog wrote:
> > On Wednesday, March 15, 2023 at 2:46:26 AM UTC-5, David Newall wrote:
> > > On 14/3/23 11:05, luser droog wrote:
> > > > The variable arguments are interpolated in reverse order (ie. the
> > > > normal top-of-stack down-ward way). I'm not sure how useful it
> > > > actually is. Should it take an array for the variable arguments and
> > > > take them left-to-right?
> > > I love this game! :-)
> > >
> > > Here's a slightly different implementation that uses search instead of
> > > testing each character.
> > Very cool. That ought to run faster and use less memory.
> >
> A little further inspiration. I first wanted to bust it up into smaller re-usable
> functions. This has the disadvantage of creating and discarding more
> intermediate arrays, but oh well. Then I re-tooled it to use search instead
> of going char by char, but now it uses more intermediate data.
>

Got rid of the intermediate arrays at the cost of parsing and constructing
a new procedure body in the new, weird looping proc. This code uses /convert
as defined in my previous message. [I'm posting through GG until I fix my gnus
setup for posting, so I can't quote indented code without losing indentation
or doing extra work to add it back.]

/sprintf4 { % data (format%rem) sprintf4 (format<data>*rem)
[ exch
(%) { % data [ (format) (rem) (%) [
pop snag % [ (format) (rem) (%) data
mark exch % [ (format) (rem) (%) [ data
convert % [ (format) (rem) (%) (<data>*)
} on-matches
join-to-mark
} def

/on-matches { % string seek proc
1 dict begin /proc exch def
({
search not { exit } if
3 1 roll mark % pre post match [
//proc exec % pre post match [ proc*
counttomark % pre post match [ proc* n
dup 2 add -1 roll pop % pre post match proc* n
dup 2 add exch % pre post match proc* n+2 n
roll % pre proc* post match
}) cvx exec end loop
} def

/join-to-mark { % [ <obj1> .. <objN>
counttomark dup 1 add copy % [ <obj1> .. <objN> n <obj1> .. <objN> n
0 exch { % ... <obj1> .. <objn> 0
exch length add
} repeat % [ <obj1> .. <objN> n length
counttomark 1 sub index type /stringtype eq
{string}{array} ifelse % [ <obj1> .. <objN> n dest
exch 0 exch { % [ <obj1> .. <objN> dest pos
counttomark -1 roll % [ <obj2> .. <objN> dest pos <obj1>
3 copy putinterval length add % [ <obj2> .. <objN> dest' pos'
} repeat % [ dest length
pop exch pop
} def

On 24/3/23 02:54, luser droog wrote:
> I'd be tempted to pull these out into a separate dictionary.
>
> /_sprintf_dict <<
> /stringtype{ pop exit }
> /nametype{ pop (/) exch dup length string cvs exit }
> ...
> /default{ pop (-unsupported-type-) exit }
> >> def
> {
> ...
> //_sprintf_dict 1 index type 2 copy known not {pop/default} if get
exec
> ...
> }

Very smart.

Here's a tiny improvement to split:

/split { % (s.t.r.i.n.g) (.) split [(s)(.)(t)(.)(r)(.)(i)(.)(n)(.)(g)]
[ 3 1 roll
{
search {1 index 4 2 roll} {exit} ifelse
} loop
]
} def