## Saturday, 25 July 2009

### Perverse Code: Deviant Forth

The Forth programming language has a set of functions (or words) called primitives. These are traditionally written in the language of the host machine to keep the system as simple and efficient as possible. Typically the primitives required no more than about five machine instructions each to implement.

Deviant Forth explores the possibility of using Forth to implement some of the primitives. Warning, prolonged exposure to this code may cause permanent damage to your eyes!

As a exercise, let's implement NIP in Forth:

`: NIP SWAP DROP ;`

Standard stuff so far. Now lets try to implement SWAP and DROP!

`: DROP DUP - + ;`
`: SWAP OVER >R >R DROP R> R> ;`

Things are beginning to look ugly. On most systems DROP can be implemented in one machine instruction and SWAP in four. It's also possible to implement DUP, + and OVER in Forth:

`: DUP >R R@ R> ;`
`: + >R DUP DUP - R> - - ;`
`: OVER >R DUP DUP R@ - DUP >R - R> R> + ;`

I'm no Forth purist, but I feel repelled by the abomination I've programmed. Despite this, it's interesting to discover so many Forth words can be implemented with just >R, R>, R@ and -, however unnatural it might be.

As an afront to the very nature of Forth I challenge you to implement ROT using only >R, R>, R@ and -. If you can in less than 50 words I'd love to see your solution, however unpleasant :-)

1. My solution for swap:

>R >R R@ R> R@ - >R R@ - R@ R@ R> - R> - -

Just took OVER, pushed one less x, and removed redundancy.

Ugly optimality proof (assuming it's correct), basically just checking all possible programs up to length 15:

def run(code):
stack = [23765234, 29387324]
retstack = []
try:
for i in code:
if i == 0:
retstack.append(stack.pop())
elif i == 1:
stack.append(retstack.pop())
elif i == 2:
stack.append(retstack[-1])
elif i == 3:
y = stack.pop()
x = stack.pop()
stack.append(x - y)
except:
return False
if stack == [29387324, 23765234] and retstack == []:
return True
else:
return False

def forbidden_of(a):
if a == 0:return 1
if a == 1:return 0
return -1

def stackcheck(instr,stack,retstack):
if instr==0:
return stack>0,stack-1,retstack+1
if instr==1:
return retstack>0,stack+1,retstack-1
if instr==2:
return retstack>0,stack+1,retstack
if instr==3:
return stack>1,stack-1,retstack

def generate(vals, amt):
if amt == 0:
yield [],-1,2,0
else:
ret=[]
for (l,forbidden,stack,retstack) in generate(vals, amt-1):
for a in xrange(vals):
if a!=forbidden:
okay,newstack,newretstack=stackcheck(a,stack,retstack)
if not okay:continue
yield [a]+l,forbidden_of(a),newstack,newretstack

for length in xrange(1, 16):
for i in generate(4, length):
l=i
if run(l):
print i

# >R = 0
# R> = 1
# R@ = 2
# - = 3
# [0, 0, 2, 1, 2, 3, 0, 2, 3, 2, 2, 1, 3, 1, 3, 3]
# >R >R R@ R> R@ - >R R@ - R@ R@ R> - R> - -

2. : rot >r swap r> swap ;

Not that ugly, unless you inline swap...

3. Note that you could also implement DROP as
: DROP DUP - - ;

Then, inlining the whole stuff, it comes out as >r >r >r r@ r> >r r@ r> r@ - >r r@ r> >r - r> r> >r >r r@ r> >r r@ r> - r> - - >r >r >r r@ r> - - r> r> r> >r >r r@ r> >r r@ r> r@ - >r r@ r> >r - r> r> >r >r r@ r> >r r@ r> - r> - - >r >r >r r@ r> - - r> r>
This is 73 words, however, we can optimize it to exactly 50 words by reducing r> >r to nothing:

>r >r >r r@ r@ r> r@ - >r r@ - r@ r@ r> - r> - - >r >r >r r@ r> - - r> r@ r@ r> r@ - >r r@ - r@ r@ r> - r> - - >r >r >r r@ r> - - r> r>

Yes, it really is ugly.

4. Using oklopol's swap, we can get a shorter solution (slightly optimized using >r r> reduction):

>r >r >r r@ r> r@ - >r r@ - r@ r@ r> - r> - - >r r@ r> r@ - >r r@ - r@ r@ r> - r> - -

Which clocks in at 32 words and still is ugly.

5. Nice work llogiq and oklopol. That's much better than my solution, I think I need to take another look :-)

6. By the way, your nip implementation is quite inefficient, inlining to 20 words, even using oklopols swap.

If we allow for a zero below the stack, >r drop r> (which inlines to >r >r r@ r> - - r>) would work, however, there is also a fully correct solution with 11 words: >r >r r@ r> - r@ r@ - r> - -

Note that we could replace the r@ r> - with >r r@ r> for an alternative solution.

7. Your DROP, like llogiq's, has a bug. Unless there is already something on the stack, you will reach a stack underflow during each. Depending on the system, you may or may not get away with it.

I once heard of a minimal Forth, I think called picoforth, that I was told implemented DROP and DUP as

: DROP TEMP ! ;

: DUP TEMP ! TEMP @ TEMP @ ;

... and so on. However, I have no first hand knowledge of this. It is probably worth looking into eforth and hforth.

8. By the way, llogiq's ROT is what you get by optimising a special case of the recursive ROLL I contributed to eforth:-

: ROLL DUP 0 > IF SWAP >R 1 - RECURSE R> SWAP ELSE DROP THEN ;

(from memory, so possibly with typo style bugs; also, Ting changed it a bit.) There is also a similar recursive PICK.

9. In a 64 bit forth I've been working on, I've adopted a few ideas that Chuck uses in colorforth. Nearly all of the stack effects can be expressed in other operations. The base "memory register" operations !a and a are the equivalent of:

variable _a
: !a _a ! ;
: a _a @ ;

These register operations are just implemented in machine code. But once you have those, dup, over, drop, nip and swap are written:

: dup !a a a ;
: drop dup xor xor ;
: over >r !a a r> a ;
: nip over xor xor ;
: swap !a >r a r> ;

10. Bravo! You have just written Forth in Brainfuck written in Forth.