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) }