26
\$\begingroup\$

While ><> is not a popular language, it can be good for golfing and has been used on this website. It was inspired by Befunge and has some similarities in its instructions.

Required Commands:

> < ^ v
Changes the direction of the instruction pointer (right, left, up, down)
/ \ | _ #
Mirrors; the pointer will change direction depending on what direction it already has.
x
Random direction.
+ - * , %
Addition, subtraction, multiplication, divison and modulo, respectively. Pops A and B off the stack, and pushes B operator A. Division by 0 raises an error.
0-9 a-f
Pushes the corresponding value onto the stack. a = 10, ..., f = 15
=
Pops A and B off the stack, and pushes 1 if B = A, and 0 otherwise.
)
Greater than. Pops A and B off the stack, and pushes 1 if B < A
(
Less than. Pops A and B off the stack, and pushes 1 if B > A
' "
Enables string parsing. String parsing pushes every character found to the stack until it finds a closing quote.
!
Skips the following instruction.
?
Skips the following instruction if top of stack is zero, or stack is empty. (note: this does not pop anything off the stack!)
:
Duplicates the top value on the stack.
~
Removes the top value from the stack.
$
Rotates the top 2 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,2,4,3)
@
Rotates the top 3 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,4,2,3)
&
Pops the top value off the stack and puts it in the registry. Calling & again will take the value in the registry and put it back on the stack.
r
Reverses the stack.
}
Shifts the stack to the right / rotates entire stack clockwise (e.g. 1,2,3,4 becomes 4,1,2,3
{
Shifts the stack to the left / rotates entire stack counter-clockwise (e.g. 1,2,3,4 becomes 2,3,4,1
g
Pops A and B off the stack, and pushes the value at B,A in the codebox.
p
Pops A, B, and C off the stack, and changes the value at C,B to A.
o
Pops and outputs as a character
n
Pops and outputs the value
i
Takes one character as user input and pushes its ASCII value to the stack
;
Ends execution

Threading is not required to be implemented, though you can if you want to.

The shortest answer wins, in the event of a tie, the first answer wins.

You may use any language, and eval is allowed.

The file will be provided through command line arguments and will have a .fish extension.

You can use the official Python interpreter as a reference if needed. The Esolangs Wiki article has more information on how the language works, along with a few more examples.

Test cases:

Hello World!
Code:

"Hello World!"r>?o?<;

Output:

Hello World!

Factorials
Code:

01::nv
:@*:n>84*o$1+

Output (Up to 5):

1 2 6 24 120
\$\endgroup\$
15
  • 5
    \$\begingroup\$ Wow! What a nice task! \$\endgroup\$
    – FUZxxl
    Commented Mar 14, 2011 at 19:29
  • \$\begingroup\$ Are you sure about the factorial output? My interpreter outputs '1 2 2 6 12 48 144 720 2880 17280 20864' (after that, the 16 bit integer wraps). (Could well be a fault in my code, so I'm just asking...) \$\endgroup\$
    – PatrickvL
    Commented Mar 15, 2011 at 13:31
  • 8
    \$\begingroup\$ Can't Fish be implemented in Fish itself? \$\endgroup\$
    – Vi.
    Commented Nov 11, 2013 at 11:29
  • 1
    \$\begingroup\$ There's also l for pushing stack length. And as far as I know, ? does pop the value. \$\endgroup\$
    – JNF
    Commented May 26, 2015 at 11:16
  • 2
    \$\begingroup\$ @JNF This question predates those additions to the language. \$\endgroup\$ Commented May 26, 2015 at 11:18

9 Answers 9

16
\$\begingroup\$

><>, 443 bytes

e1r>i::1)$a-*?v{2v
xys^p}+1$}:{:{<
v0{^?)1p}1}+1:{0-<
/rp130p120p210p110p100p00-f{p2
>01g1+11ge+g:0=' '$?$~:21g?v:'"'=$"'"=+?v  :'.'=?v::'p'=$'g'=+?/79p02g1+12g8+.
>03         v20~v?-g12     <1p12        <0p10p11~<
?!  .!p20p21\1p v
g 7a^ v<~<  
 < 69. >001-^.98
1<78v//o!^10^~
3^ 1.!0<
^^ 0-1//~$0$p$  >11g12g+:00g$0(?$~:00g)0$?$~:11pe+0$g:02g:01g+@ @$:0(?!$~$0)@:@(@@*0$?$~01p
0p131<<^$?(@:@@:g$0@:$@:-(1:+1@@:~p00$?)@:g00::+*e-1*2)-10:pbe \

Try it online!

This should (as in, I hope it does) work identically to the reference interpreter with a couple of exceptions; This doesn't strip trailing newlines, and it doesn't throw an error when . receives a negative argument (which wasn't part of the spec anyway). This isn't quite as golfed as I would like, especially regarding the sixth line (with all those chunks of whitespace), but I reached my goal of under 450 bytes, so I thought I'd post it.

This takes the program in through STDIN, and should be separated from the input with a NUL byte if there is any. Otherwise you can input stuff through the -v or -s flags.

This works by storing everything within the codebox itself, letting the simulated stack and register be the same as the actual one. We store the program below our interpreter at coordinates (1,14), with the length of each line at that line's zero. The other seven variables we need (number of lines, current x and y positions, current x and y deltas, whether stringmode is toggled, and whether we are skipping the next instruction) are stored in the top left.

Because of this, we can simulate most instructions by just placing them in the codebox and running them. Some extra care is needed when simulating movement and skipping ones, but this saves a lot of logic. The only special cases are for the jump instruction (.), the stringmode instructions (" and '), and the get and put instructions (g/p). These are mostly taken care of on the sixth line, with the get and put logic on thee last line instead, since that is very involved.

A more detailed explanation is coming...

\$\endgroup\$
13
\$\begingroup\$

APL (Dyalog) (750)

Because APL does not really have a command line, load this into a workspace (i.e. with )ed F) and then run it from the APL line like so:

      F'quine.fish'
"ar00g!;oooooooooo|

      F'hello.fish'
Hello World!

      F'stack.fish'
12543

It does not handle any errors. The behaviour of wrong code is not specified. It can't do threads either. Where the Esolang page and the question conflict, it follows the question.

Edit: a slightly more readable version with comments can be found here: https://gist.github.com/anonymous/6428866

F f
⎕IO←0
S←⍬
i←''
s←,0
D←4 2⍴D,⌽D←0 1 0 ¯1
p←0 0
v←0
r←⍬
d←0 1
M←d↓↑M⊂⍨10=M←13~⍨10,83 ¯1⎕MAP f
W←{p+←d⋄p|⍨←⍴M⋄p}
R←{⌽{v←⊃⌽S⋄S↓⍨←¯1⋄v}¨⍳⍵}
U←⎕UCS
→v/43
{L←(⍴S)-⊃⌽s
⍵∊G←'><^v':d∘←D[G⍳⍵;]
⍵∊G←'\/':d∘←⌽d×1-2×G⍳⍵
⍵∊G←'|_#':d×←⊃(1 ¯1)(¯1 1)(¯1 ¯1)[G⍳⍵]
⍵∊'x':d∘←D[?4;]
(((~×⊃⌽S)∨L≤0)∧⍵∊'?')∨⍵∊'!':{}W⍬
⍵∊'.':p∘←R 2
⍵∊G←⎕D,'abcdef':S,←G⍳⍵
⍵∊G←'+-=*,)(':S,←⊃(⍎'+-=×,><'[G⍳⍵])/R 2
⍵∊'%':S,←⊃|⍨/R 2
⍵∊'"''':v V∘←1,U⍵
⍵∊':':S,←2/R 1
⍵∊'~':{}R 1
⍵∊'$@':S,←¯1⌽R 2+⍵='@'
⍵∊G←'{}':S,←(1-2×G⍳⍵)⌽R L
⍵∊'r':S,←⌽R L
⍵∊'l':S,←L
⍵∊'[':s,←1-⍨L-R 1
⍵∊']':s↓⍨←¯1
⍵∊G←'no':⍞←(U⍣(G⍳⍵))R 1
⍵∊'&':{⍴r:r∘←⍬⊣S,←r⋄r,←R 1}⍬
⍵∊'i':i↓⍨←1⊣S,←⊃{i∘←10,⍨U⍞}⍣(⊃~×⍴i)⍨i
⍵∊'g':S,←M⌷⍨⌽R 2
⍵∊'p':((⌽1↓G)⌷M)∘←⊃G←R 3
⍵∊';':S∘←0
s≡⍬:s∘←,0⊣S∘←⍬
}U p⌷M
→45
{}{+S,←p⌷M}⍣{V=M⌷⍨W⍬}⍬
v←0
{}W⍬
→14/⍨S≢0
\$\endgroup\$
9
\$\begingroup\$

Haskell 1428

Almost all lowercase characters are used as function names.

P.S. Are there any game about these kind (2d pointer) esolangs ? They must be very amusing !

import qualified Data.Map as M
import System.Environment
import Data.Char
import System.Random
type I=Integer
data S=S{p::(I,I),d,e::Int,s::[I],r::S->S,m::M.Map(I,I)Char}
a=zip">v<^\\/_|x+-*,%()=:~!?$@&r{}gponi"[q 0,q 1,q 2,q 3,
 i[1,0,3,2],i[3,2,1,0],i[0,3,2,1],i[2,1,0,3],\s->do x<-randomRIO(0,3);t$s{d=x},
 h(+),h(-),h(*),h div,h mod,h$j(<),h$j(>),h$j(==),
 o(\(x:y)->x:x:y),o tail,t.g.g,\q->t$if s q==[]||head(s q)==0 then g q else q,
 o(\(x:y:z)->(y:x:z)),o(\(x:y:z:w)->(y:z:x:w)),\q->t$(r q)q,
 o reverse,o(\s->last s:init s),o(\s->tail s++[head s]),
 \q->let(i:j:x)=s q in t$q{s=l(b(i,j)q):x},
 \q->let(i:j:k:x)=s q in t$q{s=x,m=M.insert(i,j)(n k)(m q)},
 y$putChar.n,y$putStr.show,\q->do c<-getChar;t(q{s=l c:(s q)})
 ]++[(x,t.c i)|(x,i)<-zip['0'..'9'][0..9]++zip['a'..'f'][10..15]]
b p q=maybe ' 'id$M.lookup p(m q)
c x q=q{s=x:s q}
f(i,j)0=(i,j+1)
f(i,j)1=(i+1,j)
f(i,j)2=(i,j-1)
f(i,j)3=(i-1,j)
g q=q{p=f(p q)(d q)}
h f=o(\(b:a:k)->f b a:k)
i a s=t$s{d=a!!(d s)}
j f a b|f a b=1|1<2=0
k=zip[0,1..]
l=toInteger.ord
n=chr.fromInteger
o f q=t$q{s=f(s q)}
q x=i[x,x..]
t=return
u s=M.fromList.foldr1(++)$[map(\(j,x)->((i,j),x))l|(i,l)<-k$map k$lines s]
v q=let(x:y)=s q in q{r=w x,s=y}
w x q=q{s=x:(s q),r=v}
y o q=let(i:x)=s q in o i>>t(q{s=x})
z q=[[[y=<<(maybe t id$lookup x a)q,t()]!!j(==)x ';',y$c(l x)q]!!k,w]!!j elem x"'\""
 where k=e q;x=b(p q)q;w=y$q{e=1-k};y=z.g
main=z.S(0,0)0 0[]v.u=<<readFile.head=<<getArgs

An Example Fish Program

mm  v                           
   >              v
   ~>1f+00p       v                     
    ;v?)+afg00    <             #<-- Condition of loop 1
   p>>~ 410p      v             
   0vv?)+cfg01    <  <          #<-- Condition of loop 2
   00>~10g00gg'.'=?v~     v     #<-- Go this route when 
   +0    vp01+1g01~<            #    we find a digit.
   1g    >           ^   
   ^<                      
   v                      <   
                          >       >~      ;
0  >10g0cg"0"$-+00gg:" "=?^~:"."=?^v   
   ^     pc0+1gc0 n-$"0"          ~<

    .......................  
    .......................  
    ......112233...........   This program prints 
    .......................   the number on this field.
    .......................     <------------
    .......................  
    .......................      
    .......................       
    .......................       
\$\endgroup\$
4
  • 5
    \$\begingroup\$ You dishonoured Haskell. :P \$\endgroup\$
    – tomsmeding
    Commented Aug 11, 2014 at 21:02
  • 1
    \$\begingroup\$ just took a sneak peek, and saw that zip(['0'..'9']++['a'..'f'])[0..15] should be used instead of zip['0'..'9'][0..9]++zip['a'..'f'][10..15]. what an amazing golf! \$\endgroup\$ Commented Jan 1, 2015 at 21:01
  • \$\begingroup\$ also, \q->t$(r q)q is basically r>>=t \$\endgroup\$ Commented Jan 1, 2015 at 21:02
  • 2
    \$\begingroup\$ I know this is an old answer, but you might like to know that Monster Train is a game based on the 2D language Befunge \$\endgroup\$
    – Jo King
    Commented Nov 11, 2020 at 13:07
7
\$\begingroup\$

><>, 1242 bytes

0[0v
v&0<
>ff+$>i:a=?v:0(?vv
^<  v :$+1~<    ~ 
&   &^p$}+1:$}:@ <
~   : v]{{00+ff<$
&~  &     >~  $^:
^^?(< >}}v&>~&$^&
vg$}:$}:}<^^?(&:<
>:"'"=?!v>{${${${${$} v
v       < .-2*4c6}}}}}<
>:'"'=  ?^0c.
>:'.'=?!v$l8(?v}$:0(?vff v
v='g':  <" "}} ~~{{{~ $++<
>?vv ,00<     <      <
  > l8(?^}$:0(?!v4fv
v: <      {$++ff<-*<
>'p'=?vv ,00<      >ff+-v
 v{~{<> l9(?^}$:0(?^ff++>$:v
v      <v(}:$}:]&{{{{{{&[l <
 v~{{^? <
 >}}}}}}$:@{${${${${v
v}}}}+1<~{{v?)}:$}:$<
       ^{~{<,00<   >50p60p70v
>:'&'=?!v~&l4=?^" " 755*.
v='[':  <
>?!v~l5=?v5+{${${$vpv08]p08p<
v  <" "}} }}}[${${<0>g70g60gv
      ,00<>93*3a*. 4v}g04g05<
>:']'=  ?!^~{{{{{!.^>}}}}" "v
v{{{p}:+1*66}:4 } $!}}@}:{{{<
>:1=?v:0=?v:2=?vv ^[-5<>$}$}v
v-1$~<    >~1-l  5-[$.l}    +
$     .$[-5l+1~<>~$1+$^^:{{<f
l   >>]{${$-{~3}}}v
5   21
-v1<>^
[v2^ v2>]{+{{~0}}}v
$  v<>1^
.  12>{+{~1}}}v
     ^$<>2}}} >   >{{{{:}$v{-
   >>]{^~vff-${v?)}:$@:}$}<{f
 >]{$-{{^>++}0 >~{:}ff+(?!v^-
v~{v!?(}:$}$}$}:{{{{{<    <}<
>0}>{:0(?v{88.
      v{~<
v:{{{<>{{:}$}$88.
>}:0=?v:1=?v3=?vv
v$+1$~<{$-2 $}  <
v        +1< -2<
>  {{:}$}$}$:})v>}$}$}$~v
v~{v!?(}<vf~{v?<^:{{{{< }
>0}>{:0v:>f+}>{:}ff+(?^v<
v{~v!?(<^$}$}$}:{{{{{< <
{  >    v
>{:}$}$}>:}$v
v{${${:<g$}:<
>${${${:}=?!v{~}}}}}~" "7a.
.-2*c46}}}}}<

Notes

Reads a ><> program from stdin.

This implements a more recent spec of ><> than the one in the OP for convenience (which includes all of the "Required Commands"). Since threading was dropped in favour of multiple stacks, this implements the multi stack version.

The implementation used is the one at fishlanguage.com, which also makes multi-line input convenient.

It's probably not bug free. Known bugs:

  • Jumping with ! while wrapping vertically is off by one.

Method

Due to the ability of fish for self-modifying code, it's tempting to write a "self-erasing" interpreter, which just prints the input into its own source doe and then removes itself, before executing the code as-is.

Sadly, this isn't quite possible. You have to pick one of:

  • Solving the halting problem
  • Adding a size limitation to programs
  • Have the commands ., g and p fail in some cases.

So I did not do that

Instead

This interpreter prints the program at an offset of 30 characters. And never executes the program directly. It "pokes" into the code with the g command, carefully executing it in a sandboxed environment. That means:

  • The instruction pointer is "virtual", represented by two coordinates and a direction on the stack, in addition to the current width and height of the program. Wrapping and movement is done through arithmetic.
  • Most "simple" instructions are performed inside a "direction detection box":
    21
  1<>^
  2^ v2
   v<>1
   12

Which allows arrows, mirrors and simple math and stack operations.

  • The register & needs extra code, as it must be executed on the current stack.
  • The [ and ] stack commands need their own implementation.
  • String parsing must be done through arithmetic.
  • The ., p and g commands must have a virtual implementation, and their coordinates corrected.
\$\endgroup\$
7
  • \$\begingroup\$ I don't think that any of the restrictions for the self-erasing interpreter necessarily apply, since you can technically just keep moving the interpreter part out of the way \$\endgroup\$
    – Jo King
    Commented Aug 12, 2020 at 7:44
  • \$\begingroup\$ @JoKing When do you move it? When the program to be interpreted is running, you can no longer jump out of the code to run the moving code. And before execution, the boundary is undecidable. \$\endgroup\$ Commented Aug 12, 2020 at 7:49
  • 1
    \$\begingroup\$ @JoKing If you do it that way, you have the "last p" problem. Since the pointer is to start at 0,0 it must wrap over the right edge after hitting the final p that erases itself. But then it must arrive from the left on the first row before hitting that p, which means it interacts with the printed program. \$\endgroup\$ Commented Aug 12, 2020 at 7:56
  • 1
    \$\begingroup\$ You're entirely correct, I was just a bit confused with how quickly it jumped to "solve the halting problem". Moving on though, some bugs with your interpreter. Jumping while wrapping, using negative space, . doesn't seem to work, neither does [ on an empty stack stack. \$\endgroup\$
    – Jo King
    Commented Aug 12, 2020 at 10:16
  • 1
    \$\begingroup\$ Thanks for the bugs, Jumping while wrapping is probably an off by one problem somewhere. I had no idea negative space was allowed, which simply can't be implemented in this manner. Not sure what the third one is. [ on an empty stack can be easily fixed. \$\endgroup\$ Commented Aug 12, 2020 at 10:46
6
\$\begingroup\$

Python, 978 980 981

import sys,random
f=open(sys.argv[1]).read().split('\n')
s=t=[]
d=p=x=y=k=0
r='n'
h='0123456789abcdef'
while h:
 c=f[y][x]
 if k:k=0
 elif p:
  if c==p:p=0
  else:s+=[ord(c)]
 else:
  for l in (h+'''0123456789abcdef`s+=[h.find(c)]
><^v`d='><^v'.find(c)
x`d=random.randint(0,3)
/`d=(d+2)%4
\`d=3-d
|#`if d<2:d=1-d
_#`if d>1:d=5-d
+-*,%=)($gp`a,b=s[-2:];s=s[:-2]
+-*%`s+=[eval('a%sb'%c)]
,`s+=[a/b]
=`s+=[a==b]
(`s+=[a<b]
)`s+=[a>b]
'"`p=c
!?`if(not s)or'!'==c or s[-1]==0:k=1
:`s+=s[-1:]
~`s.pop()
$`s+=[b,a]
@`s=s[:-3]+s[-1:]+s[-3:-1]
&`s,r=(s[:-1],s[-1])if r=='n'else (s+[r],'n')
.`s,t=t,s
r`s.reverse()
}`s=[:-1]+s[-1:]
{`s=s[1:]+s[:1]
m`s,t=[],s+t
g`s+=[f[b][a]]
p`f[s.pop()][b]=a
on`z=chr if c=='o'else str;sys.stdout.write(z(s.pop()));sys.stdout.flush()
i`s+=[int(sys.stdin.read(1))]
;`h=0''').split('\n'):
   l=l.split('`')
   if c in l[0]:
    try:exec(l[1])
    except:0
 if d<2:x=(x-d*2+1)%len(f[y])
 else:
  while 1:
   try:y=(y+d*2-5)%len(f);f[y][x];break
   except:0

Doesn't support threading.

Versions:
 1. 981
 2. 980: Fixed p instruction; small improvement.
 3. 978: Fixed ? instruction.

\$\endgroup\$
8
  • \$\begingroup\$ I'm not too sure about p precedure here, because I didn't quite understand this > Pops A, B, and C off the stack \$\endgroup\$ Commented Apr 4, 2011 at 20:17
  • 1
    \$\begingroup\$ The p command takes the last three values on the stack (pops them), a b and c, and assigns the place c, b on the grid to a. This is why you can't convert to native code. \$\endgroup\$ Commented Apr 4, 2011 at 20:23
  • \$\begingroup\$ You really haven't explained anything with this. a=pop();b=pop();c=pop() or c=pop();b=pop();a=pop()? \$\endgroup\$ Commented Apr 4, 2011 at 20:26
  • 1
    \$\begingroup\$ a=pop();b=pop();c=pop() \$\endgroup\$ Commented Apr 4, 2011 at 20:29
  • \$\begingroup\$ As far as I can tell, this program never stops. Also, it does't appear to wrap the codebox, meaning it doesn't reset to the start of the line when it reaches the end. Both are shown here (modified to use stdin): ideone.com/63MzF \$\endgroup\$ Commented Apr 6, 2011 at 20:12
5
\$\begingroup\$

Delphi, 1144

All but the theading instructions are implemented.

 var f:TextFile;c,k,s:String;i,m,b,v,w,x,y,A,l:Int16;procedure U(v:Int16);begin s:=s+Chr(v)end;function O:Int32;begin if l=0then Exit(0);O:=Ord(s[l]);Delete(s,l,1);Dec(l)end;procedure T(a,b:Int16);begin x:=a;y:=b;end;procedure E;begin v:=(v+x+80)mod 80;w:=(w+y+25)mod 25;i:=Ord(c[1+v+80*w])end;begin Assign(f,ParamStr(1));Reset(f);for A:=1to 25do begin ReadLn(f,k);c:=c+k+StringOfChar(' ',80-Length(k))end;x:=1;v:=-1;repeat E;k:=s;l:=Length(k);A:=i;case i-32of 2,7:repeat E;U(i);Inc(l)until i=A;4,5,8,9,12,13,26,32,71,80,93:A:=O;6:b:=1-b;88:i:=Ord('<>^v'[1+Random(4)]);91:l:=1;73:Read(PChar(@A)^)end;case i-32of 4:l:=l+1;80:l:=O;91:A:=O;93:l:=2;26:U(A)end;case i-32of 0:;1:E;2,7,94:O;3:T(-x,-y);4,32,93:Insert(Chr(A),s,l-1);5:U(O mod A);6:if b=0then U(m)else m:=O;8:U(Ord(O>A));9:U(Ord(O<A));10:U(O*O);11:U(O+O);12:U(O div A);13:U(O-A);15:T(-y,-x);16..25:U(i-48);26,73,91:U(A);28:T(-1,0);29:U(Ord(O=O));30:T(1,0);31:if(l=0)or(k[l]=#0)then E;60:T(y,x);62:T(0,-1);63:T(x,-y);65..70:U(i-87);71:U(Ord(c[1+O+80*A]));78:Write(O);79:Write(Chr(O));80:c[1+O+80*l]:=Chr(A);82:for A:=1to(l)do s[A]:=k[l-A+1];86:T(0,1);92:T(-x,y)else Exit;end;until 0=1;end.

The indented and commented code reads :

{debug}uses Windows;{}
var
  // f is the source file
  f:TextFile;
  // c is the entire codebox (a 2-dimensional program)
  c,
  // k is a temporary stack copy, needed for reversal
  k,
  // s is the stack (kept as a string)
  s:String;
  // i is the current instruction read from the program
  i,
  // m is the registry memory value (read/written by the '&' instruction)
  m,
  // b indicates if the registry should be written (b=0) or read (b>0) by the '&' instruction
  b,
  // v,w are x,y positions into the program
  v,w,
  // x,y are steps in the respective direction (values -1,0 or 1) :
  x,y,
  // A is a temporary variable (only uppercase var, to coincide with comments)
  A,
  // l is the length of the stack (may be abused as a temporary)
  l
  :Int16;

procedure U(v:Int16); // PUSH
begin
  // Push value onto the stack:
  s:=s+Chr(v)
end;

function O:Int32; // POP
begin
  // Pop value from the stack :
  if l=0then Exit(0);
  O:=Ord(s[l]);
  Delete(s,l,1);
  Dec(l)
end;

procedure T(a,b:Int16); // TURN
begin
  // Turn in a new direction :
  x:=a;
  y:=b;
end;

procedure E; // STEP
begin
{debug}Sleep(10);{}
  // Note : x-step needs to stay on same line, y-step needs to stay on same column
  v:=(v+x+80)mod 80;
  w:=(w+y+25)mod 25;
  i:=Ord(c[1+v+80*w])
end;

begin
  // Open file given at the command-line, and read & expand it's lines into our program buffer :
  Assign(f,ParamStr(1));
  Reset(f);
  for A:=1to 25do
  begin
    ReadLn(f,k);
    c:=c+k+StringOfChar(' ',80-Length(k))
    {debug};SetLength(c,A*80)
  end;
  x:=1;
  v:=-1;
  repeat
    // Take a step (which gives a new 'i'nstruction) and make a copy of the stack :
    E;
    k:=s;
    // Note : 'l' is used to get an element from the stack. So this gives pops from the top.
    l:=Length(k);
    // Shorten '''' and '"' (case 2 and 7) string-collecting, by remembering the quote character in A :
    A:=i;

    // Prevent begin+end pairs by handling instructions in 3 consecutive case blocks; This is applied to
    // all situations where this saves 1 or more characters, justifying the cost for another case-block.

    // Shorten a few cases by preparing variables so they can be shared with eachother and the 3rd case-block below :
    case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
      // Shorten string-collecting, by pushing the entire string here (the opening quote was remembered in A) :
      2,7:repeat E;U(i);Inc(l)until i=A; // Note :  We stop at the closing character, so the next block will still handle 'i'!
      // These instructions all need to Pop A, so write it just once here :
      4,5,8,9,12,13,26,32,71,80,93:A:=O;
      // Prevent begin+end for register access, by switching the read/write flag here :
      6:b:=1-b;
      // Shorten 'x' (case 120>88): Choose a random direction instruction and let the 3rd case-block handle it :
      88:i:=Ord('<>^v'[1+Random(4)]);
      // Shorten '{' (case 123-32=91): Share 3rd case-block with ':' (>26) and 'i' (>73) by setting l to 1 here :
      91:l:=1;
      // Prevent begin+end for input retrieval, by reading the input into A here :
      73:Read(PChar(@A)^) // Note : This case is last, because it ends on ')', which avoids a closing ';'
    end;

    // Shorten a few more cases by preparing variables so they can be shared with eachother and the 3rd case-block below :
    case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
      // Shorten '$' (case 38-32=4): Set 'l' to l+1 so that the 3rd case-block can insert just like '@' and '}' :
      4:l:=l+1;
      // Shorten 'p' (case 112-32=80): Set 'l' to O() so that the 3rd case-block doesn't need a begin+end pair :
      80:l:=O;
      // Shorten '{' (case 123-32=91): Share 3rd case-block with ':' (>26) and 'i' (>73) by popping A from position 1, as tricked above!:
      91:A:=O; // Note : This is NOT the same as doing this in the 1st case-block, as 'l' needs to be 1 first!
      // Shorten '}' (case 125-32=93): Prepare 'l' so that the implementation can be shared with '@' (>32):
      93:l:=2;
      // Shorten ':' (case 58-32=26): Share implementation with 'i' (>73) by pushing first copy of A (read above) here
      26:U(A) // Note : This case is last, because it ends on ')', which avoids a closing ';'
    end;

    // This 3rd case-block contains the final code for all statements (is there's no case here, it's an error) :
    case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
      //' ': Ignore spaces
      0:;
      //'!': Skips the following instruction.
      1:E;
      //'"','''': Enables string parsing. String parsing pushes every character found to the stack until it finds a closing quote.
      //'~': Removes the top value from the stack.
      2,7,94:O;
      //'#': Mirror both axes
      3:T(-x,-y);
      //'$': Rotates the top 2 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,2,4,3)
      //'@': Rotates the top 3 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,4,2,3)
      //'}': Shifts the stack to the right / rotates entire stack clockwise (e.g. 1,2,3,4 becomes 4,1,2,3)
      4,
      32,
      93:Insert(Chr(A),s,l-1); // Note : A was Popped in 1st case block
      //'%': Pops A and B off the stack, and pushes B mod A.
      5:U(O mod A);
      //'&': Pops the top value off the stack and puts it in the registry. Calling & again will take the value in the registry and put it back on the stack.
      6:if b=0then U(m)else m:=O;
      //'(': Less than. Pops A and B off the stack, and pushes 1 if B > A
      8:U(Ord(O>A));
      //')': Greater than. Pops A and B off the stack, and pushes 1 if B < A
      9:U(Ord(O<A));
      //'*': Pops A and B off the stack, and pushes B * A.
      10:U(O*O); // Note : A and B are inverted, but order is irrelevant here
      //'+': Pops A and B off the stack, and pushes B + A.
      11:U(O+O); // Note : A and B are inverted, but order is irrelevant here
      //',': Pops A and B off the stack, and pushes B / A. Division by 0 raises an error.
      12:U(O div A);
      //'-': Pops A and B off the stack, and pushes B - A.
      13:U(O-A);
      //'/': Mirror
      15:T(-y,-x);
      //'0'..'9': Push value 0-9 onto the stack.
      16..25:U(i-48);
      //':': Duplicates the top value on the stack.
      //'i': Takes one character as user input and pushes it's ASCII value to the stack
      //'{': Shifts the stack to the left / rotates entire stack counter-clockwise (e.g. 1,2,3,4 becomes 2,3,4,1)
      26,      // Note for ':' : First A was already pushed once above
      73,      // Note for 'i' : Read() into A was done in 1st case block
      91:U(A); // Note for '{' : l=1 was done in 1st case block, A:=O was done in 2nd block
      //'<': Turn west
      28:T(-1,0);
      //'=': Pops A and B off the stack, and pushes 1 if B = A, and 0 otherwise.
      29:U(Ord(O=O)); // Note : A and B are inverted, but order is irrelevant here
      //'>': Turn east
      30:T(1,0);
      //'?': Skips the following instruction if top of stack is zero, or stack is empty. (note: this does not pop anything off the stack!)
      31:if(l=0)or(k[l]=#0)then E;
      //'\': Mirror
      60:T(y,x);
      //'^': Turn north
      62:T(0,-1);
      //'_': Mirror y
      63:T(x,-y);
      //'a'..'f': Push value 10-15 onto the stack.
      65..70:U(i-87);
      //'g': Pops A and B off the stack, and pushes the value at B,A in the codebox.
      71:U(Ord(c[1+O+80*A])); // Note : A was Popped in 1st case block
      //'n': Pops and outputs the value
      78:Write(O);
      //'o': Pops and outputs as a character
      79:Write(Chr(O));
      //'p': Pops A, B, and C off the stack, and changes the value at C,B to A.
      80:c[1+O+80*l]:=Chr(A); // Note : A was Popped in 1st case block, l was set to 1 in 2nd case block
      //'r': Reverses the stack.
      82:for A:=1to(l)do s[A]:=k[l-A+1]; // Note: This reads from the stack-copy
      //'v': Turn south
      86:T(0,1);
      //'|': Mirror x
      92:T(-x,y) // Note : This case is last, because it ends on ')', which avoids a closing ';'
    else // ';' (27) and unrecognized instructions end execution.
      Exit;
    end;
  until 0=1;
end.

Edit history :

(1306+18=1324) : Fixed bugs in a few operation orders (Delphi evaluates arguments in reverse). Also fixed stack pop (couldn't pop more than once per instruction).

(1324-33=1291) : Removed safeguard when writing contents from an empty stack

(1291-56=1235) : Added Turn function, renamed variables, decreased instruction digits

(1235-7=1228) : Reordered variables, fixed bug in '@'

(1228-37=1191) : Shared more implementation-code by spreading it out over 3 consecutive case-blocks

(1191-12=1179) : Shared the stack-cycling implementation between all 3 instructions now.

(1179-20=1159) : Split up string-parsing over 3 case-blocks, removed j variable, shared another implementation

(1159-15=1144) : Simplified 'x' by changing it into one of the 4 direction-instructions

\$\endgroup\$
3
  • \$\begingroup\$ I don't think this can be made any more compact... can anyone prove me wrong? \$\endgroup\$
    – PatrickvL
    Commented Mar 17, 2011 at 20:42
  • \$\begingroup\$ You're already a hero for making such a short program in Delphi! \$\endgroup\$ Commented Apr 4, 2011 at 20:18
  • \$\begingroup\$ The whole file handling (assign, reset, the loop) could be replaced by this line: for k in TFile.ReadAllLines(ParamStr(1))do c:=c+k+StringOfChar(' ',80-Length(k));. You can also get rid of the f:TextFile like that, but you need to add uses IOUtils; at the start. Difference:it reads all lines, and not just the first 25 lines. \$\endgroup\$ Commented Aug 19, 2011 at 18:32
4
\$\begingroup\$

Lua 1640 (1558 non threading) chars

Threading version, golfed (1640 characters):

L=loadstring L(([[z=table p=z.insert P=z.remove W=io.write t="><^v/\\|_#x+-*,%=)(!?:~$@&r}{gponi;[].m"C=t.char B=t.byte F=t.match M=setmetatable Q=getfenv R=setfenv I=io.read w="@h1,0@h-1,0@h0,-1@h0,1@h-Y,-X@hY,X|X=-X|Y=-Y@h-X,-Y|z=math.random(1,4)R(f[('><^v'):sub(z,z)],Q())()|@c@a+@a)|@c-@a+@a)|@c@a*@a)|z=@a@pz~=0 @b@c@a/z)@rerror'Div by 0'@d|y=@az=@a@cz%y)|@c@a==@a@n1@g0)|@c@a>@a@n1@g0)|@c@a<@a@n1@g0)|@i|@p#s==0@gs[#s]==0 @b@i@d|@cs[#s])|@a|z=#s s[z@k-1]=s[z-1@k]|z=#s s[z@k-1@k-2]=s[z-1@k-2@k]|@pr @b@cr)r=N @rr=@a@d|z={}@o=1,#s@qz[#s-k+1]=s[k]@ds=z|@c1,@a)|@cP(s,1))|z=@a@cc[@a][z])|z,w=@a,@ac[@a][w]=z|W(C(@a))|W(@a)|z=I(1)while F(z,'%s')@qz=I(1)@d@cB(z))|os.exit()|T.N=1|P(T,I)@o=I,#T@qT[k].I=k@d|s=s==S@nl@gS|z=s==S@nl@gS @o=#s,1,-1@qp(z,P(s,1))@d|"z=1 f={}@o in t:gmatch"."@q_,z,s=w:find("|(.-)|",z)f[k]=L(s)@dT={m@j)@i @py>#c @by=0 @fy<0 @by=#c@d@px>#c[y]@nX==1 @bx=0 @fx<0 @bx=#c[y]@d@d,n@jx,y,X,Y)z=M({I=#T+1,l={},X=X@g1,Y=Y@g0,x=x@g0,y=y@g0},{__index=_G})z.s=z.l T[z.I]=z@d}c={}S={}T.n(-1)fh=arg[1]@nio.open(arg[1])@gio.stdin y=0 for l in fh:lines()@qc[y]=M({},{__index@j)return 32@d})@o=1,#l@qz=l:sub(k,k) @pnot i @b@pF(z@l@bi=z@d@pF(z,"[^\n\r]")@b@m@d@r@pz==i @bi=N@d@m@d@dy=y+1@dwhile #T>0@qfor I=1,#T@qt=T[I]R(1,t)R(T.m,t)()n,o=X,Y q=C(c[y][x])@pi @b@pF(q@l@bi=N @r@cc[y][x])@d@fF(q@l @bi=q @fF(q,"%x")@b@ctonumber(q,16))@fF(q,"[^ ]")@bsetfenv(f[q],t)()@d@[email protected]@n(n~=X@go~=Y)@bT.n(x,y,X,Y)T.N=N X,Y=n,o@d@d]]):gsub("@(.)",{a="P(s)",b="then ",c="p(s,",d=" end ",f="elseif ",g=" or ",h="|X,Y=",i="x,y=x+X,y+Y",j="=function(",k="],s[z",l=[[,"['\"]")]],m="c[y][k-1]=B(z)",n=" and ",o="for k",p="if ",q=" do ",r="else "}))()

The threading version does some nasty hacks with setfenv and getfenv to eliminate the need for indexing for the different threads.

Threading version readable:

-- http://codegolf.stackexchange.com/questions/1595/interpret-fish
z=table
p=z.insert  -- push
P=z.remove  -- pop
W=io.write
t="><^v/\\|_#x+-*,%=)(!?:~$@&r}{gponi;[].m"     -- all tokens
C=t.char
B=t.byte
F=t.match
M=setmetatable
Q=getfenv
R=setfenv
I=io.read
--w=("@d1,0@d-1,0@d0,-1@d0,1@d-Y,-X@dY,X|X=-X|Y=-Y@d-X,-Y|z=math.random(1,4)R(f[('><^v'):sub(z,z)],Q())()|@b@a+@a)|@b-@a+@a)|@b@a*@a)|z=@aif z~=0@i@b@a/z)else error'Div by 0'end|y=@az=@a@bz%y)|@b@a==@a @c@b@a>@a@c@b@a<@a@c@h|if #s==0 or s[#s]==0@i@h end|@bs[#s])|@a@gs[z-1]=@e]@g@e-2]=@e-2],s[z]|if r@i@br)r=N else r=@aend|z={}for k=1,#s do z[#s-k+1]=s[k]end s=z|@b1,@a)|@bP(s,1))|z=@a@bc[@a][z])|z,w=@a,@ac[@a][w]=z|W(C(@a))|W(@a)|z=I(1)while F(z,'%s')do z=I(1)end @bB(z))|os.exit()|T.N=1|P(T,I)for k=I,#T do T[k].I=k end|s@f|z@f for k=#s,1,-1 do p(z,P(s,1))end|"):gsub("@(.)",{a="P(s)",b="p(s,",c="and 1 or 0)|",d="|X,Y=",e="s[z-1],s[z",f="=s==S and l or S",g="|z=#s s[z],",h="x,y=x+X,y+Y",i=" then "})
w="|X,Y=1,0|X,Y=-1,0|X,Y=0,-1|X,Y=0,1|X,Y=-Y,-X|X,Y=Y,X|X=-X|Y=-Y|X,Y=-X,-Y|z=math.random(1,4)R(f[('><^v'):sub(z,z)],Q())()|p(s,P(s)+P(s))|p(s,-P(s)+P(s))|p(s,P(s)*P(s))|z=P(s)if z~=0 then p(s,P(s)/z)else error'Div by 0'end|y=P(s)z=P(s)p(s,z%y)|p(s,P(s)==P(s) and 1 or 0)|p(s,P(s)>P(s)and 1 or 0)|p(s,P(s)<P(s)and 1 or 0)|x,y=x+X,y+Y|if #s==0 or s[#s]==0 then x,y=x+X,y+Y end|p(s,s[#s])|P(s)|z=#s s[z],s[z-1]=s[z-1],s[z]|z=#s s[z],s[z-1],s[z-2]=s[z-1],s[z-2],s[z]|if r then p(s,r)r=N else r=P(s)end|z={}for k=1,#s do z[#s-k+1]=s[k]end s=z|p(s,1,P(s))|p(s,P(s,1))|z=P(s)p(s,c[P(s)][z])|z,w=P(s),P(s)c[P(s)][w]=z|W(C(P(s)))|W(P(s))|z=I(1)while F(z,'%s')do z=I(1)end p(s,B(z))|os.exit()|T.N=1|P(T,I)for k=I,#T do T[k].I=k end|s=s==S and l or S|z=s==S and l or S for k=#s,1,-1 do p(z,P(s,1))end|"
z=1
f={}
for k in t:gmatch"." do -- will contain the tokens
    _,z,s=w:find("|(.-)|",z)
    f[k]=loadstring(s)
end
T={     -- table of threads
    --N = new thread to be created.
    m=function()
        x,y=x+X,y+Y
        if y > #c then
            y=0
        elseif y<0 then
            y=#c
        end
        if x>#c[y] and X==1 then
            x=0
        elseif x<0 then
            x=#c[y]
        end
    end,
    n=function(x,y,X,Y)
        z=M({
        I=#T+1,                 -- keep number id
        l={},                   -- local stack
        X=X or 1,                   -- 1 for +x, -1 for -x, 0 for y/-y
        Y=Y or 0,                   -- 1 for +y, -1 for -y, 0 for x/-x 
        x=x or 0,                   -- X of IP
        y=y or 0,                   -- Y of IP
        -- i,                   -- will contain type of quote when reading in a string --TODO keep local
        -- r,                   -- registry --TODO make global
        },{__index=_G})         -- Enable lookup of functions in global table.
        z.s=z.l -- current stack is local stack
        T[z.I]=z    -- add at next index
    end
    }
c={}    -- codebox IP wraps around -- TODO make codebox global in code
S={}    -- global stack
-- codebox layout
--     -----> +x
--  @  |line of text            -- wrap around to second line
--     |second line of text.    -- negative indices can be used for variables
--     |
--     V +Y

-- y first coord, x second
-- wrap around rows if nil row
-- wrap around cols if nil char.
T.n(-1)

-- compile to codebox
fh= arg[1] and io.open(arg[1]) or io.stdin  -- use file or stdin

y=0
for l in fh:lines() do
    c[y]=M({},{__index=function()return 32 end})--default to space
    for k=1,#l do
        z=l:sub(k,k)
        if not i then       -- normal mode
            if F(z,"['\"]") then i=z end
            if F(z,"[^\n\r]")then --filter out only newlines
                c[y][k-1]=B(z)
            end -- any spacing allowed.
        else                
            if z==i then i=N end-- verbatim string mode
            c[y][k-1]=B(z)
        end
    end
    y=y+1
end

io.stdout:setvbuf("no") -- direct output
while #T>0 do
    for I=1,#T do
        t=T[I]
        R(1,t)
        R(T.m,t)()
        n,o=X,Y -- keep old directions for new thread detection
        q=C(c[y][x])
        if i then                       -- stringparsing mode       
            if F(q,"['\"]") then        -- end-quote
                i=N
            else
                p(s,c[y][x])    -- push contents of box, then advance
            end
        elseif F(q,"['\"]") then        -- start-quote
            i=q
        elseif F(q,"%x") then       -- parsing a number
            p(s,tonumber(q,16))
        elseif F(q,"[^ ]") then
            assert(setfenv(f[q],t))
            f[q]()  -- call, feed with state/thread
        end
    end
    if T.N and (n~=X or o~=Y) then
        -- create new thread
        T.n(x,y,X,Y)
        T.N=N
        X,Y=n,o     -- restore directions of parent
    end
end 

Nonthreading version, golfed (1558 chars, but can be shrunk a bit more if the non-threading version is going to be the criterion):

T=table p=T.insert P=T.remove I=io.read W=io.write A=assert t="><^v/\\|_#x+-*,%=)(!?:~$@&r}{gponi;"M=t.match B=t.byte C=t.char f={"X,Y=1,0","X,Y=-1,0","X,Y=0,-1","X,Y=0,1","X,Y=-Y,-X","X,Y=Y,X","X=-X","Y=-Y","X,Y=-X,-Y","z=math.random(1,4)f[('><^v'):sub(z,z)]()","p(s,P(s)+P(s))","p(s,-P(s)+P(s))","p(s,P(s)*P(s))","p(s,(1/P(s) or error'Div by 0')*P(s))","y=P(s)z=P(s)p(s,z%y)","p(s,P(s)==P(s) and 1 or 0)","p(s,P(s)>P(s) and 1 or 0)","p(s,P(s)<P(s) and 1 or 0)","x,y=x+X,y+Y","if #s==0 or s[#s]==0 then f['!']()end","p(s,s[#s])","P(s)","z=#s s[z],s[z-1]=s[z-1],s[z]","z=#s s[z],s[z-1],s[z-2]=s[z-1],s[z-2],s[z]","if r then p(s,r)r=N else r=P(s)end","z={}for k=1,#s do z[#s-k+1]=s[k]end s=z","p(s,1,P(s))","p(s,P(s,1))","z=P(s) p(c[P(s)][z])","z,w=P(s),P(s) c[P(s)][w]=z","W(C(P(s)))","W(P(s))","z=I(1) while M(z,'%s')do z=I(1)end p(s,B(z))","os.exit()"}z=1 for k in t:gmatch"."do f[k]=A(loadstring(f[z]))z=z+1 end c={}s={}X=1 Y=0 x=0 y=0 m=function(s)x,y=x+X,y+Y if y>#c then y=0 elseif y<0 then y=#c end if x>#c[y]and X==1 then x=0 elseif x<0 then x=#c[y]end end F=arg[1]and io.open(arg[1])or io.stdin l=0 for line in F:lines()do c[l]=setmetatable({},{__index=function()return 0 end})for k=1,#line do z=line:sub(k,k)if not i then if M(z,"['\"]")then i=z end if M(z,"[^\n\r]")then c[l][k-1]=B(z)end else if z==i then i=N end c[l][k-1]=B(z)end end l=l+1 end while 1 do q=C(c[y][x])if i then if M(q,"['\"]")then i=N else p(s,c[y][x])end else if M(q,"['\"]")then i=q elseif M(q,"%x")then p(s,tonumber(q,16)) elseif M(q,"[^ %z]")then A(f[q])f[q]()end end m()end

Readable version:

-- http://codegolf.stackexchange.com/questions/1595/interpret-fish
--
-- TODO's
-- threading instructions:
-- * [ start thread at next change in direction.
-- * ] end thread
-- * . switch between global and local stack
-- * m copy global to local stack
--
p=table.insert  -- push
P=table.remove  -- pop
t=table.concat{ 
    "><^v",     -- Direction    DONE
    "/\\|_#",   -- Mirror       DONE
    "x",        -- random direction DONE
    "+-*,%",    -- arithm.  DONE
    "=)(",      -- pops A and B of the stack if A==B then push 1 else push 0,same for greater than, lesser than. (result on stack) -- DONE
    "!",        -- skip next    DONE
    "?",        -- if s[#s]==0 then skip next, else continue    DONE
    ":",        -- duplicate top    DONE
    "~",        -- remove top   DONE
    "$",        -- rotate top 2 values DONE
    "@",        -- rotate top 3 values DONE
    "&",        -- poptop to registry or read from registry DONE
    "r",        -- reverse stack DONE
    "}{",       -- shift stack right, (or up)/ shift stack left (or down) DONE
    "g",        -- pops A,B push values at B,A in the codebox on the stack DONE
    "p",        -- pops A,B,C from stack, and change value at C,B to A DONE
    "o",        -- pops from stack and output character DONE
    "n",        -- pops from stack, outputs number DONE
    "i",        -- take 1 char of input, and push the ASCII value on stack DONE
    ";",        -- os.exit() DONE
    --[["[",        -- start new thread at next direction change
    "]",        -- end thread
    ".",        -- switch between global and local stack
    "m",        -- Copy global stack to local one --]]
}
f={
"s.dx,s.dy=1,0","s.dx,s.dy=-1,0","s.dx,s.dy=0,-1","s.dx,s.dy=0,1",
"s.dx,s.dy=-s.dy,-s.dx","s.dx,s.dy=s.dy,s.dx","s.dx=-s.dx","s.dy=-s.dy","s.dx,s.dy=-s.dx,-s.dy",
"z=math.random(1,4)f[('><^v'):sub(z,z)]()",
"p(s.s,P(s.s)+P(s.s))","p(s.s,-P(s.s)+P(s.s))","p(s.s,P(s.s)*P(s.s))","p(s.s,(1/P(s.s) or error'Div by 0')*P(s.s))","y=P(s.s)z=P(s.s)p(s.s,z%y)",
"p(s.s,P(s.s)==P(s.s) and 1 or 0)",
"p(s.s,P(s.s)>P(s.s) and 1 or 0)",
"p(s.s,P(s.s)<P(s.s) and 1 or 0)",
"s.x,s.y=s.x+s.dx,s.y+s.dy",
"if #s.s==0 or s.s[#s.s]==0 then f['!']()end",
"p(s.s,s.s[#s.s])",
"P(s.s)",
"z=#s.s s.s[z],s.s[z-1]=s.s[z-1],s.s[z]",
"z=#s.s s.s[z],s.s[z-1],s.s[z-2]=s.s[z-1],s.s[z-2],s.s[z]",
"if s.r then p(s.s,s.r)s.r=nil else s.r=P(s.s)end",
"z={}for k=1,#s.s do z[#s.s-k+1]=s.s[k]end s.s=z",
"p(s.s,1,P(s.s))",
"p(s.s,P(s.s,1))",
"z=P(s.s) p(s.s,s.c[P(s.s)][z])",
"z,w=P(s.s),P(s.s) s.c[P()][w]=z",
"io.write(string.char(P(s.s)))",
"io.write(P(s.s))",
"z=io.read(1) while z:match'%s'do z=io.read(1)end p(s.s,z:byte())",
"os.exit()"
}
z=1
for k in t:gmatch"." do -- will contain the tokens
    f[k]=assert(loadstring(f[z]))
    z=z+1
end

s={             -- state
    c={},                   -- codebox IP wraps around
    s={},                   -- stack
    dx=1,                   -- 1 for +x, -1 for -x, 0 for y/-y
    dy=0,                   -- 1 for +y, -1 for -y, 0 for x/-x 
    x=0,                    -- X of IP
    y=0,                    -- Y of IP
    -- i,                   -- will contain type of quote when reading in a string
    -- r,                   -- registry
    -- codebox implementation
-- codebox layout
--
--
--     -----> +x
--  @  |line of text            -- wrap around to second line
--     |second line of text.    -- negative indices can be used for variables
--     |
--     V +Y

    -- y first coord, x second
    -- wrap around rows if nil row
    -- wrap around cols if nil char.
    move=function(s)
        s.x,s.y=s.x+s.dx,s.y+s.dy
        if s.y > #s.c then
            s.y=0
        elseif s.y<0 then
            s.y=#s.c
        end
        if s.x>#s.c[s.y] and s.dx==1 then
            s.x=0
        elseif s.x<0 then
            s.x=#s.c[s.y]
        end
    end

    }
-- compile to codebox
fh= arg[1] and io.open(arg[1]) or io.stdin  -- use file or stdin

y=0
for line in fh:lines() do
    s.c[y]=setmetatable({},{__index=function() return 0 end})
    for k=1,#line do
        z=line:sub(k,k)
        --print(y,k,"|"..z.."|")
        if not s.i then     -- normal mode
            if z:match"['\"]" then s.i=z end
            if z:match"[^\n\r]"then --filter out only newlines
                s.c[y][k-1]=string.byte(z)
            end -- any spacing allowed.
        else                -- verbatim string mode
            if z==s.i then s.i=nil end
            s.c[y][k-1]=string.byte(z)
        end
    end
    y=y+1
end

io.stdout:setvbuf("no") -- direct output
function dbg()
    print("\nIP",s.y,s.x)
    print("command",string.char(s.c[s.y][s.x]))
    print("codebox:",#s.c)
    for y=0,#s.c do
        print("\tline",y)
        io.write"\t"
        for x=0,#s.c[y] do
            --io.write(string.char(s.c[y][x]),",\t")
            io.write(tostring(s.c[y][x]),",\t")
        end
        io.write"\n"
    end
    print("stack:")
    for k,v in pairs(s.s) do print("",k,v) end
end
function run()
while 1 do
    r,e = pcall(string.char,s.c[s.y][s.x])  -- look up command in codebox
    if not r then print("Error happened reading command",s.c[s.y][s.x])
        dbg()
    end
    q=string.char(s.c[s.y][s.x])
    --print(s.y,s.x,q)
    if s.i then                     -- stringparsing mode       
        if q:match"['\"]" then      -- end-quote
            s.i=nil
        else
            p(s.s,s.c[s.y][s.x])    -- push contents of box, then advance
        end
    else                            -- not in string parsing mode
        if q:match"['\"]" then      -- start-quote
            s.i=q
        elseif q:match"%x" then     -- parsing a number
            p(s.s,tonumber(q,16))
        elseif q:match"[^ %z]" then
            assert(f[q])
            r,e= pcall(f[q])    -- call
            if not r then print("Error calling function for "..q..": \n",e) -- error happened, clarify
            end
        end
    end
    s:move()                                        -- move the IP
end
end
r,e=pcall(run)
if not r then print("Error occured:",e)
dbg()
end

Not putting the next as result, as using compression directly isn't the goal I guess ;). Using murgaLua (or any Lua version with lzlib and luaSocket(for base64 decoding)), at the magic count of 1333:

L=loadstring L(zlib.decompress(mime.unb64("eJxtVW1z4jYQ/iuqaYp0yD587fQDzaadS+c6zPQyd4lnjgw4DC8ieACZyE6wDeS3d1fCB6H3AbTa12ff5Ary0Xip2BqqINGZMjn7gqRRq/RFsW+QpMHGJLliOXhXlw8v7weD3bBRtPx38gIE/+nPzuvPf/1i9tvHdaqTP/pxsPKuIQ8m85FhH5EYl2j8CYnVKJ/M2WfIVL5S+ciF/QqPKp8p/cJuSWCpLgU1ajRlG/B2PXkPoWzb06+JtvTDA+FO/176PUvdSzwBL8R0sp5EqgIEMA/MSE/TFQ/lb+KWz/q8SUk1RSd7HvNKViKWX7kQXOzWPJNfeCZa9Oeu/tmdqHfuWgGdyYxVr9Bm+VxpVmu8r4RaZoopY1LT/Dt5YeOStZtKT3eltXK2pF5dlEfPYNkM8bKQpYa1j6Ir+vuR4PJcUMgSilZPlq37HaJrZIDwUJT1G1kMNdQTLUa4yJ3VEDtyiNk1MjSpYuRWfhiDO+gW/09ojw+nOnhzqojAHItjhIEbZmtjbK4UuoLtfoYAF9h09DtNWYVA/EXLRl3EqMMyqCzEUL7phQy/N4I4kz5RMcZFrtxYvjWoBZsY/Xzj19x6EUjWvezyUGzmCc7nJxyK5kXWFATE8gkAuf/IK9RNs0AVSY7zEgU3EGK5ItkVLoGubESUQISwgy4sbGkzwBbc2a4uqRF3GO6Mw5x5gxL0Q/KwRhSHBMmHV0HIZnWhWKJZ3nm06+UFHqoPZSUz2HRmiZ5yb8cDX+w8nO0ZAoF/XaFZBNsVzJ71JE9SzcXpCGCbyqvGxHWqxCGhHhHzsl3zUEpOkFmgZr+MCX4PEJcbqKNRURsVYBXJjJGx1MfwGF3iquIqfObbLjSiViiXmKDsQY9qEtJi25GWBRSOKKG0xF5uh0PMVBUw/GcvqgDHI1hi1augix2mUPsJ+rrDXxRo7odiNoeReeyHFjU+Nulaae44Al0iJ8unicudarykGs/mnWWiVcZpFigTwnoS/FhLo/Jno9mvH2xs8X2cl3acYWkfm4VcCKqfTnOWuArhjebN6zcHXuwJx3MZHGUPAz0wtZRg9Be0kTSOpGfXid4hgNorLRlKfqCLP6xiK7SUG/hGdNUmmAS6S6DtCOcQ9bvxLT6bOT6bUbDCkwstU8CusSe45tZ7EdMTeJrN03k2h4V3C+pMathnBjX6pzfCi+LgijzkqX5ejZVBQfi7EG+cPLA66OG7gq/9U2xx17mjLm4tbR7Xr27Q0le4d1Y0KvVY0m7fMPqWYMrsYP4fCvRCgw==")))()
\$\endgroup\$
3
\$\begingroup\$

Delphi, 1855 1701

This version has thread-support at quite a cost : The version without thread-support is 1144 characters right now, so thread-support adds 557 characters (about 50%)!

type R=^_;_=record n:R;d:R;s:String;i,m,b,p,v,w,x,y,A,l:Int16;procedure U(v:Int16);function O:Int16;procedure T(a,b:Int16);procedure E;end;var f:TextFile;c,g,k:String;h:R;procedure _.U;begin if p>0then g:=g+Chr(v)else s:=s+Chr(v)end;function _.O;begin if l=0then Exit(0);if p>0then O:=Ord(g[l])else O:=Ord(s[l]);if p>0then Delete(g,l,1)else Delete(s,l,1);Dec(l)end;procedure _.T;begin if(d<>nil)then begin d.n:=n;n:=d;d.v:=v;d.w:=w;d:=nil;n.T(a,b);Exit;end;x:=a;y:=b;end;procedure _.E;begin v:=(v+x+80)mod 80;w:=(w+y+25)mod 25;i:=Ord(c[1+v+80*w])end;var j:byte;begin h:=AllocMem(32);h.n:=h;h.x:=1;h.v:=-1;Assign(f,ParamStr(1));Reset(f);for j:=1to 25do begin ReadLn(f,k);c:=c+k+StringOfChar(' ',80-Length(k))end;repeat h:=h.n;h.E;with h^ do begin k:=s;if p>0then k:=g;l:=Length(k);A:=i;case i-32of 2,7:repeat E;U(i);Inc(l)until i=A;4,5,8,9,12,13,26,32,71,80,93:A:=O;6:b:=1-b;88:i:=Ord('<>^v'[1+Random(4)]);91:l:=1;73:Read(PChar(@A)^)end;case i-32of 4:l:=l+1;80:l:=O;91:A:=O;93:l:=2;26:U(A)end;case i-32of 0,88:;1:E;2,7,94:O;3:T(-x,-y);4,32,93:if p>0then Insert(Chr(A),g,l-1)else Insert(Chr(A),s,l-1);5:U(O mod A);6:if b=0then U(m)else m:=O;8:U(Ord(O>A));9:U(Ord(O<A));10:U(O*O);11:U(O+O);12:U(O div A);13:U(O-A);14:p:=1-p;15:T(-y,-x);16..25:U(i-48);26,73,91:U(A);28,30:T(i-61,0);29:U(Ord(O=O));31:if(l=0)or(k[l]=#0)then E;59:d:=AllocMem(32);60:T(y,x);61:begin if(h=n)then Exit;d:=n;while(d.n<>h)do d:=d.n;d.n:=h.n;d:=h;h:=n;d:=nil;end;62:T(0,-1);63:T(x,-y);65..70:U(i-87);71:U(Ord(c[1+O+80*A]));77:begin if p>0then s:=s+g else g:=g+s;if p>0then g:=''else s:=''end;78:Write(O);79:Write(Chr(O));80:c[1+O+80*l]:=Chr(A);82:for j:=1to(l)do s[j]:=k[l-j+1];86:T(0,1);92:T(-x,y)else Exit;end;end;until 0=1;end.

Note that this implementation contains a few ideas that will reduce my other submission by a few dozen characters (I'll apply them later).

This code runs the 'multithreaded hello, world' sample flawlessly, and most of the other samples. (My interpreter does give me an division by zero exception when running the 'e' sample - can anyone confirm this with another ><> interpreter?)

Here the indented and commented code :

{debug}uses Windows;{}
// Note : Lowercase identifiers are variables, Uppercase identifiers are types and functions.
type R=^_;_=record
  // n is the next thread (self if round robin)
  n:R;
  // d is an extra thread (will start running at next turn)
  d:R;
  // s is the thread-local stack (kept as a string)
  s:String;
  // i is the current instruction read from the program
  i,
  // m is the registry memory value (read/written by the '&' instruction)
  m,
  // b indicates if the registry should be written (b=0) or read (b>0) by the '&' instruction
  b,
  // p is the stack selector (p=0 : Use thread local stack, p>0 : Use global stack)
  p,
  // v,w are x,y positions into the program
  v,w,
  // x,y are steps in the respective direction (values -1,0 or 1) :
  x,y,
  // A is a temporary variable (only uppercase var, to coincide with comments)
  A,
  // l is the length of the stack (may be abused as a temporary)
  l
  :Int16;
  procedure U(v:Int16);
  function O:Int16;
  procedure T(a,b:Int16);
  procedure E;
end;

var
  // f is the source file
  f:TextFile;
  // c is the entire codebox (a 2-dimensional program)
  c,
  // g is the global stack
  g,
  // k is a temporary stack copy, needed for reversal
  k:String;
  // h is the current thread
  h:R;

procedure _.U; // PUSH
begin
  // Push value onto the stack:
  if p>0then g:=g+Chr(v)else s:=s+Chr(v)
end;

function _.O; // POP
begin
  // Pop value from the stack :
  if l=0then Exit(0);
  if p>0then O:=Ord(g[l])else O:=Ord(s[l]);
  if p>0then Delete(g,l,1)else Delete(s,l,1);
  Dec(l)
end;

procedure _.T; // TURN
begin
  // Split off a new thread when requested :
  if(d<>nil)then
  begin
    // Insert the new thread in the chain :
    d.n:=n;
    n:=d;
    // Split off the thread :
    d.v:=v;
    d.w:=w;
    d:=nil;
    n.T(a,b);
    Exit;
  end;

  // Turn in a new direction :
  x:=a;
  y:=b;
end;

procedure _.E; // STEP
begin
//{debug}Sleep(10);{}
  // Note : x-step needs to stay on same line, y-step needs to stay on same column
  v:=(v+x+80)mod 80;
  w:=(w+y+25)mod 25;
  i:=Ord(c[1+v+80*w])
end;

var
  j:byte;
begin
  {debug}Assert(SizeOf(_)=32);
  // Initialize first thread :
  h:=AllocMem(32);
  h.n:=h;
  h.x:=1;
  h.v:=-1;
  // Open file given at the command-line, and read & expand it's lines into our program buffer :
  Assign(f,ParamStr(1));
  Reset(f);
  for j:=1to 25do
  begin
    ReadLn(f,k);
    c:=c+k+StringOfChar(' ',80-Length(k))
    {debug};SetLength(c,j*80)
  end;
  // Cycle over all threads, executing one instruction per thread :
  repeat
    h:=h.n;
    // Take a step (which gives a new 'i'nstruction)
    h.E;
    with h^ do
    begin
      // Make a copy of the active stack, and determine it's length :
      k:=s;
      if p>0then
        k:=g;
      l:=Length(k);
      // Shorten '''' and '"' (case 2 and 7) string-collecting, by remembering the quote character in A :
      A:=i;
      // Prevent begin+end pair for instructions that need only 2 statements, by handling the 1st here :
      case i-32of // Note : The instruction is decreased by 32, resulting in less digits
        // Shorten string-collecting, by pushing the entire string here (the opening quote was remembered in A) :
        2,7:repeat E;U(i);Inc(l)until i=A; // Note :  We stop at the closing character, so the next block will still handle 'i'!
        // These instructions all need to Pop A, so write it just once here :
        4,5,8,9,12,13,26,32,71,80,93:A:=O;
        // Prevent begin+end for register access, by switching the read/write flag here :
        6:b:=1-b;
        // 'x' (case 120>88): Turn random direction; Choose a random direction instruction and let the 3rd case-block handle it :
        88:i:=Ord('<>^v'[1+Random(4)]);
        // Shorten '{' (case 123-32=91): Share 3rd case-block with ':' (>26) and 'i' (>73) by setting l to 1 here :
        91:l:=1;
        // Prevent begin+end for input retrieval, by reading the input into A here :
        73:Read(PChar(@A)^) // Note : This case is last, because it ends on ')', which avoids a closing ';'
      end;

      // Shorten a few more cases by preparing variables so they can be shared with eachother and the 3rd case-block below :
      case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
        // Shorten '$' (case 38-32=4): Set 'l' to l+1 so that the 3rd case-block can insert just like '@' and '}' :
        4:l:=l+1;
        // Shorten 'p' (case 112-32=80): Set 'l' to O() so that the 3rd case-block doesn't need a begin+end pair :
        80:l:=O;
        // Shorten '{' (case 123-32=91): Share 3rd case-block with ':' (>26) and 'i' (>73) by popping A from position 1, as tricked above!:
        91:A:=O; // Note : This is NOT the same as doing this in the 1st case-block, as 'l' needs to be 1 first!
        // Shorten '}' (case 125-32=93): Prepare 'l' so that the implementation can be shared with '@' (>32):
        93:l:=2;
        // Shorten ':' (case 58-32=26): Share implementation with 'i' (>73) by pushing first copy of A (read above) here
        26:U(A) // Note : This case is last, because it ends on ')', which avoids a closing ';'
      end;

      // All statements (1 statement, or 2nd statement, or begin+end pair with 2 or more statements) :
      case i-32of // Note : The instruction is decreased by 32, resulting in less digits in the cases below!
        //' ': Ignore spaces
        0,88:;
        //'!': Skips the following instruction.
        1:E;
        //'"','''': Enables string parsing. String parsing pushes every character found to the stack until it finds a closing quote.
        //'~': Removes the top value from the stack.
        2,7,94:O;
        //'#': Mirror both axes
        3:T(-x,-y);
        //'$': Rotates the top 2 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,2,4,3)
        //'@': Rotates the top 3 values on the stack clockwise, respectively. (eg. if your stack is 1,2,3,4, would result in 1,4,2,3)
        //'}': Shifts the stack to the right / rotates entire stack clockwise (e.g. 1,2,3,4 becomes 4,1,2,3)
        4,
        32,
        93:if p>0then Insert(Chr(A),g,l-1)else Insert(Chr(A),s,l-1); // Note : A was Popped in 1st case block
        //'%': Pops A and B off the stack, and pushes B mod A.
        5:U(O mod A);
        //'&': Pops the top value off the stack and puts it in the registry. Calling & again will take the value in the registry and put it back on the stack.
        6:if b=0then U(m)else m:=O;
        //'(': Less than. Pops A and B off the stack, and pushes 1 if B > A
        8:U(Ord(O>A));
        //')': Greater than. Pops A and B off the stack, and pushes 1 if B < A
        9:U(Ord(O<A));
        //'*': Pops A and B off the stack, and pushes B * A.
        10:U(O*O); // Note : A and B are inverted, but order is irrelevant here
        //'+': Pops A and B off the stack, and pushes B + A.
        11:U(O+O); // Note : A and B are inverted, but order is irrelevant here
        //',': Pops A and B off the stack, and pushes B / A. Division by 0 raises an error.
        12:U(O div A);
        //'-': Pops A and B off the stack, and pushes B - A.
        13:U(O-A);
        //'.': Switch between thread-local and global stack
        14:p:=1-p;
        //'/': Mirror
        15:T(-y,-x);
        //'0'..'9': Push value 0-9 onto the stack.
        16..25:U(i-48);
        //':': Duplicates the top value on the stack.
        //'i': Takes one character as user input and pushes it's ASCII value to the stack
        //'{': Shifts the stack to the left / rotates entire stack counter-clockwise (e.g. 1,2,3,4 becomes 2,3,4,1)
        26,      // Note for ':' : First A was already pushed once above
        73,      // Note for 'i' : Read() into A was done in 1st case block
        91:U(A); // Note for '{' : l=1 was done in 1st case block, A:=O was done in 2nd block
        //'<': Turn west
        //'>': Turn east
        28,30:T(i-61,0);
        //'=': Pops A and B off the stack, and pushes 1 if B = A, and 0 otherwise.
        29:U(Ord(O=O)); // Note : A and B are inverted, but order is irrelevant here
        //'?': Skips the following instruction if top of stack is zero, or stack is empty. (note: this does not pop anything off the stack!)
        31:if(l=0)or(k[l]=#0)then E;
        //'[': Creates a new thread at the next direction-changing instruction.
        59:d:=AllocMem(32); // Note : Double execution gives memleaks, could be fixed with prefix 'if(d=nil)then '
        //'\': Mirror
        60:T(y,x);
        //']': Ends the current thread.
        61:begin if(h=n)then Exit;d:=n;while(d.n<>h)do d:=d.n;d.n:=h.n;d:=h;h:=n;d:=nil;end; // Note : Memleak on d could be fixed with FreeMem(d)
        //'^': Turn north
        62:T(0,-1);
        //'_': Mirror y
        63:T(x,-y);
        //'a'..'f': Push value 10-15 onto the stack.
        65..70:U(i-87);
        //'g': Pops A and B off the stack, and pushes the value at B,A in the codebox.
        71:U(Ord(c[1+O+80*A])); // Note : A was Popped in 1st case block
        //'m': Takes all data from the current stack and moves it to the end of the other stack.
        77:begin if p>0then s:=s+g else g:=g+s;if p>0then g:=''else s:=''end;
        //'n': Pops and outputs the value
        78:Write(O);
        //'o': Pops and outputs as a character
        79:Write(Chr(O));
        //'p': Pops A, B, and C off the stack, and changes the value at C,B to A.
        80:c[1+O+80*l]:=Chr(A); // Note : A was Popped in 1st case block, l was set to 1 in 2nd case block
        //'r': Reverses the stack.
        82:for j:=1to(l)do s[j]:=k[l-j+1]; // Note: This reads from the stack-copy
        //'v': Turn south
        86:T(0,1);
        //'|': Mirror x
        92:T(-x,y) // Note : This case is last, because it ends on ')', which avoids a closing ';'
      else // ';' (27) and unrecognized instructions end execution.
        Exit;
      end;
    end;
  until 0=1;
end.

Edit history :

(1855-154=1701) : Applied all ideas from the non-threaded version

\$\endgroup\$
3
  • \$\begingroup\$ You can omit the method arguments in the implementation, so you can change procedure _.U(v: Int16);-->procedure _.U; and procedure _.T(A, b: Int16);-->procedure _.T; \$\endgroup\$ Commented Mar 16, 2011 at 4:14
  • \$\begingroup\$ And TextFile can be written as Text, and AssignFile() as Assign() \$\endgroup\$ Commented Mar 16, 2011 at 4:16
  • \$\begingroup\$ @Wouter van Nifterick : Thanks for the tip on the arguments and AssignFile; But 'TextFile' must stay, because ReadLn magically won't compile on a regular 'File' (and I need ReadLn to support irregular line-lengths in the input). \$\endgroup\$
    – PatrickvL
    Commented Mar 16, 2011 at 17:48
3
\$\begingroup\$

PHP, 2493 bytes

<?php if($argc<=1||$argv[1]=='-h'){echo 'e.g.: fish.php program.fish';}else{$f=$argv[1];if(file_exists($f)){$x=file_get_contents($f);$x=str_replace(a("\r\n","\r"),"\n",$x);f($x);}}function f($f){$g=explode("\n",$f);foreach($g as &$u){$a=a();$i=0;while($i++<=strlen($u)){$a[]=substr($u,$i,1);}$u=$a;}$p=a(0,0);$d=a(1,0);$s=a();$q=false;$r=null;while(1){$c=g($g,$p);if($c!==null){if($q&&$c!='"'&&$c!='\''){$s[]=ord($c);}else if(h($c)){$s[]=hexdec($c);}else {if($c=='x'){$a=a('<','>','^','v');$c=$a[mt_rand(0,3)];}switch($c){case '>':$d=a(1,0);break;case '<':$d=a(-1,0);break;case '^':$d=a(0,-1);break;case 'v':$d=a(0,1);break;case '/':$d=a(-$d[1],-$d[0]);break;case '\\':$d=a($d[1],$d[0]);break;case '|':$d[0]=-$d[0];break;case '_':$d[1]=-$d[1];break;case '#':$d=a(-$d[0],-$d[1]);break;case 'o':case 'n':case '~':$a=p($s);if($c=='o'){echo chr($a);}else if($c=='n'){echo (int)$a;}break;case ')':case '(':case '=':$a=p($s);$b=p($s);$s[]=($b<$a&&$c=='(')||($b>$a&&$c==')')||($a==$b&$c=='=')?1:0;break;case ',':case '*':case '%':case '-':case '+':$a=p($s);$b=p($s);switch($c){case '+':$s[]=$b+$a;break;case '-':$s[]=$b-$a;break;case '*':$s[]=$b*$a;break;case ',':$s[]=$b/$a;break;case '%':$s[]=$a%$b;break;}break;case ':':$a=p($s);array_push($s,$a,$a);break;case '!':case '?':if((c($s)==0)||$c=='!'){m($g,$d,$p);}break;case 'g':$a=p($s);$b=p($s);$o=ord(gc($g,a($b,$a)));$s[]=$o;break;case 'p':$j=p($s);$k=p($s);$h=p($s);$g[$k][$h]=chr($j);break;case '$':$a=p($s);$b=p($s);array_push($s,$a,$b);break;case '@':$a=p($s);$b=p($s);$j=p($s);array_push($s,$a,$j,$b);break;case 'r':$s=array_reverse($s);break;case '}':$a=p($s);array_unshift($s,$a);break;case '{':$a=array_shift($s);$s[]=$a;break;case '&':if($r==null){$r=p($s);}else {array_push($s,$r);$r=null;}break;case '\'':case '"':$q=!$q;break;case ';':return;break;case ' ':case "\n":break;default:echo 'E: Unknown syntax "'.$c.'" at ('.$p[0].', '.$p[1].')';return;break;}}}m($g,$d,$p);}}function p(&$s){return array_pop($s);}function h($c){$d=-1;if(is_numeric($c)){$d=(int)$c;}return ($d>=0&&$d<=9)||($c>='a'&&$c<='f');}function m($g,&$d,&$p){$p[1]+=$d[1];$p[0]+=$d[0];if($d[1]!=0){if($p[1]<0){$p[1]=c($g)-1;}if($p[1]>=c($g)){$p[1]=0;}}else{if($p[0]>=c($g[$p[1]])){$p[0]=0;}if($p[0]<0){$p[0]=c($g[$p[1]])-1;}}}function g($g,$p){if(kc($p[1],$g)){if(is_array($g[$p[1]])&&kc($p[0],$g[$p[1]])){return $g[$p[1]][$p[0]];}}return null;}function kc($k,$a){return array_key_exists($k,$a);}function a(){return func_get_args();}function c($a){return count($a);}

I know that it has been implemented with smaller compiler size with other languages, but nevertheless with the spirit of a never-say-die programmer, I've came up with a PHP CLI interpreter for ><> Fish. The entire source code is below.

2 main feature of the Fish programming language was not implemented, namely:

  1. Multi-threading. PHP scripts are single-threaded top-down execution only.
  2. Input i of a character. PHP CLI requires the user to press the <Enter> key in order to enter input into the input buffer.

Note that I've written and optimized much of the native functions including the creation of array by using:

function a(){
    return func_get_args();
}
$a = a(1,3,4,5);

instead of

$a = array(1,3,4,5);

The program can be accessed through command line interface (CLI) using the following command:

php fish.php program.fish

I spent a total of 6 hours to complete this with reference to the original python interpreter.

Original Source:

<?php

if($argc <= 1  || $argv[1] == '-h'){
    echo 'e.g.: fish.php program.fish';
}else{
    $f = $argv[1];
    if(file_exists($f)){
        $x = file_get_contents($f);
        $x = str_replace(a("\r\n", "\r"), "\n", $x);
        f($x);
    }
}

function f($f) {
    $g = explode("\n", $f);
    foreach($g as &$u){
        $a = a();
        $i = 0;
        while($i++ <= strlen($u)){
            $a[] = substr($u, $i, 1);
        }
        $u = $a;
    }
    $p = a(0, 0); // position
    $d = a(1, 0); // direction
    $s = a(); // stack
    $q = false; // string lateral
    $r = null; // registry
    while (1) {
        $c = g($g, $p);
        if ($c !== null) {
            if ($q && $c != '"' && $c != '\'') {
                $s[] = ord($c);
            } else if (h($c)) {
                $s[] = hexdec($c);
            } else {
                if($c == 'x'){
                    $a = a('<', '>', '^', 'v');
                    $c = $a[mt_rand(0, 3)];
                }
                switch ($c) {
                    case '>':
                        $d = a(1, 0);
                        break;
                    case '<':
                        $d = a(-1, 0);
                        break;
                    case '^':
                        $d = a(0, -1);
                        break;
                    case 'v':
                        $d = a(0, 1);
                        break;
                    case '/':
                        $d = a(-$d[1], -$d[0]);
                        break;
                    case '\\':
                        $d = a($d[1], $d[0]);
                        break;
                    case '|':
                        $d[0] = -$d[0];
                        break;
                    case '_':
                        $d[1] = -$d[1];
                        break;
                    case '#':
                        $d = a(-$d[0], -$d[1]);
                        break;
                    case 'o':
                    case 'n':
                    case '~':
                        $a = p($s);
                        if ($c == 'o') {
                            echo chr($a);
                        } else if ($c == 'n') {
                            echo (int)$a;
                        }
                        break;
                    case ')':
                    case '(':
                    case '=':
                        $a = p($s);
                        $b = p($s);
                        $s[] = ($b < $a && $c == '(') || ($b > $a && $c == ')') || ($a == $b & $c == '=') ? 1 : 0;
                        break;
                    case ',':
                    case '*':
                    case '%':
                    case '-':
                    case '+':
                        $a = p($s);
                        $b = p($s);
                        switch ($c) {
                            case '+':
                                $s[] = $b + $a;
                                break;
                            case '-':
                                $s[] = $b - $a;
                                break;
                            case '*':
                                $s[] = $b * $a;
                                break;
                            case ',':
                                $s[] = $b / $a;
                                break;
                            case '%':
                                $s[] = $a % $b;
                                break;
                        }
                        break;
                    case ':':
                        $a = p($s);
                        array_push($s, $a, $a);
                        break;
                    case '!':
                    case '?':
                        if ((c($s) == 0) || $c == '!') {
                            m($g, $d, $p);
                        }
                        break;
                    case 'g':
                        $a = p($s);
                        $b = p($s);
                        $o = ord(gc($g, a($b, $a)));
                        $s[] = $o;
                        break;
                    case 'p':
                        $j = p($s);
                        $k = p($s);
                        $h = p($s);
                        $g[$k][$h] = chr($j);
                        break;
                    case '$':
                        $a = p($s);
                        $b = p($s);
                        array_push($s, $a, $b);
                        break;
                    case '@':
                        $a = p($s);
                        $b = p($s);
                        $j = p($s);
                        array_push($s, $a, $j, $b);
                        break;
                    case 'r':
                        $s = array_reverse($s);
                        break;
                    case '}':
                        $a = p($s);
                        array_unshift($s, $a);
                        break;
                    case '{':
                        $a = array_shift($s);
                        $s[] = $a;
                        break;
                    case '&':
                        if ($r == null) {
                            $r = p($s);
                        } else {
                            array_push($s, $r);
                            $r = null;
                        }
                        break;
                    case '\'':
                    case '"':
                        $q = !$q;
                        break;
                    case ';':
                        return;
                        break;
                    case ' ':
                    case "\n":
                        break;
                    default:
                        echo 'E: Unknown syntax "' . $c . '" at (' . $p[0] . ', ' . $p[1] . ')';
                        return;
                        break;
                }
            }
        }
        m($g, $d, $p);
    }
}

function p(&$s) {
    return array_pop($s);
}

function h($c) {
    $d = -1;
    if (is_numeric($c)) {
        $d = (int) $c;
    }
    return ($d >= 0 && $d <= 9) || ($c >= 'a' && $c <= 'f');
}

function m($g, &$d, &$p) {
    $p[1] += $d[1];
    $p[0] += $d[0];
    if($d[1] != 0){
        if($p[1] < 0){
            $p[1] = c($g) - 1;
        }
        if($p[1] >= c($g)){
            $p[1] = 0;
        }
    }else{
        if($p[0] >= c($g[$p[1]])){
            $p[0] = 0;
        }
        if($p[0] < 0){
            $p[0] = c($g[$p[1]]) - 1;
        }
    }
}

function g($g, $p){
    if(kc($p[1], $g)){
        if(is_array($g[$p[1]]) && kc($p[0], $g[$p[1]])){
            return $g[$p[1]][$p[0]];
        }
    }
    return null;
}

function kc($k, $a){
    return array_key_exists($k, $a);
}

function a(){
    return func_get_args();
}

function c($a){
    return count($a);
}

Edit History

  1. Changed the x syntax to select one of the direction instead of selecting on its own.
  2. Fixed the p command where chr() should be used before pushing value into code box.
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.