1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21Nonterminals
22xref statements statement expr constants constant const
23assign_op prefix_op add_op mult_op count_op restr_op path_op cast_op
24regexp regatom regint regvar regstr
25variable id type.
26
27Terminals
28edge vertex var atom decl cast 'of' string integer
29'(' ')' '[' ']' ',' '+' '-' '*' '|' '||' '|||' '=' ':=' '#' '{' '}' ':' '/'.
30
31Rootsymbol xref.
32
33Endsymbol '$end'.
34
35xref -> statements : '$1'.
36
37assign_op -> '=' : tmp.
38assign_op -> ':=' : user.
39add_op    -> '+' : union.
40add_op    -> '-' : difference.
41mult_op   -> '*' : intersection.
42count_op  -> '#' : '#'.
43restr_op  -> '|' : '|'.
44restr_op  -> '||' : '||'.
45restr_op  -> '|||' : '|||'.
46path_op   -> 'of' : 'of'.
47cast_op   -> '(' cast ')' : value_of('$2').
48prefix_op -> id : '$1'.
49
50Left  200 add_op.
51Left  300 mult_op.
52Left  400 count_op.
53Left  500 restr_op.
54Left  600 path_op.
55Unary 700 cast_op.
56Unary 700 prefix_op.
57
58statements -> statement : ['$1'].
59statements -> expr : ['$1'].
60statements -> statement ',' statements : ['$1' | '$3'].
61
62statement -> variable assign_op expr : {assign, '$2', '$1', '$3'}.
63
64expr -> '[' constant constants ']' type : type({list, ['$2' | '$3']}, '$5').
65expr -> '{' constant constants '}' type : type({tuple, ['$2' | '$3']}, '$5').
66expr -> constant type : type('$1', '$2').
67expr -> variable : {variable, '$1'}.
68expr -> expr add_op expr : {set, '$2', '$1', '$3'}.
69expr -> expr mult_op expr : {set, '$2', '$1', '$3'}.
70expr -> count_op expr : prefix('$1', '$2').
71expr -> expr restr_op expr : {restr, '$2', '$1', '$3'}.
72expr -> expr path_op expr : {path, '$1', '$3'}.
73expr -> cast_op expr : {type, {convert, '$1'}, '$2'}.
74expr -> prefix_op expr : prefix('$1', '$2').
75expr -> regexp : '$1'.
76expr -> '(' expr ')' : '$2'.
77
78constants -> '$empty' : [].
79constants -> ',' constant constants : ['$2' | '$3'].
80
81constant -> const : '$1'.
82
83const -> id : {constant, unknown, vertex, '$1'}.
84const -> edge : value_of('$1').
85const -> vertex : value_of('$1').
86
87regexp -> regstr type : regexp(atom, '$1', '$2').
88regexp -> regatom ':' regatom '/' regint type :
89                     regexp(func, {'$1', '$3', '$5'}, '$6').
90
91regatom -> regstr : '$1'.
92regatom -> id : {atom, '$1'}.
93regatom -> regvar : '$1'.
94
95regint -> regstr : '$1'.
96regint -> integer : {integer, value_of('$1')}.
97regint -> regvar : '$1'.
98
99regstr -> string : check_regexp(value_of('$1')).
100regvar -> variable : check_regexp_variable('$1').
101
102id       -> atom    : value_of('$1').
103variable -> var     : value_of('$1').
104
105type     -> decl     : value_of('$1').
106type     -> '$empty' : unknown.
107
108Erlang code.
109
110-export([t2s/1]).
111
112-import(lists, [concat/1, flatten/1]).
113
114%%% Syntax of the parse tree:
115%%% Start = [Statement]
116%%% Statement = {assign, AOp, VarName, Expr}
117%%%           | Expr
118%%% AOp = tmp | user
119%%% Expr = Constants | Variable | Unary | Binary | RegExpr
120%%% Constants = {list, [Constant]}  % not empty list
121%%%           | {tuple, [Constant]}
122%%%           | Constant % only to avoid [ and ] in error messages...
123%%% Constant = {constant, 'Fun', vertex, MFA} |
124%%%            {constant, AtomType, vertex, atom()} |
125%%%            {constant, 'Fun', edge, {MFA, MFA}} |
126%%%            {constant, AtomType, edge, {atom(), atom()}}
127%%% Variable = {variable, VarName}
128%%% VarName = atom()
129%%% Unary = {set, SetUOp, Expr}
130%%%       | {graph, GraphUOp, Expr}
131%%%       | {type, {TypeOp, Type}, Expr}
132%%%       | {numeric, NumOp, Expr, Expr}
133%%% SetUOp = range | domain | weak | strict
134%%% GraphUOp = components | condensation | closure
135%%% Binary = {set, SetBOp, Expr, Expr}
136%%%        | {restr, RestrOp, Expr, Expr}
137%%%        | {path, Expr, Expr}
138%%% SetBOp = union | intersection | difference
139%%% RestrOp = '|' | '||' | '|||'
140%%% TypeOp = type | convert
141%%% NumOp = '#'
142%%% RegExpr = {regexpr, RExpr, Type}
143%%% RExpr = string() | {AtomReg, AtomReg, IntReg}
144%%% AtomReg = string() | atom() | variable()
145%%% IntReg = string() | integer()
146%%% MFA = {atom(), atom(), integer()}
147%%% Type = 'Rel' | 'App' | 'Mod' | 'Fun'
148%%%      | 'Lin' | 'LLin' | 'XLin' | 'ELin' | 'XXL'
149%%% AtomType = unknown | 'Rel' | 'App' | 'Mod'
150
151value_of(Token) ->
152    element(3, Token).
153
154prefix(Op, Expr) ->
155    case is_prefix_op(Op) of
156	false ->
157	    return_error(0, ["invalid_operator", Op]);
158	UOp ->
159	    {UOp, Op, Expr}
160    end.
161
162is_prefix_op(range) -> set;
163is_prefix_op(domain) -> set;
164is_prefix_op(weak) -> set;
165is_prefix_op(strict) -> set;
166is_prefix_op(components) -> graph;
167is_prefix_op(condensation) -> graph;
168is_prefix_op(closure) -> graph;
169is_prefix_op('#') -> numeric;
170is_prefix_op(_) -> false.
171
172check_regexp(String) ->
173    case re:compile(String, [unicode]) of
174	{ok, _Expr} ->
175	    {regexpr, String};
176	{error, {ErrString, Position}} ->
177	    return_error(Position, ["invalid_regexp", String, ErrString])
178    end.
179
180check_regexp_variable('_') ->
181    variable;
182check_regexp_variable(Var) ->
183    return_error(0, ["invalid_regexp_variable", Var]).
184
185regexp(func, RExpr, unknown) ->
186    {regexpr, RExpr, 'Fun'};
187regexp(_, RExpr, unknown) ->
188    return_error(0, ["missing_type", t2s({regexpr, RExpr, unknown})]);
189regexp(Kind, RExpr, Type) ->
190    E = {type, {type, Type}, {regexpr, RExpr, Type}},
191    case Type of
192	'Fun' when Kind =:= func -> E;
193	'Mod' when Kind =:= atom -> E;
194	'App' when Kind =:= atom -> E;
195	'Rel' when Kind =:= atom -> E;
196	_Else -> return_error(0, ["type_mismatch", t2s(E)])
197    end.
198
199type(Expr, unknown) ->
200    Expr;
201type(Expr, Type) ->
202    {type, {type, Type}, type_constants(Expr, Type, Expr)}.
203
204type_constants({list, L}, Type, E) ->
205    {list, type_constants(L, Type, E)};
206type_constants({tuple, L}, Type, E) ->
207    {tuple, type_constants(L, Type, E)};
208type_constants([C | Cs], Type, E) ->
209    [type_constants(C, Type, E) | type_constants(Cs, Type, E)];
210type_constants([], _Type, _E) ->
211    [];
212type_constants({constant, unknown, OType, Con}, 'Rel', _E) ->
213    {constant, 'Rel', OType, Con};
214type_constants({constant, unknown, OType, Con}, 'App', _E) ->
215    {constant, 'App', OType, Con};
216type_constants({constant, unknown, OType, Con}, 'Mod', _E) ->
217    {constant, 'Mod', OType, Con};
218type_constants(C={constant, Type, _OType, _Con}, Type, _E) ->
219    C;
220type_constants(_C, Type, E) ->
221    return_error(0, ["type_mismatch", t2s({type, {type, Type}, E})]).
222
223t2s(T) ->
224    concat(flatten(e2s(T, 0))).
225
226%% Does not handle list of statements.
227e2s({assign, VarType, Name, E}, P) ->
228    [left(P, 100), Name, name_it(VarType), e2s(E, 100), right(P, 100)];
229e2s({constant, 'Fun', vertex, MFA}, _P) ->
230    mfa2s(MFA);
231e2s({constant, _Type, vertex, A}, _P) ->
232    [c2s(A)];
233e2s({constant, 'Fun', edge, {MFA1,MFA2}}, _P) ->
234    [mfa2s(MFA1),' -> ',mfa2s(MFA2)];
235e2s({constant, _Type, edge, {A1,A2}}, _P) ->
236    [c2s(A1),' -> ',c2s(A2)];
237e2s({variable, Name}, _P) ->
238    [Name];
239e2s({list, E}, _P) ->
240    ['[', e2s(E, 0), ']'];
241e2s({tuple, E}, _P) ->
242    ['{', e2s(E, 0), '}'];
243e2s({type, {convert, Type}, E}, P) ->
244    [left(P, 700), '(',Type,') ', e2s(E, 700), right(P, 700)];
245e2s({type, {type, Type}, E}, P) ->
246    [left(P, 700), e2s(E, 700), ' : ', Type, right(P, 700)];
247e2s({set, Op, E}, P) ->
248    [left(P, 700), name_it(Op), ' ', e2s(E, 700), right(P, 700)];
249e2s({graph, Op, E}, P) ->
250    [left(P, 700), name_it(Op), ' ', e2s(E, 700), right(P, 700)];
251e2s({numeric, Op, E}, P) ->
252    [left(P, 400), name_it(Op), ' ', e2s(E, 400), right(P, 400)];
253e2s({set, Op, E1, E2}, P) ->
254    P1 = prio(Op),
255    [left(P, P1), e2s(E1, P1),name_it(Op),e2s(E2, P1+50), right(P, P1)];
256e2s({path, E1, E2}, P) ->
257    P1 = 600,
258    [left(P, P1), e2s(E1, P1),' of ',e2s(E2, P1+50), right(P, P1)];
259e2s({regexpr, Expr={regexpr,_}, _Type}, _P) ->
260    [re(Expr)];
261e2s({regexpr, {M,F,A}, _Type}, _P) ->
262    [re(M),':',re(F),'/', re(A)];
263e2s({restr, Op, E1, E2}, P) ->
264    P1 = 500,
265    [left(P, P1), e2s(E1, P1),name_it(Op),e2s(E2, P1+50), right(P, P1)];
266e2s([], _P) ->
267    [];
268e2s([E], P) ->
269    e2s(E, P);
270e2s([E | Es], P) ->
271    [e2s(E, P),', ',e2s(Es, P)].
272
273mfa2s({M,F,A}) ->
274    [c2s(M),':',c2s(F),'/',A].
275
276c2s(C) ->
277    [S] = io_lib:format("~tp", [C]),
278    list_to_atom(S).
279
280re(variable) -> ['_'];
281re({atom, Atom}) -> [Atom];
282re({integer, Int}) -> [Int];
283re({regexpr, Str}) -> ['"',erlang:list_to_atom(Str),'"'].
284
285left(P1, P2) when P1 > P2 -> ['('];
286left(_P1, _P2) -> [].
287
288right(P1, P2) when P1 > P2 -> [')'];
289right(_P1, _P2) -> [].
290
291prio(intersection) -> 300;
292prio(difference)   -> 200;
293prio(union)        -> 200.
294
295name_it(tmp)           -> ' = ';
296name_it(user)          -> ' := ';
297name_it('|')           -> ' | ';
298name_it('||')          -> ' || ';
299name_it('|||')         -> ' ||| ';
300name_it(union)         -> ' + ';
301name_it(intersection)  -> ' * ';
302name_it(difference)    -> ' - ';
303name_it(Name) -> Name.
304