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 :-)

My solution for swap:

ReplyDelete>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[0]

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> - -

Given your swap implementation,

ReplyDelete: rot >r swap r> swap ;

Not that ugly, unless you inline swap...

Note that you could also implement DROP as

ReplyDelete: 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.

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

ReplyDelete>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.

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

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

ReplyDeleteIf 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.

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.

ReplyDeleteI 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.

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

ReplyDelete: 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.

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:

ReplyDeletevariable _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> ;

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

ReplyDelete