June 2018 Update

Task/Execute-Brain----/Julia/execute-brain----.julia

@@ -0,0 +1,38 @@
+using DataStructures
+
+function execute(src)
+    pointers = Dict{Int,Int}()
+    stack    = Int[]
+    for (ptr, opcode) in enumerate(src)
+        if opcode == '[' push!(stack, ptr) end
+        if opcode == ']'
+            if isempty(stack)
+                src = src[1:ptr]
+                break
+            end
+            sptr = pop!(stack)
+            pointers[ptr], pointers[sptr] = sptr, ptr
+        end
+    end
+    if ! isempty(stack) error("unclosed loops at $stack") end
+    tape = DefaultDict{Int,Int}(0)
+    cell, ptr = 0, 1
+    while ptr ≤ length(src)
+        opcode = src[ptr]
+        if     opcode == '>' cell += 1
+        elseif opcode == '<' cell -= 1
+        elseif opcode == '+' tape[cell] += 1
+        elseif opcode == '-' tape[cell] -= 1
+        elseif opcode == ',' tape[cell] = Int(read(STDIN, 1))
+        elseif opcode == '.' print(STDOUT, Char(tape[cell]))
+        elseif (opcode == '[' && tape[cell] == 0) ||
+               (opcode == ']' && tape[cell] != 0) ptr = pointers[ptr]
+        end
+        ptr += 1
+    end
+end
+
+const src = """\
+    >++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>
+    >+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++."""
+execute(src)

Task/Execute-Brain----/Prolog/execute-brain----.pro

@@ -0,0 +1,97 @@
+/******************************************
+ Starting point, call with program in atom.
+*******************************************/
+brain(Program) :-
+	atom_chars(Program, Instructions),
+	process_bf_chars(Instructions).
+
+brain_from_file(File) :- % or from file...
+	read_file_to_codes(File, Codes, []),
+	maplist(char_code, Instructions, Codes),
+	process_bf_chars(Instructions).
+
+process_bf_chars(Instructions)	:-
+	phrase(bf_to_pl(Code), Instructions, []),
+	Code = [C|_],
+	instruction(C, Code, mem([], [0])), !.
+
+
+/********************************************
+ DCG to parse the bf program into prolog form
+*********************************************/
+bf_to_pl([]) --> [].
+bf_to_pl([loop(Ins)|Next]) --> loop_start, bf_to_pl(Ins), loop_end, bf_to_pl(Next).
+bf_to_pl([Ins|Next]) --> bf_code(Ins), bf_to_pl(Next).
+bf_to_pl(Ins) --> [X], { \+ member(X, ['[',']',>,<,+,-,'.',',']) }, bf_to_pl(Ins). % skip non bf characters
+
+loop_start --> ['['].
+loop_end --> [']'].
+
+bf_code(next_addr) --> ['>'].
+bf_code(prev_addr) --> ['<'].
+bf_code(inc_caddr) --> ['+'].
+bf_code(dec_caddr) --> ['-'].
+bf_code(out_caddr) --> ['.'].
+bf_code(in_caddr)  --> [','].
+
+/**********************
+  Instruction Processor
+***********************/
+instruction([], _, _).
+instruction(I, Code, Mem) :-
+	mem_instruction(I, Mem, UpdatedMem),
+	next_instruction(Code, NextI, NextCode),
+	!, % cuts are to force tail recursion, so big programs will run
+	instruction(NextI, NextCode, UpdatedMem).
+
+% to loop, add the loop code to the start of the program then execute
+% when the loop has finished it will reach itself again then can retest for zero
+instruction(loop(LoopCode), Code, Mem) :-
+	caddr(Mem, X),
+	dif(X, 0),
+	append(LoopCode, Code, [NextI|NextLoopCode]),
+	!,
+	instruction(NextI, [NextI|NextLoopCode], Mem).
+instruction(loop(_), Code, Mem) :-
+	caddr(Mem, 0),
+	next_instruction(Code, NextI, NextCode),
+	!,
+	instruction(NextI, NextCode, Mem).
+
+% memory is stored in two parts:
+%   1. a list with the current address and everything after it
+%   2. a list with the previous memory in reverse order
+mem_instruction(next_addr, mem(Mb, [Caddr]), mem([Caddr|Mb], [0])).
+mem_instruction(next_addr, mem(Mb, [Caddr,NextAddr|Rest]), mem([Caddr|Mb], [NextAddr|Rest])).
+mem_instruction(prev_addr, mem([PrevAddr|RestOfPrev], Caddrs), mem(RestOfPrev, [PrevAddr|Caddrs])).
+
+% wrap instructions at the byte boundaries as this is what most programmers expect to happen
+mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, 255), update_caddr(MemIn, 0, MemOut).
+mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(Val, IncVal), update_caddr(MemIn, IncVal, MemOut).
+mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, 0), update_caddr(MemIn, 255, MemOut).
+mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(DecVal, Val), update_caddr(MemIn, DecVal, MemOut).
+
+% input and output
+mem_instruction(out_caddr, Mem, Mem) :- caddr(Mem, Val), char_code(Char, Val), write(Char).
+mem_instruction(in_caddr, MemIn, MemOut) :-
+	get_single_char(Code),
+	char_code(Char, Code),
+	write(Char),
+	map_input_code(Code,MappedCode),
+	update_caddr(MemIn, MappedCode, MemOut).
+
+% need to map the newline if it is not a proper newline character (system dependent).
+map_input_code(13,10) :- nl.
+map_input_code(C,C).
+
+% The value at the current address
+caddr(mem(_, [Caddr]), Caddr).
+caddr(mem(_, [Caddr,_|_]), Caddr).
+
+% The updated value at the current address
+update_caddr(mem(BackMem, [_]), Caddr, mem(BackMem, [Caddr])).
+update_caddr(mem(BackMem, [_,M|Mem]), Caddr, mem(BackMem, [Caddr,M|Mem])).
+
+% The next instruction, and remaining code
+next_instruction([_], [], []).
+next_instruction([_,NextI|Rest], NextI, [NextI|Rest]).

Task/Execute-Brain----/ZX-Spectrum-Basic/execute-brain----.zx

@@ -0,0 +1,34 @@
+10 GO SUB 1000
+20 LET e=LEN p$
+30 LET a$=p$(ip)
+40 IF a$=">" THEN LET dp=dp+1
+50 IF a$="<" THEN LET dp=dp-1
+60 IF a$="+" THEN LET d(dp)=d(dp)+1
+70 IF a$="-" THEN LET d(dp)=d(dp)-1
+80 IF a$="." THEN PRINT CHR$ d(dp);
+90 IF a$="," THEN INPUT d(dp)
+100 IF a$="[" THEN GO SUB 500
+110 IF a$="]" THEN LET bp=bp-1: IF d(dp)<>0 THEN LET ip=b(bp)-1
+120 LET ip=ip+1
+130 IF ip>e THEN PRINT "eof": STOP
+140 GO TO 30
+
+499 REM match close
+500 LET bc=1: REM bracket counter
+510 FOR x=ip+1 TO e
+520 IF p$(x)="[" THEN LET bc=bc+1
+530 IF p$(x)="]" THEN LET bc=bc-1
+540 IF bc=0 THEN LET b(bp)=ip: LET be=x: LET x=e: REM bc will be 0 once all the subnests have been counted over
+550 IF bc=0 AND d(dp)=0 THEN LET ip=be: LET bp=bp-1
+560 NEXT x
+570 LET bp=bp+1
+580 RETURN
+
+999 REM initialisation
+1000 DIM d(100): REM data stack
+1010 LET dp=1: REM data pointer
+1020 LET ip=1: REM instruction pointer
+1030 DIM b(30): REM bracket stack
+1040 LET bp=1: REM bracket pointer
+1050 LET p$="++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>+++++.": REM program, marginally modified from Wikipedia; outputs CHR$ 13 at the end instead of CHR$ 10 as ZX Spectrum Basic handles the carriage return better than the line feed
+1060 RETURN