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