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(_, [], _)