The R13B03 release.OTP_R13B03

1 files changed, 578 insertions, 0 deletions

diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
new file mode 100644
index 0000000000..1f8076e864
--- /dev/null
+++ b/lib/stdlib/src/io.erl
@@ -0,0 +1,578 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+-module(io).
+
+-export([put_chars/1,put_chars/2,nl/0,nl/1,
+	 get_chars/2,get_chars/3,get_line/1,get_line/2,
+	 get_password/0, get_password/1,
+	 setopts/1, setopts/2, getopts/0, getopts/1]).
+-export([write/1,write/2,read/1,read/2,read/3]).
+-export([columns/0,columns/1,rows/0,rows/1]).
+-export([fwrite/1,fwrite/2,fwrite/3,fread/2,fread/3,
+	 format/1,format/2,format/3]).
+-export([scan_erl_exprs/1,scan_erl_exprs/2,scan_erl_exprs/3,
+	 scan_erl_form/1,scan_erl_form/2,scan_erl_form/3,
+	 parse_erl_exprs/1,parse_erl_exprs/2,parse_erl_exprs/3,
+	 parse_erl_form/1,parse_erl_form/2,parse_erl_form/3]).
+-export([request/1,request/2,requests/1,requests/2]).
+
+
+%%-------------------------------------------------------------------------
+
+-type device() :: atom() | pid().
+-type prompt() :: atom() | string().
+
+%% XXX: Some uses of line() in this file may need to read erl_scan:location()
+-type line()   :: pos_integer().
+
+%%-------------------------------------------------------------------------
+
+%%
+%% User interface.
+%%
+
+%% Writing and reading characters.
+
+to_tuple(T) when is_tuple(T) -> T;
+to_tuple(T) -> {T}.
+
+%% Problem: the variables Other, Name and Args may collide with surrounding
+%% ones.
+%% Give extra args to macro, being the variables to use.
+-define(O_REQUEST(Io, Request),
+    case request(Io, Request) of
+	{error, Reason} ->
+	    [Name | Args] = tuple_to_list(to_tuple(Request)),
+	    erlang:error(conv_reason(Name, Reason), [Name, Io | Args]);
+	Other ->
+	    Other
+    end).
+
+o_request(Io, Request, Func) ->
+    case request(Io, Request) of
+	{error, Reason} ->
+	    [_Name | Args] = tuple_to_list(to_tuple(Request)),
+	    {'EXIT',{undef,[_Current|Mfas]}} = (catch erlang:error(undef)),
+	    MFA = {io, Func, [Io | Args]},
+	    exit({conv_reason(Func, Reason),[MFA|Mfas]});
+%	    erlang:error(conv_reason(Name, Reason), [Name, Io | Args]);
+	Other ->
+	    Other
+    end.
+
+%% Put chars takes mixed *unicode* list from R13 onwards.
+-spec put_chars(iodata()) -> 'ok'.
+
+put_chars(Chars) ->
+    put_chars(default_output(), Chars).
+
+-spec put_chars(device(), iodata()) -> 'ok'.
+
+put_chars(Io, Chars) ->
+    o_request(Io, {put_chars,unicode,Chars}, put_chars).
+
+-spec nl() -> 'ok'.
+
+nl() ->
+    nl(default_output()).
+
+-spec nl(device()) -> 'ok'.
+
+nl(Io) ->
+%    o_request(Io, {put_chars,io_lib:nl()}).
+    o_request(Io, nl, nl).
+
+-spec columns() -> {'ok', pos_integer()} | {'error', 'enotsup'}.
+
+columns() ->
+    columns(default_output()).
+
+-spec columns(device()) -> {'ok', pos_integer()} | {'error', 'enotsup'}.
+
+columns(Io) ->
+    case request(Io, {get_geometry,columns}) of
+	N  when is_integer(N), N > 0 ->
+	    {ok,N};
+	_ ->
+	    {error,enotsup}
+    end.
+	    
+-spec rows() -> {'ok', pos_integer()} | {'error', 'enotsup'}.
+
+rows() ->
+    rows(default_output()).
+
+-spec rows(device()) -> {'ok', pos_integer()} | {'error', 'enotsup'}.
+
+rows(Io) ->
+    case request(Io,{get_geometry,rows}) of
+	N  when is_integer(N), N > 0 ->
+	    {ok,N};
+	_ ->
+	    {error,enotsup}
+    end.    
+
+-spec get_chars(prompt(), non_neg_integer()) -> iodata() | 'eof'.
+
+get_chars(Prompt, N) ->
+    get_chars(default_input(), Prompt, N).
+
+-spec get_chars(device(), prompt(), non_neg_integer()) -> iodata() | 'eof'.
+
+get_chars(Io, Prompt, N) when is_integer(N), N >= 0 ->
+    request(Io, {get_chars,unicode,Prompt,N}).
+
+-spec get_line(prompt()) -> iodata() | 'eof' | {'error', term()}.
+
+get_line(Prompt) ->
+    get_line(default_input(), Prompt).
+
+-spec get_line(device(), prompt()) -> iodata() | 'eof' | {'error', term()}.
+
+get_line(Io, Prompt) ->
+    request(Io, {get_line,unicode,Prompt}).
+
+get_password() ->
+    get_password(default_input()).
+
+get_password(Io) ->
+    request(Io, {get_password,unicode}).
+
+-type encoding()   :: 'latin1' | 'unicode' | 'utf8' | 'utf16' | 'utf32'
+                    | {'utf16', 'big' | 'little'} | {'utf32','big' | 'little'}.
+-type expand_fun() :: fun((term()) -> {'yes'|'no', string(), [string(), ...]}).
+-type opt_pair()   :: {'binary', boolean()}
+                    | {'echo', boolean()}
+                    | {'expand_fun', expand_fun()}
+                    | {'encoding', encoding()}.
+
+-spec getopts() -> [opt_pair()].
+
+getopts() ->
+    getopts(default_input()).
+
+-spec getopts(device()) -> [opt_pair()].
+
+getopts(Io) ->
+    request(Io, getopts).
+
+-type setopt() :: 'binary' | 'list' | opt_pair().
+
+-spec setopts([setopt()]) -> 'ok' | {'error', term()}.
+
+setopts(Opts) ->
+    setopts(default_input(), Opts).
+
+-spec setopts(device(), [setopt()]) -> 'ok' | {'error', term()}.
+
+setopts(Io, Opts) ->
+    request(Io, {setopts, Opts}).
+
+%% Writing and reading Erlang terms.
+
+-spec write(term()) -> 'ok'.
+
+write(Term) ->
+    write(default_output(), Term).
+
+-spec write(device(), term()) -> 'ok'.
+
+write(Io, Term) ->
+    o_request(Io, {write,Term}, write).
+
+
+-spec read(prompt()) -> 
+    {'ok', term()} | 'eof' | {'error', erl_scan:error_info()}.
+
+% Read does not use get_until as erl_scan does not work with unicode
+% XXX:PaN fixme?
+read(Prompt) ->
+    read(default_input(), Prompt).
+
+-spec read(device(), prompt()) ->
+    {'ok', term()} | 'eof' | {'error', erl_scan:error_info()}.
+
+read(Io, Prompt) ->
+    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[1]}) of
+	{ok,Toks,_EndLine} ->
+	    erl_parse:parse_term(Toks);
+%	{error, Reason} when atom(Reason) ->
+%	    erlang:error(conv_reason(read, Reason), [Io, Prompt]);
+	{error,E,_EndLine} ->
+	    {error,E};
+	{eof,_EndLine} ->
+	    eof;
+	Other ->
+	    Other
+    end.
+
+-spec read(device(), prompt(), line()) ->
+    {'ok', term(), line()} | {'eof', line()} |
+    {'error', erl_scan:error_info(), line()}.
+
+read(Io, Prompt, StartLine) when is_integer(StartLine) ->
+    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[StartLine]}) of
+	{ok,Toks,EndLine} ->
+            case erl_parse:parse_term(Toks) of
+                {ok,Term} -> {ok,Term,EndLine};
+                {error,ErrorInfo} -> {error,ErrorInfo,EndLine}
+            end;
+	{error,_E,_EndLine} = Error ->
+	    Error;
+	{eof,_EndLine} = Eof ->
+	    Eof;
+	Other ->
+	    Other
+    end.
+
+%% Formatted writing and reading.
+
+conv_reason(_, arguments) -> badarg;
+conv_reason(_, terminated) -> terminated;
+conv_reason(_, {no_translation,_,_}) -> no_translation;
+conv_reason(_, _Reason) -> badarg.
+
+-type format() :: atom() | string() | binary().
+
+-spec fwrite(format()) -> 'ok'.
+
+fwrite(Format) ->
+    format(Format).
+
+-spec fwrite(format(), [term()]) -> 'ok'.
+
+fwrite(Format, Args) ->
+    format(Format, Args).
+
+-spec fwrite(device(), format(), [term()]) -> 'ok'.
+
+fwrite(Io, Format, Args) ->
+    format(Io, Format, Args).
+
+-spec fread(prompt(), format()) -> {'ok', [term()]} | 'eof' | {'error',term()}.
+
+fread(Prompt, Format) ->
+    fread(default_input(), Prompt, Format).
+
+-spec fread(device(), prompt(), format()) -> 
+    {'ok', [term()]} | 'eof' | {'error',term()}.
+
+fread(Io, Prompt, Format) ->
+    case request(Io, {fread,Prompt,Format}) of
+%	{error, Reason} when atom(Reason) ->
+%	    erlang:error(conv_reason(fread, Reason), [Io, Prompt, Format]);
+	Other ->
+	    Other
+    end.
+
+-spec format(format()) -> 'ok'.
+
+format(Format) ->
+    format(Format, []).
+
+-spec format(format(), [term()]) -> 'ok'.
+
+format(Format, Args) ->
+    format(default_output(), Format, Args).
+
+-spec format(device(), format(), [term()]) -> 'ok'.
+
+format(Io, Format, Args) ->
+    o_request(Io, {format,Format,Args}, format).
+
+%% Scanning Erlang code.
+
+-spec scan_erl_exprs(prompt()) -> erl_scan:tokens_result().
+ 
+scan_erl_exprs(Prompt) ->
+    scan_erl_exprs(default_input(), Prompt, 1).
+
+-spec scan_erl_exprs(device(), prompt()) -> erl_scan:tokens_result().
+
+scan_erl_exprs(Io, Prompt) ->
+    scan_erl_exprs(Io, Prompt, 1).
+
+-spec scan_erl_exprs(device(), prompt(), line()) -> erl_scan:tokens_result().
+
+scan_erl_exprs(Io, Prompt, Pos0) ->
+    request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}).
+
+-spec scan_erl_form(prompt()) -> erl_scan:tokens_result().
+
+scan_erl_form(Prompt) ->
+    scan_erl_form(default_input(), Prompt, 1).
+
+-spec scan_erl_form(device(), prompt()) -> erl_scan:tokens_result().
+
+scan_erl_form(Io, Prompt) ->
+    scan_erl_form(Io, Prompt, 1).
+
+-spec scan_erl_form(device(), prompt(), line()) -> erl_scan:tokens_result().
+
+scan_erl_form(Io, Prompt, Pos0) ->
+    request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}).
+
+%% Parsing Erlang code.
+
+-type erl_parse_expr_list() :: [_]. %% XXX: should be imported from erl_parse
+
+-type parse_ret() :: {'ok', erl_parse_expr_list(), line()}
+                   | {'eof', line()}
+                   | {'error', erl_scan:error_info(), line()}.
+
+-spec parse_erl_exprs(prompt()) -> parse_ret().
+
+parse_erl_exprs(Prompt) ->
+    parse_erl_exprs(default_input(), Prompt, 1).
+
+-spec parse_erl_exprs(device(), prompt()) -> parse_ret().
+
+parse_erl_exprs(Io, Prompt) ->
+    parse_erl_exprs(Io, Prompt, 1).
+
+-spec parse_erl_exprs(device(), prompt(), line()) -> parse_ret().
+
+parse_erl_exprs(Io, Prompt, Pos0) ->
+    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}) of
+	{ok,Toks,EndPos} ->
+	    case erl_parse:parse_exprs(Toks) of
+		{ok,Exprs} -> {ok,Exprs,EndPos};
+		{error,E} -> {error,E,EndPos}
+	    end;
+	Other ->
+	    Other
+    end.
+
+-type erl_parse_absform() :: _. %% XXX: should be imported from erl_parse
+
+-type parse_form_ret() :: {'ok', erl_parse_absform(), line()}
+                        | {'eof', line()}
+                        | {'error', erl_scan:error_info(), line()}.
+
+-spec parse_erl_form(prompt()) -> parse_form_ret().
+
+parse_erl_form(Prompt) ->
+    parse_erl_form(default_input(), Prompt, 1).
+
+-spec parse_erl_form(device(), prompt()) -> parse_form_ret().
+
+parse_erl_form(Io, Prompt) ->
+    parse_erl_form(Io, Prompt, 1).
+
+-spec parse_erl_form(device(), prompt(), line()) -> parse_form_ret().
+
+parse_erl_form(Io, Prompt, Pos0) ->
+    case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}) of
+	{ok,Toks,EndPos} ->
+	    case erl_parse:parse_form(Toks) of
+		{ok,Exprs} -> {ok,Exprs,EndPos};
+		{error,E} -> {error,E,EndPos}
+	    end;
+	Other ->
+	    Other
+    end.
+
+%% Miscellaneous functions.
+
+request(Request) ->
+    request(default_output(), Request).
+
+request(standard_io, Request) ->
+    request(group_leader(), Request);
+request(Pid, Request) when is_pid(Pid) ->
+    execute_request(Pid, io_request(Pid, Request));
+request(Name, Request) when is_atom(Name) ->
+    case whereis(Name) of
+	undefined ->
+	    {error, arguments};
+	Pid ->
+	    request(Pid, Request)
+    end.
+
+execute_request(Pid, {Convert,Converted}) ->
+    Mref = erlang:monitor(process, Pid),
+    Pid ! {io_request,self(),Pid,Converted},
+    if
+	Convert ->
+	    convert_binaries(wait_io_mon_reply(Pid, Mref));
+	true ->
+	    wait_io_mon_reply(Pid, Mref)
+    end.
+
+requests(Requests) ->				%Requests as atomic action
+    requests(default_output(), Requests).
+
+requests(standard_io, Requests) ->              %Requests as atomic action
+    requests(group_leader(), Requests);
+requests(Pid, Requests) when is_pid(Pid) ->
+    {Convert, Converted} = io_requests(Pid, Requests),
+    execute_request(Pid,{Convert,{requests,Converted}});
+requests(Name, Requests) when is_atom(Name) ->
+    case whereis(Name) of
+	undefined ->
+	    {error, arguments};
+	Pid ->
+	    requests(Pid, Requests)
+    end.
+
+
+default_input() ->
+    group_leader().
+
+default_output() ->
+    group_leader().
+
+wait_io_mon_reply(From, Mref) ->
+    receive
+	{io_reply, From, Reply} ->
+	    erlang:demonitor(Mref),
+	    receive 
+		{'DOWN', Mref, _, _, _} -> true
+	    after 0 -> true
+	    end,
+	    Reply;
+	{'EXIT', From, _What} ->
+	    receive
+		{'DOWN', Mref, _, _, _} -> true
+	    after 0 -> true
+	    end,
+	    {error,terminated};
+	{'DOWN', Mref, _, _, _} ->
+	    receive
+		{'EXIT', From, _What} -> true
+	    after 0 -> true
+	    end,
+	    {error,terminated}
+    end.
+
+
+%% io_requests(Requests)
+%%  Transform requests into correct i/o server messages. Only handle the
+%%  one we KNOW must be changed, others, including incorrect ones, are
+%%  passed straight through. Perform a flatten on the request list.
+
+io_requests(Pid, Rs) ->
+    io_requests(Pid, Rs, [], []).
+
+io_requests(Pid, [{requests,Rs1}|Rs], Cont, Tail) ->
+    io_requests(Pid, Rs1, [Rs|Cont], Tail);
+io_requests(Pid, [R], [], _Tail) ->
+    {Conv,Request} = io_request(Pid, R),
+    {Conv,[Request]};
+io_requests(Pid, [R|Rs], Cont, Tail) ->
+    {_,Request} = io_request(Pid, R),
+    {Conv,Requests} = io_requests(Pid, Rs, Cont, Tail),
+    {Conv,[Request|Requests]};
+io_requests(Pid, [], [Rs|Cont], Tail) ->
+    io_requests(Pid, Rs, Cont, Tail);
+io_requests(_Pid, [], [], _Tail) -> 
+    {false,[]}.
+
+
+bc_req(Pid,{Op,Enc,Param},MaybeConvert) ->
+    case net_kernel:dflag_unicode_io(Pid) of
+	true ->
+	    {false,{Op,Enc,Param}};
+	false ->
+	    {MaybeConvert,{Op,Param}}
+    end;
+bc_req(Pid,{Op,Enc,P,F},MaybeConvert) ->
+    case net_kernel:dflag_unicode_io(Pid) of
+	true ->
+	    {false,{Op,Enc,P,F}};
+	false ->
+	    {MaybeConvert,{Op,P,F}}
+    end;
+bc_req(Pid, {Op,Enc,M,F,A},MaybeConvert) ->
+    case net_kernel:dflag_unicode_io(Pid) of
+	true ->
+	    {false,{Op,Enc,M,F,A}};
+	false ->
+	    {MaybeConvert,{Op,M,F,A}}
+    end;
+bc_req(Pid, {Op,Enc,P,M,F,A},MaybeConvert) ->
+    case net_kernel:dflag_unicode_io(Pid) of
+	true ->
+	    {false,{Op,Enc,P,M,F,A}};
+	false ->
+	    {MaybeConvert,{Op,P,M,F,A}}
+    end;
+bc_req(Pid,{Op,Enc},MaybeConvert) ->
+    case net_kernel:dflag_unicode_io(Pid) of
+	true ->
+	    {false,{Op, Enc}};
+	false ->
+	    {MaybeConvert,Op}
+    end.
+
+io_request(Pid, {write,Term}) ->
+    bc_req(Pid,{put_chars,unicode,io_lib,write,[Term]},false);
+io_request(Pid, {format,Format,Args}) ->
+    bc_req(Pid,{put_chars,unicode,io_lib,format,[Format,Args]},false);
+io_request(Pid, {fwrite,Format,Args}) ->
+    bc_req(Pid,{put_chars,unicode,io_lib,fwrite,[Format,Args]},false);
+io_request(Pid, nl) ->
+    bc_req(Pid,{put_chars,unicode,io_lib:nl()},false);
+io_request(Pid, {put_chars,Enc,Chars}=Request0) 
+  when is_list(Chars), node(Pid) =:= node() ->
+    %% Convert to binary data if the I/O server is guaranteed to be new
+    Request =
+	case catch unicode:characters_to_binary(Chars,Enc) of
+	    Binary when is_binary(Binary) ->
+		{put_chars,Enc,Binary};
+	    _ ->
+		Request0
+	end,
+    {false,Request};
+io_request(Pid, {put_chars,Enc,Chars}=Request0) 
+  when is_list(Chars) ->
+    case net_kernel:dflag_unicode_io(Pid) of
+	true ->
+	    case catch unicode:characters_to_binary(Chars,Enc,unicode) of
+		Binary when is_binary(Binary) ->
+		    {false,{put_chars,unicode,Binary}};
+		_ ->
+		    {false,Request0}
+	    end;
+	false ->
+	    %% Convert back to old style put_chars message...
+	    case catch unicode:characters_to_binary(Chars,Enc,latin1) of
+		Binary when is_binary(Binary) ->
+		    {false,{put_chars,Binary}};
+		_ ->
+		    {false,{put_chars,Chars}}
+	    end
+    end;
+io_request(Pid, {fread,Prompt,Format}) ->
+    bc_req(Pid,{get_until,unicode,Prompt,io_lib,fread,[Format]},true);
+io_request(Pid, {get_until,Enc,Prompt,M,F,A}) ->
+    bc_req(Pid,{get_until,Enc,Prompt,M,F,A},true);
+io_request(Pid, {get_chars,Enc,Prompt,N}) ->
+    bc_req(Pid,{get_chars,Enc,Prompt,N},true);
+io_request(Pid, {get_line,Enc,Prompt}) ->
+    bc_req(Pid,{get_line,Enc,Prompt},true);
+io_request(Pid, {get_password,Enc}) ->
+    bc_req(Pid,{get_password, Enc},true);
+io_request(_Pid, R) ->				%Pass this straight through
+    {false,R}.
+
+convert_binaries(Bin) when is_binary(Bin) ->
+    unicode:characters_to_binary(Bin,latin1,unicode);
+convert_binaries(Else) ->
+    Else.