From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/asn1/src/asn1ct_tok.erl | 391 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 391 insertions(+) create mode 100644 lib/asn1/src/asn1ct_tok.erl (limited to 'lib/asn1/src/asn1ct_tok.erl') diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl new file mode 100644 index 0000000000..27116c46c5 --- /dev/null +++ b/lib/asn1/src/asn1ct_tok.erl @@ -0,0 +1,391 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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(asn1ct_tok). + +%% Tokenize ASN.1 code (input to parser generated with yecc) + +-export([get_name/2,tokenise/2, file/1]). + + +file(File) -> + case file:open(File, [read]) of + {error, Reason} -> + {error,{File,file:format_error(Reason)}}; + {ok,Stream} -> + process0(Stream) + end. + +process0(Stream) -> + process(Stream,0,[]). + +process(Stream,Lno,R) -> + process(io:get_line(Stream, ''), Stream,Lno+1,R). + +process(eof, Stream,Lno,R) -> + file:close(Stream), + lists:flatten(lists:reverse([{'$end',Lno}|R])); + + +process(L, Stream,Lno,R) when is_list(L) -> + %%io:format('read:~s',[L]), + case catch tokenise(L,Lno) of + {'ERR',Reason} -> + io:format("Tokeniser error on line: ~w ~w~n",[Lno,Reason]), + exit(0); + {multiline_comment,NestingLevel} -> + {RestL,Lno2} = process_skip_multiline_comment(Stream,Lno,NestingLevel), + process(RestL,Stream,Lno2,R); + T -> + %%io:format('toks:~w~n',[T]), + process(Stream,Lno,[T|R]) + end. + +process_skip_multiline_comment(Stream,Lno,NestingLevel) -> + process_skip_multiline_comment(io:get_line(Stream, ''), + Stream, Lno + 1, NestingLevel). +process_skip_multiline_comment(eof,_Stream,Lno,_NestingLevel) -> + io:format("Tokeniser error on line: ~w, premature end of multiline comment~n",[Lno]), + exit(0); +process_skip_multiline_comment(Line,Stream,Lno,NestingLevel) -> + case catch skip_multiline_comment(Line,NestingLevel) of + {multiline_comment,NestingLevel2} -> + process_skip_multiline_comment(Stream,Lno,NestingLevel2); + T -> + {T,Lno} + end. + +tokenise([H|T],Lno) when $a =< H , H =< $z -> + {X, T1} = get_name(T, [H]), + [{identifier,Lno, list_to_atom(X)}|tokenise(T1,Lno)]; + +tokenise([$&,H|T],Lno) when $A =< H , H =< $Z -> + {Y, T1} = get_name(T, [H]), + X = list_to_atom(Y), + [{typefieldreference, Lno, X} | tokenise(T1, Lno)]; + +tokenise([$&,H|T],Lno) when $a =< H , H =< $z -> + {Y, T1} = get_name(T, [H]), + X = list_to_atom(Y), + [{valuefieldreference, Lno, X} | tokenise(T1, Lno)]; + +tokenise([H|T],Lno) when $A =< H , H =< $Z -> + {Y, T1} = get_name(T, [H]), + X = list_to_atom(Y), + case reserved_word(X) of + true -> + [{X,Lno}|tokenise(T1,Lno)]; + false -> + [{typereference,Lno,X}|tokenise(T1,Lno)]; + rstrtype -> + [{restrictedcharacterstringtype,Lno,X}|tokenise(T1,Lno)] + end; + +tokenise([$-,H|T],Lno) when $0 =< H , H =< $9 -> + {X, T1} = get_number(T, [H]), + [{number,Lno,-1 * list_to_integer(X)}|tokenise(T1,Lno)]; + +tokenise([H|T],Lno) when $0 =< H , H =< $9 -> + {X, T1} = get_number(T, [H]), + [{number,Lno,list_to_integer(X)}|tokenise(T1,Lno)]; + +tokenise([$-,$-|T],Lno) -> + tokenise(skip_comment(T),Lno); + +tokenise([$/,$*|T],Lno) -> + tokenise(skip_multiline_comment(T,0),Lno); + +tokenise([$:,$:,$=|T],Lno) -> + [{'::=',Lno}|tokenise(T,Lno)]; + +tokenise([$'|T],Lno) -> + case catch collect_quoted(T,Lno,[]) of + {'ERR',_} -> + throw({'ERR','bad_quote'}); + {Thing, T1} -> + [Thing|tokenise(T1,Lno)] + end; + +tokenise([$"|T],Lno) -> + collect_string(T,Lno); + +tokenise([${|T],Lno) -> + [{'{',Lno}|tokenise(T,Lno)]; + +tokenise([$}|T],Lno) -> + [{'}',Lno}|tokenise(T,Lno)]; + +tokenise([$]|T],Lno) -> + [{']',Lno}|tokenise(T,Lno)]; + +tokenise([$[|T],Lno) -> + [{'[',Lno}|tokenise(T,Lno)]; + +tokenise([$,|T],Lno) -> + [{',',Lno}|tokenise(T,Lno)]; + +tokenise([$(|T],Lno) -> + [{'(',Lno}|tokenise(T,Lno)]; +tokenise([$)|T],Lno) -> + [{')',Lno}|tokenise(T,Lno)]; + +tokenise([$.,$.,$.|T],Lno) -> + [{'...',Lno}|tokenise(T,Lno)]; + +tokenise([$.,$.|T],Lno) -> + [{'..',Lno}|tokenise(T,Lno)]; + +tokenise([$.|T],Lno) -> + [{'.',Lno}|tokenise(T,Lno)]; +tokenise([$^|T],Lno) -> + [{'^',Lno}|tokenise(T,Lno)]; +tokenise([$!|T],Lno) -> + [{'!',Lno}|tokenise(T,Lno)]; +tokenise([$||T],Lno) -> + [{'|',Lno}|tokenise(T,Lno)]; + + +tokenise([H|T],Lno) -> + case white_space(H) of + true -> + tokenise(T,Lno); + false -> + [{list_to_atom([H]),Lno}|tokenise(T,Lno)] + end; +tokenise([],_) -> + []. + + +collect_string(L,Lno) -> + collect_string(L,Lno,[]). + +collect_string([],_,_) -> + throw({'ERR','bad_quote found eof'}); + +collect_string([H|T],Lno,Str) -> + case H of + $" -> + [{cstring,1,lists:reverse(Str)}|tokenise(T,Lno)]; + Ch -> + collect_string(T,Lno,[Ch|Str]) + end. + + + +% is letters digits hyphens +% hypen is not the last character. Hypen hyphen is NOT allowed +% +% ::= + +get_name([$-,Char|T], L) -> + case isalnum(Char) of + true -> + get_name(T,[Char,$-|L]); + false -> + {lists:reverse(L),[$-,Char|T]} + end; +get_name([$-|T], L) -> + {lists:reverse(L),[$-|T]}; +get_name([Char|T], L) -> + case isalnum(Char) of + true -> + get_name(T,[Char|L]); + false -> + {lists:reverse(L),[Char|T]} + end; +get_name([], L) -> + {lists:reverse(L), []}. + + +isalnum(H) when $A =< H , H =< $Z -> + true; +isalnum(H) when $a =< H , H =< $z -> + true; +isalnum(H) when $0 =< H , H =< $9 -> + true; +isalnum(_) -> + false. + +isdigit(H) when $0 =< H , H =< $9 -> + true; +isdigit(_) -> + false. + +white_space(9) -> true; +white_space(10) -> true; +white_space(13) -> true; +white_space(32) -> true; +white_space(_) -> false. + + +get_number([H|T], L) -> + case isdigit(H) of + true -> + get_number(T, [H|L]); + false -> + {lists:reverse(L), [H|T]} + end; +get_number([], L) -> + {lists:reverse(L), []}. + +skip_comment([]) -> + []; +skip_comment([$-,$-|T]) -> + T; +skip_comment([_|T]) -> + skip_comment(T). + + +skip_multiline_comment([],L) -> + throw({multiline_comment,L}); +skip_multiline_comment([$*,$/|T],0) -> + T; +skip_multiline_comment([$*,$/|T],Level) -> + skip_multiline_comment(T,Level - 1); +skip_multiline_comment([$/,$*|T],Level) -> + skip_multiline_comment(T,Level + 1); +skip_multiline_comment([_|T],Level) -> + skip_multiline_comment(T,Level). + + +collect_quoted([$',$B|T],Lno, L) -> + case check_bin(L) of + true -> + {{bstring,Lno, lists:reverse(L)}, T}; + false -> + throw({'ERR',{invalid_binary_number, lists:reverse(L)}}) + end; +collect_quoted([$',$H|T],Lno, L) -> + case check_hex(L) of + true -> + {{hstring,Lno, lists:reverse(L)}, T}; + false -> + throw({'ERR',{invalid_binary_number, lists:reverse(L)}}) + end; +collect_quoted([H|T], Lno, L) -> + collect_quoted(T, Lno,[H|L]); +collect_quoted([], _, _) -> % This should be allowed FIX later + throw({'ERR',{eol_in_token}}). + +check_bin([$0|T]) -> + check_bin(T); +check_bin([$1|T]) -> + check_bin(T); +check_bin([]) -> + true; +check_bin(_) -> + false. + +check_hex([H|T]) when $0 =< H , H =< $9 -> + check_hex(T); +check_hex([H|T]) when $A =< H , H =< $F -> + check_hex(T); +check_hex([]) -> + true; +check_hex(_) -> + false. + + +%% reserved_word(A) -> true|false|rstrtype +%% A = atom() +%% returns true if A is a reserved ASN.1 word +%% returns false if A is not a reserved word +%% returns rstrtype if A is a reserved word in the group +%% RestrictedCharacterStringType +reserved_word('ABSENT') -> true; +%reserved_word('ABSTRACT-SYNTAX') -> true; % impl as predef item +reserved_word('ALL') -> true; +reserved_word('ANY') -> true; +reserved_word('APPLICATION') -> true; +reserved_word('AUTOMATIC') -> true; +reserved_word('BEGIN') -> true; +reserved_word('BIT') -> true; +reserved_word('BMPString') -> rstrtype; +reserved_word('BOOLEAN') -> true; +reserved_word('BY') -> true; +reserved_word('CHARACTER') -> true; +reserved_word('CHOICE') -> true; +reserved_word('CLASS') -> true; +reserved_word('COMPONENT') -> true; +reserved_word('COMPONENTS') -> true; +reserved_word('CONSTRAINED') -> true; +reserved_word('CONTAINING') -> true; +reserved_word('DEFAULT') -> true; +reserved_word('DEFINED') -> true; +reserved_word('DEFINITIONS') -> true; +reserved_word('EMBEDDED') -> true; +reserved_word('ENCODED') -> true; +reserved_word('END') -> true; +reserved_word('ENUMERATED') -> true; +reserved_word('EXCEPT') -> true; +reserved_word('EXPLICIT') -> true; +reserved_word('EXPORTS') -> true; +reserved_word('EXTERNAL') -> true; +reserved_word('FALSE') -> true; +reserved_word('FROM') -> true; +reserved_word('GeneralizedTime') -> true; +reserved_word('GeneralString') -> rstrtype; +reserved_word('GraphicString') -> rstrtype; +reserved_word('IA5String') -> rstrtype; +% reserved_word('TYPE-IDENTIFIER') -> true; % impl as predef item +reserved_word('IDENTIFIER') -> true; +reserved_word('IMPLICIT') -> true; +reserved_word('IMPORTS') -> true; +reserved_word('INCLUDES') -> true; +reserved_word('INSTANCE') -> true; +reserved_word('INTEGER') -> true; +reserved_word('INTERSECTION') -> true; +reserved_word('ISO646String') -> rstrtype; +reserved_word('MAX') -> true; +reserved_word('MIN') -> true; +reserved_word('MINUS-INFINITY') -> true; +reserved_word('NULL') -> true; +reserved_word('NumericString') -> rstrtype; +reserved_word('OBJECT') -> true; +reserved_word('ObjectDescriptor') -> true; +reserved_word('OCTET') -> true; +reserved_word('OF') -> true; +reserved_word('OPTIONAL') -> true; +reserved_word('PATTERN') -> true; +reserved_word('PDV') -> true; +reserved_word('PLUS-INFINITY') -> true; +reserved_word('PRESENT') -> true; +reserved_word('PrintableString') -> rstrtype; +reserved_word('PRIVATE') -> true; +reserved_word('REAL') -> true; +reserved_word('RELATIVE-OID') -> true; +reserved_word('SEQUENCE') -> true; +reserved_word('SET') -> true; +reserved_word('SIZE') -> true; +reserved_word('STRING') -> true; +reserved_word('SYNTAX') -> true; +reserved_word('T61String') -> rstrtype; +reserved_word('TAGS') -> true; +reserved_word('TeletexString') -> rstrtype; +reserved_word('TRUE') -> true; +reserved_word('UNION') -> true; +reserved_word('UNIQUE') -> true; +reserved_word('UNIVERSAL') -> true; +reserved_word('UniversalString') -> rstrtype; +reserved_word('UTCTime') -> true; +reserved_word('UTF8String') -> rstrtype; +reserved_word('VideotexString') -> rstrtype; +reserved_word('VisibleString') -> rstrtype; +reserved_word('WITH') -> true; +reserved_word(_) -> false. -- cgit v1.2.3