Execute Brain****: Difference between revisions
m
→{{header|Binary Lambda Calculus}}
(Move rest of BASIC implementations under BASIC heading) |
|||
| (15 intermediate revisions by 7 users not shown) | |||
Line 2,442:
{{out}}
<pre>Hello World!</pre>
==={{header|Commodore BASIC}}===
{{trans|TRS-80 BASIC}}
Changed hello-world text to all-caps to avoid re-coding it all for PETSCII.
<syntaxhighlight lang="gwbasic>100 REM BRAINF*CK FOR COMMODORE BASIC
110 DB=0:REM SET TO 1 FOR DEBUGGING
120 P$=""
130 READ C$
140 P$=P$+C$
150 IF LEN(C$)<>0 THEN 130
160 REM PAIR UP BRACKETS INTO B%
170 DIM B%(LEN(P$))
180 REM TRACK OPEN BRACKETS IN O%
190 DIM O%(INT(LEN(P$)/2)):O=0
200 FOR I=1 TO LEN(P$)
210 : I$=MID$(P$,I,1)
220 : IF I$="[" THEN O%(O)=I:O=O+1
230 : IF I$<>"]" THEN 270
240 : IF O=0 THEN PRINT "UNMATCHED BRACKET AT"I". ABORTING.":END
250 : O=O-1:M=O%(O)
260 : B%(I)=M:B%(M)=I
270 NEXT I
280 IF O THEN PRINT "UNMATCHED BRACKETS AT EOF. ABORTING.":END
290 REM SET MS TO NUMBER OF MEMORY CELLS NEEDED.
300 REM THE BF SPEC REQUIRES 30000, WHICH WILL WORK ON C64 OR 48K+ PET.
310 AN UNEXPANDED VIC-20 WILL HANDLE 1000, A C-16 9000. THE DEMO ONLY NEEDS 4.
320 MS=4:DIM M%(MS/2-1):MP=0
330 REM FUNCTION TO READ BYTE AT CELL N
340 DEF FNMP(N)=INT(M%(INT(N/2)) / (1+255*(N AND 1))) AND 255
350 FOR I=1 TO LEN(P$)
360 : IF MP<0 OR MP>=MS THEN PRINT "ERROR: MP OUT OF RANGE AT"I:END
370 : IF DB THEN PRINT "IP:"I"("I$") MP: "MP"("FNMP(MP)")"
380 : I$=MID$(P$,I,1)
390 : IF I$<>"[" THEN 420
400 : IF FNMP(MP)=0 THEN I=B%(I)
410 : GOTO 530
420 : IF I$<>"]" THEN 450
430 : IF FNMP(MP) THEN I=B%(I)
440 : GOTO 530
450 : IF I$="<" THEN MP=MP-1:GOTO 530
460 : IF I$=">" THEN MP=MP+1:GOTO 530
470 : IF I$="-" THEN V=FNMP(MP)-1:GOTO 560
480 : IF I$="+" THEN V=FNMP(MP)+1:GOTO 560
490 : IF I$="." THEN PRINTCHR$(FNMP(MP));:GOTO 530
500 : IF I$<>"," THEN 530
510 : GET K$:IF K$="" THEN 510
520 : V=ASC(K$):GOTO 560
530 NEXT I
540 END
550 REM UPDATE CELL AT MP WITH VALUE IN V
560 M=INT(MP/2):O=M%(M):V=V AND 255
570 N0=(O AND -256)+V
580 N1=(V*256+(O AND 255))
590 M%(M) = (MP AND 1)*N1 - ((MP AND 1)=0)*N0
600 GOTO 530
610 REM HELLO, WORLD PROGRAM
620 DATA "+++++++++[>++++++++<-]>."
630 DATA "---."
640 DATA "+++++++..+++."
650 DATA ">>++++[<+++++++++++>-]<."
660 DATA ">++++[<--->-]<."
670 DATA "<++++++++."
680 DATA "--------."
690 DATA "+++."
700 DATA "------."
710 DATA "--------."
720 DATA ">>[++][<+++++++>-]<+."
730 DATA ">++++++++++."
740 DATA ""</syntaxhighlight>
{{Out}}
<pre>HELLO, WORLD!</pre>
==={{header|FreeBASIC}}===
Line 2,626 ⟶ 2,699:
362880
</pre>
==={{header|PureBasic}}===
[[/PureBasic|Implementation in PureBasic]]
==={{header|TI-83 BASIC}}===
Line 2,635 ⟶ 2,712:
[[/TI-89 BASIC|Implementation in TI-89 Basic]].
==={{header|
This should work in Level II BASIC on any TRS-80, even a Model I. However, allocating the full 30,000-cell memory tape requires 48K of RAM.
The default character set on the TRS-80 lacks square brackets; their positions are taken by ↑ and ← characters instead. The code below uses
square brackets, which will paste into emulators as the arrows; to type on a real machine the user will have to make the substitution manually.
To allow for programs that better resemble the standard visually, this interpreter also accepts parentheses as equivalent; that will break code containing
parentheticals in comments, however, so edit lines 340 and 370 to suit your needs.
<syntaxhighlight lang="gwbasic">100 REM BRAINF*CK FOR TRS-80 LEVEL II BASIC
103 DB=0:REM SET TO 1 FOR DEBUGGING
105 REM FIRST MAKE SURE WE HAVE ENOUGH STRING HEAP FOR PROGRAM
110 READ C$:C=LEN(C$):IF C>M THEN M=C
120 PS=PS+C
130 IF C THEN 110
135 REM ALLOCATE THE HEAP
140 CLEAR 2*(PS+M)
145 REM RE-READ PROGRAM, REMEMBERING IT THIS TIME
150 RESTORE
160 P$=""
170 READ C$
180 P$=P$+C$
190 IF LEN(C$)<>0 THEN 170
195 REM PAIR UP BRACKETS INTO B%
200 DIM B%(LEN(P$))
205 REM TRACK OPEN BRACKETS IN O%
210 DIM O%(INT(LEN(P$)/2)):O=0
220 FOR I=1 TO LEN(P$)
230 : I$=MID$(P$,I,1)
240 : IF I$="(" OR I$="[" THEN O%(O)=I:O=O+1
250 : IF I$<>")" AND I$<>"]" THEN 290
260 : IF O=0 THEN PRINT "UNMATCHED BRACKET AT"I". ABORTING.":END
270 : O=O-1:M=O%(O)
280 : B%(I)=M:B%(M)=I
290 NEXT I
300 IF O THEN PRINT "UNMATCHED BRACKETS AT EOF. ABORTING.":END
303 REM SET MS TO NUMBER OF MEMORY CELLS NEEDED
305 REM THE BF SPEC REQUIRES 30000, WHICH DOES WORK ON A SYSTEM WITH 48K RAM.
307 REM THE DEMO HELLO-WORLD PROGRAM ONLY REQUIRES 4 CELLS.
310 MS=4:DIM M%(MS/2-1):MP=0
313 REM FUNCTION TO READ BYTE AT CELL N
315 DEF FNMP(N)=INT(M%(INT(N/2)) / (1+255*(N AND 1))) AND 255
320 FOR I=1 TO LEN(P$)
323 : IF MP<0 OR MP>=MS THEN PRINT "ERROR: MP OUT OF RANGE AT"I:END
327 : IF DB THEN PRINT "IP:"I"("I$") MP:"MP"("FNMP(MP)")"
330 : I$=MID$(P$,I,1)
340 : IF I$<>"(" AND I$<>"[" THEN 370
350 : IF FNMP(MP)=0 THEN I=B%(I)
360 : GOTO 480
370 : IF I$<>")" AND I$<>"]" THEN 400
380 : IF FNMP(MP) THEN I=B%(I)
390 : GOTO 480
400 : IF I$="<" THEN MP=MP-1:GOTO 480
410 : IF I$=">" THEN MP=MP+1:GOTO 480
420 : IF I$="-" THEN V=FNMP(MP)-1:GOTO 500
430 : IF I$="+" THEN V=FNMP(MP)+1:GOTO 500
440 : IF I$="." THEN ?CHR$(FNMP(MP));:GOTO 480
450 : IF I$<>"," THEN 480
460 : K$=INKEY$:IF K$="" THEN 460
470 : V=ASC(K$):GOTO 500
480 NEXT I
490 END
495 REM UPDATE CELL AT MP WITH VALUE IN V
500 M=INT(MP/2):O=M%(M):V=V AND 255
510 N0=(O AND -256)+V
520 N1=(V*256+(O AND 255))
530 M%(M) = (MP AND 1)*N1 - ((MP AND 1)=0)*N0
540 GOTO 480
545 REM HELLO, WORLD PROGRAM
570 DATA "+++++++++[>++++++++<-]>."
580 DATA "<+++++[>+++++<-]>++++."
590 DATA "+++++++..+++."
600 DATA ">>++++[<+++++++++++>-]<."
610 DATA ">++++[<--->-]<."
620 DATA "<++++++++."
630 DATA "--------."
640 DATA "+++."
650 DATA "------."
660 DATA "--------."
670 DATA ">>[++][<+++++++>-]<+."
680 DATA ">++++++++++."
690 DATA ""</syntaxhighlight>
{{Out}}
<pre>Hello, world!</pre>
==={{header|ZX Spectrum Basic}}===
Line 2,683 ⟶ 2,842:
{{omit from|GUISS}}
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
Line 2,790 ⟶ 2,950:
<pre>Filename? hello.bf
Hello World!</pre>
=={{header|Binary Lambda Calculus}}==
The following 224-byte program
<pre>0000000 44 51 a1 01 84 55 d5 02 b7 70 30 22 ff 32 f0 00
0000020 bf f9 85 7f 5e e1 6f 95 7f 7d ee c0 e5 54 68 00
0000040 58 55 fd fb e0 45 57 fd eb fb f0 b6 f0 2f d6 07
0000060 e1 6f 73 d7 f1 14 bc c0 0b ff 2e 1f a1 6f 66 17
0000100 e8 5b ef 2f cf ff 13 ff e1 ca 34 20 0a c8 d0 0b
0000120 99 ee 1f e5 ff 7f 5a 6a 1f ff 0f ff 87 9d 04 d0
0000140 ab 00 05 db 23 40 b7 3b 28 cc c0 b0 6c 0e 74 10
0000160 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 5b 3e 2b 2b 2b 2b
0000200 2b 2b 2b 3e 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 3e 2b
0000220 2b 2b 3e 2b 3c 3c 3c 3c 2d 5d 3e 2b 2b 2e 3e 2b
0000240 2e 2b 2b 2b 2b 2b 2b 2b 2e 2e 2b 2b 2b 2e 3e 2b
0000260 2b 2e 3c 3c 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b 2b
0000300 2b 2b 2b 2e 3e 2e 2b 2b 2b 2e 2d 2d 2d 2d 2d 2d
0000320 2e 2d 2d 2d 2d 2d 2d 2d 2d 2e 3e 2b 2e 3e 2e 5d</pre>
consists of the 112-byte brainfuck interpreter https://github.com/tromp/AIT/blob/master/bf.blc8 followed by the 112-byte brainfuck hello world program
<pre>++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.]</pre>
and produces output
<pre>Hello World!
</pre>
=={{header|Brainf***}}==
Line 3,835 ⟶ 4,023:
=={{header|E}}==
[[/E|Implementation in E]].
=={{header|EasyLang}}==
<syntaxhighlight>
proc exec code$ . .
len mem[] 100
dp = 1
code$[] = strchars code$
ip = 1
while ip <= len code$[]
if dp > len mem[]
len mem[] len mem[] + 100
.
if dp < 1
print "programm error"
return
.
c$ = code$[ip]
if c$ = "+"
mem[dp] += 1
elif c$ = "-"
mem[dp] -= 1
elif c$ = ">"
dp += 1
elif c$ = "<"
dp -= 1
elif c$ = "."
write strchar mem[dp]
elif c$ = ","
print "input not implemented"
elif c$ = "["
if mem[dp] = 0
br = 1
repeat
ip += 1
if code$[ip] = "["
br += 1
elif code$[ip] = "]"
br -= 1
.
until br = 0
.
else
br[] &= ip
.
elif c$ = "]"
ip = br[len br[]] - 1
len br[] -1
.
ip += 1
.
.
func syntax code$ .
for i to len code$
h$ = substr code$ i 1
if h$ = "["
br += 1
elif h$ = "]"
br -= 1
.
if br < 0
return 0
.
.
return if br = 0
.
repeat
inp$ = input
until inp$ = ""
code$ &= inp$
.
if syntax code$ <> 1
print "syntax error"
return
.
exec code$
#
input_data
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>
---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
</syntaxhighlight>
=={{header|Elena}}==
Line 6,596 ⟶ 6,866:
...
Print this backwards!</pre>
=={{header|R}}==
Unfortunately doesn't support the "," operator.
<syntaxhighlight lang="r">
bf <- function(code) {
instructions <- strsplit(code, "")[[1]]
tape <- c()
visited <- c()
pset <- function(n) {
if (n %in% visited)
p <<- n
else {
visited[length(visited)+1] <<- n
tape[as.character(n)] <<- 0
pset(n)
}
}
bracket <- function(b1, b2, x) {
nest <- 1
j <- i + x
while (nest != 0) {
if (instructions[j] == b1)
nest <- nest + 1
if (instructions[j] == b2)
nest <- nest - 1
j <- j + x
}
i <<- j
}
pset(0)
i <- 1
while (i <= length(instructions)) {
p_ <- as.character(p)
c <- instructions[i]
switch(c,
">" = pset(p + 1),
"<" = pset(p - 1),
"+" = tape[p_] <- tape[p_] + 1,
"-" = tape[p_] <- tape[p_] - 1,
"." = cat(intToUtf8(tape[p_])),
# TODO: IMPLEMENT ","
"[" = if (tape[p_] == 0) {
bracket("[", "]", 1)
i <- i - 1 # off by one error
},
"]" = bracket("]", "[", -1))
i <- i + 1
}
}
bf("++++++++++[>+>+++>+++++++>++++++++++<<<<-]>>>++.>+.+++++++..+++.<<++.>+++++++++++++++.>.+++.------.--------.<<+.<.")
</syntaxhighlight>
To run:
<pre>
R -s --vanilla < bf.r
</pre>
=={{header|Racket}}==
Line 6,705 ⟶ 7,036:
bf/run
</syntaxhighlight>
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, <Arg 1>: e.File
, <ReadFile 1 e.File>: e.Source
, <ParseBF e.Source>: {
F e.Error = <Prout e.Error>;
T e.Prog = <RunProgram e.Prog>;
};
};
ReadFile {
s.Chan e.File = <Open 'r' s.Chan e.File>
<ReadFile (s.Chan)>;
(s.Chan), <Get s.Chan>: {
0 = <Close s.Chan>;
e.Line = <SanitizeBF e.Line> <ReadFile (s.Chan)>
};
}
SanitizeBF {
= ;
s.C e.X, '+-<>.,[]': e.L s.C e.R = s.C <SanitizeBF e.X>;
s.C e.X = <SanitizeBF e.X>;
};
ParseBF {
e.X, <CheckLoops e.X>: {
T = T <ParseLoops () () e.X>;
e.Err = e.Err;
};
};
CheckLoops {
(0) = T;
(s.N) = F 'Mismatched [';
(0) ']' e.X = F 'Mismatched ]';
(s.N) '[' e.X = <CheckLoops (<+ s.N 1>) e.X>;
(s.N) ']' e.X = <CheckLoops (<- s.N 1>) e.X>;
(s.N) s.I e.X = <CheckLoops (s.N) e.X>;
e.X = <CheckLoops (0) e.X>;
};
ParseLoops {
(e.X) (e.C) = e.X e.C;
(e.R) (e.Cur) '[' e.Prog = <ParseLoops (e.R (e.Cur)) () e.Prog>;
(e.R (e.Last)) (e.Cur) ']' e.Prog = <ParseLoops (e.R) (e.Last (e.Cur)) e.Prog>;
(e.R) (e.Cur) s.Instr e.Prog = <ParseLoops (e.R) (e.Cur s.Instr) e.Prog>;
}
RunProgram {
e.Prog, (() 0 ()): t.Tape,
(() ()): t.IObuf,
(t.Tape t.IObuf): t.State,
<RunBF t.State e.Prog>: (t.TapeOut t.IObufOut),
t.IObufOut: ((e.In) (e.Out)),
e.Out: {
= ;
e.X = <Prout e.X>;
};
};
RunBF {
t.State = t.State;
t.State t.Step e.Prog = <RunBF <StepBF t.State t.Step> e.Prog>;
};
StepBF {
(t.Tape t.IObuf) '+' = (<TapeF Inc t.Tape> t.IObuf);
(t.Tape t.IObuf) '-' = (<TapeF Dec t.Tape> t.IObuf);
(t.Tape t.IObuf) '<' = (<TapeLeft t.Tape> t.IObuf);
(t.Tape t.IObuf) '>' = (<TapeRight t.Tape> t.IObuf);
t.State ',' = <BFIn t.State>;
t.State '.' = <BFOut t.State>;
t.State (e.Loop), t.State: ((t.L 0 t.R) t.IObuf) = t.State;
t.State (e.Loop), <RunBF t.State e.Loop>: t.Newstate = <StepBF t.Newstate (e.Loop)>;
};
TapeLeft {
((e.L s.N) s.C (e.R)) = ((e.L) s.N (s.C e.R));
(() s.C (e.R)) = (() 0 (s.C e.R));
};
TapeRight {
((e.L) s.C (s.N e.R)) = ((e.L s.C) s.N (e.R));
((e.L) s.C ()) = ((e.L s.C) 0 ());
};
TapeF {
s.F ((e.L) s.C (e.R)) = ((e.L) <Mu s.F s.C> (e.R));
};
BFIn {
(t.Tape t.IObuf), t.Tape: (t.L s.C t.R),
t.IObuf: (t.In t.Out),
t.In: {
(s.Char e.Rest), (t.L s.Char t.R): t.Newtape,
((e.Rest) t.Out): t.NewIO
= (t.Newtape t.NewIO);
(), <Card>: {
0 = ((t.L 0 t.R) t.IObuf);
e.Line = <BFIn (t.Tape ((<Ord e.Line> 10) t.Out))>;
};
};
};
BFOut {
(t.Tape t.IObuf), t.Tape: (t.L s.C t.R),
t.IObuf: (t.In t.Out),
s.C: {
10, t.Out: (e.Line) = <Prout <Chr e.Line>> (t.Tape (t.In ()));
s.C, t.Out: (e.Line) = (t.Tape (t.In (e.Line s.C)));
};
};
Inc { s.X = <Mod <+ 1 s.X> 256>; };
Dec { s.X = <Mod <+ 255 s.X > 256>; };</syntaxhighlight>
{{out}}
<pre>$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ refgo bf hello.bf
Hello World!</pre>
=={{header|REXX}}==
Line 6,766 ⟶ 7,219:
<pre>
Hello World!
</pre>
=={{header|RPL}}==
« 3000 DUP { } + 0 CON 'Tape' STO "" 'StdOut' STO 1
{ « 1 + »
« 1 - »
« 'Tape' OVER DUP2 GET 1 + PUT »
« 'Tape' OVER DUP2 GET 1 - PUT »
« StdOut 'Tape' 3 PICK GET CHR + 'StdOut' STO »
« 'Tape' OVER '''DO UNTIL''' KEY '''END''' PUT »
« '''IF''' 'Tape' OVER GET NOT '''THEN'''
1 CF
'''DO''' pgm pptr 1 + DUP 'pptr' STO DUP SUB
'''IF''' DUP "" == OVER "]" == OR '''THEN''' 1 SF '''END'''
'''UNTIL''' 1 FS? '''END END''' »
« '''IF''' 'Tape' OVER GET '''THEN'''
1 CF
'''DO''' pgm pptr 1 - DUP 'pptr' STO DUP SUB
'''IF''' DUP "" == '''THEN''' 1 SF pgm SIZE 'pptr' STO '''END'''
'''IF''' "[" == '''THEN''' 1 SF '''END'''
'''UNTIL''' 1 FS? '''END END''' »
}
→ pgm mmax pptr code
« 1
'''DO''' "><+-.,[]" pgm pptr DUP SUB POS
'''IF''' DUP '''THEN''' code SWAP GET EVAL '''ELSE''' DROP '''END'''
pptr 1 + 'pptr' STO
'''UNTIL''' DUP NOT OVER mmax > OR pptr pgm SIZE > OR '''END'''
DROP StdOut
{ 'Tape' 'StdOut'} PURGE
» » '<span style="color:blue">BRAIN</span>' STO
"++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." <span style="color:blue">BRAIN</span>
{{out}}
<pre>
1: "Hello world!"
</pre>
Line 7,008 ⟶ 7,497:
Original source [http://seed7.sourceforge.net/algorith/puzzles.htm#brainf7].
=={{header|SETL}}==
<syntaxhighlight lang="setl">program brainfuck;
if command_line(1) = om then
print("error: no program file given");
stop;
end if;
if (f := open(command_line(1), "r")) = om then
print("error: cannot open file");
stop;
end if;
[pgm, loopmap] := read_program(f);
close(f);
mem_left := [];
mem_right := [];
mem_cur := 0;
pc := 1;
loop while pc <= #pgm do
case pgm(pc) of
("+"): mem_cur +:= 1;
mem_cur mod:= 256;
("-"): mem_cur -:= 1;
mem_cur mod:= 256;
(">"): mem_left with:= mem_cur;
mem_cur frome mem_right;
mem_cur ?:= 0;
("<"): mem_right with:= mem_cur;
mem_cur frome mem_left;
mem_cur ?:= 0;
("."): putchar(char mem_cur);
(","): mem_cur := ichar (getchar ? '\x00');
("["): if mem_cur = 0 then pc := loopmap(pc); end if;
("]"): if mem_cur /= 0 then pc := loopmap(pc); end if;
end case;
pc +:= 1;
end loop;
proc read_program(f);
pgm := [];
loop doing ch := getc(f); while ch /= om do
if ch in "+-<>.,[]" then
pgm with:= ch;
end if;
end loop;
stack := [];
loopmap := {};
loop for i in [1..#pgm] do
case pgm(i) of
("["):
stack with:= i;
("]"):
j frome stack;
if j=om then
print("mismatched brackets");
stop;
end if;
loopmap(i) := j;
loopmap(j) := i;
end case;
end loop;
if stack /= [] then
print("mismatched brackets");
stop;
end if;
return [pgm, loopmap];
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ setl brainfuck.setl hello.bf
Hello World!</pre>
=={{header|Sidef}}==
Line 7,413 ⟶ 7,980:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="
class Brainf__k {
| |||