Firstly, be very careful about choosing names for your definitions. length
is the name of an operator. So while your definition is in effect (presumably in userdict
) the operator (in systemdict
) is not accessible by name*.
For any tricky stack-manipulation code, it's a very good habit to write comments describing the stack at the end of each line. This is where you can use "free" variable names.
count % ... n
Now, since we're using this value immediately, it doesn't actually need to be defined at all. Just leave it on the stack.
{ %
} repeat
Now loops may seem tricky to document the stack but really it's exactly the same. The repeat loop takes the repeat-count argument off of the stack, so the procedure begins with the contents just below.
{ % ...
1 index 0 index
would be better as 1 index 1 index
(right? because the first one shifted the stack depth). But it's best as 2 copy
.
2 copy gt { % ... x y (x>y)
The (x>y)
here is not on the stack but represents knowledge of the variables' relationship.
2 1 roll
is better as exch
.
exch % ... y x (x>y)
count 1 sub -1 roll %
This will pull the second-from-the-bottom to the top. See my guide to the roll
operator: Positive j to roll away, negative to retrieve.
exch % a b ... y x (x>y)
But if x<y
then we still want to roll the next number from the bottom, right? So the if
clause should end here.
} if
count 1 sub -1 roll % a ... y x b
If you remove the 1 sub
, then it grabs the bottom of stack. And then I think it should do what you describe.
} repeat
Assembled.
count % ... n
{ % ...
2 copy gt { % a ... x y (x>y)
exch % a ... y x (x>y)
} if % a ... y x (x>y)
count -1 roll % ... y x a (x>y)
} repeat
Edit, one day later: Um. Problem. It's not right. Since the roll
happens after the comparison, there's going to be one extra unnecessary roll
before the loop terminates which places one of the smaller, rejected values on the top.
A quick fix is to add
count 1 roll % a ... y x (x>y)
at the very end, after the loop. But I think a nicer way is to roll first, then compare.
It's a "fence-posting" problem if ever I saw one.
a b c d e f g h
g>h
f>g
e>f
d>e
c>d
b>c
a>b
So we only actually need n-1 comparisons. Which leads to this version, which I think should work better.
count 1 sub % a b c ... x y n-1
{
count -1 roll % b c ... x y a
2 copy gt { exch } if % b c ... x y a (a>y)
} repeat
There's still one unnecessary roll
(the very first one), but it's harmless now.
[*] It's still accessible in procedures which have had bind
applied.