((local_echo_on))

((logfile nul))

((resume)
	(errm n)
	(logfile F)
	(resume2 F)
	(!))
((resume)
	(addcl ((logfile nul)) )
	(resume2 nul))

((resume2 F)
	(flush F)
	(!))
((resume2 F)
	(create_a F))

((log on)
	(!)
	(kill logfile)
	(addcl ((logfile stdprn)) )
	(pheader))
((log off)
	(delcl ((logfile X)) )
	(negg eq X stdprn)
	(!)
	(close X)
	(kill logfile)
	(addcl ((logfile nul)) ))
((log off)
	(!)
	(putb stdprn 12)
	(flush stdprn)
	(kill logfile)
	(addcl ((logfile nul)) ))
((log X)
	(p 'Use "newlog' X)
	(p '" or "addlog' X)
	(pp '" as required.'))

((newlog X)
	(kill logfile)
	(create X)
	(addcl ((logfile X)) )
	(pheader))

((addlog X)
	(kill logfile)
	(create_a X)
	(addcl ((logfile X)) ))

((pheader)
	(date D T)
	(pplog _) 
	(plog _ 'Conceptual Graph Session Log : ' D T)
	(pplog _)
	(pplog _ '========================================================')
	(pplog _))

((list2 X)
	(logfile F)
	(listfile F X)
	(local_echo_on)
	(list X)
	(fail))
((list2 _)
	(logfile F)
	(flush F)
	(flush stdout))

((print_next_text _File)
	(logfile F)
	(filepos _File X)
	(filesearch _File ';;;')
	(filepos _File Y)
	(sum N 3 Y)
	(sum X Z N)
	(filepos _File X)
	(if (eq F nul) () ((filebcopy _File F Z) (flush F) (filepos _File X)) )
	(if (local_echo_on) ((filebcopy _File stdout Z) (flush stdout)) ())
	(flush _File)
	(filepos _File Y))

((p2|X)
	(logfile F)
	(w F|X)
	(local_echo_on)
	(!)
	(p|X))
((p2|_))

((pp2|X)
	(logfile F)
	(write F|X)
	(local_echo_on)
	(!)
	(pp|X))
((pp2|_))

((palt A B)
	(logfile F)
	(w F B)
	(local_echo_on)
	(!)
	(p A))
((palt _ _))

((plog stdin|X)
	(logfile F)
	(w F|X)
	(!))
((plog _|_))

((pplog stdin|X)
	(logfile F)
	(write F|X)
	(!))
((pplog _|_))

((pspaces2 N)
	(logfile F)
	(pspaces3 F N)
	(local_echo_on)
	(!)
	(pspaces N))
((pspaces2 _))

((pspaces3 _ 0)
	(!))
((pspaces3 F N)
	(int N)
	(sum M 1 N)
	(w F " ")
	(pspaces3 F M))

((getb2 stdin X)
	(logfile F)
	(getb stdin X)
	(putb F X)
	(getb3 F X)
	(!))
((getb2 F X)
	(getb F X))

((getb3 _ 10))
((getb3 F _)
	(w F))

((intok2 stdin X)
	(!)
	(logfile F)
	(intok stdin X)
	(w F X)
	(w F))
((intok2 F X)
	(intok F X))

/* ********************************************************************* */

((get_gname N N)
	(int N)
	(!))
((get_gname (G1|L) G2)
	(!)
	(abstr _ G1 L G2))
((get_gname G1 G2)
	(findall N ((abstr _ G1 _ N)) L)
	(get_gname2 G1 L)
	(abstr _ G1 _ G2)) 

((get_gname2 G () )
	(!)
	(p2 Illegal command : graph G does not exist)
	(pp2)
	(addcl ((error_reported command)) )
	(!)
	(fail))
((get_gname2 G (_) )
	(!))
((get_gname2 G _)
	(p2 Ambiguous command : The following graphs match G ':')
	(pp2)
	(glist G)
	(pp2)
	(pp2 'Re-enter command specifying graph by number')
	(addcl ((error_reported command)) )
	(!)
	(fail))

((type _Type)
	(resume)
	(abstr type _Type _ _)
	(print _Type))
((type _Type)
	(sub _Type _)
	(pp2)
	(p2 type _Type ':')
	(pp2)
	(psubtypes _Type)
	(psupertypes _Type)
	(pconforms _Type))

((psubtypes T1)
	(sub T1 T2)
	(p2 '    ') 
	(findall T3 ((sub T3 T2)) L)
	(solesub L)
	(p2 subtype of T2)
	(altsubs T1 L)
	(fail))
((psubtypes _))

((solesub (_) )
	(p2 'sole ')
	(!))
((solesub _))

((altsubs T1 (T1) )
	(!)
	(pp2))
((altsubs T1 L1)
	(delete T1 L1 L2) 
	(p2 ' (alternative subtype')
	(altsubs2 L2)
	(pp2 ')'))

((altsubs2 (T2) )
	(!)
	(p2 ' :' T2))
((altsubs2 L)
	(p2 's : ')
	(ptlist L))

((ptlist (X1 X2 X3 X4 X5|T) )
	(!)
	(ptlist2 (X1 X2 X3 X4) )
	(pp2 ',')
	(pspaces2 16)
	(ptlist2 (X5|T) ))
((ptlist L)
	(ptlist2 L))

((ptlist2 (X) )
	(!)
	(p2 X))
((ptlist2 (H|T) )
	(p2 H)
	(p2 ',')
	(ptlist2 T))

((psupertypes T1)
	(sub _ T1)
	(!)
	(p2 '    immediate supertype of : ')
	(findall T2 ((sub T2 T1)) L)
	(ptlist L)
	(pp2))
((psupertypes _)
	(pp2 '    has no subtypes'))

((pconforms T)
	(ind_conf (_) (T))
	(!)
	(p2 '    conforming individual referent')
	(findall R ((ind_conf (R) (T) )) L1)
	(remdup L1 L2)
	(altsubs2 L2)
	(pp2))
((pconforms _)
	(pp2 '    has no conforming individual referents'))

((concs G1)
	(get_gname G1 G2)
	(forall	((conc G2 _ _ _ _ _))
			((pp2 ((conc G2 A B C D E)) )) ))

((relns G1)
	(get_gname G1 G2)
	(cl ((reln G2|_)) )
	(forall	((reln G2|R))
			((pp2 ((reln G2|R)) )) )
	(!))
((relns G1)
	(get_gname G1 G2)
	(p2 No relations in graph G2)
	(pp2))

((glist all)
	(glist_all _))
((glist _Type)
	(resume)
	(glookup _Type X N)
	(glist2 _Type _ X N))
((glist _Name)
	(resume)
	(glist_all _Name))
((glist _))

((glist_all _Name)
	(resume)
	(pp2)
	(glookup _Type X N)
	(snips glist2 _Type _Name X N)
	(fail))

(glookup
	(graph s 14)
	(individual s 9)
	(schema s 13)
	(prototype s 10)
	(type ' definitions' 4)
	(relation ' definitions' 0)
	(actor ' definitions' 3))

((glist2 _Type _Name X N)
	(findall (_Name P _Num) ((abstr _Type _Name P _Num )) ((N2 P2 M2)|T) )
	(p2 '   ' _Type)
	(p2 X)
	(pspaces2 N)
	(p2 M2)
	(ptab M2)
	(p2 ' :' N2)
	(glist4 _Type P2)
	(glist3 _Type T))

((glist3 _ () ))
((glist3 _Type ((_Name _Params _Num)|T) )
	(p2 '                       ' _Num)
	(ptab _Num)
	(p2 ' :' _Name)
	(glist4 _Type _Params)
	(glist3 _Type T))

((glist4 individual ('#' N) )
	(p2 ' #')
	(pp2 N))
((glist4 individual (X) )
	(p2)
	(pp2 X))
((glist4 _ _)
	(pp2))

((clist G)
	(resume)
	(show_list conc _ G))
((rlist G)
	(resume)
	(show_list reln rel G))
((alist G)
	(resume)
	(show_list reln act G))

((show_list T1 T2 G1)
	(get_gname G1 G2)
	(gcount2 T1 G2 0 _Max 1)
	(pp2)
	(show_list2 T1 T2 G2 0 _Max))

((show_list2 T1 T2 G N1 _Max)
	(less N1 _Max)
	(sum N1 1 N2)
	(show_list3 T1 T2 G N2)
	(show_list2 T1 T2 G N2 _Max))
((show_list2 | _))

((show_list3 conc _ G N)
	(conc G N | _)
	(snips show conc G N))
((show_list3 conc | _)
	(!))
((show_list3 T1 T2 G N)
	(cl ((T1 G N T2 | _)) )
	(snips show T1 G N))
((show_list3 | _))

((show_list4 _ _ () ))
((show_list4 _Type G (H|T) )
	(show _Type G H)
	(show_list4 _Type G T))

((show reln G N)
	(get_reln G N A B L R A1 A2)
	(p2 ' ' N)
	(ptab N)
	(p2 '.  ')
	(preln A B)
	(p2 '  IN CONTEXT:   ')
	(pconleft G L A1 _ _)
	(preln A B)
	(pright A2)
	(conc G R C D _ _)
	(pconc C D)
	(pp2))
((show conc G N)
	(conc G N C1 D1 _ (R|_) )
	(p2 ' ' N)
	(ptab N)
	(p2 '.  ')
	(pconc C1 D1)
	(get_reln G R T B2 N R2 A1 A2)
	(conc G R2 C2 D2 _ _)
	(pstar C1 D1 C2 D2)
	(p2 '  IN CONTEXT:  ')
	(pconc C1 D1)
	(pstar C1 D1 C2 D2)
	(pright A1)
	(preln T B2)
	(pright A2)
	(pconc C2 D2)
	(pp2))
((show conc G N)
	(conc G N C1 D1 (L|_) _)
	(p2 ' ' N)
	(p2 '.  ')
	(pconc C1 D1)
	(get_reln G L T B2 L2 N A1 A2)
	(p2 '  IN CONTEXT:  ')
	(pconleft G L2 A1 C2 D2)
	(preln T B2)
	(pright A2)
	(pconc C1 D1)
	(pstar C1 D1 C2 D2)
	(pp2))
((show conc G N)
	(p2 ' ' N)
	(p2 '.  ')
	(pconc C1 D1)
	(pp2 '  CONTEXT-FREE'))

((get_reln G N A B L2 R2 A1 A2)
	(cl ((reln G N A B L1 R1)) )
	(interp L1 L2 A1)
	(interp R1 R2 A2))

((interp () () 0))
((interp (N) N 0))
((interp L N A)
	(member (A N) L))

((pconleft _ () _ () ()))
((pconleft G L A C D)
	(conc G L C D _ _)
	(pconc C D)
	(pright A))

/* ********************************************************************* */

((pnode conc G N)
	(conc G N C D _ _)
	(pconc C D))
((pnode reln G N)
	(reln G N A B _ _)
	(preln A B))

((pconc C D)
	(p2 '[')
	(pflat C)
	(pref D)
	(p2 ']'))
((pstar C D C D)
	(p2 '*'))
((pstar |_))

((pright 0)
	(p2)
	(pright2))
((pright N)
	(p2 ' -{')
	(p2 N)
	(p2 '}')
	(pright2))

((pright2)
	(name (45 16 32) A)
	(palt '-> ' A))

((preln rel R)
	(p2 '(')
	(p2 R)
	(p2 ')'))
((preln act A)
	(p2 '<<')
	(p2 A)
	(p2 '>>'))

((pref ('%') ))
((pref (M|R) )
	(p2 ':')
	(pref2 R)
	(pmark M))

((pref2 ())
	(!))
((pref2 (R))
	(pflat R)
	(!))
((pref2 (H|T))
	(pflat H)
	(p2 '=')
	(pref2 T))

((pflat () ))
((pflat (H|T))
	(pflat H)
	(pflat T)
	(!))
((pflat '<*')
	(p2 '{'))
((pflat '*>')
	(p2 '}'))
((pflat X)
	(p2 X))

((pmark '%'))
((pmark M)
	(p2 M))

((ptab N)
	(less N 10)
	(p2 ' ')
	(!))
((ptab _))

/* ********************************************************************* */