An esoteric programming language - Fiftween
Community Forums/Showcase/An esoteric programming language - Fiftween
| ||
| I've been trying to think of a way to use group theory to make an esoteric programming language for a while, preferably with the Rubik's cube as the underlying group. Well, in the shower this morning I had a brainwave (most brainwaves happen in the shower, don't you agree?) I've made a programming language based on the game Fifteen. It's nowhere near as complicated as Rubik's cube, but it's based on some of the same ideas. If you don't know what it is, here's a brief description - you've got a 4x4 grid of tiles with one tile removed, and the rest shuffled. You have to move the tiles around until they're all in order. So I've made a virtual machine based on an infinitely-large fifteen grid, where data is stored in the spaces under the tiles, so you effectively move the 'gap' around to look at your data. The basic operations are: - writing a number in the cell where you are - moving in a direction - copying the current cell's number to an adjacent cell - adding, subtracting, etc. the current cell's number to an adjacent cell and some more program logic stuff which doesn't directly rely on the grid. I've made a program to compute the fibonacci series: w1d^mvm>w1d^m<s1d^m^w1000-vi2mvp+>d>dvm<d^g1s2e or with comments: w1 'write 1 in first space d^mvm> 'duplicate this in the square above and move back down and right w1 'write 1 in second space d^m< 'duplicate in square above and move left s1 'start of loop d^m^w1000-vi2mv 'check if number is bigger than 1000, if so go to end, otherwise carry on p 'print number +>d>dv 'add the two numbers, then duplicate right and down m<d^ 'move left, and duplicate this number to row above g1 'go back to start of loop s2e 'end of program Here's the code for the interpreter - call it either with the name of a file to interpret or a line of code
Type cell
Field neighbours:cell[4]
Field numneighbours
'0 up
'1 left
'2 down
'3 right
Field value
Method New()
End Method
Method getneighbour:cell(dir)
If Not neighbours[dir]
'debugo "find neighbour"
findneighbours(dir)
If Not neighbours[dir]
'debugo "create neighbour"
c:cell=New cell
neighbours[dir]=c
c.neighbours[(dir+2) Mod 4]=Self
numneighbours:+1
c.numneighbours:+1
EndIf
EndIf
Return neighbours[dir]
End Method
Method findneighbours(tdir)
checked:TList=New TList
onsearch(Self,checked,0,0,tdir)
End Method
Method onsearch(c:cell,checked:TList,x,y,tdir)
If checked.contains(Self) Then Return
checked.addlast Self
If x=0
If y=-1 'up
dir=0
Else 'down
dir=2
EndIf
Else
If x=-1 'left
dir=1
Else 'right
dir=3
EndIf
EndIf
If Abs(x)+Abs(y)=1 And c.neighbours[dir]=Null 'adjacent to original cell, not already known
Select dir
Case 0
'debugo "found up"
Case 2
'debugo "found down"
Case 1
'debugo "found left"
Case 3
'debugo "found right"
End Select
c.neighbours[dir]=Self
neighbours[(dir+2) Mod 4]=c
c.numneighbours:+1
numneighbours:+1
If c.numneighbours=4 Then Return
If tdir=dir Then Return
EndIf
For dir=0 To 3
If neighbours[dir]
dy=-Cos(dir*90)
dx=-Sin(dir*90)
'debugo "check ("+String(dx)+","+String(dy)+")"
neighbours[dir].onsearch(c,checked,x+dx,y+dy,tdir)
If c.numneighbours=4
'debugo "4 neighbours"
Return
EndIf
If c.neighbours[tdir]
'debugo "got wanted neighbour"
Return
EndIf
EndIf
Next
End Method
Method setvalue(n)
debugo "new value "+String(n)
value=n
End Method
End Type
Type machine
Field curcell:cell
Field txt$,pos
Field subs[1000]
Field backtrace[100]
Field tracesize
Field compressedtxt$
Method New()
curcell=New cell
End Method
Function Create:machine(txt$)
m:machine=New machine
m.txt=txt+" "
m.findsubs()
Return m
End Function
Method compresscode(cmd$)
compressedtxt:+cmd
End Method
Method findsubs()
pos=0
incomment=0
While pos<Len(txt)
If incomment
If txt[pos]=39 Or txt[pos]=10
incomment=0
Else
pos:+1
EndIf
Else
cmd$=Chr(txt[pos])
pos:+1
If cmd=" " Or cmd="~t" Or cmd="~n" Or cmd="'"
Else
compresscode cmd
EndIf
Select cmd
Case "s"
n=getnumber()
compresscode String(n)
subs[n]=pos
debugo "sub "+String(n)+" at "+String(pos)
Case "'"
incomment=1
End Select
EndIf
Wend
pos=0
End Method
Method go()
cmd$=Chr(txt[pos])
pos:+1
debugo cmd
Select cmd
Case "w" 'write
debugo "write"
n=getnumber()
curcell.setvalue n
Case "d" 'duplicate
debugo "duplicate"
v=curcell.value
debugo v
move()
curcell.setvalue v
Case "m" 'move
debugo "move"
move()
Case "s" 'sub
debugo "sub"
n=getnumber()
subs[n]=pos
Case "g" 'goto
debugo "goto"
n=getnumber()
repos subs[n]
Case "t" 'goto with backtrace
debugo "goto with backtrace"
n=getnumber()
repos subs[n],1
Case "r" 'return
debugo "return"
goback
Case "p" 'print
debugo "print"
WriteStdout curcell.value
Case "e" 'end
debugo "end"
pos=Len(txt)
Case "+" 'add
debugo "add"
v=curcell.value
debugo v
move()
curcell.setvalue curcell.value +v
Case "-" 'subtract
debugo "subtract"
v=curcell.value
move()
curcell.setvalue curcell.value -v
Case "*" 'multiply
debugo "multiply"
v=curcell.value
move()
curcell.setvalue curcell.value *v
Case "/" 'divide
debugo "divide"
v=curcell.value
move()
curcell.setvalue curcell.value /v
Case "%"
debugo "modulo"
v=curcell.value
move()
curcell.setvalue curcell.value Mod v
Case "i" 'if
n=getnumber()
If curcell.value>0
debugo "true: going to "+String(n)+" which is at "+String(subs[n])
repos subs[n]
EndIf
Case "n" 'not
If curcell.value
curcell.setvalue 0
Else
curcell.setvalue 1
EndIf
Case "'" 'comment
debugo "comment"
cmt$=""
While txt[pos]<>39 And txt[pos]<>10 And pos<Len(txt)
cmt:+Chr(txt[pos])
pos:+1
Wend
debugo cmt
Case "!" 'start/stop debugging
debugging=1-debugging
Case "~q" 'print string
debugo "print"
outstr$=getstring()
WriteStdout outstr
End Select
If pos>=Len(txt)
Return 1
EndIf
End Method
Method repos(n,r=0)
If r
backtrace[tracesize]=pos
tracesize:+1
EndIf
pos=n
End Method
Method goback()
tracesize:-1
pos=backtrace[tracesize]
End Method
Method getnumber()
If txt[pos]=46
debugo "number current cell value = "+String(curcell.value)
Return curcell.value
EndIf
n=0
While txt[pos]>=48 And txt[pos]<=57
n=n*10+txt[pos]-48
pos:+1
Wend
debugo "number "+String(n)
Return n
End Method
Method getstring$()
outstr$=""
While txt[pos]<>34
outstr:+Chr(txt[pos])
pos:+1
Wend
pos:+1
Return outstr
End Method
Method move()
Select txt[pos]
Case 94 '^ - up
dir=0
debugo "up"
Case 118 'v - down
dir=2
debugo "down"
Case 60 '< - left
dir=1
debugo "left"
Case 62 '> - right
dir=3
debugo "right"
End Select
curcell=curcell.getneighbour(dir)
pos:+1
End Method
End Type
Global f:TStream=WriteFile("out.txt")
Function debugo(txt$)
If debugging
Print txt
EndIf
WriteLine f,txt
End Function
inp$=AppArgs[1]
If FileType(inp)=1
f:TStream=ReadFile(inp)
code$=""
While Not f.Eof()
code:+f.ReadLine()+"~n"
Wend
Else
code$=inp
EndIf
Global debugging
m:machine=machine.Create(code)
If FileType(inp)=1
f:TStream=WriteFile("compressed."+inp)
Else
f:TStream=WriteFile("compressed.fiftween")
EndIf
f.WriteLine m.compressedtxt
f.close
While 1
If m.go()
End
EndIf
If debugging
i$=Input()
If i="e" Then End
EndIf
'Delay 1000
Wend
Here's a spec of the language: The interpreter reads along the input, ignoring anything that isn't a command, until it gets to a command character. Commands might take either an integer number or a direction directly after them. The directions are - ^ for up, v for down, < for left, and > for right. Commands, in the form command[argument]: w[number] - write the number in the current cell d[direction] - duplicate the current cell's value to the cell in the given direction and move to that cell m[direction] - move in the given direction +[direction] - add the current cell's value to the cell in the given direction, and move to that cell. - , * / and % also do what you expect them to s[number] - set a marker for a subroutine, referred to by the given number g[number] - go to the marker corresponding to the given number t[number] - same as g, but you can come back to this place later with an r command r - return to the last t command encountered. i[number] - if the value of the current cell is bigger than 0, go to the marker corresponding to the current number p - print the current cell's value " - print every character until another " is reached n - if the current cell's value is not 0, set it to 0, otherwise set it to 1 e - end the program comments start with a ' and can be ended by either another ' or a newline. That's all. I hope someone read all this and actually finds it interesting! |
| ||
| most brainwaves happen in the shower, don't you agree? Isn't it because of the oxygenated environment, or sommat?So it's kinda like a mini 'wrapped-stack' Forth? |
| ||
| not sure how it's like forth. It doesn't have any stacks, really... I suppose a tiny bit of the syntax is the same, but it's more like befunge, which itself is a bit more like forth. |
| ||
It took me about 10 minutes, but I've written my first program in it:w10 'write 10 to cell 1 (counter) m> 'move right w1 'write 1 g1 'goto sub 1 'SUB 4 s4 'sub 4 e 'end program 'SUB 1 s1 'begin sub 1 d> 'duplicate to next cell and move forward m< 'move back +> 'add to next cell p 'print current cell d< 'duplicate to previous cell and move back m< 'move back to counter g2 'goto sub 2 (decrement counter) s5 'return point m> 'move forward to cell 2 (workspace) g1 'end of sub 1 'SUB 2 s2 'decrement counter m^ 'move up w1 'write 1 -v 'subtract 1 from counter and move down 'p 'print counter 'p 'print counter again (to highlight for debug) g3 'end of sub 2 now check counter 'SUB 3 s3 'check the counter i5 g4 'end of sub 3 It computes powers of two for 10 loops :) |
| ||
And here's a prime number generator. Oh, I've added a modulo command to make this possible.w2mvw2 'write 2 as start of list, set n=2 s1 'start of infinite loop mvw1+^ 'add 1 to n dvmvw1000-^i99m^ 'check if n > 1000 g2 s2 'start of prime checking routine m^ i3 'if not at end of list, do modulo check mvd^pg101 ' otherwise n is prime! write n at end of list, go back to start of loop s3 'modulo check d^mvmvd^m^%v 'move y and n up, calculate n mod y i4 'if y mod n != 0, move to next space m^dvg101 ' otherwise put n back in place, go back to start of loop s4 m^dvmvd>g2 'move n back in place, go sub 2 s101 'find start of list sub i102 'if this cell not empty go 102 m>mvg1 'else return to start of loop s102 'sub 102 m<g101 'move left, go 101 s99 e Weirdly, it's not massively longer than perturbatio's program. |
| ||
| Disturbing, yet, addictive. |
| ||
A factorial function:w1 'write f=1 mvw4 'write n "factorial: "p"! = " g201 s201 'start of loop dvm^*^ 'multiply f*n mvmvw1-^ 'set n=n-1 i201 'if n, go back to start of loop m^pe and I've added a " command to allow nice text output. EDIT: and a very slow bubble sort w1m>w2m>w7m>w4m>w6m>w3m>w5 'initialise list m<m<m<m<m<m< ' move back to sort of list g1 'go to start of sort s1 'start of sort - go until swap needed or end of list m>i2g99 'if next element along is empty, finished s2 d^mvm<d^m>-< 'compute a-b above a i3 'if a>b, swap mvm>g1 'otherwise move along to b, go back to start of check s3 mvd^mvm>d<m^d>dv 'swap a and b g101 'go back to start of list s101 'find start of list m<i101 m>g1 s99 'end of sort - go back through list printing elements m< s98 p" "m<i98 e |
| ||
| It doesn't seem to work for me anymore, it just produces compressed versions of the code and then an unhandled exception. :( |
| ||
| Running which program? I can run your powers-of-two program fine with the latest version. |
| ||
| Why not write a real programming language? |
| ||
| It's been done. Why write a real programming language? |
| ||
| I need to check which version of the language I have, but it didn't work with any code samples, including my power of two thing. |
| ||
| Just copy out the code in the first post, and life will be gravy. |
| ||
| If I run the latest code, and enable debug mode, I get Attempt to write to readonly stream in the debugo function. presumably because you're reusing the global TStream variable f which gets reassigned before you're done debugging. (BMax v. 1.28) |
   |