The R13B03 release.OTP_R13B03

1 files changed, 928 insertions, 0 deletions

diff --git a/lib/tools/src/xref_compiler.erl b/lib/tools/src/xref_compiler.erl
new file mode 100644
index 0000000000..67ac8c617d
--- /dev/null
+++ b/lib/tools/src/xref_compiler.erl
@@ -0,0 +1,928 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2000-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(xref_compiler).
+
+-include("xref.hrl").
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(FORMAT(P, A), io:format(P, A)).
+-define(CALL(F), F).
+-else.
+-define(FORMAT(P, A), ok).
+-define(CALL(F), ok).
+-endif.
+
+-export([compile/2]).
+
+-export([update_graph_counter/3]).
+
+-export([format_error/1]).
+
+-import(lists, 
+	[concat/1, foldl/3, nthtail/2, reverse/1, sort/1, sublist/2]).
+
+-import(sofs,
+	[composite/2, difference/2, empty_set/0, from_term/1,
+	 intersection/2, is_empty_set/1, multiple_relative_product/2,
+	 projection/2, relation/1, relation_to_family/1,
+	 restriction/2, substitution/2, to_external/1, union/2,
+	 union_of_family/1]).
+
+%%
+%%  Exported functions
+%%
+
+compile(Chars, Table) ->
+    case xref_scanner:scan(Chars) of
+	{ok, Tokens}  ->
+	    case xref_parser:parse(Tokens) of
+		{ok, ParseTree} ->
+		    ?FORMAT("ParseTree ~p~n", [ParseTree]),
+		    case catch statements(ParseTree, Table) of
+			E={error, _, _} ->
+			    E;
+			{ok, UV, P} ->
+			    %% User variables to be.
+			    Table1 = user_vars(UV, Table),
+			    ?CALL(statistics(runtime)),
+			    Reply = i(P, Table1),
+			    ?CALL({_, Time} = statistics(runtime)),
+			    ?FORMAT("Result in ~p ms~n",[Time]),
+			    Reply
+		    end;
+		{error, {Line, _Module, Error}} ->
+		    error({parse_error, Line, Error})
+	    end;
+	{error, Info, Line} ->
+	    error({parse_error, Line, Info})
+    end.
+    
+format_error({error, Module, Error}) ->
+    Module:format_error(Error);
+format_error({parse_error, Line, Error}) ->
+    format_parse_error(Error, format_line(Line));
+format_error({variable_reassigned, Expr}) ->
+    io_lib:format("Variable assigned more than once: ~s~n", [Expr]);
+format_error({unknown_variable, Name}) ->
+    io_lib:format("Variable ~p used before set~n", [Name]);
+format_error({type_error, Expr}) ->
+    io_lib:format("Operator applied to argument(s) of different or "
+		  "invalid type(s): ~s~n", [Expr]);
+format_error({type_mismatch, Expr1, Expr2}) ->
+    io_lib:format("Constants of different types: ~s, ~s~n",
+		  [Expr1, Expr2]);
+format_error({unknown_constant, Constant}) ->
+    io_lib:format("Unknown constant ~s~n", [Constant]);
+format_error(E) ->
+    io_lib:format("~p~n", [E]).
+
+%%
+%%  Local functions
+%%
+
+user_vars([{{user,Name}, Val} | UV], Table) ->
+    user_vars(UV, dict:store(Name, Val, Table));
+user_vars([_V | UV], Table) ->
+    user_vars(UV, Table);
+user_vars([], Table) ->
+    Table.
+
+statements(Stmts, Table) ->
+    statements(Stmts, Table, [], []).
+
+statements([Stmt={assign, VarType, Name, E} | Stmts0], Table, L, UV) ->
+    case dict:find(Name, Table) of
+	{ok, _} ->
+	    throw_error({variable_reassigned, xref_parser:t2s(Stmt)});
+	error ->
+	    {Type, OType, NewE} = t_expr(E, Table),
+	    Val = #xref_var{name = Name, vtype = VarType, 
+			    otype = OType, type = Type},
+	    NewTable = dict:store(Name, Val, Table),
+	    Stmts = if Stmts0 =:= [] -> [{variable, Name}]; true -> Stmts0 end,
+	    Variable = {VarType, Name},
+	    Put = {put, Variable, NewE},
+	    statements(Stmts, NewTable, [Put | L], [{Variable,Val} | UV])
+    end;
+statements([Expr], Table, L, UV) ->
+    {Type, OType, NewE} = t_expr(Expr, Table),
+    E1 = un_familiarize(Type, OType, NewE),
+    NE = case {Type, OType} of
+	     %% Edges with empty sets of line numbers are removed.
+	     {{line, _}, edge} -> 
+		 {relation_to_family, E1};
+	     {_Type, edge_closure} -> 
+		 %% Fake a closure usage, just to make sure it is destroyed.
+		 E2 = {fun graph_access/2, E1, E1},
+                 {fun(_E) -> 'closure()' end, E2};
+	     _Else -> E1
+	 end,
+    {ok, UV, stats(L, NE)}.
+
+stats([{put, V, X} | Ss], E) ->
+    stats(Ss, {put, V, X, E});
+stats([], E) ->
+    E.
+
+t_expr(E, Table) ->
+    {expr, Type, OType, E1} = check_expr(E, Table),
+    ?FORMAT("TExpr:~n~p~n",[E1]),
+    E2 = convert(E1),
+    ?FORMAT("After conversion:~n~p~n",[E2]),
+    {Type, OType, E2}.
+
+%%% check_expr/2 translates Expr in xref_parser.yrl into TExpr:
+%%%
+%%% TExpr = {expr, Type, ObjectType, Expr}
+%%% Expr = {constants, [Constant]}
+%%%      | {variable, {VarType, VarName}}
+%%%      | {call, Call, Expr}
+%%%      | {call, Call, Expr, Expr}
+%%%      | {call, restriction, integer(), Expr, Expr}
+%%%      | {convert, ObjectType, Type, Type}
+%%%      | {convert, Type, Type}
+%%% Constant = atom() | {atom(), atom()} | MFA | {MFA, MFA}
+%%% Call = atom() % function in the sofs module
+%%%      | fun()
+%%% Type = {line, LineType} | function | module | application | release 
+%%%      | number
+%%% LineType = line | local_call | external_call | export_call | all_line_call
+%%% VarType = predef | user | tmp
+%%% ObjectType = vertex | vertex_set | edge | edge_set | edge_closure | path
+%%%            | number
+%%% MFA = {atom(), atom(), integer()}
+
+%% -> TExpr
+check_expr({list, L}, Table) ->
+    check_constants(L, Table);
+check_expr({tuple, L}, Table) ->
+    {expr, Type, vertex, _Consts} = check_constants(L, Table),
+    Cs = reverse(constant_vertices(L, [])),
+    {expr, Type, path, {constants, Cs}};
+check_expr({variable, Name}, Table) ->
+    case dict:find(Name, Table) of
+	{ok, #xref_var{vtype = VarType, otype = OType, type = Type}} ->
+	    V0 = {variable, {VarType, Name}},
+	    V = case {VarType, Type, OType} of 
+		    {predef, release, _} -> V0;
+		    {predef, application, _} -> V0;
+		    {predef, module, _} -> V0;
+		    {predef, function, vertex} -> V0;
+		    {predef, function, edge} -> {call, union_of_family, V0};
+		    _Else  -> V0
+	    end,
+	    {expr, Type, OType, V};
+	error ->
+	    throw_error({unknown_variable, Name})
+    end;
+check_expr({type, {type, _Type}, E}, Table) ->
+    check_expr(E, Table);
+check_expr(Expr={type, {convert, NewType0}, E}, Table) ->
+    NewType = what_type(NewType0),
+    {expr, OldType, OType, NE} = check_expr(E, Table),
+    ok = check_conversion(OType, OldType, NewType, Expr),
+    {expr, NewType, OType, {convert, OType, OldType, NewType, NE}};
+check_expr(Expr={set, SOp, E}, Table) ->
+    {expr, Type, OType0, E1} = check_expr(E, Table),
+    OType = case {OType0, SOp} of
+		{edge, range} -> vertex;
+		{edge, domain} -> vertex;
+		{edge, weak} -> edge;
+		{edge, strict} -> edge;
+		{edge_set, range} -> vertex_set;
+		{edge_set, domain} -> vertex_set;
+		{edge_set, weak} -> edge_set;
+		{edge_set, strict} -> edge_set;
+		_ -> 
+		    throw_error({type_error, xref_parser:t2s(Expr)})
+	    end,
+    Op = set_op(SOp),
+    NE = function_vertices_to_family(Type, OType, {call, Op, E1}),
+    {expr, Type, OType, NE};
+check_expr(Expr={graph, Op, E}, Table) ->
+    {expr, Type, NOType, E1} = check_expr(E, Table),
+    case Type of
+	{line, _LineType} ->
+	    throw_error({type_error, xref_parser:t2s(Expr)});
+	_Else -> 
+	    ok
+    end,
+    OType = 
+	case {NOType, Op} of
+	    {edge, components} -> vertex_set;
+	    {edge, condensation} -> edge_set;
+	    {edge, closure} -> edge_closure;
+	    {edge_closure, components} -> vertex_set;
+	    {edge_closure, condensation} -> edge_set;
+	    {edge_closure, closure} -> edge_closure;
+	    %% Neither need nor want these ones:
+	    %% {edge_set, closure} -> edge_set_closure;
+	    %% {edge_set, components} -> vertex_set_set;
+	    _ -> 
+		throw_error({type_error, xref_parser:t2s(Expr)})
+	end,
+    E2 = {convert, NOType, edge_closure, E1},
+    NE = case Op of
+	     closure -> E2;
+	     _Op -> use_of_closure(Op, E2)
+	 end,
+    {expr, Type, OType, NE};
+check_expr(Expr={numeric, '#', E}, Table) ->
+    {expr, Type, OType, E1} = check_expr(E, Table),
+    case OType of
+	vertex -> ok;
+	vertex_set -> ok;
+	edge -> ok;
+	edge_set -> ok;
+	_Else -> throw_error({type_error, xref_parser:t2s(Expr)})
+    end,
+    NE = {convert, OType, Type, number, E1},
+    {expr, number, number, {call, no_elements, NE}};
+check_expr(Expr={set, SOp, E1, E2}, Table) ->
+    %% sets and numbers...
+    {expr, Type1, OType1, NE1} = check_expr(E1, Table),
+    {expr, Type2, OType2, NE2} = check_expr(E2, Table),
+    OType = case {OType1, OType2} of
+		{vertex, vertex} -> vertex;
+		{edge, edge} -> edge;
+		{number, number} -> number;
+		_ -> throw_error({type_error, xref_parser:t2s(Expr)})
+	    end,
+    case OType of
+	number ->
+	    {expr, number, number, {call, ari_op(SOp), NE1, NE2}};
+	_Else -> % set
+	    {Type, NewE1, NewE2} = 
+		case {type_ord(Type1), type_ord(Type2)} of
+		    {T1, T2} when T1 =:= T2 ->
+			%% Example: if Type1 = {line, line} and 
+			%% Type2 = {line, export_line}, then this is not
+			%% correct, but works:
+			{Type1, NE1, NE2};
+		    {T1, T2} when T1 < 2; T2 < 2 ->
+			throw_error({type_error, xref_parser:t2s(Expr)});
+		    {T1, T2} when T1 > T2 ->
+			{Type2, {convert, OType, Type1, Type2, NE1}, NE2};
+		    {T1, T2} when T1 < T2 ->
+			{Type1, NE1, {convert, OType, Type2, Type1, NE2}}
+		end,
+	    Op = set_op(SOp, Type, OType),
+	    {expr, Type, OType, {call, Op, NewE1, NewE2}}
+    end;
+check_expr(Expr={restr, ROp, E1, E2}, Table) ->
+    {expr, Type1, OType1, NE1} = check_expr(E1, Table),
+    {expr, Type2, OType2, NE2} = check_expr(E2, Table),
+    case {Type1, Type2} of
+	{{line, _LineType1}, _Type2} ->
+	    throw_error({type_error, xref_parser:t2s(Expr)});
+	{_Type1, {line, _LineType2}} ->
+	    throw_error({type_error, xref_parser:t2s(Expr)});
+	_ -> 
+	    ok
+    end,
+    case {OType1, OType2} of
+	{edge, vertex} when ROp =:= '|||' ->
+	    {expr, _, _, R1} = restriction('|', E1, Type1, NE1, Type2, NE2),
+	    {expr, _, _, R2} = restriction('||', E1, Type1, NE1, Type2, NE2),
+	    {expr, Type1, edge, {call, intersection, R1, R2}};
+	{edge, vertex} ->
+	    restriction(ROp, E1, Type1, NE1, Type2, NE2);
+	{edge_closure, vertex} when ROp =:= '|||' ->
+	    {expr, _, _, R1} = 
+		closure_restriction('|', Type1, Type2, OType2, NE1, NE2),
+	    {expr, _, _, R2} = 
+		closure_restriction('||', Type1, Type2, OType2, NE1, NE2),
+	    {expr, Type1, edge, {call, intersection, R1, R2}};
+	{edge_closure, vertex} -> 
+	    closure_restriction(ROp, Type1, Type2, OType2, NE1, NE2);
+	_ -> 
+	    throw_error({type_error, xref_parser:t2s(Expr)})
+    end;
+check_expr(Expr={path, E1, E2}, Table) ->
+    {expr, Type1, OType1a, E1a} = check_expr(E1, Table),
+    {expr, Type2, OType2, E2a} = check_expr(E2, Table),
+    case {Type1, Type2} of
+	{{line, _LineType1}, _Type2} ->
+	    throw_error({type_error, xref_parser:t2s(Expr)});
+	{_Type1, {line, _LineType2}} ->
+	    throw_error({type_error, xref_parser:t2s(Expr)});
+	_Else ->
+	    ok
+    end,
+    E2b = {convert, OType2, Type2, Type1, E2a},
+    {OType1, NE1} = path_arg(OType1a, E1a),
+    NE2 = case {OType1, OType2} of 
+	      {path, edge} -> {convert, OType2, edge_closure, E2b};
+	      {path, edge_closure} when Type1 =:= Type2 -> E2b;
+	      _ -> throw_error({type_error, xref_parser:t2s(Expr)})
+	  end,
+    {expr, Type1, path, use_of_closure(path, NE2, NE1)};
+check_expr({regexpr, RExpr, Type0}, _Table) ->
+    %% Using the "universal" variables is not optimal as regards speed,
+    %% but it is simple...
+    Type = what_type(Type0),
+    V = case Type of
+	    function -> v;
+	    module -> 'M';
+	    application -> 'A';
+	    release -> 'R'
+	end,
+    Var = {variable, {predef, V}},
+    Call = {call, fun(E, V2) -> xref_utils:regexpr(E, V2) end, 
+	    {constants, RExpr}, Var},
+    {expr, Type, vertex, Call};
+check_expr(C={constant, _Type, _OType, _C}, Table) ->
+    check_constants([C], Table).
+
+path_arg(edge, E={constants, C}) ->
+    case to_external(C) of
+	[{V1,V2}] -> {path, {constants, [V1, V2]}};
+	_ -> {edge, E}
+    end;
+path_arg(OType, E) ->
+    {OType, E}.
+
+check_conversion(OType, Type1, Type2, Expr) ->
+    case conversions(OType, Type1, Type2) of
+	ok -> ok;
+	not_ok -> throw_error({type_error, xref_parser:t2s(Expr)})
+    end.
+
+%% Allowed conversions.
+conversions(_OType, {line, LineType}, {line, LineType}) -> ok; 
+conversions(edge, {line, _}, {line, all_line_call}) -> ok;
+conversions(edge, From, {line, Line}) 
+                 when is_atom(From), Line =/= all_line_call -> ok;
+conversions(vertex, From, {line, line}) when is_atom(From) -> ok;
+conversions(vertex, From, To) when is_atom(From), is_atom(To) -> ok;
+conversions(edge, From, To) when is_atom(From), is_atom(To) -> ok;
+%% "Extra":
+conversions(edge, {line, Line}, To) 
+                 when is_atom(To), Line =/= all_line_call -> ok;
+conversions(vertex, {line, line}, To) when is_atom(To) -> ok;
+conversions(_OType, _From, _To) -> not_ok.
+
+set_op(union, {line, _LineType}, edge) -> family_union;
+set_op(intersection, {line, _LineType}, edge) -> family_intersection;
+set_op(difference, {line, _LineType}, edge) -> family_difference;
+set_op(union, function, vertex) -> family_union;
+set_op(intersection, function, vertex) -> family_intersection;
+set_op(difference, function, vertex) -> family_difference;
+set_op(SOp, _Type, _OType) -> SOp.
+
+set_op(weak) -> weak_relation;
+set_op(strict) -> strict_relation;
+set_op(Op) -> Op.
+
+ari_op(union) -> fun(X, Y) -> X + Y end;
+ari_op(intersection) -> fun(X, Y) -> X * Y end;
+ari_op(difference) -> fun(X, Y) -> X - Y end.
+
+restriction(ROp, E1, Type1, NE1, Type2, NE2) ->
+    {Column, _} = restr_op(ROp),
+    case NE1 of 
+	{call, union_of_family, _E} when ROp =:= '|' ->
+	    restriction(Column, Type1, E1, Type2, NE2);
+	{call, union_of_family, _E} when ROp =:= '||' ->
+	    E1p = {inverse, E1},
+	    restriction(Column, Type1, E1p, Type2, NE2);
+	_ ->
+	    NE2a = {convert, vertex, Type2, Type1, NE2},
+	    NE2b = family_to_function_vertices(Type1, vertex, NE2a),
+	    {expr, Type1, edge, {call, restriction, Column, NE1, NE2b}}
+    end.
+
+restriction(Column, Type1, VE, Type2, E2) when Type1 =:= function ->
+    M = {convert, vertex, Type2, module, E2},
+    Restr = {call, union_of_family, {call, restriction, VE, M}},
+    C = {convert, vertex, Type2, Type1, E2},
+    F = family_to_function_vertices(Type1, vertex, C),
+    {expr, Type1, edge, {call, restriction, Column, Restr, F}}.
+
+closure_restriction(Op, Type1, Type2, OType2, E1, E2) ->
+    {_, Fun} = restr_op(Op),
+    E2a = {convert, OType2, Type2, Type1, E2},
+    E2b = family_to_function_vertices(Type1, vertex, E2a),
+    {expr, Type1, edge, use_of_closure(Fun, E1, E2b)}.
+
+restr_op('|')  -> {1, call};
+restr_op('||') -> {2, use}.
+
+%% Closures (digraphs) must be deleted, but not too soon. A wrapper
+%% is inserted here for every use of a closure, to make sure that a
+%% 'save' and an 'unput' instruction are inserted for every digraph, in
+%% particular the temporary ones. The 'unput' instruction must occur
+%% _after_ the call to the function that uses the digraph (the default
+%% is that it is inserted _before_ the call).
+use_of_closure(Op, C) ->
+    access_of_closure(C, {call, fun(X) -> xref_utils:Op(X) end, C}).
+
+use_of_closure(Op, C, E) ->
+    access_of_closure(C, {call, fun(X, Y) -> xref_utils:Op(X, Y) end, C, E}).
+
+access_of_closure(C, E) ->
+    {call, fun graph_access/2, C, E}.
+
+check_constants(Cs=[C={constant, Type0, OType, _Con} | Cs1], Table) ->
+    check_mix(Cs1, Type0, OType, C),
+    Types = case Type0 of
+		unknown -> ['Rel', 'App', 'Mod'];
+		T -> [T]
+	    end,
+    case split(Types, Cs, Table) of
+	[{TypeToBe, _Cs}] ->
+            S = from_term([Con || {constant, _T, _OT, Con} <- Cs]),
+	    Type = what_type(TypeToBe),
+	    E = function_vertices_to_family(Type, OType, {constants, S}),
+	    {expr, Type, OType, E};
+	[{Type1, [C1|_]}, {Type2, [C2|_]} | _] ->
+	    throw_error({type_mismatch, 
+			 make_vertex(Type1, C1), 
+			 make_vertex(Type2, C2)})
+    end.
+
+check_mix([C={constant, 'Fun', OType, _Con} | Cs], 'Fun', OType, _C0) ->
+    check_mix(Cs, 'Fun', OType, C);
+check_mix([C={constant, Type, OType, _Con} | Cs], Type0, OType, _C0)
+         when Type =/= 'Fun', Type0 =/= 'Fun' ->
+    check_mix(Cs, Type, OType, C);
+check_mix([C | _], _Type0, _OType0, C0) ->
+    throw_error({type_mismatch, xref_parser:t2s(C0), xref_parser:t2s(C)});
+check_mix([], _Type0, _OType0, _C0) -> 
+    ok.
+
+split(Types, Cs, Table) ->
+    Vs = from_term(constant_vertices(Cs, [])),
+    split(Types, Vs, empty_set(), unknown, Table, []).
+
+split([Type | Types], Vs, AllSoFar, _Type, Table, L) ->
+    S0 = known_vertices(Type, Vs, Table),
+    S = difference(S0, AllSoFar),
+    case is_empty_set(S) of
+	true -> 
+	    split(Types, Vs, AllSoFar, Type, Table, L);
+	false -> 
+	    All = union(AllSoFar, S0),
+	    split(Types, Vs, All, Type, Table, 
+		  [{Type, to_external(S)} | L])
+    end;
+split([], Vs, All, Type, _Table, L) ->
+    case to_external(difference(Vs, All)) of
+	[] -> L;
+	[C|_] -> throw_error({unknown_constant, make_vertex(Type, C)})
+    end.
+
+make_vertex(Type, C) -> 
+    xref_parser:t2s({constant, Type, vertex, C}).
+
+constant_vertices([{constant, _Type, edge, {A,B}} | Cs], L) ->
+    constant_vertices(Cs, [A, B | L]);
+constant_vertices([{constant, _Type, vertex, V} | Cs], L) ->
+    constant_vertices(Cs, [V | L]);
+constant_vertices([], L) ->
+    L.
+
+known_vertices('Fun', Cs, T) ->
+    M = projection(1, Cs),
+    F = union_of_family(restriction(fetch_value(v, T), M)),
+    intersection(Cs, F);
+known_vertices('Mod', Cs, T) ->
+    intersection(Cs, fetch_value('M', T));
+known_vertices('App', Cs, T) ->
+    intersection(Cs, fetch_value('A', T));
+known_vertices('Rel', Cs, T) ->
+    intersection(Cs, fetch_value('R', T)).
+
+function_vertices_to_family(function, vertex, E) ->
+    {call, partition_family, 1, E};
+function_vertices_to_family(_Type, _OType, E) ->
+    E.
+
+family_to_function_vertices(function, vertex, E) ->
+    {call, union_of_family, E};
+family_to_function_vertices(_Type, _OType, E) ->
+    E.
+
+-define(Q(E), {quote, E}).
+
+convert({inverse, {variable, Variable}}) ->
+    {get, {inverse, var_name(Variable)}};
+convert({variable, Variable}) ->
+    {get, var_name(Variable)};
+convert({convert, FromOType, ToOType, E}) ->
+    convert(convert(E), FromOType, ToOType);
+convert({convert, OType, FromType, ToType, E}) ->
+    convert(convert(E), OType, FromType, ToType);
+convert({call, Op, E}) ->
+    {Op, convert(E)};
+convert({call, Op, E1, E2}) ->
+    {Op, convert(E1), convert(E2)};
+convert({call, Op, E1, E2, E3}) ->
+    {Op, convert(E1), convert(E2), convert(E3)};
+convert({constants, Constants}) ->
+    ?Q(Constants);
+convert(I) when is_integer(I) ->
+    ?Q(I).
+
+var_name({predef, VarName}) -> VarName;
+var_name(Variable) -> Variable.
+
+convert(E, OType, OType) ->
+    E;
+convert(E, edge, edge_closure) ->
+    {fun(S) -> xref_utils:closure(S) end, E}.
+
+convert(E, OType, FromType, number) ->
+    un_familiarize(FromType, OType, E);
+convert(E, OType, FromType, ToType) ->
+    case {type_ord(FromType), type_ord(ToType)} of
+        {FT, To} when FT =:= To ->
+            E;
+	{FT, ToT} when FT > ToT ->
+            special(OType, FromType, ToType, E);
+	{FT, ToT} when FT < ToT ->
+            general(OType, FromType, ToType, E)
+    end.
+
+-define(T(V), {tmp, V}).
+
+general(_ObjectType, FromType, ToType, X) when FromType =:= ToType ->
+    X;
+general(edge, {line, _LineType}, ToType, LEs) -> 
+    VEs = {projection, ?Q({external, fun({V1V2,_Ls}) -> V1V2 end}), LEs},
+    general(edge, function, ToType, VEs);
+general(edge, function, ToType, VEs) ->
+    MEs = {projection, 
+	   ?Q({external, fun({{M1,_,_},{M2,_,_}}) -> {M1,M2} end}),
+	   VEs},
+    general(edge, module, ToType, MEs);
+general(edge, module, ToType, MEs) ->
+    AEs = {image, {get, me2ae}, MEs},
+    general(edge, application, ToType, AEs);
+general(edge, application, release, AEs) ->
+    {image, {get, ae}, AEs};
+general(vertex, {line, _LineType}, ToType, L) -> 
+    V = {partition_family, ?Q(1), {domain, L}},
+    general(vertex, function, ToType, V);
+general(vertex, function, ToType, V) ->
+    M = {domain, V},
+    general(vertex, module, ToType, M);
+general(vertex, module, ToType, M) ->
+    A = {image, {get, m2a}, M},
+    general(vertex, application, ToType, A);
+general(vertex, application, release, A) ->
+    {image, {get, a2r}, A}.
+
+special(_ObjectType, FromType, ToType, X) when FromType =:= ToType ->
+    X;
+special(edge, {line, _LineType}, {line, all_line_call}, Calls) ->
+   {put, ?T(mods), 
+       {projection, 
+	?Q({external, fun({{{M1,_,_},{M2,_,_}},_}) -> {M1,M2} end}), 
+	Calls},
+       {put, ?T(def_at), 
+           {union, {image, {get, def_at},
+                           {union, {domain, {get, ?T(mods)}}, 
+                                   {range, {get, ?T(mods)}}}}},
+           {fun funs_to_lines/2,
+	           {get, ?T(def_at)}, Calls}}};
+special(edge, function, {line, LineType}, VEs) ->
+    Var = if 
+	      LineType =:= line -> call_at;
+	      LineType =:= export_call -> e_call_at;
+	      LineType =:= local_call -> l_call_at;
+	      LineType =:= external_call -> x_call_at
+	  end,
+    line_edges(VEs, Var);
+special(edge, module, ToType, MEs) ->
+    VEs = {image,
+	   {projection, 
+	    ?Q({external, fun(FE={{M1,_,_},{M2,_,_}}) -> {{M1,M2},FE} end}),
+	    {union, 
+	     {image, {get, e},
+	      {projection, ?Q({external, fun({M1,_M2}) -> M1 end}), MEs}}}},
+	   MEs},
+    special(edge, function, ToType, VEs);
+special(edge, application, ToType, AEs) ->
+    MEs = {inverse_image, {get, me2ae}, AEs},
+    special(edge, module, ToType, MEs);
+special(edge, release, ToType, REs) ->
+    AEs = {inverse_image, {get, ae}, REs},
+    special(edge, application, ToType, AEs);
+special(vertex, function, {line, _LineType}, V) ->
+    {restriction, 
+       {union_of_family, {restriction, {get, def_at}, {domain, V}}},
+       {union_of_family, V}};
+special(vertex, module, ToType, M) ->
+    V = {restriction, {get, v}, M},
+    special(vertex, function, ToType, V);
+special(vertex, application, ToType, A) ->
+    M = {inverse_image, {get, m2a}, A},
+    special(vertex, module, ToType, M);
+special(vertex, release, ToType, R) ->
+    A = {inverse_image, {get, a2r}, R},
+    special(vertex, application, ToType, A).
+
+line_edges(VEs, CallAt) ->
+    {put, ?T(ves), VEs, 
+        {put, ?T(m1), 
+             {projection, ?Q({external, fun({{M1,_,_},_}) -> M1 end}), 
+	      {get, ?T(ves)}},
+	     {image, {projection, ?Q({external, fun(C={VV,_L}) -> {VV,C} end}),
+		      {union, {image, {get, CallAt}, {get, ?T(m1)}}}},
+		     {get, ?T(ves)}}}}.
+
+%% {(((v1,l1),(v2,l2)),l) : 
+%%       (v1,l1) in DefAt and (v2,l2) in DefAt and ((v1,v2),L) in CallAt}
+funs_to_lines(DefAt, CallAt) ->
+    T1 = multiple_relative_product({DefAt, DefAt}, projection(1, CallAt)),
+    T2 = composite(substitution(1, T1), CallAt),
+    Fun = fun({{{V1,V2},{L1,L2}},Ls}) -> {{{V1,L1},{V2,L2}},Ls} end,
+    projection({external, Fun}, T2).
+
+what_type('Rel')         -> release;
+what_type('App')         -> application;
+what_type('Mod')         -> module;
+what_type('Fun')         -> function;
+what_type('Lin')         -> {line, line};
+what_type('LLin')        -> {line, local_call};
+what_type('XLin')        -> {line, external_call};
+what_type('ELin')        -> {line, export_call};
+what_type('XXL')         -> {line, all_line_call}.
+
+type_ord({line, all_line_call}) -> 0;
+type_ord({line, _LT})           -> 1;
+type_ord(function)              -> 2;
+type_ord(module)                -> 3;
+type_ord(application)           -> 4;
+type_ord(release)               -> 5.
+
+%% While evaluating, sets of vertices are represented as families.
+%% Sets of edges are not families, but plain sets (this might change).
+%% Calls (with line numbers) are "straightened" out here, but will be
+%% families again shortly, unless just counted.
+un_familiarize(function, vertex, E) ->
+    {union_of_family, E};
+un_familiarize({line, _}, edge, E) ->
+    {family_to_relation, E};
+un_familiarize(_Type, _OType, E) ->
+    E.
+
+%% Expressions are evaluated using a stack and tail recursion.
+%% Common subexpressions are evaluated once only, using a table for
+%% storing temporary results.
+%% (Using a table _and_ a stack is perhaps not a very good way of
+%% doing things.)
+i(E, Table) ->
+    Start = 1,
+    {N, _NE, _NI, NT} = find_nodes(E, Start, dict:new()),
+    {Vs, UVs0, L} = save_vars(dict:to_list(NT), NT, [], [], []),
+
+    VarsToSave = to_external(relation_to_family(relation(Vs))),
+    Fun = fun({NN,S}, D) ->
+		  dict:store(NN, {extra,S,dict:fetch(NN, D)}, D)
+	  end,
+    D = foldl(Fun, dict:from_list(L), VarsToSave),
+
+    UVs = reverse(sort(UVs0)),
+    {_D, Is0} = make_instructions(N, UVs, D),
+    Is = insert_unput(Is0),
+    ?FORMAT("Instructions:~n~p~n~n~n", [Is]),
+    %% Well, compiles _and_ evaluates...
+    evaluate(Is, Table, []).
+
+%% Traverses the expression tree in postorder, giving a unique number
+%% to each node. A table is created, and common subexpressions found.
+find_nodes(E={quote,_}, I, T) ->
+    find_node(E, I, T);
+find_nodes({get, Var}, I, T) ->
+    find_node({var,Var}, I, T);
+find_nodes({put, Var, E1, E2}, I, T) ->
+    {_NE1_N, NE1, I1, T1} = find_nodes(E1, I, T),
+    %% Now NE1 is considered used once, which is wrong. Fixed below.
+    NT = dict:store({var, Var}, NE1, T1),
+    find_nodes(E2, I1, NT);
+find_nodes(Tuple, I, T) when is_tuple(Tuple) ->
+    [Tag0 | L] = tuple_to_list(Tuple),
+    Fun = fun(A, {L0, I0, T0}) ->
+		  {NA, _E, NI, NT} = find_nodes(A, I0, T0),
+		  {[NA | L0], NI, NT}
+	  end,
+    {NL, NI, T1} = foldl(Fun, {[], I, T}, L),
+    Tag = case Tag0 of
+	      _ when is_function(Tag0) -> Tag0;
+	      _ when is_atom(Tag0) -> {sofs, Tag0}
+	  end,
+    find_node({apply, Tag, NL}, NI, T1).
+
+find_node(E, I, T) ->
+    case dict:find(E, T) of
+        {ok, {reuse, N}} ->
+	    {N, E, I, T};
+	{ok, N} when is_integer(N) ->
+	    {N, E, I, dict:store(E, {reuse, N}, T)};
+	{ok, E1} ->
+	    find_node(E1, I, T);
+	error ->
+ 	    {I, E, I+1, dict:store(E, I, T)}
+    end.
+
+%% Creates save instructions for those values (stored on the stack while
+%% evaluating) that are to be used after the result has been popped.
+save_vars([{I, {reuse,N}} | DL], D, Vs, UVs, L) ->
+    save_vars(DL, D, [{N, {save, {tmp, N}}} | Vs], UVs, [{N, I} | L]);
+save_vars([{I, N} | DL], D, Vs, UVs, L) when is_integer(N) ->
+    save_vars(DL, D, Vs, UVs, [{N, I} | L]);
+save_vars([{{var,V={user,_}}, I} | DL], D, Vs, UVs, L) ->
+    N = case dict:fetch(I, D) of
+	    {reuse, N0} -> N0;
+	    N0 -> N0
+	end,
+    save_vars(DL, D, [{N, {save, V}} | Vs], [N | UVs], L);
+save_vars([{{var,{tmp,_}}, _I} | DL], D, Vs, UVs, L) ->
+    save_vars(DL, D, Vs, UVs, L);
+save_vars([], _D, Vs, UVs, L) ->
+    {Vs, UVs, L}.
+
+%% Traverses the expression again, this time using more or less the
+%% inverse of the table created by find_nodes. The first time a node
+%% is visited, its children are traversed, the following times a 
+%% get instructions are inserted (using the saved value).
+make_instructions(N, UserVars, D) ->
+    {D1, Is0} = make_instrs(N, D, []),
+    %% Assignments the results of which are not used by the final
+    %% expression are handled here. Instructions are created for user
+    %% variables only (assignment of a closure is handled properly
+    %% without further action).
+    make_more_instrs(UserVars, D1, Is0).
+
+make_more_instrs([UV | UVs], D, Is) ->
+    case dict:find(UV, D) of
+	error -> 
+	    make_more_instrs(UVs, D, Is);
+	_Else -> 
+	    {ND, NIs} = make_instrs(UV, D, Is),
+	    make_more_instrs(UVs, ND, [pop | NIs])
+    end;
+make_more_instrs([], D, Is) ->
+    {D, Is}.
+
+make_instrs(N, D, Is) ->
+    case dict:find(N, D) of
+	{ok, {extra, Save, Val}} ->
+	    {D1, Is1} = make_instr(Val, D, Is),
+	    {dict:erase(N, D1), Save ++ Is1};
+	{ok, Val} ->
+	    {D1, Is1} = make_instr(Val, D, Is),
+	    {dict:erase(N, D1), Is1};
+	error ->
+	    {D, [{get, {tmp, N}} | Is]}
+    end.
+
+make_instr({var, V}, D, Is) ->
+    {D, [{get, V} | Is]};
+make_instr(Q = {quote, _T}, D, Is) ->
+    {D, [Q | Is]};
+make_instr({apply, MF, Ns}, D, Is) ->
+    Fun = fun(N, {D0, Is0}) -> make_instrs(N, D0, Is0) end,
+    {D1, Is1} = foldl(Fun, {D, Is}, Ns),
+    {D1, [{apply, MF, length(Ns)} | Is1]}.
+
+%% Makes sure that temporary results are removed from the table as soon
+%% as they are no longer needed.
+%% Assignments may create extra save instructions, which are removed here.
+insert_unput(L) ->
+    insert_unput(L, dict:new(), []).
+
+insert_unput([I={get, V={tmp, _}} | Is], D, L) ->
+    case dict:find(V, D) of
+        {ok, _} -> insert_unput(Is, D, [I | L]);
+        error ->   insert_unput(Is, dict:store(V, [], D), [I,  {unput, V} | L])
+    end;
+insert_unput([I={save, V={tmp,_}} | Is], D, L) ->
+    case dict:find(V, D) of
+	{ok, _} ->
+	    insert_unput(Is, dict:erase(V, D), [I | L]);
+	error ->
+	    %% Extra save removed.
+	    insert_unput(Is, dict:erase(V, D), L)
+    end;
+insert_unput([I | Is], D, L) ->
+    insert_unput(Is, D, [I | L]);
+insert_unput([], _D, L) ->
+    L.
+
+graph_access(_G, V) ->
+    %% _G may have been deleted by an unput already
+    V.
+
+evaluate([{apply, MF, NoAs} | P], T, S) ->
+    Args = sublist(S, NoAs),
+    NewS = nthtail(NoAs, S),
+    ?FORMAT("Applying ~p/~p~n", [MF,NoAs]),
+    evaluate(P, T, [apply(MF, Args) | NewS]);
+evaluate([{quote, Val} | P], T, S) ->
+    evaluate(P, T, [Val | S]);
+evaluate([{get, Var} | P], T, S) when is_atom(Var) -> % predefined
+    Value = fetch_value(Var, T),
+    Val = case Value of 
+	      {R, _} -> R; % relation
+	      _ -> Value   % simple set
+	  end,
+    evaluate(P, T, [Val | S]);    
+evaluate([{get, {inverse, Var}} | P], T, S) -> % predefined, inverse
+    {_, R} = fetch_value(Var, T),
+    evaluate(P, T, [R | S]);    
+evaluate([{get, {user, Var}} | P], T, S) ->
+    Val = fetch_value(Var, T),
+    evaluate(P, T, [Val | S]);    
+evaluate([{get, Var} | P], T, S) -> % tmp
+    evaluate(P, T, [dict:fetch(Var, T) | S]);
+evaluate([{save, Var={tmp, _}} | P], T, S=[Val | _]) ->
+    T1 = update_graph_counter(Val, +1, T),
+    evaluate(P, dict:store(Var, Val, T1), S);
+evaluate([{save, {user, Name}} | P], T, S=[Val | _]) ->
+    #xref_var{vtype = user, otype = OType, type = Type} = dict:fetch(Name, T),
+    NewVar = #xref_var{name = Name, value = Val, 
+		       vtype = user, otype = OType, type = Type},
+    T1 = update_graph_counter(Val, +1, T),
+    NT = dict:store(Name, NewVar, T1),
+    evaluate(P, NT, S);
+evaluate([{unput, Var} | P], T, S) ->
+    T1 = update_graph_counter(dict:fetch(Var, T), -1, T),
+    evaluate(P, dict:erase(Var, T1), S);
+evaluate([pop | P], T, [_ | S]) ->
+    evaluate(P, T, S);
+evaluate([], T, [R]) ->
+    {T, R}.
+
+%% (PossibleGraph, 1 | -1, dict()) -> dict()
+%% Use the same table for everything... Here: Reference counters for digraphs.
+update_graph_counter(Value, Inc, T) ->
+    case catch digraph:info(Value) of
+	Info when is_list(Info) ->
+	    case dict:find(Value, T) of
+		{ok, 1} when Inc =:= -1 ->
+		    true = digraph:delete(Value),
+		    dict:erase(Value, T);
+		{ok, C} ->
+		    dict:store(Value, C+Inc, T);
+		error when Inc =:= 1 ->
+		    dict:store(Value, 1, T)
+	    end;
+	_EXIT -> 
+	    T
+    end.
+
+fetch_value(V, D) ->
+    #xref_var{value = Value} = dict:fetch(V, D),
+    Value.
+
+format_parse_error(["invalid_regexp", String, Error], Line) ->
+    io_lib:format("Invalid regular expression \"~s\"~s: ~s~n",
+		  [String, Line, lists:flatten(Error)]);
+format_parse_error(["invalid_regexp_variable", Var], Line) ->
+    io_lib:format("Invalid wildcard variable ~p~s "
+		  "(only '_' is allowed)~n", [Var, Line]);
+format_parse_error(["missing_type", Expr], Line) ->
+    io_lib:format("Missing type of regular expression ~s~s~n",
+		  [Expr, Line]);
+format_parse_error(["type_mismatch", Expr], Line) ->
+    io_lib:format("Type does not match structure of constant~s: ~s~n",
+		  [Line, Expr]);
+format_parse_error(["invalid_operator", Op], Line) ->
+    io_lib:format("Invalid operator ~p~s~n", [Op, Line]);
+format_parse_error(Error, Line) ->
+    io_lib:format("Parse error~s: ~s~n", [Line, lists:flatten(Error)]).
+
+format_line(-1) ->
+    " at end of string";
+format_line(0) ->
+    "";
+format_line(Line) when is_integer(Line) ->
+    concat([" on line ", Line]).
+
+throw_error(Reason) ->
+    throw(error(Reason)).
+
+error(Reason) ->
+    {error, ?MODULE, Reason}.