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 : GEN_LIN.PL 34Creation Date : 90/06/26 By: mw 35Abbreviations : mw - Michel Wermelinger 36Description : Generates the linear notation of a semantic net component 37Notes : the arity of the DCG predicates doesn't include the lists 38 an edge is an arc with its associated nodes 39 40************************************************************************/ 41 42/* HISTORY ************************************************************** 43 441.0 90/07/08 mw handles contexts and single-use types 451.1 90/08/23 mw handles type definitions and schemas 461.2 90/08/25 mw supports n-adic relations; lots of code simplified 471.3 90/08/29 mw supports compound graphs; more code simplified 481.4 90/10/23 mw added can_graph to gen_linear/2 491.5 90/11/26 mw write_linear/3 now stops with the empty list 501.6 90/11/27 mw added gen_header/6 51 52************************************************************************/ 53 54/* CONTENTS ************************************************************* 55 56write_linear/2 pretty prints the linear form of a graph or abstraction 57write_linear/3 does the actual pretty-printing 58gen_header/6 DCG predicate to generate the descriptive first line 59 60************************************************************************/ 61 62/* write_linear/2 ****************************************************** 63 64Usage : write_linear(+Kind, +ObjectId) 65Argument(s) : atom term 66Description : writes the linear form of a graph, type definition or schema 67Notes : the possible values for the Kind-ObjectId pair are 68 graph-GID, type_def-TypeName, rel_def-RelName, schema-LID 69 and can_graph-TypeName 70 71************************************************************************/ 72 73write_linear(Kind, Obj) :- 74 gen_linear(Kind, Obj, Linear, ['.']), 75 ( recorded(crl, _, Ref), erase(Ref), fail ; true ), 76 write_linear(0, Linear, []), !. 77 78/* gen_linear/2 ********************************************************* 79 80Usage : gen_linear(+Kind, +ObjectId) 81Argument(s) : atom term 82Description : DCG predicate to generate the linear notation 83Notes : the possible values for the Kind-ObjectId pair are 84 graph-GID, type_def-TypeName, rel_def-RelName, schema-LID 85 and can_graph-TypeName 86 87************************************************************************/ 88 89gen_linear(type_def, Type) --> 90 { concept_type(Type, Label, l/Id, _, _), l(l/Id, CIDs, GID) }, 91 gen_header(type_def, Label, CIDs, Marked, 0, TmpVar), [nl], 92 gen_graph(GID, Marked, TmpVar, _). 93gen_linear(rel_def, Type) --> 94 { relation_type(Type, Label, l/Id, _, _), l(l/Id, CIDs, GID) }, 95 gen_header(rel_def, Label, CIDs, Marked, 0, TmpVar), [nl], 96 gen_graph(GID, Marked, TmpVar, _). 97gen_linear(schema, LID) --> 98 { l(LID, [CID], GID), type(CID, Type), 99 concept_type(Type, Label, _, _, _) 100 }, 101 gen_header(schema, Label, [CID], Marked, 0, TmpVar), [nl], 102 gen_graph(GID, Marked, TmpVar, _). 103gen_linear(can_graph, Type) --> 104 { concept_type(Type, Label, _, Can, _) 105 ; relation_type(Type, Label, _, Can, _) 106 }, 107 gen_header(can_graph, Label, [], Marked, 0, TmpVar), [nl], 108 gen_graph(Can, Marked, TmpVar, _). 109gen_linear(graph, GID) --> 110 gen_graph(GID, [], 0, _). 111 112gen_header(type_def, Label, CIDs, Marked, VarIn, VarOut) --> 113 ['type ', Label, '('], 114 gen_param(CIDs, Marked, VarIn, VarOut), [') is']. 115gen_header(rel_def, Label, CIDs, Marked, VarIn, VarOut) --> 116 ['relation ', Label, '('], 117 gen_param(CIDs, Marked, VarIn, VarOut), [') is']. 118gen_header(schema, Label, CIDs, Marked, VarIn, VarOut) --> 119 ['schema for ', Label, '('], 120 gen_param(CIDs, Marked, VarIn, VarOut), [') is']. 121gen_header(can_graph, Label, _, [], VarIn, VarIn) --> 122 ['canonical graph for ', Label, ' is']. 123 124/* gen_param/4 ********************************************************** 125 126Usage : gen_param(+Parameters, -Marked, +VarIn, -Varout) 127Argument(s) : list list integer integer 128Description : DCG predicate to generate the linear form (variables) 129 of the Parameters of an abstraction 130Notes : Parameters is a list of GID-CID pairs 131 VarIn/VarOut is the number of variables used before/after 132 this predicate 133 Marked is the list of CID-variable pairs 134 135************************************************************************/ 136 137gen_param([CID], [CID+Var], VarIn, VarOut) --> 138 { number2var(VarIn, Var), succ(VarIn, VarOut) }, [Var]. 139gen_param([CID|T1], [CID+Var|T2], VarIn, VarOut) --> 140 { number2var(VarIn, Var), succ(VarIn, TmpVar) }, 141 [Var, ','], gen_param(T1, T2, TmpVar, VarOut). 142 143/* gen_graph/4 ********************************************************* 144 145Usage : gen_graph(+Graph, +Marked, +VarIn, -VarOut) 146Argument(s) : GIDs list integer integer 147Description : DCG predicate to generate the linear notation of Graph 148Notes : VarIn/VarOut is the number of variables used before/after 149 linearizing Graph 150 Marked is a list of concepts of Graph which are already 151 attached to a variable 152 Graph is a list of GIDs if it is compound 153 154************************************************************************/ 155 156gen_graph([GID], Marked, VarIn, VarOut) --> 157 gen_graph(GID, Marked, VarIn, VarOut). 158gen_graph([H|T], Marked, VarIn, VarOut) --> 159 gen_graph(H, Marked, VarIn, TmpVar), [';'], 160 gen_graph(T, Marked, TmpVar, VarOut). 161gen_graph(GID, Marked, VarIn, VarOut) --> 162 { g(GID, [CID-_], []) }, % graph consists of a single concept 163 process_vars([CID], Marked, VarIn, VarOut). 164gen_graph(GID, Marked, VarIn, VarOut) --> 165 { g(GID, CL, RL), dir_reference(CL, RL), edges(RL, 0, EdgeList), 166 gen_graph(EdgeList, Linear, []) 167 }, process_vars(Linear, Marked, VarIn, VarOut). 168 169/* process_vars/4 ******************************************************* 170 171Usage : process_vars(+Linear, +Marked, +VarIn, -VarOut) 172Argument(s) : list list integer integer 173Description : DCG predicate to get the correct linear notation for the 174 concepts, using variables as referents when needed 175Notes : VarIn/VarOut is the number of variables used before/after 176 processing Linear 177 Marked is a list of concepts that already appeared as 178 parameters (CID+Var) or in the same graph (CID-Var) and 179 therefore have a variable as referent 180 Linear contains the IDs of the concepts, not their 181 linear form 182 183************************************************************************/ 184 185process_vars([X/Id|T], Marked, VarIn, VarOut) --> 186 { member(X/Id+Var, Marked), delete_one(X/Id+Var, Marked, TmpMarked) }, 187 gen_concept(X/Id-Var, VarIn, TmpVar), 188 process_vars(T, [X/Id-Var|TmpMarked], TmpVar, VarOut). 189process_vars([X/Id|T], Marked, VarIn, VarOut) --> 190 { member(X/Id-Var, Marked) }, 191 gen_concept(X/Id*Var, VarIn, TmpVar), 192 process_vars(T, Marked, TmpVar, VarOut). 193process_vars([X/Id|T], Marked, VarIn, VarOut) --> 194 { member(X/Id, T), succ(VarIn, TmpVar1), number2var(VarIn, Var) }, 195 gen_concept(X/Id-Var, TmpVar1, TmpVar2), 196 process_vars(T, [X/Id-Var|Marked], TmpVar2, VarOut). 197process_vars([X/Id|T], Marked, VarIn, VarOut) --> 198 gen_concept(X/Id, VarIn, TmpVar), 199 process_vars(T, Marked, TmpVar, VarOut). 200process_vars([H|T], Marked, VarIn, VarOut) --> 201 [H], process_vars(T, Marked, VarIn, VarOut). % not a concept 202process_vars([], _, VarIn, VarIn) --> []. 203 204/* edges/3 *************************************************************** 205 206Usage : edges(+Relations, +Number, -Edges) 207Argument(s) : list integer list 208Description : computes the Edges of a graph given the Relations 209Notes : Number is used to uniquely identify the relation; 210 an edge is of the form e(N, CID, Rel-Number) where N > 0 211 if the arc points to Rel, otherwise N < 0 212 213************************************************************************/ 214 215edges([H|T], N, L) :- 216 H =.. [Rel|Args], length(Args, NumArgs), 217 ( NumArgs > 2 -> ArcCount = 1 ; ArcCount = none ), 218 edges_with_rel(Rel-N, ArcCount, Args, L1), 219 succ(N, N1), edges(T, N1, L2), conc(L1, L2, L). 220edges([], _, []). 221 222/* edges_with_rel/4 ***************************************************** 223 224Usage : edges_with_rel(+Relation, +ArcCount, +Arguments, -Edges) 225Argument(s) : term integer list list 226Description : computes all Edges which include Relation 227Notes : ArcCount is 'none' if Relation is monadic or dyadic 228 Arguments is the list of CIDs attached to Relation 229 230************************************************************************/ 231 232edges_with_rel(Rel, none, [CID], [e(-_, CID, Rel)]). % last arc points away 233edges_with_rel(Rel, N, [CID], [e(-N, CID, Rel)]). 234edges_with_rel(Rel, none, [CID|T1], [e(+_, CID, Rel)|T2]) :- 235 edges_with_rel(Rel, none, T1, T2). 236edges_with_rel(Rel, N, [CID|T1], [e(+N, CID, Rel)|T2]) :- 237 succ(N, N1), edges_with_rel(Rel, N1, T1, T2). 238 239/* relation_linked/3 **************************************************** 240 241Usage : relation_linked(+Relation, ?List, +Edges) 242Argument(s) : term list list 243Description : List contains all of the Edges which include Relation 244Notes : if there are several edges including Relation and the 245 same concept, only one is considered 246 247************************************************************************/ 248 249relation_linked(Rel, List, AL) :- 250 findall(e(N, CID, Rel), member(e(N, CID, Rel), AL), TmpList), 251 del_dup_edges(TmpList, List). 252 253/* concept_linked/3 ***************************************************** 254 255Usage : concept_linked(+Concept, ?List, +Edges) 256Argument(s) : CID list list 257Description : List contains all of the Edges which include Concept 258Notes : if there are several edges including Concept and the 259 same relation, only one appears in List 260 261************************************************************************/ 262 263concept_linked(CID, List, AL) :- 264 findall(e(N, CID, Rel), member(e(N, CID, Rel), AL), TmpList), 265 del_dup_edges(TmpList, List). 266 267/* del_dup_edges/2 ******************************************************* 268 269Usage : del_dup_edges(+Edges, ?NewList) 270Argument(s) : list list 271Description : NewList has all members of Edges but without duplicates 272Notes : two edges are considered duplicates when they include 273 the same nodes, no matter the direction of the arrow 274 275************************************************************************/ 276 277del_dup_edges([e(_, CID, Rel)|T], L) :- 278 member(e(_, CID, Rel), T), 279 del_dup_edges(T, L). 280del_dup_edges([H|T1], [H|T2]) :- 281 del_dup_edges(T1, T2). 282del_dup_edges([], []) :- 283 !. 284 285/* mark_edges/3 ********************************************************* 286 287Usage : mark_edges(+Edges, +List, -Marked) 288Argument(s) : lists 289Description : Marked has all edges from List which include the 290 relations appearing in Edges 291Notes : 292 293************************************************************************/ 294 295mark_edges([e(_, _, Rel)|T], AL, Marked) :- 296 relation_linked(Rel, List, AL), mark_edges(T, AL, AL2), 297 conc(List, AL2, Marked). 298mark_edges([], _, []) :- 299 !. 300 301/* gen_graph/1 ********************************************************** 302 303Usage : gen_graph(+Edges) 304Argument(s) : list 305Description : DCG predicate to linearize a graph given its Edges 306Notes : 307 308************************************************************************/ 309 310gen_graph([e(N, CID, neg-X)|T]) --> 311 gen_relation(neg-X), gen_conlink([e(N, CID, neg-X)|T], _, neg-X). 312gen_graph([e(N, CID, Rel)|T]) --> 313 [CID], gen_rlink([e(N, CID, Rel)|T], _, CID). 314 315/* gen_conlink/3 ******************************************************** 316 317Usage : gen_conlink(+EdgesIn, -EdgesOut, +Relation) 318Argument(s) : list list term 319Description : DCG predicate to linearize the part of the graph attached 320 to Relation 321Notes : EdgesIn/EdgesOut are the edges still unused before/after 322 this predicate has acted 323 324************************************************************************/ 325 326gen_conlink(AL, AL, Rel) --> 327 { relation_linked(Rel, [], AL) }. 328gen_conlink(AL, AL3, Rel) --> 329 { relation_linked(Rel, [Edge], AL), delete_one(Edge, AL, AL2) }, 330 gen_arc(Rel, CID, Edge), [CID], gen_rlink(AL2, AL3, CID). 331gen_conlink(AL, AL3, Rel) --> 332 { relation_linked(Rel, EdgeList, AL), difference(AL, EdgeList, AL2) }, 333 [start_list], gen_conlist(AL2, AL3, EdgeList), [end_list]. 334 335/* gen_conlist/3 ******************************************************** 336 337Usage : gen_conlist(+EdgesIn, -EdgesOut, +List) 338Argument(s) : lists 339Description : DCG predicate to process the List of concepts attached to 340 the same relation 341Notes : EdgesIn/EdgesOut are the edges still unused before/after 342 this predicate has acted 343 344************************************************************************/ 345 346gen_conlist(AL, AL3, [Edge|T]) --> 347 [nl], gen_arc(_, CID, Edge), 348 [CID], gen_rlink(AL, AL2, CID), gen_conlist(AL2, AL3, T). 349gen_conlist(AL, AL, []) --> 350 []. 351 352/* gen_rlink/3 ********************************************************** 353 354Usage : gen_rlink(+EdgesIn, -EdgesOut, +Concept) 355Argument(s) : list list CID 356Description : DCG predicate to linearize the part of the graph attached 357 to Concept 358Notes : EdgesIn/EdgesOut are the edges still unused before/after 359 this predicate has acted 360 361************************************************************************/ 362 363gen_rlink(AL, AL, CID) --> 364 { concept_linked(CID, [], AL) }. 365gen_rlink(AL, AL3, CID) --> 366 { concept_linked(CID, [Edge], AL), delete_one(Edge, AL, AL2) }, 367 gen_arc(CID, Rel, Edge), gen_relation(Rel), gen_conlink(AL2, AL3, Rel). 368gen_rlink(AL, AL3, CID) --> 369 { concept_linked(CID, EdgeList, AL), difference(AL, EdgeList, AL2) }, 370 [start_list], gen_rlist(AL2, AL3, EdgeList), [end_list]. 371 372/* gen_rlist/3 ********************************************************** 373 374Usage : gen_rlist(+EdgesIn, -EdgesOut, +List) 375Argument(s) : lists 376Description : DCG predicate to process the List of relations attached to 377 the same concept 378Notes : EdgesIn/EdgesOut are the edges still unused before/after 379 this predicate has acted 380 381************************************************************************/ 382 383gen_rlist(AL, AL5, [Edge|T]) --> 384 [nl], 385 { Edge = e(_, _, Rel), 386 mark_edges(T, AL, MAL), difference(AL, MAL, AL2) 387 }, 388 gen_relation(Rel), gen_conlink(AL2, AL3, Rel), 389 { conc(MAL, AL3, AL4) }, gen_rlist(AL4, AL5, T). 390gen_rlist(AL, AL, []) --> 391 []. 392 393/* gen_arc/3 ************************************************************ 394 395Usage : gen_arc(?Node1, ?Node2, +Edge) 396Argument(s) : terms 397Description : DCG predicate to draw the arrow 398Notes : this predicate is called once in mode -/-/+ and the 399 caller assumes that Node2 is the concept 400 401************************************************************************/ 402 403gen_arc(Rel, CID, e(-N, CID, Rel)) --> ( { nonvar(N) }, [N] ; [] ), ['->']. 404gen_arc(Rel, CID, e(+N, CID, Rel)) --> ( { nonvar(N) }, [N] ; [] ), ['<-']. 405gen_arc(CID, Rel, e(+N, CID, Rel)) --> ( { nonvar(N) }, [N] ; [] ), ['->']. 406gen_arc(CID, Rel, e(-N, CID, Rel)) --> ( { nonvar(N) }, [N] ; [] ), ['<-']. 407 408/* gen_relation/1 *********************************************************** 409 410Usage : gen_relation(+Relation) 411Argument(s) : term 412Description : DCG predicate to linearize a relation 413Notes : 414 415************************************************************************/ 416 417gen_relation(Type-_) --> 418 { relation_type(Type, TypeName, _, _, _) }, 419 ['(', TypeName, ')']. 420 421/* gen_concept/3 ******************************************************** 422 423Usage : gen_concept(+Concept, +VarIn, -VarOut) 424Argument(s) : PID/CID integer integer 425Description : DCG predicate to get the linear notation of Concept 426Notes : VarIn/VarOut is the number of variables used before/after 427 linearizing Concept 428 429************************************************************************/ 430 431gen_concept(ID*Var, VarIn, VarOut) --> 432 { type(ID, Type) }, 433 ['['], gen_typefield(Type, VarIn, VarOut), [':', '*', Var, ']']. 434gen_concept(ID-Var, VarIn, VarOut) --> 435 { type(ID, Type), referent(ID, Ref) }, 436 ['['], gen_typefield(Type, VarIn, TmpVar), 437 [':'], gen_reffield(ID, Ref = '*'-Var, TmpVar, VarOut), [']']. 438gen_concept(ID, VarIn, VarOut) --> 439 { referent(ID, '*'), type(ID, Type) }, 440 ['['], gen_typefield(Type, VarIn, VarOut), [']']. 441gen_concept(ID, VarIn, VarOut) --> 442 { type(ID, Type), referent(ID, Ref) }, 443 ['['], gen_typefield(Type, VarIn, TmpVar), 444 [':'], gen_reffield(ID, Ref, TmpVar, VarOut), [']']. 445 446/* gen_typefield/3 ****************************************************** 447 448Usage : gen_typefield(+Type, +VarIn, -VarOut) 449Argument(s) : term integer integer 450Description : DCG predicate to get the linear notation of Type 451Notes : VarIn/VarOut is the number of variables used before/after 452 linearizing Type 453 454************************************************************************/ 455 456gen_typefield(Type, VarIn, VarIn) --> 457 { concept_type(Type, TypeName, _, _, _) }, [TypeName]. 458gen_typefield(l/Id, VarIn, VarOut) --> 459 { l(l/Id, [CID], GIDs), succ(VarIn, TmpVar), number2var(VarIn, Var) }, 460 ['\\', Var], gen_graph(GIDs, [CID+Var], TmpVar, VarOut). 461 462/* gen_reffield/4 ******************************************************* 463 464Usage : gen_reffield(+Concept, +Referent, +VarIn, -VarOut) 465Argument(s) : CID/PID term integer integer 466Description : DCG predicate to get the linear notation of Referent 467Notes : VarIn/VarOut is the number of variables used before/after 468 linearizing Referent of Concept 469 470************************************************************************/ 471 472gen_reffield(CID, ('*') = X, VarIn, VarOut) --> % '*' is defined as fy 473 gen_reffield(CID, X, VarIn, VarOut). 474gen_reffield(CID, Ref = X, VarIn, VarOut) --> 475 gen_reffield(CID, Ref, VarIn, TmpVar), 476 ['='], gen_reffield(CID, X, TmpVar, VarOut). 477gen_reffield(_, Kind/Id, VarIn, VarIn) --> 478 { recorded(crl, Kind/Id-Var, _) }, reffield(('*') = '*'-Var). 479gen_reffield(CID, _Kind/_Id, VarIn, VarOut) --> 480 { number2var(VarIn, Var), succ(VarIn, VarOut), 481 recorda(crl, CID-Var, _) }, 482 reffield(('*') = '*'-Var). 483gen_reffield(p/_Id, [GID|List], VarIn, VarOut) --> 484 [push, nl], gen_graph([GID|List], [], VarIn, VarOut), [pop, nl]. 485gen_reffield(_, '*'-Var, VarIn, VarIn) --> 486 reffield(('*') = '*'-Var). 487gen_reffield(_, Ref, VarIn, VarIn) --> 488 reffield(Ref). 489 490/* write_linear/3 ******************************************************* 491 492Usage : write_linear(+Level, +Linear, +Buffer) 493Argument(s) : integer list list 494Description : pretty prints the Linear notation of a graph at the 495 current indentation Level 496Notes : Linear may contain formatting information 497 Buffer is empty or contains looked-ahead commas 498 499************************************************************************/ 500 501write_linear(N, [push|T], []) :- 502 succ(N, N1), write_linear(N1, T, []). 503write_linear(N, [pop|T], _) :- 504 succ(N0, N), write_linear(N0, T, []). 505write_linear(N, [nl|T], _) :- 506 nl, Indent is N * 4, tab(Indent), write_linear(N, T, []). 507write_linear(N, [start_list|T], []) :- 508 write(' -'), write_linear(N, [push|T], []). 509write_linear(N, ['='|T], []) :- 510 write(' = '), write_linear(N, T, []). 511write_linear(N, [','|T], []) :- 512 write(', '), write_linear(N, T, []). 513write_linear(N, [':'|T], _) :- 514 write(': '), write_linear(N, T, []). 515write_linear(N, ['(', 'NEG', ')', '->'|T], []) :- 516 write('~'), write_linear(N, T, []). 517write_linear(N, [I, '->'|T], []) :- 518 integer(I), write(' '), write(I), write(' -> '), 519 write_linear(N, T, []). 520write_linear(N, [I, '<-'|T], []) :- 521 integer(I), write(' '), write(I), write(' <- '), 522 write_linear(N, T, []). 523write_linear(N, ['->'|T], []) :- 524 write(' -> '), write_linear(N, T, []). 525write_linear(N, ['<-'|T], []) :- 526 write(' <- '), write_linear(N, T, []). 527write_linear(N, [end_list|T], Buf) :- 528 succ(N0, N), write_linear(N0, T, [','|Buf]). 529write_linear(N, [';'|T], _) :- 530 write(';'), write_linear(N, [nl|T], []). 531write_linear(_, ['.'], _) :- 532 write('.'). 533write_linear(N, [H|T], []) :- 534 write(H), write_linear(N, T, []). 535write_linear(N, [H|T], Buf) :- 536 apply(write(_), Buf), write(H), write_linear(N, T, []). 537write_linear(_, [], _)