1/*  Part of SWI-Prolog odf-sheet pack
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org/pack/list?p=odf-sheet
    6
    7    Copyright (c) 2012-2014, VU University of Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions are
   12    met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15    notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18    notice, this list of conditions and the following disclaimer in the
   19    documentation and/or other materials provided with the distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
   22    IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
   23    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
   24    PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
   25    HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
   26    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
   27    TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
   28    PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
   29    LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
   30    NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
   31    SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   32*/
   33
   34:- module(ods_formula,
   35	  [ sheet_ds_formulas/2,	% :Sheet, -DSFormulas
   36	    sheet_formula_groups/3,	% :Sheet, -Groups, -Singles
   37	    ds_formulas/2,		% +Formulas, -DSFormulas
   38	    generalize_formula/8,	% +S0, +X0, +Y0, +F0, -S, -X, -Y, -F
   39	    sheet_dependency_graph/2,	% :Sheet, -DepGraph
   40	    cell_dependency_graph/5	% :Sheet, +X, +Y, +Direction, -Graph
   41	  ]).   42:- use_module(library(record)).   43:- use_module(library(clpfd), except([transpose/2])).   44:- use_module(library(ugraphs)).   45:- use_module(library(debug)).   46:- use_module(library(apply)).   47:- use_module(library(pairs)).   48:- use_module(library(lists)).   49:- use_module(library(ordsets)).   50:- use_module(library(thread)).   51:- use_module(table).   52:- use_module(datasource).   53
   54:- record
   55	map(sheet,x,y).
   56
   57:- meta_predicate
   58	sheet_ds_formulas(:, -),
   59	sheet_formula_groups(:, -, -),
   60	sheet_dependency_graph(:, -),
   61	cell_dependency_graph(:,+,+,+,-).

Reason about formulas

*/

 sheet_ds_formulas(:Sheet, -Formulas) is det
Formulas is a list of generalised formulas in Sheet
   72sheet_ds_formulas(Sheet, DSFormulas) :-
   73	sheet_formula_groups(Sheet, Groups, Singles),
   74	append(Groups, Grouped),
   75	append(Singles, Grouped, AllFormulas),
   76	ds_formulas(AllFormulas, DSFormulas0),
   77	sort(DSFormulas0, DSFormulas).
 sheet_formula_groups(:Sheet, -Groups, -Singles) is det
   81sheet_formula_groups(Sheet, Groups, Singles) :-
   82	findall(f(Sheet,X,Y,F),
   83		cell_formula(Sheet, X, Y, F),
   84		Formulas),
   85	length(Formulas, Count),
   86	debug(formula, '~q: Found ~D formulas', [Sheet, Count]),
   87	map_list_to_pairs(skolem_formula, Formulas, Keyed),
   88	keysort(Keyed, Sorted),
   89	group_pairs_by_key(Sorted, ByKey),
   90	pairs_values(ByKey, CandidateGroups),
   91	length(CandidateGroups, CCount),
   92	debug(formula, '~D candidate groups', [CCount]),
   93	concurrent_maplist(make_groups,
   94			   CandidateGroups, NestedGroups, NestedSingles),
   95	append(NestedGroups, Groups),
   96	append(NestedSingles, Singles).
   97
   98make_groups([], [], []).
   99make_groups([F0|FT], Groups, Singles) :-
  100	generalize_formula(F0, P),
  101	partition(match_formula(P), FT, Matching, Rest),
  102	length(Matching, Matches),
  103	length(Rest, Left),
  104	debug(formula, '~p: ~D matches; ~D left', [P, Matches, Left]),
  105	(   Matching \== []
  106	->  make_group(P, [F0|Matching], G0),
  107	    Groups = [G0|GT],
  108	    RS = Singles
  109	;   Groups = GT,
  110	    Singles = [F0|RS]
  111	),
  112	make_groups(Rest, GT, RS).
  113
  114match_formula(P, F) :-
  115	\+ \+ P = F.
 make_group(+Pattern, +Matches, -Group)
Turn a set of matches into a group. Groups is a term forall(Var in Values, Formula).
Arguments:
Pattern- is a term f(S,X,Y,F), where S,X,Y are variables.
Matches- is a list of ground terms f(S,X,Y,F).
  125make_group(P, Matches, Groups) :-
  126	P = f(S,X,Y,_),
  127	findall(b(S,X,Y), member(P,Matches), Bindings),
  128	maplist(arg(1), Bindings, AllSheets), sort(AllSheets, Sheets),
  129	maplist(arg(2), Bindings, AllXs),     sort(AllXs, Xs),
  130	maplist(arg(3), Bindings, AllYs),     sort(AllYs, Ys),
  131	group(Sheets, Xs, Ys, P, Matches, Groups0),
  132	flatten(Groups0, Groups).
  133
  134group([S], [X], [Y], P, _, Result) :- !,
  135	P = f(S,X,Y,F),
  136	assertion(ground(P)),
  137	Result = (cell(S,X,Y) = F).
  138group([S], [X],  Ys, f(S,X,Y,F), _, forall(row,   Y in Set, f(S,X,Y,F))) :- !,
  139	compress(Ys, Set).
  140group([S], Xs,  [Y], f(S,X,Y,F), _, forall(col,   X in Set, f(S,X,Y,F))) :- !,
  141	compress(Xs, Set).
  142group(Ss,  [X], [Y], f(S,X,Y,F), _, forall(sheet, S in Ss,  f(S,X,Y,F))) :- !.
  143group([S], Xs, Ys, f(S,X,Y,F), Matches,
  144      [forall(area, [X in SetX, Y in SetY], f(S,X,Y,F))]) :-
  145	forall(( member(X,Xs),
  146		 member(Y,Ys)
  147	       ),
  148	       memberchk(f(S,X,Y,_), Matches)), !,
  149	compress(Xs, SetX),
  150	compress(Ys, SetY).
  151group([S], Xs, Ys, P, Matches, Groups) :-
  152	P = f(S,X,Y,_),
  153	length(Xs, Xc),
  154	length(Ys, Yc),
  155	(   Xc < Yc
  156	->  findall(G, (member(X,Xs), make_group(P, Matches, G)), NGroups)
  157	;   findall(G, (member(Y,Ys), make_group(P, Matches, G)), NGroups)
  158	),
  159	append(NGroups, Groups).
 compress(+List, -Description)
Create a short description of the elements in list using ranges. Ranges are expressed as Low-High.
  166compress(List, Description) :-
  167	sort(List, Sorted),
  168	create_ranges(Sorted, Description).
  169
  170create_ranges([], []).
  171create_ranges([Low|T0], [Low-High|T]) :-
  172	range(Low, T0, High, T1),
  173	High > Low, !,
  174	create_ranges(T1, T).
  175create_ranges([H|T0], [H|T]) :-
  176	create_ranges(T0, T).
  177
  178range(Low, [Next|T0], High, T) :-
  179	succ(Low, Next), !,
  180	range(Next, T0, High, T).
  181range(High, T, High, T).
 ds_formulas(+Formulas:list, -DSFormulas:list) is det
  186ds_formulas(FL0, FL) :-
  187	ds_formulas(FL0, FL1, []),
  188	maplist(simplify_formula, FL1, FL).
  189
  190ds_formulas([], FL, FL).
  191ds_formulas([H|T], FL0, FL) :-
  192	(   ds_formula(H, FL0, FL1)
  193	->  true
  194	;   gtrace,
  195	    pp(H),
  196	    ds_formula(H, FL0, FL1)
  197	),
  198	ds_formulas(T, FL1, FL).
 ds_formula(+Group, -DSFormula, ?Tail) is det
Translate a formula using the forall() notation above into a formula between data-sources. Some examples:
  207ds_formula(f(S,X,Y,F), [cell(S,X,Y) = F|FL], FL) :- !.
  208ds_formula(forall(_, _ in [], _), FL, FL) :- !.
  209					% rows
  210ds_formula(forall(row, Y in [Ya-Yz|T], P),
  211	   [cell_range(S,X,Ya,X,Yz) = FDS|More], FL) :-
  212	P = f(S,X,Y,F),
  213	range_formula(y(Y,Ya,Yz), F, FDS), !,
  214	assertion(ground(FDS)),
  215	ds_formula(forall(row, Y in T, P), More, FL).
  216ds_formula(forall(row, Y in [Ya-Yz|T], P), FL0, FL) :- !,
  217	numlist(Ya, Yz, YL),
  218	append(YL, T, Ys),
  219	ds_formula(forall(row, Y in Ys, P), FL0, FL).
  220ds_formula(forall(row, Y in [Y0|Ys], P),
  221	   [cell(S,X,Y0) = FDS|More], FL) :- !,
  222	P = f(S,X,Y,F),
  223	range_formula(y(Y,Y0,Y0), F, FDS),
  224	assertion(ground(FDS)),
  225	ds_formula(forall(row, Y in Ys, P), More, FL).
  226					% columns
  227ds_formula(forall(col, X in [Xa-Xz|T], P),
  228	   [cell_range(S,Xa,Y,Xz,Y) = FDS|More], FL) :-
  229	P = f(S,X,Y,F),
  230	range_formula(x(X,Xa,Xz), F, FDS), !,
  231	assertion(ground(FDS)),
  232	ds_formula(forall(col, X in T, P), More, FL).
  233ds_formula(forall(col, X in [Xa-Xz|T], P), FL0, FL) :- !,
  234	numlist(Xa, Xz, XL),
  235	append(XL, T, Xs),
  236	ds_formula(forall(col, X in Xs, P), FL0, FL).
  237ds_formula(forall(col, X in [X0|Xs], P),
  238	   [cell(S,X0,Y) = FDS|More], FL) :- !,
  239	P = f(S,X,Y,F),
  240	range_formula(x(X,X0,X0), F, FDS),
  241	assertion(ground(FDS)),
  242	ds_formula(forall(col, X in Xs, P), More, FL).
  243					% areas
  244ds_formula(forall(area, [_ in [],_], _), FL, FL) :- !.
  245ds_formula(forall(area, [_,_ in []], _), FL, FL) :- !.
  246ds_formula(forall(area, [X in [Xa-Xz|TX], Y in [Ya-Yz|TY]], P),
  247	   [ cell_range(S,Xa,Ya,Xz,Yz) = FDS | More ], FL) :- !,
  248	P = f(S,X,Y,F),
  249	range_formula(xy(X,Xa,Xz,Y,Ya,Yz), F, FDS),
  250	assertion(ground(FDS)),
  251	ds_formula(forall(area, [X in TX, Y in [Ya-Yz|TY]], P),
  252		   More, FL0),
  253	ds_formula(forall(area, [X in [Xa-Xz|TX], Y in TY], P),
  254		   FL0, FL).
  255ds_formula(forall(area, [X in [X0|TX], Y in [Ya-Yz|TY]], P),
  256	   [ cell_range(S,X0,Ya,X0,Yz) = FDS | More ], FL) :- !,
  257	P = f(S,X,Y,F),
  258	range_formula(xy(X,X0,X0,Y,Ya,Yz), F, FDS),
  259	assertion(ground(FDS)),
  260	ds_formula(forall(area, [X in TX, Y in [Ya-Yz|TY]], P),
  261		   More, FL0),
  262	ds_formula(forall(area, [X in [X0|TX], Y in TY], P),
  263		   FL0, FL).
  264ds_formula(forall(area, [X in [Xa-Xz|TX], Y in [Y0|TY]], P),
  265	   [ cell_range(S,Xa,Y0,Xz,Y0) = FDS | More ], FL) :- !,
  266	P = f(S,X,Y,F),
  267	range_formula(xy(X,Xa,Xz,Y,Y0,Y0), F, FDS),
  268	assertion(ground(FDS)),
  269	ds_formula(forall(area, [X in TX, Y in [Y0|TY]], P),
  270		   More, FL0),
  271	ds_formula(forall(area, [X in [Xa-Xz|TX], Y in TY], P),
  272		   FL0, FL).
  273ds_formula(forall(area, [X in [X0|TX], Y in [Y0|TY]], P),
  274	   [ cell(S,X0,Y0) = FDS | More ], FL) :- !,
  275	P = f(S,X,Y,F),
  276	range_formula(xy(X,X0,X0,Y,Y0,Y0), F, FDS),
  277	assertion(ground(FDS)),
  278	ds_formula(forall(area, [X in TX, Y in [Y0|TY]], P),
  279		   More, FL0),
  280	ds_formula(forall(area, [X in [X0|TX], Y in TY], P),
  281		   FL0, FL).
  282
  283ds_formula(Formula, [Formula|FL], FL).		% TBD
 range_formula(+Spec, +F, -FDS) is semidet
  288					% y...
  289range_formula(y(Y,Ya,Ya), cell(S,X,YF), cell(S,X,Ys)) :-
  290	findall(YF, Y=Ya, [Ys]), !.
  291range_formula(y(Y,Ya,Ya), cell_range(S,Xs,YFs,Xe,YFe),
  292	                  cell_range(S,Xs,Ys,Xe,Ye)) :-
  293	findall(YFs-YFe, Y=Ya, [Ys-Ye]), !.
  294range_formula(y(Y,Ya,Yz), cell(S,X,YF), cell_range(S,X,Ys,X,Ye)) :-
  295	findall(YF, (Y=Ya; Y=Yz), [Ys,Ye]), !.
  296					% x...
  297range_formula(x(X,Xa,Xa), cell(S,XF,Y), cell(S,Xs,Y)) :-
  298	findall(XF, X=Xa, [Xs]), !.
  299range_formula(x(X,Xa,Xa), cell_range(S,XFs,Ys,XFe,Ye),
  300	                  cell_range(S,Xs,Ys,Xe,Ye)) :-
  301	findall(XFs-XFe, X=Xa, [Xs-Xe]), !.
  302range_formula(x(X,Xa,Xz), cell(S,XF,Y), cell_range(S,Xs,Y,Xe,Y)) :-
  303	findall(XF, (X=Xa; X=Xz), [Xs,Xe]), !.
  304					% xy...
  305range_formula(xy(X,Xa,Xa,Y,Ya,Ya),
  306	      cell_range(S,XFs,YFs,XFe,YFe),
  307	      cell_range(S,Xs,Ys,Xe,Ye)) :-
  308	findall(XFs-XFe, X=Xa, [Xs-Xe]),
  309	findall(YFs-YFe, Y=Ya, [Ys-Ye]), !.
  310range_formula(xy(X,Xa,Xz,Y,Ya,Yz),
  311	      cell(S,XF,YF),
  312	      cell_range(S,Xs,Ys,Xe,Ye)) :-
  313	findall(XF, (X=Xa; X=Xz), [Xs,Xe]),
  314	findall(YF, (Y=Ya; Y=Yz), [Ys,Ye]), !.
  315					% Cannot do these
  316range_formula(_, cell(_,_,_), _) :- !, fail.
  317range_formula(_, cell_range(_,_,_,_,_), _) :- !, fail.
  318					% General recursion
  319range_formula(Y, From, To) :-
  320	compound(From), !,
  321	From =.. [Name|Args0],
  322	maplist(range_formula(Y), Args0, Args),
  323	To =.. [Name|Args].
  324range_formula(_, Formula, Formula).
 generalize_formula(F0, F) is det
 generalize_formula(+S0, +X0, +Y0, +F0, -S, -X, -Y, -F) is det
F is F0, after replacing coordinates by the variables X and Y or constraints thereof. The idea is that F now unifies to other formulas that have the same structure with the same relative cell positions.
  336generalize_formula(f(S0,X0,Y0,F0), f(S,X,Y,F)) :-
  337	generalize_formula(S0, X0, Y0, F0, S, X, Y, F).
  338
  339generalize_formula(S0, X0, Y0, F0, S, X, Y, F) :-
  340	Map = map(S0-S, X0-X, Y0-Y),
  341	generalize_formula(Map, F0, F).
  342
  343skolem_formula(f(S0,X0,Y0,F0), F) :-
  344	generalize_formula(S0, X0, Y0, F0, 'S', 'X', 'Y', F).
  345
  346
  347
  348generalize_formula(Map, cell(S0,X0,Y0), cell(S,X,Y)) :- !,
  349	generalize_sheet(S0, Map, S),
  350	generalize_x(X0, Map, X),
  351	generalize_y(Y0, Map, Y).
  352generalize_formula(Map,
  353		   cell_range(S0,SX0,SY0,EX0,EY0),
  354		   cell_range(S, SX, SY, EX, EY)) :- !,
  355	generalize_sheet(S0, Map, S),
  356	generalize_x(SX0, Map, SX),
  357	generalize_y(SY0, Map, SY),
  358	generalize_x(EX0, Map, EX),
  359	generalize_y(EY0, Map, EY).
  360generalize_formula(Map, From, To) :-
  361	compound(From), !,
  362	From =.. [Name|Args0],
  363	maplist(generalize_formula(Map), Args0, Args),
  364	To =.. [Name|Args].
  365generalize_formula(_, Formula, Formula).
  366
  367
  368generalize_sheet(S0, Map, S) :-
  369	map_sheet(Map, F-T),
  370	(   S0 == F
  371	->  S = T
  372	;   S = S0
  373	).
  374generalize_x(X0, Map, X) :-
  375	map_x(Map, F-T),
  376	generalize_cordinate(X0, F-T, X).
  377generalize_y(Y0, Map, Y) :-
  378	map_y(Map, F-T),
  379	generalize_cordinate(Y0, F-T, Y).
  380
  381generalize_cordinate(X0, F-T, X) :-
  382	(   X0 == F
  383	->  X = T
  384	;   atom(T)
  385	->  X = T
  386	;   integer(X0)
  387	->  Dif is X0-F,
  388	    (	Dif > 0
  389	    ->	X #= T+Dif	    ;	MinDif is -Dif,		X #= T-MinDif	    )	;   X = X0	).
 simplify_formula(+FormulaIn, -FormulaOut) is det
Replace single-cell ranges with a cell.
  400simplify_formula(Var, Var) :-
  401	var(Var), !.
  402simplify_formula(cell_range(S,X,Y,X,Y), cell(S,X,Y)) :- !.
  403simplify_formula(F0, F) :-
  404	compound(F0), !,
  405	F0 =.. [Name|Args0],
  406	maplist(simplify_formula, Args0, Args),
  407	F =.. [Name|Args].
  408simplify_formula(F, F).
 sheet_dependency_graph(:Sheet, -UGraph) is det
Create a UGraph that represents the dependencies between cells. Nodes in the cells are terms cell(S,X,Y).
  416sheet_dependency_graph(Sheet, Graph) :-
  417	findall(Cell-Dep, cell_dependency(Sheet, Cell, Dep), Graph0),
  418	sort(Graph0, Graph1),
  419					% Add missing (source) nodes
  420	pairs_keys_values(Graph1, Left, RightSets),
  421	append(RightSets, Right0),
  422	sort(Right0, Right),
  423	ord_subtract(Right, Left, Sources),
  424	maplist(pair_nil, Sources, SourceTerms),
  425	ord_union(Graph1, SourceTerms, Graph2),
  426	transpose(Graph2, Graph).
  427
  428pair_nil(X, X-[]).
  429
  430cell_dependency(Sheet, cell(Sheet,X,Y), Inputs) :-
  431	Sheet = M:_,
  432	cell_formula(Sheet, X, Y, Formula),
  433	formula_cells(Formula, M, Inputs0, []),
  434	sort(Inputs0, Inputs).
  435
  436formula_cells(cell(S,X,Y), M, [cell(M:S,X,Y)|T], T) :- !.
  437formula_cells(DataSource, M,  Cells, Rest) :-
  438	DataSource = cell_range(S,SX,SY,EX,EY), !,
  439	debug(dep, 'DataSource: ~q', [DataSource]),
  440	(   forall(ds_inside(DataSource,X,Y),
  441		   \+ cell_formula(M:S,X,Y,_))
  442	->  debug(dep, 'DataSource without formulas: ~p', [DataSource]),
  443	    Cells = [cell_range(M:S,SX,SY,EX,EY)|Rest]
  444	;   findall(cell(M:S,X,Y), ds_inside(DataSource,X,Y), Cells, Rest)
  445	).
  446formula_cells(ext(URL, DS), _M, Cells, Cells) :- !,
  447	debug(dep, 'External ref: ~p ~p', [URL, DS]).
  448formula_cells(Compound, M, Cells, Rest) :-
  449	compound(Compound), !,
  450	Compound =.. [_|Args],
  451	list_formula_cells(Args, M, Cells, Rest).
  452formula_cells(_, _, Cells, Cells).
  453
  454list_formula_cells([], _, Cells, Cells).
  455list_formula_cells([H|T], M, Cells, Rest) :-
  456	formula_cells(H, M, Cells, Rest0),
  457	list_formula_cells(T, M, Rest0, Rest).
 cell_dependency_graph(:Sheet, +X, +Y, +Direction, -Graph) is det
True when Graph is an Ugraph expressing the dependencies of StartCell. Direction is one of inputs, outputs or both.
To be done
- Implement outputs and both. Probably need to materialize the dependecies for that. We could do that while loading the spreadsheet?
  468cell_dependency_graph(Sheet, X, Y, inputs, Graph) :- !,
  469	input_graph(Sheet, X, Y, Graph).
  470cell_dependency_graph(_,_,_,Dir,_) :-
  471	must_be(oneof([inputs]), Dir).
  472
  473input_graph(Sheet, Col, Y, Graph) :-
  474	column_x(Col, X),
  475	Cell0 = cell(Sheet,X,Y),
  476	empty_assoc(V0),
  477	put_assoc(Cell0, V0, true, V1),
  478	traverse_input_graph([Cell0], V1, Edges, []),
  479	vertices_edges_to_ugraph([Cell0], Edges, Graph).
  480
  481traverse_input_graph([], _, Edges, Edges).
  482traverse_input_graph([Cell0|CellT], Visited0, Edges, ETail) :-
  483	inputs(Cell0, Inputs),
  484	edges(Inputs, Cell0, Edges, Tail0),
  485	update_visited(Inputs, Visited0, Visited1, NewInputs, CellT),
  486	traverse_input_graph(NewInputs, Visited1, Tail0, ETail).
  487
  488inputs(cell(Sheet,X,Y), Inputs) :-
  489	cell_formula(Sheet, X, Y, Formula), !,
  490	Sheet = M:_,
  491	formula_cells(Formula, M, Inputs, []).
  492inputs(_, []).
  493
  494edges([], _, Edges, Edges).
  495edges([H|T], V0, [H-V0|Edges], ET) :-
  496	edges(T, V0, Edges, ET).
  497
  498update_visited([], Visited, Visited, Inputs, Inputs).
  499update_visited([H|T], Visited0, Visited, Inputs0, Inputs) :-
  500	get_assoc(H, Visited0, _), !,
  501	update_visited(T, Visited0, Visited, Inputs0, Inputs).
  502update_visited([H|T], Visited0, Visited, [H|Inputs1], Inputs) :-
  503	put_assoc(H, Visited0, true, Visited1),
  504	update_visited(T, Visited1, Visited, Inputs1, Inputs).
  505
  506
  507column_x(Col, X) :-
  508	atom(Col), !,
  509	upcase_atom(Col, COL),
  510	column_name(X, COL).
  511column_x(Col, X) :-
  512	integer(Col), !,
  513	X = Col.
  514column_x(Col, _) :-
  515	type_error(column, Col)