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