1/* COPYRIGHT ************************************************************
    2
    3Conceptual Graph Tools (CGT) - a partial implementation of Sowa's CS Theory
    4Copyright (C) 1990 Miguel Alexandre Wermelinger
    5
    6    This program is free software; you can redistribute it and/or modify
    7    it under the terms of the GNU General Public License as published by
    8    the Free Software Foundation; either version 2 of the License, or
    9    (at your option) any later version.
   10
   11    This program is distributed in the hope that it will be useful,
   12    but WITHOUT ANY WARRANTY; without even the implied warranty of
   13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14    GNU General Public License for more details.
   15
   16    You should have received a copy of the GNU General Public License
   17    along with this program; if not, write to the Free Software
   18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   19
   20************************************************************************/
   21
   22/* AUTHOR(S) ************************************************************
   23
   24Michel Wermelinger
   25Dept. de Informatica, Univ. Nova de Lisboa, Quinta da Torre
   26P - 2825 Monte da Caparica, PORTUGAL
   27Phone: (+351) (1) 295 44 64 ext. 1360  Internet: mw@fct.unl.pt
   28
   29************************************************************************/
   30
   31/* GENERALITIES *********************************************************
   32 
   33File Name	: MISC.PL
   34Creation Date	: 90/06/16 	By: mw
   35Abbreviations	: mw - Michel Wermelinger
   36Description	: Implements miscellaneous operations on conceptual graphs
   37 
   38************************************************************************/
   39
   40/* HISTORY **************************************************************
   41
   420.0	90/06/23  mw	show_obj/1, _id predicates
   430.1	90/08/23  mw	mark-&-sweep memory management
   44			error handling predicates
   450.2	90/09/09  mw	added quantity, name and measure expansion/contraction
   46			debugged mark-&-sweep predicates
   470.3	90/10/19  mw	added delete_concepts/1
   480.4	90/10/23  mw	added cg_warning/1, new_type/3 and _db predicates
   490.5	90/10/29  mw	improved mark-&-sweep predicates
   500.6	90/11/04  mw	generalized delete_concepts/1 to shallow_delete/1
   51			added sweep_all/0; debugged sweep/0
   520.7	90/11/05  mw	show_obj/1 now deterministic; added take_crl/2
   530.71	90/11/07  mw	put_crl/2 deterministic
   540.72	90/11/08  mw	referent/2 deterministic
   55			changed direct calls to c/3
   560.8	90/12/05  mw    changed some predicates to work with CGE
   57			( heads of contraction preedicates )
   580.81	90/12/06  mw    added same_context/2
   590.9	90/12/10  mw    added description file to save_db and load_db
   601.0	90/12/13  mw    added notion of current database
   611.1	91/05/02  mw	free_id/1 takes into account that an object may have 
   62			been marked in a mark level superior to the current one;
   63			sweep/0 now also deletes the level mark
   641.2	91/05/14  mw	free_id/1 now ignores at what level an object was marked
   651.21	92/04/23  mw	added comments
   661.22	92/05/05  mw	augmented copyright notice; 
   67			'lexicon' isn't reconsulted by start_cgp/1 anymore
   68
   69************************************************************************/
   70 
   71/* CONTENTS *************************************************************
   72
   73start_cgp/1		start processing conceptual graphs
   74end_cgp/1		stop processing conceptual graphs
   75clear_db/0		clears current database
   76current_db/1		returns current database name
   77load_db/1		loads a graph database
   78save_db/1		saves current database
   79
   80mark/0			starts a new level to mark objects created henceforth
   81unmark/0		unmarks all objects created in current level
   82sweep/0			deletes all object marked in current level
   83new_id/1		returns a new unique identifier for the created object
   84free_id/1		makes an identifier available again
   85shallow_delete/1	deletes an object but not its sub-components
   86delete_obj/1		deletes an object (graph, abstraction or concept)
   87
   88number2var/2		given N returns Nth variable (a, b, ..., z, aa, ab, ...)
   89dir_reference/2		makes relations refer directly to attached concepts
   90ind_reference/4		makes relations refer indirectly to attached concepts
   91new_type/3		creates a new concept or relation type
   92
   93referent/2		returns referent of given concept (Assumption 3.3.1)
   94basic_ref/2		returns referent of given concept without coref. links
   95change_ref/2		changes a referent or coreference link
   96put_crl/2		creates a coreference link between two given concepts
   97take_crl/2		removes coreference link between two given concepts
   98
   99meas_expansion/2	measure expansion
  100meas_contraction/2	measure contraction
  101qty_expansion/2		quantity expansion
  102qty_contraction/2	quantity contraction
  103name_expansion/2	name expansion
  104name_contraction/2	name contraction
  105del_univ_quant/5	universal quantifier expansion
  106
  107which_graph/3		returns graph containing a given concept
  108which_context/2		returns deepest context containing given graph
  109same_context/2		succeeds if given graphs are all in the same context
  110
  111check_graph/1		checks if given graph is well defined
  112
  113cg_error/2		outputs an error message
  114
  115************************************************************************/
  116
  117/************************************************************************
  118
  119		D A T A B A S E   O P E R A T I O N S 
  120
  121************************************************************************/
  122 
  123/* start_cgp/1 **********************************************************
  124
  125Usage		: start_cgp(+Canon)
  126Argument(s)	: 	     atom
  127Description	: starts a session loading the database from Canon
  128Notes		: 
  129
  130************************************************************************/
  131
  132start_cgp(Canon) :-
  133    clear_db, load_id, load_db(Canon), nl, nl,
  134    write('Conceptual Graph Tools (CGT) version 1.0'), nl,
  135    write('Copyright (C) 1990 Miguel Alexandre Wermelinger'), nl, nl,
  136    write('CGT comes with ABSOLUTELY NO WARRANTY.'), nl,
  137    write('This is free software, and you are welcome to redestribute it'),
  138    nl, 
  139    write('according to the GNU General Public License (version 2 or later);'),
  140    nl,
  141    write('see the acompanying file "COPYING".'), nl, nl,
  142    write('If you have not received it, contact the Free Software'), nl,
  143    write('Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA'), nl, 
  144    write('or'), nl,
  145    write('Michel Wermelinger, Dep. de Informatica, Univ. Nova de Lisboa,'),
  146    nl,
  147    write('Quinta da Torre, 2825 Monte da Caparica, PORTUGAL'), nl,
  148    write('E-mail: mw@fct.unl.pt'), nl, nl.
  149
  150
  151/* end_cgp/1 ************************************************************
  152
  153Usage		: end_cgp(+Canon)
  154Argument(s)	: 	    atom
  155Description	: ends the session saving the current database to Canon
  156Notes		: 
  157
  158************************************************************************/
  159
  160end_cgp(Canon) :-
  161	save_id, save_db(Canon), clear_db.
  162	
  163/* clear_db/0 ***********************************************************
  164
  165Usage		: clear_db
  166Argument(s)	: 
  167Description	: clears the current database
  168Notes		: succeeds always
  169
  170************************************************************************/
  171
  172clear_db :-
  173	abolish(g/3), abolish(c/3), abolish(p/4), abolish(l/3), sweep_all,
  174	member(Key, [c,g,p,l]), recorded(Key, _, Ref), erase(Ref), fail.
  175clear_db.
  176
  177/* current_db/1 *********************************************************
  178
  179Usage		: current_db(-Canon)
  180Argument(s)	: 	      atom
  181Description	: returns the name of the current database
  182Notes		: 
  183
  184************************************************************************/
  185
  186current_db(Canon) :-
  187        recorded(get_current_db, Canon, _).
  188
  189/* load_db/1 ************************************************************
  190
  191Usage		: load_db(+Canon)
  192Argument(s)	: 	    atom
  193Description	: loads the current database from the given Canon
  194Notes		: 
  195
  196************************************************************************/
  197
  198
  199load_db_dir(Canon,CanonFull):- 
  200  absolute_file_name(library(cgt/Canon),File,[extensions([gr]),access(read)]),
  201  atom_concat(CanonFull,'.gr',File),!.
  202load_db(Canon0) :-
  203        load_db_dir(Canon0,Canon),
  204	name(Canon, L),
  205	name('.gr',  E1), conc(L, E1, L1), name(File1, L1), reconsult(File1),
  206	name('.hrc', E2), conc(L, E2, L2), name(File2, L2), reconsult(File2),
  207	name('.rty', E3), conc(L, E3, L3), name(File3, L3), reconsult(File3),
  208	name('.cty', E4), conc(L, E4, L4), name(File4, L4), reconsult(File4),
  209	name('.dsc', E5), conc(L, E5, L5), name(File5, L5), reconsult(File5),
  210        ( recorded(get_current_db, _, Ref), erase(Ref) ; true ),
  211        recorda(get_current_db, Canon, _).
  212
  213% the following clause is to be used iff CGE is available
  214load_db(Canon) :-
  215        acknowledge([Canon, ' is not a valid GET database!']), !, fail.
  216
  217/* the following clause is to be used iff CGE isn't available
  218load_db(Canon) :-
  219        nl, write(Canon), write(' is not a valid GET database!'), nl, !, fail.
  220*/
  221
  222/* save_db/1 ************************************************************
  223
  224Usage		: save_db(+Canon)
  225Argument(s)	: 	    atom
  226Description	: saves the current database to the given Canon
  227Notes		: 
  228
  229************************************************************************/
  230
  231save_db(Canon) :- 
  232	telling(Old), told, 
  233	save_gr(Canon), save_cty(Canon), save_rty(Canon), 
  234        save_hrc(Canon), save_dsc(Canon),
  235	tell(Old), save_id, recorded(get_current_db, OldDb, Ref),
  236        ( OldDb = Canon
  237	; erase(Ref), recorda(get_current_db, Canon, _)
  238	).
  239
  240/* save_gr/1 ************************************************************
  241
  242Usage		: save_gr(+Canon)
  243Argument(s)	: 	    atom
  244Description	: saves the currently stored graphs to the given Canon
  245Notes		: 
  246
  247************************************************************************/
  248
  249save_gr(Canon) :-
  250	name(Canon, L1), name('.gr', L2), conc(L1, L2, L3), name(File, L3),
  251	tell(File), write(':- dynamic g/3, c/3, p/4, l/3.'), nl,
  252	g(ID, C, R), portray_clause( g(ID, C, R) ), fail.
  253save_gr(_) :-
  254	c(ID, T, R), portray_clause( c(ID, T, R) ), fail.
  255save_gr(_) :-
  256	p(ID, T, R, E), portray_clause( p(ID, T, R, E) ), fail.
  257save_gr(_) :-
  258	l(ID, C, G), portray_clause( l(ID, C, G) ), fail.
  259save_gr(_) :- told.
  260
  261/* save_cty/1 ***********************************************************
  262
  263Usage		: save_cty(+Canon)
  264Argument(s)	: 	    atom
  265Description	: saves the current concept types to the given Canon
  266Notes		: 
  267
  268************************************************************************/
  269
  270save_cty(Canon) :-
  271	name(Canon, L1), name('.cty', L2), conc(L1, L2, L3), name(File, L3),
  272	tell(File), write(':- dynamic concept_type/5.'), nl,
  273	concept_type(T, L, D, C, S), 
  274        portray_clause( concept_type(T, L, D, C, S) ),
  275	fail.
  276save_cty(_) :- told.
  277
  278/* save_rty/1 ***********************************************************
  279
  280Usage		: save_rty(+Canon)
  281Argument(s)	: 	    atom
  282Description	: saves the current relation types to the given Canon
  283Notes		: 
  284
  285************************************************************************/
  286
  287save_rty(Canon) :-
  288	name(Canon, L1), name('.rty', L2), conc(L1, L2, L3), name(File, L3),
  289	tell(File), write(':- dynamic relation_type/5.'), nl,
  290	relation_type(T, L, D, C, S), 
  291        portray_clause( relation_type(T, L, D, C, S) ), fail.
  292save_rty(_) :- told.
  293
  294/* save_hrc/1 ***********************************************************
  295
  296Usage		: save_hrc(+Canon)
  297Argument(s)	: 	    atom
  298Description	: saves the current type hierarchy to the given Canon
  299Notes		: 
  300
  301************************************************************************/
  302
  303save_hrc(Canon) :-
  304	name(Canon, L1), name('.hrc', L2), conc(L1, L2, L3), name(File, L3),
  305	tell(File), write(':- dynamic ''<<''/2.'), nl,
  306	X << Y, portray_clause( X << Y), fail.
  307save_hrc(_) :- told.
  308
  309/* save_dsc/1 ***********************************************************
  310
  311Usage		: save_dsc(+Canon)
  312Argument(s)	: 	    atom
  313Description	: saves the current descriptions to the given Canon
  314Notes		: 
  315
  316************************************************************************/
  317
  318save_dsc(Canon) :-
  319	name(Canon, L1), name('.dsc', L2), conc(L1, L2, L3), name(File, L3),
  320	tell(File), write(':- dynamic description/3.'), nl,
  321	description(Kind, Obj, Desc), 
  322        portray_clause( description(Kind, Obj, Desc) ),
  323        fail.
  324save_dsc(_) :- told.
  325
  326/************************************************************************
  327
  328		   M E M O R Y   M A N A G E M E N T
  329
  330************************************************************************/
  331 
  332/* mark/0 ***************************************************************
  333
  334Usage		: mark
  335Argument(s)	: 
  336Description	: starts a new mark level
  337Notes		: all objects created after this will be automatically marked
  338
  339************************************************************************/
  340
  341mark :- recorded(mark_level, N, _), succ(N, M), recorda(mark_level, M, _), !.
  342mark :- recorda(mark_level, 0, _).
  343
  344/* unmark/0 *************************************************************
  345
  346Usage		: unmark
  347Argument(s)	: 
  348Description	: unmarks all objects marked at the current mark level
  349Notes		: 
  350
  351************************************************************************/
  352
  353unmark :- 
  354	recorded(mark_level, N, Ref), 
  355	( recorded(cg_mark, _ID-N, R), erase(R), fail
  356	; erase(Ref)
  357	), !.
  358
  359/* sweep/0 **************************************************************
  360
  361Usage		: sweep
  362Argument(s)	: 
  363Description	: deletes all objects marked at the current mark level
  364Notes		: 
  365
  366************************************************************************/
  367
  368sweep :-
  369	recorded(mark_level, N, Ref),
  370	( recorded(cg_mark, ID-N, DbRef), erase(DbRef), 
  371	  ( delete_obj(ID) ; delete_obj(ID-_) ), fail
  372	; erase(Ref)
  373	), !.
  374sweep.
  375
  376/* sweep_all/0 **********************************************************
  377
  378Usage		: sweep_all
  379Argument(s)	: 
  380Description	: deletes all objects currently marked
  381Notes		: 
  382
  383************************************************************************/
  384
  385sweep_all :-
  386	recorded(mark_level, _, _), sweep, fail.
  387sweep_all.
  388
  389/* new_id/1 *************************************************************
  390
  391Usage		: new_id(?Identifier)
  392Argument(s)	: 	      ID
  393Description	: returns a new unique Identifier 
  394Notes		: the kind of identifier (concept, context, graph, or 
  395			abstraction) must be indicated
  396
  397************************************************************************/
  398
  399new_id(Key/Id) :-
  400	recorded(Key, Id, Ref), erase(Ref),
  401	( recorded(mark_level, N, _), recorda(cg_mark, Key/Id-N, _)
  402	; true
  403	),
  404	( recorded(Key, _, _)
  405	; succ(Id, NewId), recorda(Key, NewId, _)
  406	), !.
  407
  408/* free_id/1 ************************************************************
  409
  410Usage		: free_id(+Identifier)
  411Argument(s)	: 	      ID
  412Description	: makes Identifier available for reuse by a new concept,
  413			graph, or lambda abstraction
  414Notes		: 
  415
  416************************************************************************/
  417
  418free_id(Key/Id) :-
  419	% recorded(mark_level, N, _), % !, 
  420	recorded(cg_mark, Key/Id- _N, Ref), erase(Ref),
  421	recorda(Key, Id, _), !.
  422free_id(Key/Id) :-
  423	recorda(Key, Id, _).
  424
  425/* load_id/0 ************************************************************
  426
  427Usage		: load_id
  428Argument(s)	: 
  429Description	: loads identifiers from a file
  430Notes		: 
  431
  432************************************************************************/
  433
  434cgp_id_dat(File):- absolute_file_name(library('cgt/cgp_id.dat'), File,[access(read)]).
  435
  436load_id :-
  437        cgp_id_dat(File),
  438	seeing(Old), seen, see(File),
  439	repeat, read(T), 
  440	( T = end_of_file
  441	; T = id(Key, Id), recordz(Key, Id, _), fail
  442	),
  443	seen, seeing(Old).
  444load_id :-
  445        cgp_id_dat(File),
  446	format('File ~w is misssing!~n',[File]),  abort.
  447
  448/* save_id/0 ************************************************************
  449
  450Usage		: save_id
  451Argument(s)	: 
  452Description	: saves current state of used identifiers to a file
  453Notes		: succeeds always
  454
  455************************************************************************/
  456
  457save_id :-
  458        cgp_id_dat(File),
  459	telling(Old), told, tell(File),
  460	( member(Key, [c,g,p,l]), recorded(Key, Id, _Ref),% erase(Ref), 
  461	  write(id(Key, Id)), write('.'), nl, fail
  462	; told, tell(Old)
  463	).
  464
  465/* shallow_delete/1 *****************************************************
  466
  467Usage		: shallow_delete(+Object)
  468Argument(s)	: 	     ID/list
  469Description	: deletes non-recursively the Object
  470Notes		: succeeds always; Object may be a list of IDs
  471
  472************************************************************************/
  473
  474shallow_delete([ID|List]) :-
  475	shallow_delete(ID), shallow_delete(List).
  476shallow_delete(g/Id) :-
  477	retract( g(g/Id, _, _) ), free_id(g/Id).
  478shallow_delete(c/Id-_) :-
  479	retract( c(c/Id, _, _) ), free_id(c/Id).
  480shallow_delete(p/Id-_) :-
  481	retract( p(p/Id, _, _, _) ), free_id(p/Id).
  482shallow_delete(l/Id) :-
  483	retract( l(l/Id, _, _) ), free_id(l/Id).
  484shallow_delete(_).
  485
  486/* delete_obj/1 *********************************************************
  487
  488Usage		: delete_obj(+Object)
  489Argument(s)	: 	     ID/list
  490Description	: deletes the Object and recursively all its components
  491Notes		: succeeds always; Object may be a list of IDs
  492
  493************************************************************************/
  494
  495delete_obj([ID|List]) :-
  496	delete_obj(ID), delete_obj(List), !.
  497delete_obj(g/Id) :-
  498	retract( g(g/Id, CL, _) ), free_id(g/Id), delete_obj(CL), !.
  499delete_obj(p/Id-_) :-
  500	retract( p(p/Id, Type, Ref, _) ), 
  501	free_id(p/Id), delete_obj(Type),
  502	basic_ref(Ref, GIDs), delete_obj(GIDs), !.
  503delete_obj(c/Id-_) :-
  504	retract( c(c/Id, Type, _) ), free_id(c/Id), delete_obj(Type), !.
  505delete_obj(l/Id) :-
  506	retract( l(l/Id, _, GIDs) ), free_id(l/Id), delete_obj(GIDs), !.
  507delete_obj(_) :- !.
  508
  509/************************************************************************
  510
  511			M I S C E L A N N E O U S
  512
  513************************************************************************/
  514
  515/* show_obj/1 ***********************************************************
  516
  517Usage		: show_obj(+Object)
  518Argument(s)	: 	   ID/list
  519Description	: displays the data structures representing the Object
  520Notes		: succeeds always; Object may be a list of IDs
  521		  this predicate is only for debugging purposes
  522
  523************************************************************************/
  524
  525:- style_check(-singleton).  526
  527getable_objects(g/Id) :- g(g/Id, CL, RL).
  528getable_objects(p/Id-_) :- p(p/Id, Type, Ref, Env).
  529getable_objects(c/Id-_) :- type(c/Id, Type) ; referent(c/Id, Ref).
  530getable_objects(l/Id) :- l(l/Id, CL, GIDs).
  531getable_objects(Rel) :- relation_type(Rel, Label, Def, Can, Arcs).
  532getable_objects(Type) :- concept_type(Type, Label, Def, Can, SL).
  533
  534
  535
  536show_obj(Var):-var(Var),!,getable_objects(Var),nonvar(Var),show_obj(Var).
  537show_obj([ID|List]) :- 
  538	show_obj(ID), show_obj(List), !.
  539show_obj(g/Id) :-
  540	g(g/Id, CL, RL), write( g(g/Id, CL, RL) ), nl, show_obj(CL), !.
  541show_obj(p/Id-_) :-
  542	p(p/Id, Type, Ref, Env), write( p(p/Id, Type, Ref, Env) ), nl,
  543	( Type = l/Id -> show_obj(Type) ; true ),
  544	basic_ref(Ref, GIDs), show_obj(GIDs), !.
  545show_obj(c/Id-_) :-
  546	type(c/Id, Type), referent(c/Id, Ref),
  547	write( c(c/Id, Type, Ref) ), nl, 
  548	( Type = l/_ -> show_obj(Type) ; true ), !.
  549show_obj(l/Id) :-
  550	l(l/Id, CL, GIDs), write( l(l/Id, CL, GIDs) ), nl, show_obj(GIDs), !.
  551show_obj(Rel) :-
  552	relation_type(Rel, Label, Def, Can, Arcs),
  553	write( relation_type(Rel, Label, Def, Can, Arcs) ), nl,
  554	show_obj(Def), show_obj(Can), !.
  555show_obj(Type) :-
  556	concept_type(Type, Label, Def, Can, SL),
  557	write( concept_type(Type, Label, Def, Can, SL) ), nl,
  558	show_obj(Def), show_obj(Can), show_obj(SL), !.
  559show_obj(_).
  560
  561
  562/* number2var/2 *********************************************************
  563
  564Usage		: number2var(+Number, ?Variable)
  565Argument(s)	: 	     integer	 atom
  566Description	: Variable is the atom corresponding to Number according
  567			the following sequence: 0 - a, 1 - b, ..., 26 - aa, ...
  568Notes		: 
  569
  570************************************************************************/
  571
  572number2var(X, V) :-
  573	n2v(X, L1), reverse(L1, L2), name(V, L2).
  574
  575n2v(-1, []).
  576n2v(0, [97]).
  577n2v(X, [Y|L]) :-
  578	Y is X mod 26 + 97, Z is X // 26 - 1, n2v(Z, L).
  579
  580/* dir_reference/2 ******************************************************
  581
  582Usage		: dir_reference(+Concepts, +Relations)
  583Argument(s)	: lists
  584Description	: each variable in Relations is substitued with the CID it
  585		  stands for (direct reference)
  586Notes		: 
  587
  588************************************************************************/
  589
  590dir_reference([CID-CID|T], RL) :- 
  591	dir_reference(T, RL).
  592dir_reference([], _).
  593
  594/* ind_reference/4 ******************************************************
  595
  596Usage		: ind_reference(+OldRel, -NewRel, +OldConcepts, -NewConcepts)
  597Argument(s)	: lists
  598Description	: each argument in OldRel is substitued with the 
  599		  corresponding variable (indirect reference)
  600Notes		: OldConcepts is the list of CID-Var pairs already known
  601
  602************************************************************************/
  603
  604ind_reference([Rel|T1], [NewRel|T2], CL, NewCL) :-
  605	Rel =.. [Type|Args], args_reference(Args, NewArgs, CL, TmpCL),
  606	NewRel =.. [Type|NewArgs], ind_reference(T1, T2, TmpCL, NewCL).
  607ind_reference([], [], CL, CL).
  608	
  609/* args_reference/4 *****************************************************
  610
  611Usage		: args_reference(+Args, -NewArgs, +OldConcepts, -NewConcepts)
  612Argument(s)	: lists
  613Description	: Args, a list of CIDs, is translated into a list of the
  614		  corresponding variables
  615Notes		: OldConcepts is the list of CID-Var pairs already known
  616
  617************************************************************************/
  618
  619args_reference([ID|T1], [Var|T2], CL, NewCL) :-
  620	member(ID-Var, CL), args_reference(T1, T2, CL, NewCL).
  621args_reference([ID|T1], [Var|T2], CL, NewCL) :-
  622	args_reference(T1, T2, [ID-Var|CL], NewCL).
  623args_reference([], [], CL, CL).
  624
  625/* new_type/3 ***********************************************************
  626
  627Usage		: new_type(+Type, +Label, +Supertypes_or_NumberOfArgs)
  628Argument(s)	: 	    atom   atom            list/number
  629Description	: adds Type and the corresponding Label to the database
  630Notes		: if Type is to be a concept type then the third argument
  631			must be a (possibly empty) list of its immediate
  632			supertypes (excluding T)
  633		  if Type is to be a relation type, then the third argument
  634			must be an integer (greater then 0) stating the
  635			relation's arity
  636		  it is not checked whether Type already exists
  637
  638************************************************************************/
  639
  640new_type(Type, Label, []) :-
  641	assert( concept_type(Type, Label, none, none, []) ).
  642new_type(Type, Label, [SuperLabel|T]) :-
  643	concept_type(SuperType, SuperLabel, _, _, _),
  644	assert( Type << SuperType ), new_type(Type, Label, T).
  645
  646new_type(Type, Label, Args) :-
  647	assert( relation_type(Type, Label, none, none, Args) ).
  648
  649/************************************************************************
  650
  651		R E F E R E N T   O P E R A T I O N S
  652
  653************************************************************************/
  654
  655/* referent/2 ***********************************************************
  656
  657Usage		: referent(+Concept, ?Referent)
  658Argument(s)	: 	    CID/PID	term
  659Description	: succeeds iff Referent is the referent of Concept
  660Notes		: 
  661
  662************************************************************************/
  663
  664referent(p/Id, Ref) :-
  665	p(p/Id, _, Ref, _), !.
  666referent(c/Id, Ref) :-
  667	c(c/Id, _, Ref), !.
  668
  669/* basic_ref/2 **********************************************************
  670
  671Usage		: basic_ref(+Referent, ?Basic)
  672Argument(s)	: terms 
  673Description	: succeeds iff Basic is the basic part of Referent
  674Notes		: Basic is just Referent with the coreference links 
  675			stripped off 
  676
  677************************************************************************/
  678
  679basic_ref(A = _CRL, C) :- basic_ref(A, C).
  680basic_ref(A, A).
  681
  682/* change_ref/4 *********************************************************
  683
  684Usage		: change_ref(+OldPart, +OldRef, +NewPart, -NewRef)
  685Argument(s)	: terms 
  686Description	: the part of OldRef which matches OldPart is changed to NewPart
  687Notes		: NewRef is the resulting referent
  688
  689************************************************************************/
  690
  691change_ref(OldCRL, Ref = OldCRL, none, Ref) :- !.
  692change_ref(OldCRL, Ref = OldCRL, NewCRL, Ref = NewCRL).
  693change_ref(Old, OldRef = CRL, New, NewRef = CRL) :-
  694	change_ref(Old, OldRef, New, NewRef).
  695change_ref(OldRef, OldRef, NewRef, NewRef).
  696
  697/* put_crl/2 ************************************************************
  698
  699Usage		: put_crl(+Concept1, +Concept2)
  700Argument(s)	: 	      ID	 ID
  701Description	: links the two concepts with a coreference link
  702Notes		: 
  703
  704************************************************************************/
  705
  706put_crl(ID1, ID2) :-
  707	retract( c(ID1, Type1, Ref1) ), assert( c(ID1, Type1, Ref1 = ID2) ),
  708	retract( c(ID2, Type2, Ref2) ), assert( c(ID2, Type2, Ref2 = ID1) ), !.
  709put_crl(ID1, ID2) :-
  710	retract( p(ID1, Type1, Ref1, Env1) ), 
  711	assert( p(ID1, Type1, Ref1 = ID2, Env1) ),
  712	retract( p(ID2, Type2, Ref2, Env2) ), 
  713	assert( p(ID2, Type2, Ref2 = ID1, Env2) ), !.
  714
  715/* take_crl/2 ***********************************************************
  716
  717Usage		: take_crl(+Concept1, +Concept2)
  718Argument(s)	: 	      ID	 ID
  719Description	: removes the coreference link between the two concepts
  720Notes		: 
  721
  722************************************************************************/
  723
  724take_crl(ID1, ID2) :-
  725	retract( c(ID1, Type1, OldRef1) ),
  726	change_ref(ID2, OldRef1, none, NewRef1),
  727	assert( c(ID1, Type1, NewRef1) ),
  728	retract( c(ID2, Type2, OldRef2) ),
  729	change_ref(ID1, OldRef2, none, NewRef2),
  730	assert( c(ID2, Type2, NewRef2) ), !.
  731take_crl(ID1, ID2) :-
  732	retract( p(ID1, Type1, OldRef1, Env1) ),
  733	change_ref(ID2, OldRef1, none, NewRef1),
  734	assert( p(ID1, Type1, NewRef1, Env1) ),
  735	retract( p(ID2, Type2, OldRef2, Env2) ),
  736	change_ref(ID1, OldRef2, none, NewRef2),
  737	assert( p(ID2, Type2, NewRef2, Env2) ), !.
  738
  739/* meas_expansion/2 *****************************************************
  740
  741Usage		: meas_expansion(+Concept, +Graph)
  742Argument(s)	: 	     	    ID	     GID
  743Description	: expands the Concept of Graph according to measure expansion
  744Notes		: this predicate assumes the referent of Concept is a measure
  745
  746************************************************************************/
  747
  748meas_expansion(CID, GID) :-
  749	retract( c(CID, Type, Ref) ), change_ref(meas(M), Ref, '*', NewRef),
  750	assert( c(CID, Type, NewRef) ),
  751	new_id(c/Id), assert( c(c/Id, measure, name(M)) ),
  752	retract( g(GID, CL, RL) ), member(CID-X, CL),
  753	assert( g(GID, [c/Id-Y|CL], [meas(X, Y)|RL]) ).
  754
  755/* meas_contraction/2 ***************************************************
  756
  757Usage		: meas_contraction(+Relation, +Graph)
  758Argument(s)	: 	     	      term      GID
  759Description	: tries to contract the measure Relation of Graph
  760Notes		: this predicate fails iff
  761			a) the concept with the dimension is not generic
  762		     or	b) the concept with the measure is coreferenced
  763		     or c) the concept with the measure is generic	
  764
  765************************************************************************/
  766
  767meas_contraction(meas(ID1, ID2), GID) :-
  768	g(GID, CL, RL), dir_reference(CL, RL), member(meas(ID1, ID2), RL), !,
  769	referent(ID2, name(M)), referent(ID1, Ref), %c(ID1, _, Ref), 
  770	change_ref('*', Ref, name(M), NewRef), 
  771	retract( c(ID1, Type, _) ), assert( c(ID1, Type, NewRef) ),
  772	join_on(GID, GID, [ID1-Var], [ID2-Var]),
  773	retract( g(GID, NewCL, NewRL) ), delete_one(meas(_, _), NewRL, RL2),
  774	assert( g(GID, NewCL, RL2) ).
  775
  776/* qty_expansion/2 ******************************************************
  777
  778Usage		: qty_expansion(+Concept, +Graph)
  779Argument(s)	: 	     	   ID	    GID
  780Description	: expands the Concept of Graph according to quantity expansion
  781Notes		: this predicate assumes the referent of Concept is a set
  782			with known cardinality
  783
  784************************************************************************/
  785
  786qty_expansion(CID, GID) :-
  787	retract( c(CID, Type, Ref) ), 
  788	change_ref(set(Kind, Set, Card), Ref, set(Kind, Set, _), NewRef),
  789	assert( c(CID, Type, NewRef) ),
  790	new_id(c/Id), assert( c(c/Id, number, name(Card)) ),
  791	retract( g(GID, CL, RL) ), member(CID-X, CL),
  792	assert( g(GID, [c/Id-Y|CL], [qty(X, Y)|RL]) ).
  793
  794/* qty_contraction/2 ****************************************************
  795
  796Usage		: qty_contraction(+Relation, +Graph)
  797Argument(s)	: 	     	     term      GID
  798Description	: tries to contract the quantity Relation of Graph
  799Notes		: this predicate fails iff there is a qty/2 relation but
  800			a) the concept with the set has known cardinality
  801		     or	b) the referent of the number concept isn't an integer
  802		     or c) the number concept is coreferenced
  803	
  804************************************************************************/
  805
  806qty_contraction(qty(ID1, ID2), GID) :-
  807	g(GID, CL, RL), dir_reference(CL, RL), member(qty(ID1, ID2), RL), !,
  808	referent(ID2, name(Number)), integer(Number), referent(ID1, Ref),
  809	change_ref(set(Kind, Set, Card), Ref, set(Kind, Set, Number), NewRef),
  810	var(Card), retract( c(ID1, Type, _) ), assert( c(ID1, Type, NewRef) ),
  811	join_on(GID, GID, [ID1-Var], [ID2-Var]),
  812	retract( g(GID, NewCL, NewRL) ), delete_one(qty(_, _), NewRL, RL2),
  813	assert( g(GID, NewCL, RL2) ).
  814
  815/* name_expansion/2 *****************************************************
  816
  817Usage		: name_expansion(+Concept, +Graph)
  818Argument(s)	: 	     	    ID	     GID
  819Description	: expands the Concept of Graph according to name expansion
  820Notes		: this predicate assumes the referent of Concept is a name
  821
  822************************************************************************/
  823
  824name_expansion(CID, GID) :-
  825	retract( c(CID, Type, Ref) ), change_ref(name(N), Ref, '*', NewRef), 
  826	assert( c(CID, Type, NewRef) ),
  827	new_id(c/Id), assert( c(c/Id, N, '*') ),
  828	retract( g(GID, CL, RL) ), member(CID-X, CL),
  829	assert( g(GID, [c/Id-Y|CL], [name(X, Y)|RL]) ).
  830
  831/* name_contraction/2 ***************************************************
  832
  833Usage		: name_contraction(+Relation, +Graph)
  834Argument(s)	: 	     	      term      GID
  835Description	: tries to contract the name Relation of Graph
  836Notes		: this predicate fails iff
  837			a) the concept to be named is not generic
  838		     or	b) the concept with the name is coreferenced
  839		     or c) the concept with the name is not generic	
  840
  841************************************************************************/
  842
  843name_contraction(name(ID1, ID2), GID) :-
  844	g(GID, CL, RL), dir_reference(CL, RL), member(name(ID1, ID2), RL), !,
  845	type(ID2, Name), referent(ID2, '*'), referent(ID1, Ref),
  846	change_ref('*', Ref, name(Name), NewRef),
  847	retract( c(ID1, Type, _) ), assert( c(ID1, Type, NewRef) ),
  848	join_on(GID, GID, [ID1-Var], [ID2-Var]),
  849	retract( g(GID, NewCL, NewRL) ), delete_one(name(_, _), NewRL, RL2),
  850	assert( g(GID, NewCL, RL2) ).
  851
  852/* del_univ_quant/5 *****************************************************
  853
  854Usage		: del_univ_quant(+Con, +Graph, -NewCon, -NewGraph, -DoubleNeg)
  855Argument(s)	: 	   	  ID	 GID	  ID	   GID	       GID
  856Description	: deletes the universal quantifier of Con(cept) in Graph
  857Notes		: NewCon in NewGraph is the Con(cept)'s coreferenced copy
  858		  DoubleNeg is the double negation created during the process
  859
  860************************************************************************/
  861
  862del_univ_quant(ID, GID, NewID, NewGraph, NewGID) :- 
  863	( retract( c(ID, Type, Ref) ) ; retract( p(ID, Type, Ref, Env) ) ),
  864	change_ref(every, Ref, '*', NewRef),
  865	( ID = c/_ -> assert( c(ID, Type, NewRef) ) 
  866		    ; assert( p(ID, Type, NewRef, Env) )
  867	),
  868	which_context(GID, PID),
  869/*	( PID = outer -> GIDs = [GID]
  870		       ; p(PID, _, Ref1, _), basic_ref(Ref1, GIDs)
  871	),
  872*/	double_negation([GID], PID, NewGID), 
  873	g(NewGID, [NewEnv-_], _),
  874	copy_concept(ID-_, NewID-_, NewEnv),
  875	new_id(g/NewGraph), assert( g(g/NewGraph, [NewID-_], []) ),
  876	retract( p(NewEnv, Type2, GIDs2, Env2) ),
  877	assert( p(NewEnv, Type2, [g/NewGraph|GIDs2], Env2) ),
  878	put_crl(ID, NewID).
  879	
  880/************************************************************************
  881
  882		    S E A R C H   O P E R A T I O N S
  883
  884************************************************************************/
  885
  886/* which_graph/3 ********************************************************
  887
  888Usage		: which_graph(+Concept, ?Possible, -Graph)
  889Argument(s)	: 	       CID/PID	   list	     GID
  890Description	: returns the Graph containing Concept
  891Notes		: Possible is the list of graphs searched for Concept
  892		  if Possible is a variable, all graphs in the database are
  893		  	searched
  894
  895************************************************************************/
  896
  897which_graph(ID, GIDList, GID) :- 
  898	member(GID, GIDList), g(GID, CL, _), member(ID-_, CL).
  899
  900/* which_context/2 ******************************************************
  901
  902Usage		: which_context(+Graph, ?Context)
  903Argument(s)	: 	   	  GID	  term
  904Description	: succeeds iff Context is the deepest context containing Graph
  905Notes		: 
  906
  907************************************************************************/
  908
  909which_context(g/Id, Env) :- 
  910	p(ID, _, Ref, _), basic_ref(Ref, GIDs), member(g/Id, GIDs), !, Env = ID.
  911which_context(g/_, outer).
  912
  913/* same_context/2 *******************************************************
  914
  915Usage		: same_context(+Graphs, ?Context)
  916Argument(s)	: 	   	 GIDs	 term
  917Description	: succeeds iff Graphs are all in the same Context
  918Notes		: 
  919
  920************************************************************************/
  921
  922same_context([GID], Env) :-
  923        !, which_context(GID, Env).
  924same_context([GID|List], Env) :-
  925        which_context(GID, p/Id), !, Env= p/Id, 
  926        referent(p/Id, Ref), basic_ref(Ref, GIDs),
  927        subset(List, GIDs), Env = p/Id.
  928same_context([_|List], outer) :-
  929        !, same_context(List, outer).
  930same_context(GID, Env) :-
  931        which_context(GID, Env).
  932
  933/************************************************************************
  934
  935		     O U T P U T   O P E R A T I O N S
  936
  937************************************************************************/
  938
  939/* cg_warning/1 *********************************************************
  940
  941Usage		: cg_warning(+Msg)
  942Argument(s)	: 	     atom
  943Description	: issues a warning message
  944Notes		: 
  945
  946************************************************************************/
  947
  948cg_warning(Msg) :-
  949	nl, write('Warning: '), write(Msg), nl.
  950
  951/* cg_error/2 ***********************************************************
  952
  953Usage		: cg_error(+Kind, +Culprit)
  954Argument(s)	: 	    atom    term
  955Description	: issues an error message and aborts execution
  956Notes		: Kind describes the nature of the error
  957		  Culprit describes the location of the error
  958
  959************************************************************************/
  960
  961% the following clause is to be used iff CGE is available
  962cg_error(Kind, Culprit) :-
  963        acknowledge(write_msg(Kind, Culprit)), sweep, get_back.
  964
  965/* the following clause is to be used iff CGE isn't available
  966cg_error(Kind, Culprit) :-
  967	nl, write_msg(Kind, Culprit), nl, sweep, abort.
  968*/
  969
  970/* write_msg/2 **********************************************************
  971
  972Usage		: write_msg(+Kind, +Culprit)
  973Argument(s)	: 	     atom    term
  974Description	: displays an error message
  975Notes		: Kind describes the nature of the error
  976		  Culprit describes the location of the error
  977
  978************************************************************************/
  979
  980write_msg(dup_type_def, Label) :-
  981        write('Type '), write(Label), write(' is already defined!').
  982write_msg(dup_rel_def, Relation) :-
  983        write('Relation '), write(Relation), write(' is already defined!').
  984write_msg(dup_type_can, Label) :-
  985        write('Type '), write(Label), write(' already has a canonical graph!').
  986write_msg(dup_rel_can, Relation) :-
  987        write('Relation '), write(Relation), 
  988        write(' already has a canonical graph!').
  989write_msg(too_many_arcs, Rel) :-
  990	write('Relation '), write_rel(Rel),
  991	write(' has too many arcs attached to it!').
  992write_msg(too_few_arcs, Rel) :-
  993	write('Relation '), write_rel(Rel),
  994	write(' has not enough arcs attached to it!').
  995write_msg(point_away, Rel) :-
  996	write('The last arc attached to '), write_rel(Rel),
  997	write(' must point away from it!').
  998write_msg(point_into, Rel) :-
  999	write('All but one arc attached to '), write_rel(Rel),
 1000	write(' must point to it!').
 1001write_msg(duplicate_arc, N-Rel) :-
 1002	write('Arc '), write(N), write(' of relation '), 
 1003	write_rel(Rel), write(' is duplicate!').
 1004write_msg(ambiguous_arc, Rel) :-
 1005	write('Relation '), write_rel(Rel),
 1006	write(' has ambiguous arcs attached to it!').
 1007write_msg(undef_param, Var) :-
 1008	write('Parameter '), write(Var), 
 1009	write(' does not denote any concept in the abstraction body!').
 1010write_msg(ambiguous_var, Var) :-
 1011	write('Variable '), write(Var), write(' denotes different concepts!').
 1012write_msg(wrong_crl, Var) :-
 1013	write('Coreference link '), write(Var), 
 1014	write(' denotes incompatible concepts!').
 1015write_msg(unknown_type, Type) :-
 1016	write('Concept type '), write(Type), write(' is not defined!').
 1017write_msg(unknown_rel, Type) :-
 1018	write('Relation type '), write(Type), write(' is not defined!').
 1019write_msg(inv_name, Name) :-
 1020	write(Name), write(' is not a valid name!').
 1021write_msg(wrong_rel_arg, Rel-N-Type) :-
 1022	write('The concept attached to arc '), write(N), 
 1023	write(' of '), write_rel(Rel), write(' must be of a subtype of '),
 1024	concept_type(Type, Label, _, _, _), write(Label), write('!').
 1025write_msg(double_def, Ref) :-
 1026	write('Referent '), reffield(Ref, L, []), apply(write(_), L),
 1027	write(' denotes a concept defined in the same graph!').
 1028write_msg(context_type, Type) :-
 1029	concept_type(Type, Label, _, _, _), write(Label), 
 1030	write(' should be a subtype of PROPOSITION!').
 1031write_msg(context_ref, Ref) :-
 1032	write('Referent '), reffield(Ref, L, []), apply(write(_), L),
 1033	write(' should be generic or a set of graphs!').
 1034write_msg(not_measure, Type) :-
 1035	concept_type(Type, Label, _, _, _), write('A concept of type '),
 1036	write(Label), write(' cannot have a measure as referent!').
 1037
 1038/* write_rel/1 **********************************************************
 1039
 1040Usage		: write_rel(+Relation)
 1041Argument(s)	: 	       term
 1042Description	: writes Relation in the form label/arity
 1043Notes		: 
 1044
 1045************************************************************************/
 1046
 1047write_rel(Rel) :-
 1048	functor(Rel, Type, NumArgs), 
 1049	relation_type(Type, Label, _, _, _), write(Label/NumArgs).
 1050
 1051/************************************************************************
 1052
 1053		C H E C K I N G   O P E R A T I O N S
 1054
 1055************************************************************************/
 1056
 1057/* check_graph/1 ********************************************************
 1058
 1059Usage		: check_graph(+Graph)
 1060Argument(s)	: 	   	GID
 1061Description	: succeeds iff Graph is well defined
 1062Notes		: 
 1063
 1064************************************************************************/
 1065
 1066check_graph(GID) :-
 1067	g(GID, CL, RL), dir_reference(CL, RL), 
 1068	apply(check_relation(_, GID), RL), apply(check_concept(_, GID), CL).
 1069
 1070/* check_relation/2 *****************************************************
 1071
 1072Usage		: check_relation(+Relation, +Graph)
 1073Argument(s)	: 	       	    term      GID
 1074Description	: succeeds iff Relation of Graph is well used
 1075Notes		: 
 1076
 1077************************************************************************/
 1078
 1079check_relation(Rel, GID) :-
 1080	functor(Rel, Type, NumArgs), relation_type(Type, _, Def, Can, NumArgs),
 1081	check_rel_def(Def, Rel, GID), check_rel_can(Can, Rel, GID).
 1082	
 1083/* check_rel_def/3 ******************************************************
 1084
 1085Usage		: check_rel_def(+Definition, +Relation, +Graph)
 1086Argument(s)	: 	       	    LID		term	  GID
 1087Description	: succeeds iff Relation of Graph is well used according
 1088		  to its Definition
 1089Notes		: Definition may be the atom 'none'
 1090
 1091************************************************************************/
 1092
 1093check_rel_def(LID, Rel, GID) :-
 1094	l(LID, CL, _), Rel =.. [_RelType|Args], 
 1095	nth_member(CID1, Args, N), type(CID1, Type1),
 1096	nth_member(CID2, CL,   N), type(CID2, Type2),
 1097	( subtype(Type1, Type2) -> fail ; 
 1098		delete_obj(GID), cg_error(wrong_rel_arg, Rel-N-Type2) 
 1099	).
 1100check_rel_def(_, _, _).
 1101
 1102/* check_rel_can/3 ******************************************************
 1103
 1104Usage		: check_rel_can(+Canonical, +Relation, +Graph)
 1105Argument(s)	: 	       	    GID	       term	 GID
 1106Description	: succeeds iff Relation of Graph is well used according
 1107		  to its Canonical graph
 1108Notes		: 
 1109
 1110************************************************************************/
 1111
 1112check_rel_can(Can, Rel1, GID) :-
 1113	g(Can, CL, RL), dir_reference(CL, RL), 
 1114	Rel1 =.. [RelType|Args1], member(Rel2, RL), Rel2 =.. [RelType|Args2],
 1115	nth_member(CID1, Args1, N), type(CID1, Type1),
 1116	nth_member(CID2, Args2, N), type(CID2, Type2),
 1117	( subtype(Type1, Type2) -> fail ; 
 1118		delete_obj(GID), cg_error(wrong_rel_arg, Rel1-N-Type2)
 1119	).
 1120check_rel_can(_, _, _).
 1121
 1122/* check_concept/2 ******************************************************
 1123
 1124Usage		: check_concept(+Concept, +Graph)
 1125Argument(s)	: 	       	   ID	    GID
 1126Description	: succeeds iff Concept (a node of Graph) is well-formed
 1127Notes		: if Concept is a context, it must be subtype of PROPOSITION
 1128			and it may not be coreferenced
 1129		  if Concept's referent is a measure then its type must 
 1130			be a dimension 
 1131
 1132************************************************************************/
 1133
 1134check_concept(p/Id-_, GID) :-
 1135	p(p/Id, Type, Ref, _), basic_ref(Ref, Ident),
 1136	( subtype(Type, proposition) 
 1137	; delete_obj(GID), cg_error(context_type, Type)
 1138	),
 1139	( Ident = [_|_] ; Ident = ('*')
 1140	; delete_obj(GID), cg_error(context_ref, Ident)
 1141	).
 1142check_concept(c/Id-_, _) :-
 1143	type(c/Id, Type), referent(c/Id, Ref), basic_ref(Ref, meas(_)),
 1144	( subtype(Type, dimension) ; cg_error(not_measure, Type) ).
 1145check_concept(c/_-_, _).
 1146
 1147%%% unused
 1148
 1149%partially_specified(set(_, Set, _)) :- delete_one('*', Set, [_|_]).