brainfxxk in AL

brainfxxk.al.txt

brainfuck_run Script :- next(Script, "", "0", "").

error Msg :- puts("Error: !$Msg!\n"), halt.

inc {(?<I>.*)0$}, Res :- !,            Res = "${I}1".
inc {(?<I>.*)1$}, Res :- !, inc(I, J), Res = "${J}0".
inc X, "1" :- !.

dec A, C :- dec0(A, B), B = {^0*(?<C>.+)}.
dec0 {(?<I>.*)1$}, Res :- !,             Res = "${I}0".
dec0 {(?<I>.*)0$}, Res :- !, dec0(I, J), Res = "${J}1".
dec0 X, Y :- error("underflow").

memget Mem, Key, Val :- Mem = {<$Key:(?<Old>[10]+)>}, !, Old = Val.
memget Mem, Key, "0".

memset Mem, Mem2, Key, Val :-
	Mem  = {(?<L>.*?)<$Key:[10]+>(?<R>.*)}, !,
	Mem2 = "$L<$Key:$Val>$R".

memset Mem, Mem2, Key, Val :- Mem2 = "<$Key:$Val>$Mem".

next Src, Rev, Cur, Mem :-
	Src  = {(?<C>.)(?<Src2>.*)},
	Rev2 = "$C$Rev",
	( C = ">", !, inc(Cur,Cur2), next(Src2,Rev2,Cur2,Mem)
	; C = "<", !, dec(Cur,Cur2), next(Src2,Rev2,Cur2,Mem)
	; C = ",", !, getc(Val), memset(Mem,Mem2,Cur,Val), next(Src2,Rev2,Cur,Mem2)
	; C = ".", !, memget(Mem,Cur,Val), putc(Val), next(Src2,Rev2,Cur,Mem)
	; C = "+", !, memget(Mem,Cur,Val), inc(Val,Val2), memset(Mem,Mem2,Cur,Val2), next(Src2,Rev2,Cur,Mem2)
	; C = "-", !, memget(Mem,Cur,Val), dec(Val,Val2), memset(Mem,Mem2,Cur,Val2), next(Src2,Rev2,Cur,Mem2)
	; C = "[", !,
		(memget(Mem,Cur,"0"), !
			, jump("[","]",Src2,Src3,Rev3,"1")
			, next(Src3,"$Rev3$Rev2",Cur,Mem)
			; next(Src2,Rev2,Cur,Mem))
	; C = "]", !,
		(memget(Mem,Cur,"0"), !
			, next(Src2,Rev2,Cur,Mem)
			; jump("]","[",Rev ,Rev3,Src3,"1")
			, next("$Src3$Src",Rev3,Cur,Mem))).

jump L, R, Src, Src ,  "", "0" :- !.
jump L, R, Src, Src3, Rev, Cur :-
	Src = {^(?<C>.)(?<Src2>.*)},
	( C = L, !, inc(Cur, Cur2)
	; C = R, !, dec(Cur, Cur2); !, Cur = Cur2),
	jump(L, R, Src2, Src3, Rev2, Cur2),
	Rev = "$Rev2$C".

putc O :- char_map(C, O), puts(C).
getc O :-
	gets({^(?<C>.)}),
	char_map(C, O); getc(O).

%
% 32.upto(126) {|i| printf("char_map \"%s\", \"%b\" :- !.\n", i.chr, i); }
%

char_map "\n", "1010" :- !.
char_map " ", "100000" :- !.
char_map "!", "100001" :- !.
char_map "\"", "100010" :- !.
char_map "#", "100011" :- !.
char_map "$", "100100" :- !.
char_map "%", "100101" :- !.
char_map "&", "100110" :- !.
char_map "'", "100111" :- !.
char_map "(", "101000" :- !.
char_map ")", "101001" :- !.
char_map "*", "101010" :- !.
char_map "+", "101011" :- !.
char_map ",", "101100" :- !.
char_map "-", "101101" :- !.
char_map ".", "101110" :- !.
char_map "/", "101111" :- !.
char_map "0", "110000" :- !.
char_map "1", "110001" :- !.
char_map "2", "110010" :- !.
char_map "3", "110011" :- !.
char_map "4", "110100" :- !.
char_map "5", "110101" :- !.
char_map "6", "110110" :- !.
char_map "7", "110111" :- !.
char_map "8", "111000" :- !.
char_map "9", "111001" :- !.
char_map ":", "111010" :- !.
char_map ";", "111011" :- !.
char_map "<", "111100" :- !.
char_map "=", "111101" :- !.
char_map ">", "111110" :- !.
char_map "?", "111111" :- !.
char_map "@", "1000000" :- !.
char_map "A", "1000001" :- !.
char_map "B", "1000010" :- !.
char_map "C", "1000011" :- !.
char_map "D", "1000100" :- !.
char_map "E", "1000101" :- !.
char_map "F", "1000110" :- !.
char_map "G", "1000111" :- !.
char_map "H", "1001000" :- !.
char_map "I", "1001001" :- !.
char_map "J", "1001010" :- !.
char_map "K", "1001011" :- !.
char_map "L", "1001100" :- !.
char_map "M", "1001101" :- !.
char_map "N", "1001110" :- !.
char_map "O", "1001111" :- !.
char_map "P", "1010000" :- !.
char_map "Q", "1010001" :- !.
char_map "R", "1010010" :- !.
char_map "S", "1010011" :- !.
char_map "T", "1010100" :- !.
char_map "U", "1010101" :- !.
char_map "V", "1010110" :- !.
char_map "W", "1010111" :- !.
char_map "X", "1011000" :- !.
char_map "Y", "1011001" :- !.
char_map "Z", "1011010" :- !.
char_map "[", "1011011" :- !.
char_map "\\", "1011100" :- !.
char_map "]", "1011101" :- !.
char_map "^", "1011110" :- !.
char_map "_", "1011111" :- !.
char_map "`", "1100000" :- !.
char_map "a", "1100001" :- !.
char_map "b", "1100010" :- !.
char_map "c", "1100011" :- !.
char_map "d", "1100100" :- !.
char_map "e", "1100101" :- !.
char_map "f", "1100110" :- !.
char_map "g", "1100111" :- !.
char_map "h", "1101000" :- !.
char_map "i", "1101001" :- !.
char_map "j", "1101010" :- !.
char_map "k", "1101011" :- !.
char_map "l", "1101100" :- !.
char_map "m", "1101101" :- !.
char_map "n", "1101110" :- !.
char_map "o", "1101111" :- !.
char_map "p", "1110000" :- !.
char_map "q", "1110001" :- !.
char_map "r", "1110010" :- !.
char_map "s", "1110011" :- !.
char_map "t", "1110100" :- !.
char_map "u", "1110101" :- !.
char_map "v", "1110110" :- !.
char_map "w", "1110111" :- !.
char_map "x", "1111000" :- !.
char_map "y", "1111001" :- !.
char_map "z", "1111010" :- !.
char_map "{", "1111011" :- !.
char_map "|", "1111100" :- !.
char_map "}", "1111101" :- !.
char_map "~", "1111110" :- !.
char_map X, Y :- error("unmapped_char($X -> $Y)").