%%% BEGIN pibfi_tape.erl %%%
%%%
%%% pibfi - Platonic Ideal Brainf*ck Interpreter
%%% Copyright (c)2003 Cat's Eye Technologies.  All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions
%%% are met:
%%%
%%%   Redistributions of source code must retain the above copyright
%%%   notice, this list of conditions and the following disclaimer.
%%%
%%%   Redistributions in binary form must reproduce the above copyright
%%%   notice, this list of conditions and the following disclaimer in
%%%   the documentation and/or other materials provided with the
%%%   distribution.
%%%
%%%   Neither the name of Cat's Eye Technologies nor the names of its
%%%   contributors may be used to endorse or promote products derived
%%%   from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
%%% CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
%%% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
%%% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
%%% DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
%%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
%%% OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
%%% PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
%%% OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
%%% ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
%%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
%%% OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
%%% POSSIBILITY OF SUCH DAMAGE. 

%% @doc Tape ADT for the Platonic Ideal Brainf*ck Interpreter.
%%
%% <p>Now a behaviour.</p>
%%
%% @end

-module(pibfi_tape).
-vsn('2003.0505').
-copyright('Copyright (c)2003 Cat`s Eye Technologies. All rights reserved.').

-export([behaviour_info/1]).
-export([start/3, server/2]).
-export([left/1, right/1, increment/1, decrement/1]).
-export([left/2, right/2, increment/2, decrement/2]).
-export([read/1, write/2]).
-export([examine/1]).

behaviour_info(callbacks) ->
  [
    {new, 1},
    % Brainf*ck semantics
    {left, 2},  % (tape(), delta()) -> {tape(), cell()}
    {right, 2}, % (tape(), delta()) -> {tape(), cell()}
    % Efficiency extensions
    {read, 1},  % (tape()) -> cell()
    {write, 2}, % (tape(), cell()) -> {tape(), cell()}
    {peek, 2},  % (tape(), position()) -> cell()
    {poke, 3},  % (tape(), position, cell()) -> tape()
    {head, 1}   % (tape()) -> position()
  ].
  
%% @spec start(module(), Supervisor::pid(), [option()]) -> pid()
%%         option() = {atom(), term()}
%% @doc Starts and returns the pid of a new tape server.
%% For a description of the allowed options, see the documentation for
%% the <code><a href="pibfi.html">pibfi</a></code> module.

start(Module, Supervisor, Options) ->
  pibfi_supervisor:spawn_link(Supervisor, "tape server", noncritical,
    ?MODULE, server, [Module, Options]).

server(Module, Options) ->
  NewTape = Module:new(Options),
  Position = Module:head(NewTape),
  Value = Module:read(NewTape),
  WrapTape = pibfi_options:get_option(Options, wraptape, false),
  MaxTape = pibfi_options:get_option(Options, maxtape, infinity),
  MinTape = pibfi_options:get_option(Options, mintape, 0),
  WrapCell = pibfi_options:get_option(Options, wrapcell, false),
  MaxCell = pibfi_options:get_option(Options, maxcell, infinity),
  MinCell = pibfi_options:get_option(Options, mincell, 0),
  case {WrapTape, MaxTape, MinTape, WrapCell, MaxCell, MinCell} of
    {true, infinity, _, _, _, _} ->
      exit(maxtape_must_be_finite_when_wraptape_is_true);
    {true, _, infinity, _, _, _} ->
      exit(mintape_must_be_finite_when_wraptape_is_true);
    {_, _, _, true, infinity, _} ->
      exit(maxcell_must_be_finite_when_wrapcell_is_true);
    {_, _, _, true, _, infinity} ->
      exit(mincell_must_be_finite_when_wrapcell_is_true);

    {_, A, B, _, _, _} when B =/= infinity, A =/= infinity, B > A ->
      exit(mintape_cannot_exceed_maxtape);
    {_, A, infinity, _, _, _} when A =/= infinity, A < 0 ->
      exit(mintape_maxtape_range_must_include_start_cell_0);
    {_, infinity, B, _, _, _} when B =/= infinity, B > 0 ->
      exit(mintape_maxtape_range_must_include_start_cell_0);
    {_, A, B, _, _, _} when B =/= infinity, A =/= infinity, B > 0, A > 0 ->
      exit(mintape_maxtape_range_must_include_start_cell_0);
    {_, A, B, _, _, _} when B =/= infinity, A =/= infinity, B < 0, A < 0 ->
      exit(mintape_maxtape_range_must_include_start_cell_0);

    {_, _, _, _, A, B} when B =/= infinity, A =/= infinity, B > A ->
      exit(mincell_cannot_exceed_maxcell);

    _ ->
      Value = 0,
      loop(Module, NewTape, Position, Value,
           0, 0, 0, 0,
           MinTape, MaxTape, WrapTape,
           MinCell, MaxCell, WrapCell)
  end.

% only read and examine are synchronous

loop(Module, Tape, Position, Value,
     LowPos, HighPos, LowValue, HighValue,
     MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell) ->
  {LowPos0, HighPos0} = case Position of
    L when L < LowPos -> {L, HighPos};
    H when H > HighPos -> {LowPos, H};
    _ -> {LowPos, HighPos}
  end,
  {LowValue0, HighValue0} = case Value of
    L0 when L0 < LowValue -> {L0, HighValue};
    H0 when H0 > HighValue -> {LowValue, H0};
    _ -> {LowValue, HighValue}
  end,
  receive
    {Pid, increment, N} ->
      % Pid ! {self(), {increment, N}, ok},
      Value0 = case WrapCell of
        true ->
          pibfi:wrap(Value + N, MinCell, MaxCell);
        false ->
          pibfi:assert_in_bounds(tape_cell, MinCell, Value, MaxCell),
          Value + N
      end,    
      {Tape0, Value1} = Module:write(Tape, Value0),
      loop(Module, Tape0, Position, Value1,
           LowPos0, HighPos0, LowValue0, HighValue0,
	   MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell);
    {Pid, decrement, N} ->
      % Pid ! {self(), {decrement, N}, ok},
      Value0 = case WrapCell of
        true ->
          pibfi:wrap(Value - N, MinCell, MaxCell);
        false ->
          pibfi:assert_in_bounds(tape_cell, MinCell, Value, MaxCell),
          Value - N
      end,    
      {Tape0, Value1} = Module:write(Tape, Value0),
      loop(Module, Tape0, Position, Value1,
           LowPos0, HighPos0, LowValue0, HighValue0,
           MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell);
    {Pid, left, N} ->
      % Pid ! {self(), {left, N}, ok},
      NewPosition = case Position - N of
        P when MinTape == infinity ->
          P;
        P when P < MinTape ->
          pibfi:assert(WrapTape, {tape_out_of_bounds, P}),
          pibfi:wrap(P, MinTape, MaxTape);
        P ->
          P
      end,
      {Tape0, Value0} = Module:left(Tape, N),
      % ce_log:write("left, newval ~p", [Value0]),
      loop(Module, Tape0, NewPosition, Value0,
           LowPos0, HighPos0, LowValue0, HighValue0,
           MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell);
    {Pid, right, N} ->
      % Pid ! {self(), {right, N}, ok},
      NewPosition = case Position + N of
        P when MaxTape == infinity ->
          P;
        P when P > MaxTape ->
          pibfi:assert(WrapTape, {tape_out_of_bounds, P}),
          pibfi:wrap(P, MinTape, MaxTape);
        P ->
          P
      end,
      {Tape0, Value0} = Module:right(Tape, N),
      % ce_log:write("right, newval ~p", [Value0]),
      loop(Module, Tape0, NewPosition, Value0,
           LowPos0, HighPos0, LowValue0, HighValue0,
           MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell);
    {Pid, read} ->
      Pid ! {self(), read, Module:read(Tape)},
      loop(Module, Tape, Position, Value,
           LowPos0, HighPos0, LowValue0, HighValue0,
           MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell);
    {Pid, write, Value0} ->
      % ce_log:write("write: ~p", [Value0]),
      Value1 = case WrapCell of
        true ->
          pibfi:wrap(Value0, MinCell, MaxCell);
        false ->
          pibfi:assert_in_bounds(tape_cell, MinCell, Value0, MaxCell),
          Value0
      end,    
      {Tape0, Value2} = Module:write(Tape, Value1),
      % ce_log:write("writing ~p", [Value2]),
      % Pid ! {self(), {write, Value}, Value2},
      loop(Module, Tape0, Position, Value2,
           LowPos0, HighPos0, LowValue0, HighValue0,
           MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell);
    {Pid, examine} ->
      server_examine(Module, Tape, Position, Value,
                     LowPos0, HighPos0, LowValue0, HighValue0,
                     MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell),
      Pid ! {self(), examine, ok},
      loop(Module, Tape, Position, Value,
           LowPos0, HighPos0, LowValue0, HighValue0,
           MinTape, MaxTape, WrapTape, MinCell, MaxCell, WrapCell)
  end.

%% @spec left(pid()) -> ok
%% @doc Moves the read/write head one position left on the tape.

left(TapePid) -> left(TapePid, 1).

%% @spec left(pid(), N::integer()) -> ok
%% @doc Moves the read/write head N positions left on the tape.

left(TapePid, N) ->
  TapePid ! {self(), left, N}. % , waitfor({TapePid, {left, N}, ok}).

%% @spec right(pid()) -> ok
%% @doc Moves the read/write head one position right on the tape.

right(TapePid) -> right(TapePid, 1).

%% @spec right(pid(), N::integer()) -> ok
%% @doc Moves the read/write head N positions right on the tape.

right(TapePid, N) ->
  TapePid ! {self(), right, N}. % , waitfor({TapePid, {right, N}, ok}).

%% @spec read(pid()) -> integer()
%% @doc Returns the value at the current position on the tape.

read(TapePid) ->
  TapePid ! {self(), read},
  receive
    {TapePid, read, X} ->
      X
  end.

waitfor(Thing) ->
  receive
    Thing ->
      ok
    after 1000 ->
      {error, timeout}
  end.

%% @spec write(tape(), integer()) -> {ok, integer()} | {error, Reason}
%% @doc Places the given value at the current position on the tape.

write(TapePid, Value) ->
  TapePid ! {self(), write, Value}.

%% @spec increment(tape()) -> ok | {error, Reason}
%% @doc Increments the value at the current position on the tape.

increment(TapePid) -> increment(TapePid, 1).

%% @spec increment(tape(), N::integer()) -> ok | {error, Reason}
%% @doc Increments the value at the current position on the tape N times.

increment(TapePid, N) ->
  TapePid ! {self(), increment, N}.

%% @spec decrement(tape()) -> ok | {error, Reason}
%% @doc Decrements the value at the current position on the tape.

decrement(TapePid) -> decrement(TapePid, 1).

%% @spec decrement(tape(), N::integer()) -> ok | {error, Reason}
%% @doc Decrements the value at the current position on the tape N times.

decrement(TapePid, N) ->
  TapePid ! {self(), decrement, N}.

%% @spec examine(TapePid::pid()) -> ok | {error, Reason}
%% @doc Examines the state of the tape.

examine(TapePid) ->
  TapePid ! {self(), examine}, waitfor({TapePid, examine, ok}).


server_examine(Module, Tape, Position, Value,
 LowPos, HighPos, LowValue, HighValue,
 MinTape, MaxTape, WrapTape,
 MinCell, MaxCell, WrapCell) ->
  case Position of
    0 ->
     io:fwrite("+ Tape head position: at start");
    1 ->
     io:fwrite("+ Tape head position: 1 cell right of start");
    -1 ->
     io:fwrite("+ Tape head position: 1 cell left of start");
    P when P > 1 ->
     io:fwrite("+ Tape head position: ~p cells right of start",
       [Position]);
    P when P < -1 ->
     io:fwrite("+ Tape head position: ~p cells left of start",
       [-1 * Position])
  end,
  io:fwrite(", cell contents: ~p~n", [Value]),
  io:fwrite("+ Tape observed head position: min ~p, max ~p, range ~p~n",
    [LowPos, HighPos, (HighPos - LowPos) + 1]),
  io:fwrite("+ Tape observed cell contents: min ~p, max ~p, range ~p~n",
    [LowValue, HighValue, (HighValue - LowValue) + 1]),
  Low = case Position - 5 of
    L when MinTape =/= infinity, L < MinTape ->
      MinTape;
    L ->
      L
  end,
  High = case Position + 4 of
    H when MaxTape =/= infinity, H > MaxTape ->
      MaxTape;
    H ->
      H
  end,
  io:fwrite("+ Tape contents (~p - ~p cells right of start):~n", [Low, High]),
  Range = lists:seq(Low, High),
  lists:foreach(fun(X) ->
    A = case X of
      Position ->
        "->#" ++ integer_to_list(X);
      _ ->
        "#" ++ integer_to_list(X)
    end,
    io:fwrite("~8s", [A])
  end, Range),
  io:nl(),
  TapeContext = lists:reverse(lists:foldl(fun(X, A) ->
    [Module:peek(Tape, X) | A]
  end, [], Range)),
  lists:foreach(fun(X) ->
    io:fwrite("~8w", [X])
  end, TapeContext),
  io:nl().

%%% END of pibfi_tape.erl %%%