妄想を一部変更した。
- '{' と '}'
- '{'が処理される時点でポインタが指しているセルの値をスレッド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を使っているのでこちらの方が実装が楽。