Хотя> <> не является популярным языком, он может быть хорош для игры в гольф и использовался на этом сайте. Он был вдохновлен Befunge и имеет некоторые сходства в инструкциях.

Обязательные команды:

> < ^ v
Изменяет направление указателя инструкции (вправо, влево, вверх, вниз)
/ \ | _ #
Зеркала; указатель изменит направление в зависимости от того, в каком направлении он уже находится.
x
Случайное направление.
+ - * , %
Сложение, вычитание, умножение, деление и по модулю соответственно. Вытаскивает A и B из стека и выталкивает оператор B A. Деление на 0 вызывает ошибку.
0-9 a-f
Помещает соответствующее значение в стек. a = 10, ..., f = 15
=
выталкивает A и B из стека и выталкивает 1, если B = A, и 0 в противном случае.
)
Больше чем. Вытаскивает A и B из стека и толкает 1, если B <A
(
меньше чем. Выдвигает A и B из стека и выталкивает 1, если B> A
' "
Включает разбор строки. Разбор строк помещает каждый найденный символ в стек, пока не найдет закрывающую кавычку.
!
Пропускает следующую инструкцию.
?
Пропускает следующую инструкцию, если вершина стека равна нулю или стек пуст. (примечание: это ничего не выталкивает из стека!)
:
Дублирует верхнее значение в стеке.
~
Удаляет верхнее значение из стека.
$
Вращает 2 верхних значения в стеке по часовой стрелке, соответственно. (например, если ваш стек равен 1,2,3,4, получится 1,2,4,3)
@
Поворот 3 верхних значений в стеке по часовой стрелке, соответственно. (Например, если ваш стек равен 1,2,3,4, получится 1,4,2,3). Вытаскивает
&
верхнее значение из стека и помещает его в реестр. Вызов & снова примет значение в реестре и вернет его обратно в стек.
r
Переворачивает стек.
}
Смещает стек вправо / вращает весь стек по часовой стрелке (например, 1,2,3,4 становится 4,1,2,3 Смещает
{
стек влево / вращает весь стек против часовой стрелки (например, 1,2,3,4 становится 2,3,4,1, выталкивает
g
A и B из стека и сбрасывает значение в B, A. в кодовом поле, выталкивает
p
A, B и C из стека и изменяет значение в C, B на A.
o
Выдает и выводит как символ.
n
Выдает и выводит значение.
i
Принимает один символ как пользовательский ввод и помещает его значение ASCII в стек.
;
Завершение выполнения.

Потоки не обязательно должны быть реализованы, хотя вы можете, если хотите.

Самый короткий ответ выигрывает, в случае ничьей выигрывает первый ответ.

Вы можете использовать любой язык, и eval разрешен.

Файл будет предоставлен через аргументы командной строки и будет иметь .fishрасширение.

Вы можете использовать официальный интерпретатор Python в качестве справки, если это необходимо. В статье Esolangs Wiki есть больше информации о том, как работает язык, а также еще несколько примеров.

Тестовые случаи:

Привет, мир!
Код:

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

Выход:

Hello World!

Кодекс факториалов :

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

Выход (до 5):

1 2 6 24 120

APL (Дьялог) (750)

Поскольку у APL на самом деле нет командной строки, загрузите ее в рабочее пространство (то есть с помощью )ed F), а затем запустите ее из строки APL следующим образом:

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

      F'hello.fish'
Hello World!

      F'stack.fish'
12543

Он не обрабатывает никаких ошибок. Поведение неправильного кода не указано. Это не может делать темы либо. Там, где страница Esolang и вопрос конфликтуют, следует вопрос.

Изменить: чуть более читаемую версию с комментариями можно найти здесь: 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

Дельфы, 1144

Все, кроме ведущих инструкций, реализованы.

 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.

Код с отступом и комментариями гласит:

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

Редактировать историю:

(1306 + 18 = 1324): исправлены ошибки в нескольких операциях (Delphi оценивает аргументы в обратном порядке). Также исправлено появление стека (не может появиться более одного раза за инструкцию).

(1324-33 = 1291): убрана защита при записи содержимого из пустой стопки

(1291-56 = 1235): добавлена ​​функция поворота, переименованы переменные, уменьшены цифры команд

(1235-7 = 1228): переупорядоченные переменные, исправлена ​​ошибка в '@'

(1228-37 = 1191): делится большим количеством кода реализации, распределяя его по 3 последовательным блокам

(1191-12 = 1179): Совместно реализовал реализацию циклического стека между всеми 3 инструкциями.

(1179-20 = 1159): разделение строк на 3 блока, удаление переменной j, совместное использование другой реализации

(1159-15 = 1144): Упростил 'x', изменив его на одну из 4 инструкций направления

Haskell 1428

Почти все строчные буквы используются в качестве имен функций.

PS Есть ли игра про подобные (2d указатель) esolangs? Они должны быть очень забавными!

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

Пример рыбной программы

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

Питон, 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

Не поддерживает многопоточность.

Версии:
 1. 981
 2. 980: исправлена pинструкция; небольшое улучшение.
 3. 978: исправлена ?инструкция.

Дельфы, 1855 1701

Эта версия имеет поддержку потоков по довольно высокой цене: версия без поддержки потоков сейчас составляет 1144 символа, поэтому поддержка потоков добавляет 557 символов (около 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.

Обратите внимание, что эта реализация содержит несколько идей, которые уменьшат мою другую отправку на несколько десятков символов (я их применю позже).

Этот код безупречно выполняет пример многопоточного «привет, мир» и большинство других примеров. (Мой интерпретатор дает мне исключение деления на ноль при выполнении образца 'e' - может ли кто-нибудь подтвердить это другим> <> интерпретатором?)

Здесь код с отступом и комментариями:

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

Редактировать историю:

(1855-154 = 1701): применил все идеи из версии без резьбы

PHP, 2493 байта

<?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);}

Я знаю, что он был реализован с меньшим размером компилятора с другими языками, но, тем не менее, в духе непревзойденного программиста, я придумал интерпретатор PHP CLI для ><> Fish. Весь исходный код ниже.

2 Основные функции языка программирования Fish не были реализованы, а именно:

1. Многопоточность. PHP-скрипты являются однопоточными только сверху вниз.
2. Ввод iперсонажа. PHP CLI требует, чтобы пользователь нажал <Enter>клавишу для ввода ввода в буфер ввода.

Обратите внимание, что я написал и оптимизировал большинство встроенных функций, включая создание массива с помощью:

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

вместо того

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

Доступ к программе можно получить через интерфейс командной строки (CLI) с помощью следующей команды:

php fish.php program.fish

Я потратил в общей сложности 6 часов, чтобы завершить это со ссылкой на оригинальный интерпретатор Python.

Первоначальный источник:

<?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);
}

Редактировать историю

1. Изменен xсинтаксис для выбора одного направления вместо самостоятельного выбора.
2. Исправлена pкоманда, в которой chr()следует использовать, прежде чем вставлять значение в поле кода.

Lua 1640 (1558 без резьбы) символы

Резьбовая версия, игра в гольф (1640 символов):

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@d@pT.N@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 "}))()

Потоковая версия делает несколько неприятных хаков с setfenv и getfenv, чтобы исключить необходимость индексации для разных потоков.

Потоковая версия для чтения:

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

Версия без резьбы, игра в гольф (1558 символов, но ее можно сжать немного больше, если критерием будет версия без резьбы):

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

Читаемая версия:

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

Не ставить следующий как результат, поскольку использование сжатия напрямую не является целью;). Используя murgaLua (или любую версию Lua с lzlib и luaSocket (для декодирования base64)), при магическом счете 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==")))()