icscan.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 451 行 · 第 1/2 页

    scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line,
			 (lists:reverse(Accum))} | Out]).

scan_exp(G, BE, [X|Str], Accum, Line, Out) when X==$- ->
    scan_exp2(G, BE, Str, [X|Accum], Line, Out);
scan_exp(G, BE, Str, Accum, Line, Out) ->
    scan_exp2(G, BE, Str, Accum, Line, Out).

scan_exp2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) ->
    scan_exp2(G, BE, Str, [X|Accum], Line, Out);
scan_exp2(G, BE, Str, Accum, Line, Out) ->
    scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line,
			 (lists:reverse(Accum))} | Out]).


scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_upper(X) ->
    scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out);
scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_lower(X) ->
    scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out);
scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_number(X) ->
    scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out);
scan_name(G, BE, [$_|Str], Accum, TypeCheck, Line, Out) ->
    scan_name(G, BE, Str, [$_|Accum], TypeCheck, Line, Out);
scan_name(G, BE, S, Accum, false, Line, Out) ->
    %% The CORBA 2.3 specification allows the user to override typechecking:
    %% typedef string _native;
    %% interface i {
    %%     void foo(in _native VT);
    %% };
    %% BUT, the IFR-id remains the same ("IDL:native:1.0") etc. The reason for
    %% this is that one don't have to re-write a large chunk of IDL- and
    %% application-code.
    scan(G, BE, S, Line, [{'<identifier>', Line, lists:reverse(Accum)} | Out]);
scan_name(G, BE, S, Accum, _, Line, Out) ->
    L = lists:reverse(Accum),
    X = case is_reserved(L, BE) of
	    undefined -> 
		{'<identifier>', Line, L};
	    Yes -> 
		{Yes, Line}
	end,
    scan(G, BE, S, Line, [X | Out]).

%% Shall scan a constant
scan_const(G, BE, string, [$" | Rest], Accum, Line, [{'<string_literal>', _, Str}|Out]) ->
    scan(G, BE, Rest, Line, 
	 [{'<string_literal>', Line, Str ++ lists:reverse(Accum)} | Out]);
scan_const(G, BE, string, [$" | Rest], Accum, Line, Out) ->
    scan(G, BE, Rest, Line, 
	 [{'<string_literal>', Line, lists:reverse(Accum)} | Out]);
scan_const(G, BE, wstring, [$" | Rest], Accum, Line, [{'<wstring_literal>', _,Wstr}|Out]) -> %% WSTRING
    scan(G, BE, Rest, Line, 
	 [{'<wstring_literal>', Line, Wstr ++ lists:reverse(Accum)} | Out]);
scan_const(G, BE, wstring, [$" | Rest], Accum, Line, Out) -> %% WSTRING
    scan(G, BE, Rest, Line, 
	 [{'<wstring_literal>', Line, lists:reverse(Accum)} | Out]);
scan_const(G, _BE, string, [], _Accum, Line, Out) -> %% Bad string
    ic_error:error(G, {bad_string, Line}),
    Out;
scan_const(G, _BE, wstring, [], _Accum, Line, Out) -> %% Bad WSTRING
    ic_error:error(G, {bad_string, Line}),
    Out;
scan_const(G, BE, char, [$' | Rest], Accum, Line, Out) ->
    scan(G, BE, Rest, Line, 
	 [{'<character_literal>', Line, lists:reverse(Accum)} | Out]);
scan_const(G, BE, wchar, [$' | Rest], Accum, Line, Out) -> %% WCHAR
    scan(G, BE, Rest, Line, 
	 [{'<wcharacter_literal>', Line, lists:reverse(Accum)} | Out]);
scan_const(G, BE, Mode, [$\\, C | Rest], Accum, Line, Out) ->
    case escaped_char(C) of
	error ->
	    ic_error:error(G, {bad_escape_character, Line, C}), %% Bad escape character
	    scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out);
	octal ->
	    {Num,Rest2} = scan_octal_number([C|Rest], 0),
	    scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out); 
	hexadecimal ->
	    {Num,Rest2} = scan_hex_number(Rest, 0),
	    if
		Num > 255 -> %% 16#FF
		    ic_error:error(G, {bad_escape_character, Line, C}),
		    scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out);
		true ->
		    scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out)
	    end;
	unicode ->
	    {Num,Rest2} = scan_hex_number(Rest, 0),
	    if
		Num > 65535 -> %% 16#FFFF
		    ic_error:error(G, {bad_escape_character, Line, C}),
		    scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out);
		true ->
		    scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out)
	    end;
	EC ->
	    scan_const(G, BE, Mode, Rest, [EC | Accum], Line, Out)
    end;
scan_const(G, BE, Mode, [C | Rest], Accum, Line, Out) ->
    scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out).


%%
%% Preprocessor output handling
%%
%%	gcc outputs a line with line number, file name (within \") and
%%	one or more integer flags. The scanner scans the line number,
%%	the id and all integers up to nl.
%%
%% NOTE: This will have to be enhanced in order to eat #pragma
%%
scan_preproc(G, BE, Str, Line, Out) ->
    {List, Rest} = scan_to_nl(strip(Str), []),
    NewLine = get_new_line_nr(strip(List), Line+1, []),
    case scan_number(G, BE, List, [], Line, [{'#', Line} | Out]) of
	L when list(L) ->
	    scan(G, BE, Rest, NewLine, [{'#', Line} | L])
    end.

get_new_line_nr([C|R], Line, Acc) when C>=$0, C=<$9 ->
    get_new_line_nr(R, Line, [C|Acc]);
get_new_line_nr(_, Line, []) -> Line;		% No line nr found
get_new_line_nr(_, _, Acc) -> list_to_integer(reverse(Acc)).

scan_to_nl([], Acc) -> {reverse(Acc), []};
scan_to_nl([$\n|Str], Acc) -> {reverse(Acc), Str};
scan_to_nl([$\r|R], Acc) -> scan_to_nl(R, Acc);
scan_to_nl([C|R], Acc) -> scan_to_nl(R, [C|Acc]).

strip([$ |R]) -> strip(R);
strip(L) -> L.

%% Escaped character. Escaped chars are repr as two characters in the
%% input list of letters and this is translated into one char.
escaped_char($n) -> $\n;
escaped_char($t) -> $\t;
escaped_char($v) -> $\v;
escaped_char($b) -> $\b;
escaped_char($r) -> $ ;
escaped_char($f) -> $\f;
escaped_char($a) -> $\a;
escaped_char($\\) -> $\\;
escaped_char($?) -> $?;
escaped_char($') -> $';
escaped_char($") -> $";
escaped_char($x) -> hexadecimal;
escaped_char($u) -> unicode;
escaped_char(X) when ?is_octal(X) -> octal;
%% Error
escaped_char(_Other) -> error.

skip_to_nl([]) -> [];
skip_to_nl([$\n | Str]) ->[$\n | Str];
skip_to_nl([_|Str]) ->
    skip_to_nl(Str).

skip_comment([$\\, _ | Str]) ->
    skip_comment(Str);
skip_comment([$*, $/ | Str]) -> Str;
skip_comment([_|Str]) -> 
    skip_comment(Str).


%%----------------------------------------------------------------------
%% Shall separate keywords from identifiers and numbers

%% Fill in the ets of reserved words
is_reserved("Object", _) ->     'Object';
is_reserved("in", _) ->          in;
is_reserved("interface", _) ->   interface;
is_reserved("case", _) ->       'case';
is_reserved("union", _) ->       union;
is_reserved("struct", _) ->      struct;
is_reserved("any", _) ->         any;
is_reserved("long", _) ->        long;
is_reserved("float", _) ->       float;
is_reserved("out", _) ->         out;
is_reserved("enum", _) ->        enum;
is_reserved("double", _) ->      double;
is_reserved("context", _) ->     context;
is_reserved("oneway", _) ->      oneway;
is_reserved("sequence", _) ->    sequence;
is_reserved("FALSE", _) ->      'FALSE';
is_reserved("readonly", _) ->    readonly;
is_reserved("char", _) ->        char;
is_reserved("wchar", _) ->       wchar;
is_reserved("void", _) ->        void;
is_reserved("inout", _) ->       inout;
is_reserved("attribute", _) ->   attribute;
is_reserved("octet", _) ->       octet;
is_reserved("TRUE", _) ->       'TRUE';
is_reserved("switch", _) ->      switch;
is_reserved("unsigned", _) ->    unsigned;
is_reserved("typedef", _) ->     typedef;
is_reserved("const", _) ->       const;
is_reserved("raises", _) ->      raises;
is_reserved("string", _) ->      string;
is_reserved("wstring", _) ->     wstring;
is_reserved("default", _) ->     default;
is_reserved("short", _) ->       short;
is_reserved("module", _) ->      module;
is_reserved("exception", _) ->   exception;
is_reserved("boolean", _) ->     boolean;
%% --- New keywords Introduced in CORBA-2.3.1 ---
%% For now we cannot add these for all backends right now since it would cause
%% some problems for at least one customer.
is_reserved("fixed", BE) ->       check_be(BE, fixed);
%is_reserved("abstract", BE) ->    check_be(BE, abstract);
%is_reserved("custom", BE) ->      check_be(BE, custom);
%is_reserved("factory", BE) ->     check_be(BE, factory);
%is_reserved("local", BE) ->       check_be(BE, local);
%is_reserved("native", BE) ->      check_be(BE, native);
%is_reserved("private", BE) ->     check_be(BE, private);
%is_reserved("public", BE) ->      check_be(BE, public);
%is_reserved("supports", BE) ->    check_be(BE, supports);
%is_reserved("truncatable", BE) -> check_be(BE, truncatable);
%is_reserved("ValueBase", BE) ->   check_be(BE, 'ValueBase');
%is_reserved("valuetype", BE) ->   check_be(BE, valuetype);
is_reserved(_, _) -> undefined.

check_be(erl_corba, KeyWord) ->
    KeyWord;
check_be(_, _) ->
    undefined.