98 lines
3.6 KiB
Prolog
98 lines
3.6 KiB
Prolog
/******************************************
|
|
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]).
|