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 : REC_LIN.PL 34Creation Date : 90/07/08 By: mw 35Abbreviations : mw - Michel Wermelinger 36Description : Recognizes the linear notation of a semantic net component 37Notes : the arity of the DCG predicates doesn't include the lists 38 marked concepts have variables as referents 39 for a description of lists of marked concepts see pop_ct/2 40 41************************************************************************/ 42 43/* HISTORY ************************************************************** 44 451.0 90/07/11 mw handles contexts and single-use types 461.1 90/08/23 mw handles non-recursive type definitions and schemas 47 uses new error handling and mark-&-sweep predicates 481.2 90/08/25 mw supports n-adic relations 491.3 90/08/28 mw supports compound graphs 501.4 90/09/09 mw generalized reffield/1; simplified some code 511.5 90/10/23 mw added can_graph to rec_linear/2 52 changed processing of referents which are names 531.6 90/11/06 mw changed put_arg/3 because of C-Prolog bug 541.7 90/12/28 mw card/2 checks if integer is a word 55 can't change canonical graph anymore 56 57************************************************************************/ 58 59/* CONTENTS ************************************************************* 60 61read_linear/2 builds a graph, schema or type from its linear form 62 63************************************************************************/ 64 65/* read_linear/2 ******************************************************** 66 67Usage : read_linear(-Kind, -Identifier) 68Argument(s) : atom term 69Description : recognizes the linear notation of a semantic net component 70Notes : the possible values for the Kind-Identifier pair are 71 graph-GID, type_def-TypeName, rel_def-RelName, schema-LID 72 and can_graph-TypeName 73 74************************************************************************/ 75 76read_linear(Kind, Obj) :- 77 get_token(T), mark, rec_linear(Kind, Obj, T, ['.']), unmark. 78 79/* rec_linear/2 ********************************************************* 80 81Usage : rec_linear(-Kind, -Identifier) 82Argument(s) : atom term 83Description : DCG predicate to recognize the linear notation of something 84Notes : all data structures are created while parsing the linear 85 notation 86 the possible values for the Kind-Identifier pair are 87 graph-GID, type_def-TypeName, rel_def-RelName, schema-LID 88 89************************************************************************/ 90 91rec_linear(type_def, Name) --> 92 [(type)], rec_typelabel(Label), ['(', Var, ')', is], 93 { ( concept_type(_, Label, _, _, _) 94 -> cg_error(dup_type_def, Label) 95 ; true 96 ) }, 97 rec_graph_list(GIDs, [], MC, outer), 98 { abstraction_args([Var], MC, [CID]), 99 new_id(l/Id), assert( l(l/Id, [CID], GIDs) ), 100 label_to_name(Label, Name), 101 assert( concept_type(Name, Label, l/Id, none, []) ), 102 type(CID, Type), assert( Name << Type ) 103 }. 104rec_linear(rel_def, Label) --> 105 [relation, Label, '('], rec_param(Vars), [')', is], 106 { ( relation_type(_, Label, _, _, Args) 107 -> cg_error(dup_rel_def, Label/Args) 108 ; true 109 ) }, 110 rec_graph_list(GIDs, [], MC, outer), 111 { abstraction_args(Vars, MC, Params), new_id(l/Id), 112 assert( l(l/Id, Params, GIDs) ), length(Params, Arcs), 113 assert( relation_type(Label, Label, l/Id, none, Arcs) ) 114 }. 115rec_linear(schema, l/Id) --> 116 [schema, for], rec_typelabel(Label), ['(', Var, ')', is], 117 { concept_type(_, Label, _, _, _) ; cg_error(unknown_type, Label) }, 118 rec_graph_list(GIDs, [], MC, outer), 119 { abstraction_args([Var], MC, [CID]), type(CID, Type), 120 ( retract( concept_type(Type, Label, Def, Can, SL) ) 121 ; cg_error(ambiguous_var, Var) 122 ), 123 new_id(l/Id), assert( l(l/Id, [CID], GIDs) ), 124 assert( concept_type(Type, Label, Def, Can, [l/Id|SL]) ) 125 }. 126rec_linear(can_graph, Type) --> 127 [canonical, graph, for], rec_typelabel(Label), ['(', Var, ')', is], 128 { ( concept_type(Type, Label, Def, Can, SL) 129 ; cg_error(unknown_type, Label) 130 ), 131 ( Can = none ; cg_error(dup_type_can, Label) ) 132 }, 133 rec_graph_list(GIDs, [], MC, outer), 134 { abstraction_args([Var], MC, [CID]), 135 ( type(CID, Type) ; cg_error(ambiguous_var, Var) ), 136 retract( concept_type(Type, Label, Def, Can, SL) ), 137 ( GIDs = [GID] ; GIDs = GID ), 138 assert( concept_type(Type, Label, Def, GID, SL) ) 139 }. 140rec_linear(can_graph, Type) --> 141 [canonical, graph, for, Label, is], 142 { ( relation_type(_, Label, _, Can, Arcs) 143 ; cg_error(unknown_type, Label) 144 ), 145 ( Can = none ; cg_error(dup_rel_can, Label/Arcs) ) 146 }, 147 rec_graph_list(GIDs, [], _, outer), 148 { retract( relation_type(Type, Label, Def, Can, Arcs) ), 149 ( GIDs = [GID] ; GIDs = GID ), 150 assert( relation_type(Type, Label, Def, GID, Arcs) ) 151 }. 152rec_linear(graph, GIDs) --> 153 rec_graph_list(GIDs, [], _, outer). 154 155/* label_to_name/2 ****************************************************** 156 157Usage : label_to_name(+Label, -Name) 158Argument(s) : atoms 159Description : builds a type Name for a given Label 160Notes : 161 162************************************************************************/ 163 164label_to_name(Label, Name) :- 165 name(Label, [C|T]), name('"', [C]), conc(N, [C], T), name(Name, N), !. 166label_to_name(Label, Label). 167 168/* rec_param/1 ********************************************************** 169 170Usage : rec_param(-Variables) 171Argument(s) : list 172Description : DCG predicate to recognize a list of variables (parameters) 173Notes : 174 175************************************************************************/ 176 177rec_param([Var|T]) --> 178 [Var], 179 ( [','], rec_param(T) 180 ; { T = [] } 181 ). 182 183/* abstraction_args/3 *************************************************** 184 185Usage : abstraction_args(+Variables, +Marked, -Concepts) 186Argument(s) : lists 187Description : returns the Concepts in Marked denoted by the Variables 188Notes : 189 190************************************************************************/ 191 192abstraction_args([Var|T], Marked, [CID|T1]) :- 193 member(_GID-CID-Var, Marked), abstraction_args(T, Marked, T1). 194abstraction_args([Var|_], _, _) :- 195 cg_error(undef_param, Var). 196abstraction_args([], _, []). 197 198/* put_arg/3 ************************************************************ 199 200Usage : put_arg(+Concept, +N, +Relation) 201Argument(s) : CID integer term 202Description : Concept will be the N-th argument of Relation 203Notes : if N > 0 then the arc points to Relation, else points away 204 205************************************************************************/ 206:- style_check(-singleton). 207 208put_arg(CID, -NArgs, Rel) :- 209 functor(Rel, _, NArgs), arg(NArgs, Rel, Arg), var(Arg), Arg = CID. 210put_arg(CID, +N, Rel) :- 211 var(N), Rel =.. [_|Args], conc(Inwards, [Last], Args), 212 setof(Arg, ( member(Arg, Inwards), var(Arg) ), [Arg]), 213 member(Arg, Args), var(Arg), Arg = CID. 214put_arg(_, +N, Rel) :- 215 var(N), cg_error(ambiguous_arc, Rel). 216put_arg(_, -_, Rel) :- 217 cg_error(point_into, Rel). 218put_arg(_, +NArgs, Rel) :- 219 nonvar(NArgs), functor(Rel, _, NArgs), cg_error(point_away, Rel). 220put_arg(CID, +N, Rel) :- 221 arg(N, Rel, Arg), var(Arg), Arg = CID. 222/*put_arg(_, +N, Rel) :- 223 nonvar(N), cg_error(duplicate_arc, N-Rel).*/ 224put_arg(CID, _, Rel) :- 225 cg_error(too_many_arcs, Rel). 226 227/* inv_arrow/2 ********************************************************** 228 229Usage : inv_arrow(+Arrow, ?Inv) 230Argument(s) : terms 231Description : Inv has the opposite direction of Arrow 232Notes : 233 234************************************************************************/ 235 236inv_arrow(+N, -N). 237inv_arrow(-N, +N). 238 239/* rec_graph_list/4 ***************************************************** 240 241Usage : rec_graph_list(-GIDs, +MarkedIn, -MarkedOut, +Env) 242Argument(s) : list list list term 243Description : DCG predicate to recognize the linear notation of graphs 244Notes : GIDs is the list of graphs built during parsing 245 Env is the current environment 246 MarkedIn is the list of marked concepts in other graphs 247 (may be coreference links) 248 MarkedOut is the list of marked concepts after this 249 predicate 250 251************************************************************************/ 252 253rec_graph_list([GID|T], MCI, MCO, Env) --> 254 { new_id(g/Id), GID = g/Id }, rec_graph(GID, MCI, TmpMC, Env), 255 { check_graph(GID) }, 256 ( [;], rec_graph_list(T, TmpMC, MCO, Env) 257 ; { T = [], MCO = TmpMC } 258 ). 259 260/* rec_graph/4 ********************************************************** 261 262Usage : rec_graph(-Graph, +MarkedIn, -MarkedOut, +Env) 263Argument(s) : GID list list term 264Description : DCG predicate to recognize the linear notation of Graph 265Notes : Env is the current context 266 MarkedIn is the list of marked concepts in other graphs 267 (may be coreference links) 268 MarkedOut is the list of marked concepts after this 269 predicate 270 271************************************************************************/ 272 273rec_graph(g/Id, MCI, MCO, Env) --> 274 rec_concept(g/Id, CID, Env, MCI, TmpMC), 275 rec_rlink(g/Id, CID, TmpRL, Env, TmpMC, MCO), 276 { ind_reference(TmpRL, RL, [CID-Var], CL), assert( g(g/Id, CL, RL) ) }. 277rec_graph(g/Id, MCI, MCO, Env) --> 278 rec_relation(Rel), rec_conlink(g/Id, Rel, T, Env, MCI, MCO), 279 { numbervars(Rel, 0, 0), 280 ind_reference([Rel|T], RL, [], CL), assert( g(g/Id, CL, RL) ) 281 ; cg_error(too_few_arcs, Rel) 282 }. 283 284/* rec_rlink/6 ********************************************************** 285 286Usage : rec_rlink(+Graph, +Con, -Rel, +Env, +MCI, -MCO) 287Argument(s) : GID CID list term list list 288Description : DCG predicate to recognize the part of the Graph 289 attached to Con(cept), generating the Rel(ations) parsed 290Notes : Env is the current context 291 MCI/MCO is the list of marked concepts before/after this 292 predicate 293 294************************************************************************/ 295 296rec_rlink(GID, CID, [Rel|T], Env, MCI, MCO) --> 297 rec_arc(A), rec_relation(Rel), 298 { put_arg(CID, A, Rel) }, 299 rec_conlink(GID, Rel, T, Env, MCI, MCO), 300 { numbervars(Rel, 0, 0) ; cg_error(too_few_arcs, Rel) }, !. 301rec_rlink(GID, CID, RL, Env, MCI, MCO) --> 302 ['-'], rec_rlist(GID, CID, RL, Env, MCI, MCO), 303 ( [','] ; [] ), !. 304rec_rlink(_, _, [], _, MCI, MCI) --> []. 305 306/* rec_rlist/6 ********************************************************** 307 308Usage : rec_rlist(+Graph, +Con, -Rel, +Env, +MCI, -MCO) 309Argument(s) : GID CID list term list list 310Description : DCG predicate to recognize the list of Rel(ations) 311 attached to Con(cept) 312Notes : Env is the current context 313 MCI/MCO is the list of marked concepts before/after this 314 predicate 315 316************************************************************************/ 317 318rec_rlist(GID, CID, [Rel|T], Env, MCI, MCO) --> 319 ( ['|'] ; [] ), 320 rec_relation(Rel), rec_conlink(GID, Rel, T1, Env, MCI, MC1), 321 { put_arg(CID, _, Rel), 322 ( numbervars(Rel, 0, 0) ; cg_error(too_few_arcs, Rel) ) 323 }, 324 rec_rlist(GID, CID, T2, Env, MC1, MCO), 325 { conc(T1, T2, T) }. 326rec_rlist(_, _, [], _, MCI, MCI) --> []. 327 328/* rec_conlink/6 ******************************************************** 329 330Usage : rec_conlink(+Graph, +Rel, -RL, +Env, +MCI, -MCO) 331Argument(s) : GID term list term list list 332Description : DCG predicate to recognize the part of Graph attached 333 to the relation Rel 334Notes : RL is the relation list generated by this predicate 335 Env is the current context 336 MCI/MCO is the list of marked concepts before/after this 337 predicate 338 339************************************************************************/ 340 341rec_conlink(GID, Rel, RL, Env, MCI, MCO) --> 342 rec_arc(A), rec_concept(GID, CID, Env, MCI, MC1), 343 { inv_arrow(A, A1), put_arg(CID, A1, Rel) }, 344 rec_rlink(GID, CID, RL, Env, MC1, MCO), !. 345rec_conlink(GID, Rel, RL, Env, MCI, MCO) --> 346 ['-'], rec_conlist(GID, Rel, RL, Env, MCI, MCO), 347 ( [','] ; [] ), !. 348rec_conlink(_, _, [], _, MCI, MCI) --> []. 349 350/* rec_conlist/6 ******************************************************** 351 352Usage : rec_conlist(+Graph, +Rel, -RL, +Env, +MCI, -MCO) 353Argument(s) : GID term list term list list 354Description : DCG predicate to recognize the list of concepts attached 355 to relation Rel 356Notes : RL is the relation list generated by this predicate 357 Env is the current context 358 MCI/MCO is the list of marked concepts before/after this 359 predicate 360 361************************************************************************/ 362 363rec_conlist(GID, Rel, RL, Env, MCI, MCO) --> 364 ['|'], rec_arc(A), rec_concept(GID, CID, Env, MCI, MC1), 365 { inv_arrow(A, A1), put_arg(CID, A1, Rel) }, 366 rec_rlink(GID, CID, L1, Env, MC1, MC2), 367 rec_conlist(GID, Rel, L2, Env, MC2, MCO), 368 { conc(L1, L2, RL) }. 369rec_conlist(_, _, [], _, MCI, MCI) --> []. 370 371/* rec_arc/1 ************************************************************ 372 373Usage : rec_arc(-Arc) 374Argument(s) : term 375Description : DCG predicate to recognize an arrow 376Notes : 377 378************************************************************************/ 379 380rec_arc(+N) --> [N, -, >], { integer(N) }. 381rec_arc(-N) --> [N, <, -], { integer(N) }. 382rec_arc(+_) --> [-, >]. 383rec_arc(-_) --> [<, -]. 384 385/* rec_relation/1 ******************************************************* 386 387Usage : rec_relation(-Relation) 388Argument(s) : term 389Description : DCG predicate to recognize the linear notation of Relation 390Notes : 391 392************************************************************************/ 393 394rec_relation(Rel) --> 395 ['(', Label, ')'], 396 { relation_type(Type, Label, _, _, NArgs), functor(Rel, Type, NArgs) }. 397rec_relation(Rel) --> 398 ['(', Label], { cg_error(unknown_rel, Label) }. 399 400/* rec_concept/5 ******************************************************** 401 402Usage : rec_concept(+Graph, -Concept, +Env, +MCI, -MCO) 403Argument(s) : GID PID/CID term list list 404Description : DCG predicate to recognize the linear notation of Concept 405Notes : Env is the current context 406 MCI/MCO is the list of marked concepts before/after this 407 predicate 408 409************************************************************************/ 410 411rec_concept(GID, ID, Env, MCI, MCO) --> 412 ['['], reffield(Ref), [']'], 413 { basic_ref(Ref, '*'), 414 process_concept(GID, ID, proposition, Ref, Env, MCI, MCO) 415 }. 416rec_concept(GID, ID, Env, MCI, MCO) --> 417 ['['], rec_typefield(Type), 418 ( [']'], 419 { process_concept(GID, ID, Type, '*', Env, MCI, MCO) } 420 ; [:], reffield(Ref), [']'], 421 { process_concept(GID, ID, Type, Ref, Env, MCI, MCO) } 422 ; [:], { new_id(p/Id), ID = p/Id }, 423 rec_graph_list(GIDs, [ct|MCI], TmpMC, ID), [']'], 424 { assert( p(ID, Type, GIDs, Env) ), pop_ct(TmpMC, MCO) } 425 ). 426rec_concept(GID, ID, Env, MCI, MCO) --> 427 ['['], { new_id(p/Id), ID = p/Id }, 428 rec_graph_list(GIDs, [ct|MCI], TmpMC, ID), [']'], 429 { assert( p(ID, proposition, GIDs, Env) ), pop_ct(TmpMC, MCO) }. 430 431/* pop_ct/2 ************************************************************* 432 433Usage : pop_ct(+MCI, -MCO) 434Argument(s) : lists 435Description : predicate to pop out of a context 436Notes : MCI/MCO is the list of marked concepts before/after this 437 predicate 438 a list of marked concepts consists of GID-CID-Var terms 439 and atoms 'ct' to separate the contexts 440 the list is used as a stack (outer context at the end) 441 442************************************************************************/ 443 444pop_ct([ct|T], T). 445pop_ct([_|T], L) :- pop_ct(T, L). 446 447/* process_concept/7 **************************************************** 448 449Usage : process_concept(+Graph, -Con, +Type, +Ref, +Env, +MCI, -MCO) 450Argument(s) : GID ID term term term list list 451Description : processes Type and Ref to obtain the concept's ID 452Notes : Env is the current context 453 MCI/MCO is the list of marked concepts before/after this 454 predicate 455 456************************************************************************/ 457 458process_concept(GID, ID, Type, ('*') = '*'-V, Env, MCI, MCI) :- 459 member(GID-ID-V, MCI), ( type(ID, Type) ; cg_error(ambiguous_var, V) ). 460process_concept(GID, ID, Type, Ref = CRL, Env, MCI, MCI) :- 461 defined_concept(GID, Ref = CRL, MCI), 462 cg_error(double_def, Ref = CRL) . 463process_concept(GID, PID, Type, Ref, Env, MCI, MCO) :- 464 subtype(Type, proposition), new_id(p/Id), PID = p/Id, 465 process_referent(GID, PID, Type, Ref, NewRef, MCI, MCO), 466 assert( p(PID, Type, NewRef, Env) ). 467process_concept(GID, CID, Type, Ref, Env, MCI, MCO) :- 468 new_id(c/Id), CID = c/Id, 469 process_referent(GID, CID, Type, Ref, NewRef, MCI, MCO), 470 assert( c(CID, Type, NewRef) ). 471 472/* defined_concept/3 **************************************************** 473 474Usage : defined_concept(+Graph, +Referent, +MCI) 475Argument(s) : GID term list 476Description : succeeds iff Referent denotes a concept defined in Graph 477Notes : MCI is the list of already marked concepts 478 479************************************************************************/ 480 481defined_concept(GID, Ref = '*'-Var, MC) :- 482 member(GID-ID-Var, MC). 483defined_concept(GID, Ref = '*'-Var, MC) :- 484 defined(GID, Ref, MC). 485defined_concept(GID, '*'-Var, MC) :- 486 member(GID-ID-Var, MC). 487 488/* process_referent/7 *************************************************** 489 490Usage : process_referent( 491 +Graph, +Con, +Type, +Ref, -NewRef, +MCI, -MCO) 492Argument(s) : GID ID term term term list list 493Description : processes Type and Ref to obtain the Con(cept)'s NewRef 494Notes : Ref contains unresolved coreference links 495 MCI/MCO is the list of marked concepts before/after this 496 predicate 497 498************************************************************************/ 499 500process_referent(GID, ID, Type, Ref = '*'-V, NewRef = ID2, MCI, MCO) :- 501 member(GID2-ID2-V, MCI), type(ID2, Type2), 502 ( subtype(Type, Type2) ; subtype(Type2, Type) ; cg_error(wrong_crl, V) ), 503 ( retract( c(ID2, Type2, Ref2) ), 504 assert( c(ID2, Type2, Ref2 = ID) ) 505 ; retract( p(ID2, Type2, Ref2, Env2) ), 506 assert( p(ID2, Type2, Ref2 = ID, Env2) ) 507 ), process_referent(GID, ID, Type, Ref, NewRef, MCI, MCO). 508process_referent(GID, ID, Type, Ref = '*'-V, NewRef, MCI, [GID-ID-V|MCO]) :- 509 process_referent(GID, ID, Type, Ref, NewRef, MCI, MCO). 510/*process_referent(GID, ID, Type, '*'-V, ('*') = ID2, MCI, MCI) :- 511 member(GID2-ID2-V, MCI), type(ID2, Type2), 512 ( subtype(Type, Type2) ; subtype(Type2, Type) ; cg_error(wrong_crl, V) ), 513 ( retract( c(ID2, Type2, Ref2) ), 514 assert( c(ID2, Type2, Ref2 = ID) ) 515 ; retract( p(ID2, Type2, Ref2, Env2) ), 516 assert( p(ID2, Type2, Ref2 = ID, Env2) ) 517 ). 518process_referent(GID, ID, Type, '*'-V, '*', MCI, [GID-ID-V|MCI]). */ 519process_referent(_GID, _ID, _Type, Ref, Ref, MCI, MCI). 520 521/* rec_typefield/1 ****************************************************** 522 523Usage : rec_typefield(-Type) 524Argument(s) : term 525Description : DCG predicate to recognize the Type of a concept 526Notes : 527 528************************************************************************/ 529 530rec_typefield(l/Id) --> 531 ['\\', Var], rec_graph_list(GIDs, [], MC, _), 532 { member(GID-CID-Var, MC), new_id(l/Id), assert( l(l/Id, [CID], GIDs) ) 533 ; cg_error(undef_param, Var) 534 }. 535rec_typefield(Type) --> 536 rec_typelabel(Label), { concept_type(Type, Label, _, _, _) }. 537/* 538rec_typefield(Type) --> 539 ['"', TypeName, '"'], 540 { name('"', [C]), name(TypeName, L1), conc([C|L1], [C], L2), 541 name(Label, L2), concept_type(Type, Label, _, _, _) 542 }. 543rec_typefield(Type) --> 544 [TypeName], 545 { concept_type(Type, TypeName, _, _, _) }. 546*/ 547rec_typefield(Type) --> 548 rec_typelabel(TypeName), %[TypeName], 549 { name(TypeName, [L|_]), letter(L), cg_error(unknown_type, TypeName) }. 550 551/* rec_typelabel/1 ****************************************************** 552 553Usage : rec_typelabel(-Label) 554Argument(s) : atom 555Description : DCG predicate to recognize the Label of a type 556Notes : 557 558************************************************************************/ 559 560rec_typelabel(Label) --> 561 ['"', TypeName, '"'], 562 { name('"', [C]), name(TypeName, L1), conc([C|L1], [C], L2), 563 name(Label, L2) }. 564rec_typelabel(Label) --> 565 [Label]. 566 567/* reffield/1 *********************************************************** 568 569Usage : reffield(?Ref) 570Argument(s) : term 571Description : DCG predicate to process the (multiple) referent(s) 572 of a concept 573Notes : this predicate is bidirectional 574 575************************************************************************/ 576 577reffield(Ref) --> { var(Ref) }, ['*', Var], coref(('*') = '*'-Var, Ref). 578reffield(Ref) --> { var(Ref) }, referent(B), coref(B, Ref). 579 580reffield(('*')='*'-Var) --> ['*', Var]. 581reffield(Ref = '*'-Var) --> { nonvar(Ref) }, reffield(Ref), [=, '*', Var]. 582reffield(Ref) --> referent(Ref). 583 584coref(R, R) --> []. 585coref(B, R) --> [=, '*', Var], coref(B = '*'-Var, R). 586 587/* referent/1 *********************************************************** 588 589Usage : referent(?Ref) 590Argument(s) : term 591Description : DCG predicate to process a single referent of a concept 592Notes : this predicate is bidirectional 593 594************************************************************************/ 595 596referent(set(dist, L, C)) --> ['Dist', '{'], set(L), ['}'], card(C). 597referent(set(resp, L, C)) --> ['Resp', '<'], set(L), ['>'], card(C). 598referent(set(coll, L, C)) --> ['{'], set(L), ['}'], card(C). 599referent(set(disj, L, C)) --> ['{'], disj_set(L), ['}'], card(C). 600referent(meas(M)) --> ['@'], set_element(name(M)). 601referent(every) --> ['V']. 602referent(R) --> set_element(R). 603 604/* set_element/1 ******************************************************** 605 606Usage : set_element(?Ref) 607Argument(s) : term 608Description : DCG predicate to process those referents which can appear 609 in a set 610Notes : this predicate is bidirectional 611 612************************************************************************/ 613 614set_element('*') --> ['*']. 615set_element(I) --> ['#', I], { integer(I) }. 616set_element('#') --> ['#']. 617set_element(name(Name)) --> 618 [Name], { subtype(Name, word) /*; cg_error(inv_name, Name) */}. 619 620/* set/1 **************************************************************** 621 622Usage : set(?Set) 623Argument(s) : list 624Description : DCG predicate to process a referent which is a set 625Notes : this predicate is bidirectional 626 627************************************************************************/ 628 629set([R]) --> set_element(R). 630set([H|T]) --> set_element(H), [','], set(T). 631 632/* disj_set/1 *********************************************************** 633 634Usage : disj_set(?Set) 635Argument(s) : list 636Description : DCG predicate to process a disjunctive set 637Notes : this predicate is bidirectional 638 639************************************************************************/ 640 641disj_set([R]) --> set_element(R). 642disj_set([H|T]) --> set_element(H), ['|'], disj_set(T). 643 644/* card/1 *************************************************************** 645 646Usage : card(?Cardinality) 647Argument(s) : integer 648Description : DCG predicate to process the Cardinality of a set 649Notes : this predicate is bidirectional 650 651************************************************************************/ 652 653card(C) --> ['@', C], { integer(C), concept_type(C, _, _, _, _) }. 654card(X) --> [], { var(X) }