Параллелим Brainfuck

    Не будем терять темпа. Поскольку неделя еще не закончилась, еще есть время для очередного топика про Brainfuck. Идея меня захватила, но реализаций интерпретаторов было уже такое количество, что захотелось какой-то изюминки. Поэтому в качестве цели эксперимента я выбрал Brainfork — многопоточную версию Brainfuck-а. А в качестве средства — Erlang, который прекрасно подходит для реализации параллельных процессов. Тем, кому эта тема до сих пор не осточертела, предлагаю заглянуть под кат.

    Принципы языка Brainfork абсолютно аналогичны принципам Brainfuck-а за одним исключением: добавляется дополнительная инструкция Y, которая форкает процесс, обнуляя текущую ячейку в родительском, и инкрементируя следующую ячейку в дочернем процессе. При этом указатель ячейки в дочернем так же сдвигается на единицу вправо.

    Для начала можно взглянуть на код, а комментарии я дам ниже

    
    -module(bf).
    -export([start/1, code_server_loop/1, execute_loop/2]).
    
    start(ProgramString) ->
    	Program = array:from_list(ProgramString),
    	register(code, spawn(?MODULE, code_server_loop, [Program])),
    	spawn(?MODULE, execute_loop, [{[], 0, []}, 0]).
    	
    code_server_loop(Program) ->
    	receive
    		{get_token, Pid, Pos} -> 
    			reply(Pid, token, array:get(Pos, Program)), 
    			code_server_loop(Program);
    		{get_left_brace, Pid, Pos} ->
    			reply(Pid, left_brace, find_left_brace(Pos, Program)), 
    			code_server_loop(Program);
    		{get_right_brace, Pid, Pos} ->
    			reply(Pid, right_brace, find_right_brace(Pos, Program)), 
    			code_server_loop(Program);			
    		stop -> ok
    	after 5000 ->
    		self() ! stop,
    		code_server_loop(Program)
    	end.
    	
    reply(Pid, ReplyType, Value) ->
    	case Value of
    		undefined -> Pid ! end_of_program;
    		Value -> Pid ! {ReplyType, Value}
    	end.
    
    find_left_brace(Pos, Program) -> find_left_brace(Pos - 1, Program, 0).
    find_left_brace(Pos, Program, Count) ->
    	case array:get(Pos, Program) of
    		$[ -> 
    			if
    				Count == 0 -> Pos;
    				true -> find_left_brace(Pos-1, Program, Count-1)
    			end;
    		$] -> find_left_brace(Pos-1, Program, Count+1);
    		undefined -> undefined;
    		_ -> find_left_brace(Pos-1, Program, Count)
    	end.
    	
    find_right_brace(Pos, Program) -> find_right_brace(Pos + 1, Program, 0).
    find_right_brace(Pos, Program, Count) ->
    	case array:get(Pos, Program) of
    		$] -> 
    			if
    				Count == 0 -> Pos;
    				true -> find_right_brace(Pos+1, Program, Count-1)
    			end;
    		$[ -> find_right_brace(Pos+1, Program, Count+1);
    		undefined -> undefined;
    		_ -> find_right_brace(Pos+1, Program, Count)
    	end.
    	
    get_code_server(MessageType, Position) ->
    	code ! {MessageType, self(), Position},
    	receive		
    		end_of_program -> exit(normal);
    		{_ReplyType, Reply} -> Reply
    	end.
    	
    get_token(Position) -> get_code_server(get_token, Position).
    get_left_brace(Position) -> get_code_server(get_left_brace, Position).
    get_right_brace(Position) -> get_code_server(get_right_brace, Position).
    	
    execute_loop(Tape, CodePosition) ->
    	Token = get_token(CodePosition),
    	case execute_token(Token, Tape, CodePosition) of
    		{skip, SkipPosition, NewTape} -> execute_loop(NewTape, SkipPosition);
    		NewTape -> execute_loop(NewTape, CodePosition + 1)
    	end.
    	
    execute_token($., {_, C, _} = Tape, _) -> io:format("~c", [C]), Tape;
    execute_token($,, {L, _, R}, _) -> [C] = io:get_chars("> ", 1), {L, C, R};
    execute_token($+, {L, C, R}, _) -> {L, C+1, R};
    execute_token($-, {L, C, R}, _) -> {L, C-1, R};
    execute_token($>, {L, C, []}, _) -> {[C|L], 0, []};
    execute_token($>, {L, C, [RH|RT]}, _) -> {[C|L], RH, RT};
    execute_token($<, {[], C, R}, _) -> {[], 0, [C|R]};
    execute_token($<, {[LH|LT], C, R}, _) -> {LT, LH, [C|R]};
    execute_token($[, {_, C, _} = Tape, Position) ->
    	case C of
    		0 -> {skip, get_right_brace(Position) + 1, Tape};
    		_ -> Tape
    	end;
    execute_token($], Tape, Position) -> {skip, get_left_brace(Position), Tape};
    
    execute_token($Y, {L, _, R} = Tape, Position) -> fork(Tape, Position + 1), {L, 0, R}.
    
    fork({L, C, []}, Position) -> fork({L, C, [0]}, Position);
    fork({L, C, [RH|RT]}, Position) ->
    	spawn(?MODULE, execute_loop, [{[C|L], RH+1, RT}, Position]).	
    


    Код исполняется по-символьно. Было бы здорово (и не так трудно) построить AST, как в реализации bf на Mercury. Но это вызвало бы существенное усложнение кода для форка. А поскольку за скоростью интерпретации гонки нет, то реализация дешева и сердита.

    Для упрощения в первую очередь инициализации дочернего процесса код между всеми процессами делится. Занимается этим сервер кода, процесс которого регистрируется второй строкой в функции start под именем code. В данном случае, процессы интерпретатора являются для него клиентами. Сервер может принимать запросы на получение инструкции в определенной позиции, а так же вспомогательные функции для нахождения позиции левой и правой соответствующей скобки. Этот сервер автоматически завершает работу через 5 секунд простоя (очевидно, что все потоки интерпретатора или завершились так или иначе, или не завершаться никогда).

    Сама интерпретация кода довольно тривиальна: спрашиваем у сервера инструкцию, исполняем ее и спрашиваем следующую. И так, пока сервер не ответит нам, что кода больше нет (end_of_program). Тогда мы просто завершаем процесс. Способ хранения ленты ячеек я позаимствовал у хабраюзера xonix (спасибо-спасибо!): это кортеж, содержащий список ячеек до текущей, текущую ячейку, и список ячеек после текущей. Он оказался достаточно удобен не только потенциальной бесконечностью ленты, но и простотой работы с ним имеющимися языковыми средствами.

    Самое главное, то, ради чего все это и писалось, содержится в всего в четырех строках: последнем клозе в определении execute_token и в fork. Собственно, порождение дочернего процесса. И там все довольно просто: спавним новый процесс, слегка изменив его ленту ячеек.

    В качестве эксперимента можно попробовать запустить такой код (это дополненный хэлоуворлд):
    Y[-<]++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.
    А лучше, запустить его несколько раз и удостоверится, что результат каждый раз разный: все из-за того, что между потоками не происходит никакой синхронизации.

    Код, конечно, не является эталонным. И написан больше в тренировочных целях. Так что не думаю, что кому-то это пригодится. Но и блог выбран подходящий.
    Поделиться публикацией
    Похожие публикации
    Ой, у вас баннер убежал!

    Ну. И что?
    Реклама
    Комментарии 7
    • +8
      Хорошая статья, спасибо!

      Пора бы на хабре блог «Brainfuck» создавать уже…
      • 0
        К сожалению, пока нельзя создавать новые блоги:
        «О, ужас! Количество блогов достигло критической массы и Хабр вот-вот сколлапсирует! Чтобы не было беды, мы временно отключили возможность добавления новых блогов. Прости нас, %username%!»
      • +7
        ++++[>++>++++<<-]
        >>-[>++[>+++++>++++>++++++>+++++++>++++++>++++>+<<<<<<<-]<-]
        >++++[>+>++>>>++>++++<<<<<<-]
        >>>>--.<<<++.>>>+.>>++++.<<.<<+.>>-.<+.     >>>>++.
        <<<.<++.>.>+.<.<-------.>.<+++++.>+.<<+.    >>>>>.
        <<<.<<.>>-.>+.<.>---.<.>-. >>.<<<.<---.     >>>>.
        <<<.>--.<.>-.<.<.>+.<<--.>>-.<--.
        >+.>>---.<<-.>--.<.>++++++++.<.>-----.<+.
        >>++++++.<<.<<+++++.
        <<<<[>+>++++++<<-]>>--...<++.<.<  
        • +3
          Да, хочется иногда отвлечь мозг чем-нибудь непохожим на его обычную деятельность.
        • 0
          Что-то этот интерпретатор время от времени выдает ошибку если несколько раз запустить из erl консоли.
          bf:start("Y[-<]++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.").
          ** exception error: bad argument
               in function  register/2
                  called as register(code,<0.58.0>)
               in call from bf:start/1
          

          А так да, работает))
          • +1
            А, понял! Это если не подождать 5 секунд до смерти code сервера…
            • +3
              Да. Время задержки выбрано пальцем в небо. Можно смело уменьшить до секунды.

          Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

          Самое читаемое