1%% ========================== -*-Erlang-*- =============================
2%% EDoc type specification grammar for the Yecc parser generator,
3%% adapted from Sven-Olof Nyström's type specification parser.
4%%
5%% Also contains entry points for parsing things like typedefs,
6%% references, and throws-declarations.
7%%
8%% Copyright (C) 2002-2005 Richard Carlsson
9%%
10%% Licensed under the Apache License, Version 2.0 (the "License"); you may
11%% not use this file except in compliance with the License. You may obtain
12%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
13%%
14%% Unless required by applicable law or agreed to in writing, software
15%% distributed under the License is distributed on an "AS IS" BASIS,
16%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
17%% See the License for the specific language governing permissions and
18%% limitations under the License.
19%%
20%% Alternatively, you may use this file under the terms of the GNU Lesser
21%% General Public License (the "LGPL") as published by the Free Software
22%% Foundation; either version 2.1, or (at your option) any later version.
23%% If you wish to allow use of your version of this file only under the
24%% terms of the LGPL, you should delete the provisions above and replace
25%% them with the notice and other provisions required by the LGPL; see
26%% <http://www.gnu.org/licenses/>. If you do not delete the provisions
27%% above, a recipient may use your version of this file under the terms of
28%% either the Apache License or the LGPL.
29%%
30%% Author contact: carlsson.richard@gmail.com
31%% =====================================================================
32
33Nonterminals
34start spec func_type utype_list utype_tuple utypes utype ptypes ptype
35nutype function_name where_defs defs defs2 def typedef etype
36throws qname ref aref mref lref var_list vars fields field
37utype_map utype_map_fields utype_map_field
38futype_list bin_base_type bin_unit_type.
39
40Terminals
41atom float integer var an_var string start_spec start_typedef start_throws
42start_ref
43
44'(' ')' ',' '.' '=>' ':=' '->' '{' '}' '[' ']' '|' '+' ':' '::' '=' '/' '//'
45'*' '#' 'where' '<<' '>>' '..' '...'.
46
47Rootsymbol start.
48
49start -> start_spec spec: '$2'.
50start -> start_throws throws: '$2'.
51start -> start_typedef typedef: '$2'.
52start -> start_ref ref: '$2'.
53
54%% Produced in reverse order.
55qname -> atom: [tok_val('$1')].
56qname -> qname '.' atom: [tok_val('$3') | '$1'].
57
58spec -> func_type where_defs:
59    #t_spec{type = '$1', defs = '$2'}.
60spec -> function_name func_type where_defs:
61    #t_spec{name = '$1', type = '$2', defs = '$3'}.
62
63where_defs -> 'where' defs: '$2'.
64where_defs -> defs: '$1'.
65
66function_name -> atom: #t_name{name = tok_val('$1')}.
67
68func_type -> utype_list '->' utype:
69    #t_fun{args = element(1, '$1'), range = '$3'}.
70
71
72%% Paired with line number, for later error reporting
73utype_list -> '(' utypes ')' : {lists:reverse('$2'), tok_line('$1')}.
74
75futype_list -> utype_list : '$1'.
76futype_list -> '(' '...' ')' : {[#t_var{name = '...'}], tok_line('$1')}.
77
78utype_map -> '#' '{' utype_map_fields '}' : lists:reverse('$3').
79
80utype_map_fields -> '$empty' : [].
81utype_map_fields -> utype_map_field : ['$1'].
82utype_map_fields -> utype_map_fields ',' utype_map_field : ['$3' | '$1'].
83
84utype_map_field -> utype '=>' utype : #t_map_field{assoc_type = assoc,
85                                                   k_type = '$1',
86                                                   v_type = '$3'}.
87utype_map_field -> utype ':=' utype : #t_map_field{assoc_type = exact,
88                                                   k_type = '$1',
89                                                   v_type = '$3'}.
90
91utype_tuple -> '{' utypes '}' : lists:reverse('$2').
92
93%% Produced in reverse order.
94utypes -> '$empty' : [].
95utypes -> utype : ['$1'].
96utypes -> utypes ',' utype : ['$3' | '$1'].
97
98utype -> nutype string: annotate('$1', tok_val('$2')).
99utype -> nutype: '$1'.
100
101nutype -> var '::' ptypes: annotate(union('$3'), tok_val('$1')).
102nutype -> ptypes: union('$1').
103
104%% Produced in reverse order.
105ptypes -> ptype : ['$1'].
106ptypes -> ptypes '+' ptype : ['$3' | '$1'].
107ptypes -> ptypes '|' ptype : ['$3' | '$1'].
108
109ptype -> var : #t_var{name = tok_val('$1')}.
110ptype -> atom : #t_atom{val = tok_val('$1')}.
111ptype -> integer: #t_integer{val = tok_val('$1')}.
112ptype -> integer '..' integer: #t_integer_range{from = tok_val('$1'),
113                                                  to = tok_val('$3')}.
114ptype -> float: #t_float{val = tok_val('$1')}.
115ptype -> utype_tuple : #t_tuple{types = '$1'}.
116ptype -> utype_map : #t_map{types = '$1'}.
117ptype -> '[' ']' : #t_nil{}.
118ptype -> '[' utype ']' : #t_list{type = '$2'}.
119ptype -> '[' utype ',' '...' ']' : #t_nonempty_list{type = '$2'}.
120ptype -> utype_list:
121	if length(element(1, '$1')) == 1 ->
122		%% there must be exactly one utype in the list
123                #t_paren{type = hd(element(1, '$1'))};
124	   length(element(1, '$1')) == 0 ->
125		return_error(element(2, '$1'), "syntax error before: ')'");
126	   true ->
127		return_error(element(2, '$1'), "syntax error before: ','")
128	end.
129ptype -> futype_list '->' ptype:
130	#t_fun{args = element(1, '$1'), range = '$3'}.
131ptype -> '#' atom '{' '}' :
132        #t_record{name = #t_atom{val = tok_val('$2')}}.
133ptype -> '#' atom '{' fields '}' :
134	#t_record{name = #t_atom{val = tok_val('$2')},
135		  fields = lists:reverse('$4')}.
136ptype -> atom utype_list:
137             case {tok_val('$1'), element(1, '$2')} of
138                 {nil, []} ->
139                     %% Prefer '[]' before 'nil(). Due to
140                     %% compatibility with Erlang types, which do not
141                     %% separate '[]' from 'nil()'.
142                     #t_nil{};
143                 {list, [T]} ->
144                     %% Prefer '[T]' before 'list(T). Due to
145                     %% compatibility with Erlang types, which do not
146                     %% separate '[T]' from 'list(T)'.
147                     #t_list{type = T};
148                 {'fun', [#t_fun{}=Fun]} ->
149                     %% An incompatible change as compared to EDOc 0.7.6.6.
150                     %% Due to compatibility with Erlang types.
151                     Fun;
152                 {'fun', []} ->
153                     #t_type{name = #t_name{name = function}};
154                 {Name, Args} ->
155                     #t_type{name = #t_name{name = Name},
156                             args = Args}
157             end.
158ptype -> qname ':' atom utype_list :
159	#t_type{name = #t_name{module = qname('$1'),
160			       name = tok_val('$3')},
161		args = element(1, '$4')}.
162ptype -> '//' atom '/' qname ':' atom utype_list :
163	#t_type{name = #t_name{app = tok_val('$2'),
164			       module = qname('$4'),
165			       name = tok_val('$6')},
166		args = element(1, '$7')}.
167ptype -> '<<' '>>' : #t_binary{}.
168ptype -> '<<' bin_base_type '>>' : #t_binary{base_size = '$2'}.
169ptype -> '<<' bin_unit_type '>>' : #t_binary{unit_size = '$2'}.
170ptype -> '<<' bin_base_type ',' bin_unit_type '>>' :
171        #t_binary{base_size = '$2', unit_size = '$4'}.
172
173bin_base_type -> an_var ':' integer: tok_val('$3').
174
175bin_unit_type -> an_var ':' an_var '*' integer : tok_val('$5').
176
177%% Produced in reverse order.
178fields -> field : ['$1'].
179fields -> fields ',' field : ['$3' | '$1'].
180
181field -> atom '=' utype :
182	#t_field{name = #t_atom{val = tok_val('$1')}, type = '$3'}.
183
184defs -> '$empty' : [].
185defs -> def defs2 : ['$1' | lists:reverse('$2')].
186
187%% Produced in reverse order.
188defs2 -> '$empty' : [].
189defs2 -> defs2 def : ['$2' | '$1'].
190defs2 -> defs2 ',' def : ['$3' | '$1'].
191
192def -> var '=' utype:
193       #t_def{name =  #t_var{name = tok_val('$1')},
194	      type = '$3'}.
195def -> atom '(' utypes ')' '=' utype:
196       build_def(tok_val('$1'), '$2', '$3', '$6').
197
198var_list -> '(' ')' : [].
199var_list -> '(' vars ')' : lists:reverse('$2').
200
201%% Produced in reverse order.
202vars -> var : [#t_var{name = tok_val('$1')}].
203vars -> vars ',' var : [#t_var{name = tok_val('$3')} | '$1'].
204
205typedef -> atom var_list where_defs:
206       #t_typedef{name = #t_name{name = tok_val('$1')},
207		  args = '$2',
208		  defs = '$3'}.
209typedef -> atom var_list '=' utype where_defs:
210       #t_typedef{name = #t_name{name = tok_val('$1')},
211		  args = '$2',
212		  type = '$4',
213		  defs = '$5'}.
214
215%% References
216
217ref -> aref: '$1'.
218ref -> mref: '$1'.
219ref -> lref: '$1'.
220
221aref -> '//' atom:
222    edoc_refs:app(tok_val('$2')).
223aref -> '//' atom '/' mref:
224    edoc_refs:app(tok_val('$2'), '$4').
225
226mref -> qname ':' atom '/' integer:
227    edoc_refs:function(qname('$1'), tok_val('$3'), tok_val('$5')).
228mref -> qname ':' atom '(' ')':
229    edoc_refs:type(qname('$1'), tok_val('$3')).
230mref -> qname:
231    edoc_refs:module(qname('$1')).
232
233lref -> atom '/' integer:
234    edoc_refs:function(tok_val('$1'), tok_val('$3')).
235lref -> atom '(' ')':
236    edoc_refs:type(tok_val('$1')).
237
238%% Exception declarations
239
240etype -> utype: '$1'.
241
242throws -> etype where_defs:
243	#t_throws{type = '$1',
244		  defs = '$2'}.
245
246Header
247"%% EDoc function specification parser, generated from the file"
248"%% \"edoc_parser.yrl\" by the Yecc parser generator."
249"%%"
250"%% Licensed under the Apache License, Version 2.0 (the \"License\"); you may"
251"%% not use this file except in compliance with the License. You may obtain"
252"%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>"
253"%%"
254"%% Unless required by applicable law or agreed to in writing, software"
255"%% distributed under the License is distributed on an \"AS IS\" BASIS,"
256"%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied."
257"%% See the License for the specific language governing permissions and"
258"%% limitations under the License."
259"%%"
260"%% Alternatively, you may use this file under the terms of the GNU Lesser"
261"%% General Public License (the \"LGPL\") as published by the Free Software"
262"%% Foundation; either version 2.1, or (at your option) any later version."
263"%% If you wish to allow use of your version of this file only under the"
264"%% terms of the LGPL, you should delete the provisions above and replace"
265"%% them with the notice and other provisions required by the LGPL; see"
266"%% <http://www.gnu.org/licenses/>. If you do not delete the provisions"
267"%% above, a recipient may use your version of this file under the terms of"
268"%% either the Apache License or the LGPL."
269"%%"
270"%% @private"
271"%% @copyright 2002-2005 Richard Carlsson"
272"%% @author Richard Carlsson <carlsson.richard@gmail.com>"
273"".
274
275Erlang code.
276
277-export([parse_spec/2, parse_typedef/2, parse_throws/2, parse_ref/2,
278	 parse_see/2, parse_param/2]).
279
280-include("edoc_types.hrl").
281
282%% Multiple entry point hack:
283
284start_spec(Ts, L) -> run_parser(Ts, L, start_spec).
285
286start_typedef(Ts, L) -> run_parser(Ts, L, start_typedef).
287
288start_throws(Ts, L) -> run_parser(Ts, L, start_throws).
289
290start_ref(Ts, L) -> run_parser(Ts, L, start_ref).
291
292%% Error reporting fix
293
294run_parser(Ts, L, Start) ->
295    case parse([{Start,L} | Ts]) of
296	{error, {999999,?MODULE,_}} ->
297	    What = case Start of
298		       start_spec -> "specification";
299		       start_typedef -> "type definition";
300		       start_throws -> "exception declaration";
301		       start_ref -> "reference"
302		   end,
303	    {error, {L,?MODULE,["unexpected end of ", What]}};
304	Other -> Other
305    end.
306
307%% Utility functions:
308
309tok_val(T) -> element(3, T).
310
311tok_line(T) -> element(2, T).
312
313qname([A]) -> A.
314
315union(Ts) ->
316    case Ts of
317	[T] -> T;
318	_ -> #t_union{types = lists:reverse(Ts)}
319    end.
320
321annotate(T, A) -> ?add_t_ann(T, A).
322
323build_def(S, P, As, T) ->
324    case all_vars(As) of
325        true ->
326            #t_def{name = #t_type{name = #t_name{name = S},
327                                  args = lists:reverse(As)},
328                   type = T};
329        false ->
330            return_error(tok_line(P), "variable expected after '('")
331    end.
332
333all_vars([#t_var{} | As]) ->
334    all_vars(As);
335all_vars(As) ->
336    As =:= [].
337
338%% ---------------------------------------------------------------------
339
340%% EDoc type specification parsing. Parses the content of
341%% <a href="overview-summary.html#ftag-spec">`@spec'</a> declarations.
342
343parse_spec(S, L) ->
344    case edoc_scanner:string(S, L) of
345	{ok, Ts, _} ->
346	    case start_spec(Ts, L) of
347		{ok, Spec} ->
348		    Spec;
349		{error, E} ->
350		    throw_error({parse_spec, E}, L)
351	    end;
352	{error, E, _} ->
353	    throw_error({parse_spec, E}, L)
354    end.
355
356%% ---------------------------------------------------------------------
357
358%% EDoc type definition parsing. Parses the content of
359%% <a href="overview-summary.html#gtag-type">`@type'</a> declarations.
360
361parse_typedef(S, L) ->
362    {S1, S2} = edoc_lib:split_at_stop(S),
363    N = edoc_lib:count($\n, S1),
364    L1 = L + N,
365    Text = edoc_lib:strip_space(S2),
366    {parse_typedef_1(S1, L), edoc_wiki:parse_xml(Text, L1)}.
367
368parse_typedef_1(S, L) ->
369    case edoc_scanner:string(S, L) of
370	{ok, Ts, _} ->
371	    case start_typedef(Ts, L) of
372		{ok, T} ->
373		    T;
374		{error, E} ->
375		    throw_error({parse_typedef, E}, L)
376	    end;
377	{error, E, _} ->
378	    throw_error({parse_typedef, E}, L)
379    end.
380
381%% ---------------------------------------------------------------------
382
383%% Parses a <a
384%% href="overview-summary.html#References">reference</a> to a module,
385%% function, type, or application
386
387parse_ref(S, L) ->
388    case edoc_scanner:string(S, L) of
389	{ok, Ts, _} ->
390	    case start_ref(Ts, L) of
391		{ok, T} ->
392		    T;
393		{error, E} ->
394		    throw_error({parse_ref, E}, L)
395	    end;
396	{error, E, _} ->
397	    throw_error({parse_ref, E}, L)
398    end.
399
400%% ---------------------------------------------------------------------
401
402%% Parses the content of
403%% <a href="overview-summary.html#ftag-see">`@see'</a> references.
404parse_see(S, L) ->
405    {S1, S2} = edoc_lib:split_at_stop(S),
406    N = edoc_lib:count($\n, S1),
407    L1 = L + N,
408    Text = edoc_lib:strip_space(S2),
409    {parse_ref(S1, L), edoc_wiki:parse_xml(Text, L1)}.
410
411%% ---------------------------------------------------------------------
412
413%% Parses the content of
414%% <a href="overview-summary.html#ftag-param">`@param'</a> tags.
415parse_param(S, L) ->
416    {S1, S2} = edoc_lib:split_at_space(edoc_lib:strip_space(S)),
417    case edoc_lib:strip_space(S1) of
418	"" -> throw_error(parse_param, L);
419	Name ->
420	    Text = edoc_lib:strip_space(S2),
421	    {list_to_atom(Name), edoc_wiki:parse_xml(Text, L)}
422    end.
423
424%% ---------------------------------------------------------------------
425
426%% EDoc exception specification parsing. Parses the content of
427%% <a href="overview-summary.html#ftag-throws">`@throws'</a> declarations.
428
429parse_throws(S, L) ->
430    case edoc_scanner:string(S, L) of
431	{ok, Ts, _} ->
432	    case start_throws(Ts, L) of
433		{ok, Spec} ->
434		    Spec;
435		{error, E} ->
436		    throw_error({parse_throws, E}, L)
437	    end;
438	{error, E, _} ->
439	    throw_error({parse_throws, E}, L)
440    end.
441
442%% ---------------------------------------------------------------------
443
444-spec throw_error(term(), erl_anno:line()) -> no_return().
445
446throw_error({parse_spec, E}, L) ->
447    throw_error({"specification", E}, L);
448throw_error({parse_typedef, E}, L) ->
449    throw_error({"type definition", E}, L);
450throw_error({parse_ref, E}, L) ->
451    throw_error({"reference", E}, L);
452throw_error({parse_throws, E}, L) ->
453    throw_error({"throws-declaration", E}, L);
454throw_error(parse_param, L) ->
455    throw({error, L, "missing parameter name"});
456throw_error({Where, E}, L) when is_list(Where) ->
457    throw({error,L,{"unknown error parsing ~ts: ~P.",[Where,E,15]}}).
458
459%% vim: ft=erlang
460