てきとう

てきとう

妄想の実装

妄想を一部変更した。

'{' と '}'
'{'が処理される時点でポインタが指しているセルの値をスレッドIDとして、対応する'}'までを新しいスレッドで処理。

これはpbrainの影響。*1
ただ、標準入出力(=0)や親(=1)や定義済みの子供が行方不明になり得る諸刃の剣。


いつもの通り、ソースがgdgd。
しかし、コメント全然ないな…後で付け足そう。

%%%-------------------------------------------------------------------
%%% File    : cbf.erl
%%% Author  : Zubenalt
%%% Description : concurrent(?) brainf*ck
%%%
%%% Created : 24 Mar 2009 by Zubenalt
%%%-------------------------------------------------------------------
-module(cbf).

-define(iop, bf_stdio).
-define(msg, bf_msg).
-define(timeout, 2000).

-record(env, {src={[],$_,[]},
	      mem={[],0,[]},
	      prc=[{0, ?iop},{1,null}], op=0, ip=0}).

-compile(export_all).

test()->
    T1="+{+:+++[>++++[>++++<-]<-]>>++++++++.}
+{+:+++++[>++++[>++++<-]<-]>>+++++.}
+{+:++++++[>++++[>++++<-]<-]>>----...}
+{+:++++++[>++++[>++++<-]<-]>>-..}
+{+:+++[>+++++++++++<-]>.}
+{+:+++[>++++++++<-]>.}
+{+:++++++[>++++[>++++<-]<-]>>+++++++.}
+{+:++++++[>++++[>++++<-]<-]>>++.}
+{+:+++++[>++++[>++++<-]<-]>>++++.}
+{+:++[>+++++++++++<-]>.}
+{+:+++++++++.}
[-]
+;>,.'H'
<+;>,.'e'
<+;>,.'l'
,.'l'
<+;>,.'o'
<+;>,.','
<+;>,.' '
<+;>,.'w'
<---;>,.'o'
<++++;>,.'r'
<-----;>,.'l'
<++++++;>,.'d'
<+;>,.'!'
<+;>,.'lf'",
    io:format("t1:~p~n",[eval(T1)]),
    ok.

eval(Src) when is_binary(Src) ->
    eval(binary_to_list(Src));
eval(Src) when is_list(Src) ->
    eval(new_env(Src));
eval(Env) when is_record(Env, env) ->
    init(Env).


%% Internal Functions
new_env(Src) ->
    [H|T]=parse(Src),
    #env{src={[],H,T}}.

parse(Src) ->
    parse(root, Src, []).
parse(root,[],Res) ->
    lists:reverse(Res);
parse(V,[91|T], Res) -> %% $[
    {T_,R={while,_}}=parse(while,T,[]),
    parse(V,T_,[R|Res]);
parse(while,[$]|T], Res) ->
    {T,{while, lists:reverse(Res)}};
parse(V,[123|T], Res) -> %% ${
    {T_,R={spawn,_}}=parse(spawn,T,[]),
    parse(V,T_,[R|Res]);
parse(spawn,[$}|T], Res) ->
    {T,{spawn, lists:reverse(Res)}};
parse(V,[H|T], Res) ->
    parse(V,T,[H|Res]).

init(Env) ->
    try loop(Env)
    catch {no_instruction, E}->
	    E
    end.

loop(Env) ->
    loop(rins(ins(Env))).

rins(Env=#env{src={_,_,[]}}) ->
    throw({no_instruction,Env});
rins(Env=#env{src={L,C,[H|T]}}) ->
    Env#env{src={[C|L],H,T}}.
lins(Env=#env{src={[],_,_}}) ->
    throw({no_instruction,Env});
lins(Env=#env{src={[H|T],C,R}}) ->
    Env#env{src={T,H,[C|R]}}.


ins(Env=#env{src={_, $+, _}}) ->
    inc(Env);
ins(Env=#env{src={_, $-, _}}) ->
    dec(Env);
ins(Env=#env{src={_, $,, _}}) ->
    read(Env);
ins(Env=#env{src={_, $., _}}) ->
    write(Env);
ins(Env=#env{src={_, $<, _}}) ->
    lcel(Env);
ins(Env=#env{src={_, $>, _}}) ->
    rcel(Env);
ins(Env=#env{src={_, $;, _},mem={_,M,_}}) ->
    Env#env{ip=M};
ins(Env=#env{src={_, $:, _},mem={_,M,_}}) ->
    Env#env{op=M};
ins(Env=#env{src={_,{while, _},_},mem={_,0,_}}) ->
    Env;
ins(Env=#env{src={_,{while, S},_}}) ->
    E_=init(Env#env{src={[],0,S}}),
    lins(E_#env{src=Env#env.src});
ins(Env=#env{src={_,{spawn, _},_}}) ->
    cbf:spawn(Env);
ins(Env=#env{src={_,$#,_}}) ->
    io:format("~p~n",[Env]), %% dump
    Env;
ins(Env) ->
    Env. %% ignores other cases

inc(Env=#env{mem={L,C,R}}) ->
    Env#env{mem={L,case C+1 of
			256 -> 0;
			N -> N
		    end,R}}.
dec(Env=#env{mem={L,C,R}}) ->
    Env#env{mem={L,case C-1 of
			-1 -> 255;
			N -> N
		    end,R}}.

rcel(Env=#env{mem={L,C,[]}}) ->
    Env#env{mem={[C|L],0,[]}};
rcel(Env=#env{mem={L,C,[H|T]}}) ->
    Env#env{mem={[C|L],H,T}}.

lcel(Env=#env{mem={[],C,R}}) ->
    Env#env{mem={[],0,[C|R]}};
lcel(Env=#env{mem={[H|T],C,R}}) ->
    Env#env{mem={T,H,[C|R]}}.

get_char(null) ->
    0;
get_char(?iop) ->
    [C]=io:get_chars('',1),
    C;
get_char(From) when is_pid(From)->
    receive
	{From, ?msg, C} ->
	    C
    after ?timeout ->
	    0
    end.
    
put_char(null,_) ->
    null;
put_char(?iop,C) ->
    io:put_chars([C]);
put_char(To,C) when is_pid(To) ->
    To!{self(), ?msg, C},
    ok.

read(Env=#env{prc=P,ip=I,mem={L,_,R}}) ->
    Env#env{mem={L,get_char(proplists:get_value(I,P,null)),R}}.
write(Env=#env{prc=P,op=O,mem={_,C,_}}) ->
    put_char(proplists:get_value(O,P,null),C),
    Env.

spawn(Env=#env{src={_,{spawn, S},_}, mem={_,C,_}}) ->
    Self=self(),
    P=erlang:spawn(fun()->
		    init(#env{src={[],$_,S}, prc=[{0,?iop},{1,Self}]})
	    end),
    Env#env{prc=[{C,P}|proplists:delete(C,Env#env.prc)]}.

*1:もあるが、proplistsを使っているのでこちらの方が実装が楽。