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

    PROGRAM NAME : 'cg_parse'                AUTHOR : Chris Mitchell
    VERSION      : 1.1                       LAST REVISED : 30-JUL-87
   FRIL VERSION : 3.0

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

/* Definite Clause Grammar for loading conceptual graphs in linear form */

grammar (
( (cstring) --> ((print)) (graphname G) (? ((print G)) ) )
( (cstring) --> ((print)) (graphname G) (opt from) (noderead T A B) (!)
                          (? ((print G T A B)) ) )
( (cstring) --> ((copy)) (!) (graphname G1) (opt to) (graphname G2) 
                         (? ((gcopy G1 G2)) ) )
( (cstring) --> ((expand)) (noderead T A B) (!) (cstring4 G) (!)
                           (? ((expand T A B G)) ) )
( (cstring) --> ((expand)) (label L) (opt in) (noderead conc A B) (!)
                           (cstring4 G)
                           (? ((clookup L R) (expand R A B G)) ) )
( (cstring) --> ((contract)) (noderead reln rel R) (!) (cstring4 G)
                             (? ((contract reln rel R G)) ) )
( (cstring) --> ((contract)) (label L) (!) (cstring4 G)
                             (? ((clookup L R) (contract reln rel R G)) ) )
( (cstring) --> ((restrict)) (noderead conc T1 R1) (cstring4 G) (opt to)
                             (noderead conc T2 R2) (!) 
                             (? ((restrict T1 R1 T2 R2 G)) ) )
( (cstring) --> ((restrict)) (!) (noderead conc T1 R1) (opt to)
                             (noderead conc T2 R2) (cstring4 G)
                             (? ((restrict T1 R1 T2 R2 G)) ) )
( (cstring) --> ((join)) (!) (noderead conc T1 R1) (cstring4 G1) (opt and) 
                         (noderead conc T2 R2) (cstring4 G2) (cstring5 G3) (!)
                         (? ((join T1 R1 G1 T2 R2 G2 G3)) ) )
( (cstring) --> ((maxj)) (!) (graphname G1) (opt and) (graphname G2)
							(cstring5 G3) (!) (? ((max_join G1 G2 G3))) )
)

grammar (
( (cstring) --> ((graph)) (!) (graphname G1) (cstring3 G1 () G2)
                          (? ((abstraction graph G1 () G2)) ) )
( (cstring) --> ((type)) (!) (cstring2 T L G)
                         (? ((abstraction type T (L) G)) ) )
( (cstring) --> ((schema)) (!) ((for)) (cstring2 S L G)
                           (? ((abstraction schema S (L) G)) ) )
( (cstring) --> ((prototype)) (!) ((for)) (cstring2 P L G)
                              (? ((abstraction prototype P (L) G)) ) )
( (cstring) --> ((individual)) (!) (typelabel I) (('(')) (indlabel L)
                               ((')')) (cstring3 I L G)
                               (? ((abstraction individual I L G)) ) )
( (cstring) --> ((relation)) (!) (relnlabel R) (('('))
                             (paramlist () L) ((')'))
                             (!) (cstring3 R L G)
                             (? ((abstraction relation R L G)) ) )
( (cstring) --> ((actor)) (!) (actlabel A) (('(')) ((in))
                          (paramlist () L1) ((';')) ((out))
                          (paramlist () L2) ((')'))
                          (? ((append L1 L2 L)) ) (!) (cstring3 A L G)
                          (? ((abstraction actor A (L1 L2) G)) ) )
)
grammar (
( (cstring2 G1 L G2) --> (typelabel G1) (('(')) (varlabel L) ((')')) 
                         (cstring3 G1 (L) G2) (!))

( (cstring3 G1 L G2) --> ((is)) (!)  (? ((kill reading_graph)(kill fplist)
                         (addcl ((reading_graph G1)) )(addcl ((fplist L)) )) )
                         (cgraphlist G2) (!) )

( (cstring4 G) --> (opt in) (graphname G) )

( (cstring5 G) --> (opt to) (opt give) (graphname G) )

( (noderead conc T R)   --> (opt concept) (concread T R) )
( (noderead reln rel R) --> (opt relation) (relnread rel R) )
( (noderead reln act A) --> (opt actor) (relnread act A) )
( (noderead conc num N) --> ((concept)) (integer N) )
( (noderead reln rel N) --> ((relation)) (integer N) )
( (noderead reln act N) --> ((actor)) (integer N) )

( (opt W) --> ((W)) (!) )
( (opt W) --> (cnull) )
)
grammar (
( (paramlist L1 L2)  --> (varlabel L) (paramlist2 (L|L1) L2) )

( (paramlist2 L1 L2) --> ((',')) (paramlist L1 L2) (!) )
( (paramlist2 L1 L2) --> (cnull) (? ((revlist L1 () L2)) ) )
( (paramlist2 L1 L2) --> (? ((error 160 control (formal parameter list)
								y (paramlist2 L1 L2|_) fail)) ) )

( (cgraphlist G) --> (negsymbol) (!) (('[')) (graphlist () L) ((']'))
                     (? ((new_graph2 G)(addcl ((conc G 1 '-' L () () )) )) ) )
( (cgraphlist G) --> (graphlist () L) (cgraphlist2 G L) )

( (cgraphlist2 G (G) ) --> (cnull) )
( (cgraphlist2 G L)    --> (? ((new_graph2 G)
                               (addcl ((conc G 1 '+' L () () )) )) ) )

( (cgraph G)          --> (cgraph2 G) )
( (cgraph G)          --> (? ((error 161 control (outermost context)
								y (cgraph G|_) fail)) ) )

( (cgraph2 G)         --> (concept2 G N) (!) (cgraph3 G N L R)
                          (? ((update_conc G N L R)
                              (del_matching_cl ((temp _ G | _)) )) ) )
( (cgraph2 G)         --> (relnode2 G N) (!) (conlink right G N L R)
                          (? ((update_reln G N L R)
                              (del_matching_cl ((temp _ G | _)) )) ) )

( (cgraph3 G N L R)   --> (rlink G N L R) (!))
( (cgraph3 G N () ()) --> (cnull) )
)
grammar (
( (rlink G N1 (N) ())     --> (arcc left A) (!) (relnode2 G N)
                              (rlink2 left G N L R)
                              (? ((update_reln G N L ((A N1)|R) )) ) )
( (rlink G N1 () (N))     --> (arcc right A) (!) (relnode2 G N)
                              (rlink2 right G N L R)
                              (? ((update_reln G N ((A N1)|L) R)) ) )
( (rlink G N L R)         --> (('-')) (relist G N L R) (!) (commadot G) )

( (rlink2 D G N L R)      --> (conlink2 D G N L R) (!))
( (rlink2 left G N () ()) --> (cnull) )
)
grammar (
( (conlink D G N L R) --> (conlink2 D G N L R) )
( (conlink D G N L R) --> (? ((error 162 control (arrow usage)
								y (conlink D G N L R|_) fail)) ) )

( (conlink2 left G N1 ((A N)) ())  --> (arcc left A) (!) (concept G N)
                                       (conlink3 G N L R)
                                       (? ((update_conc G N L (N1|R) )) ) )
( (conlink2 right G N1 () ((A N))) --> (arcc right A) (!) (concept G N)
                                       (conlink3 G N L R)
                                       (? ((update_conc G N (N1|L) R)) ) )
( (conlink2 D G N L R)             --> (('-')) (conlist G N L R) (!)
                                       (commadot G) )

( (conlink3 G N L R)               --> (rlink G N L R) (!))
( (conlink3 G N () ())             --> (cnull) )
)
grammar (
( (relist G N L R) --> (newline) (relnode G N2) (!)
                       (rlist3 G N N2 () () L2 R2) (!)
                       (rlist4 G N L2 R2 L R) )
( (relist G N L R) --> (? ((error 163 control (relation list)
								y (relist G N L R|_) fail)) ) )

( (rlist2 G N1 L1 R1 L3 R3)         --> (newline) (relnode2 G N2) (!)
                                        (rlist3 G N1 N2 L1 R1 L2 R2) (!)
                                        (rlist4 G N1 L2 R2 L3 R3) )

( (rlist3 G N1 N2 L1 R1 L1 (N2|R1)) --> (conlink2 right G N2 L R)
                                        (? ((update_reln G N2 ((0 N1)|L) R)) ) )
( (rlist3 G N1 N2 L1 R1 (N2|L1) R1) --> (conlink2 left G N2 L R)
                                        (? ((update_reln G N2 L ((0 N1)|R) ))) )
( (rlist3 G N1 N2 L1 R1 (N2|L1) R1) --> (cnull)
                                        (? ((update_reln G N2 () ((0 N1)) ))) )

( (rlist4 G N L1 R1 L2 R2)          --> (rlist2 G N L1 R1 L2 R2) (!))
( (rlist4 G N L1 R1 L2 R2)          --> (cnull) (? ((revlist L1 () L2)
                                                   (revlist R1 () R2)) ) )
)
grammar (
( (conlist G N L R)           --> (conlist2 G N () () L R) )

( (conlist2 G N1 L1 R1 L2 R2) --> (newline) (arcc left A) (concept G N2) (!) 
                                  (conlist3 G N2 L R)
                                  (? ((update_conc G N2 L (N1|R) )) ) (!)
                                  (conlist4 G N1 ((A N2)|L1) R1 L2 R2) )
( (conlist2 G N1 L1 R1 L2 R2) --> (newline) (arcc right A) (concept G N2) (!)
                                  (conlist3 G N2 L R)
                                  (? ((update_conc G N2 (N1|L) R)) ) (!)
                                  (conlist4 G N1 L1 ((A N2)|R1) L2 R2) )

( (conlist3 G N L R)          --> (rlink G N L R) (!))
( (conlist3 G N () ())        --> (cnull) )

( (conlist4 G N L1 R1 L2 R2)  --> (conlist2 G N L1 R1 L2 R2) (!))
( (conlist4 G N L1 R1 L2 R2)  --> (cnull) (? ((revlist L1 () L2)
                                             (revlist R1 () R2)) ) )
)
grammar (
( (arcc left A) --> (('<-')) (leftarc2 A) (!) )

( (leftarc2 A) --> (('{')) (!) (integer A) (('}')) (('-')) )
( (leftarc2 0) --> (cnull) )

( (arcc right A) --> (rightarc2 A) (('->')) (!) )

( (rightarc2 A) --> (('-')) (('{')) (!) (integer A) (('}')) )
( (rightarc2 0) --> (cnull) )

( (relnode G N)  --> (relnode2 G N) )
( (relnode G N)  --> (? ((error 164 control (relation node)
							y (relnode G N|_) fail)) ) )

( (relnode2 G N) --> (('(')) (!) (relnlabel R) ((')')) 
                     (? ((new_node reln G N rel R)) ) (!) )
( (relnode2 G N) --> (('<<')) (!) (actlabel A) (('>>'))
                     (? ((new_node reln G N act A)) ) (!) )

( (relnread rel R) --> (('(')) (relnlabel R) ((')')) )
( (relnread act R) --> (('<<')) (actlabel A) (('>>')) )

( (concread T R) --> (('[')) (typefield T0 T) (concept3 T0 R) ((']')) )

( (typeread T)   --> (typelabel T) )
)
grammar (
( (concept G N)  --> (concept2 G N) )
( (concept G N)  --> (? ((error 165 control (concept node)
							y (concept G N|_) fail)) ) )

( (concept2 G N) --> (('[')) (typefield T0 T) (concept3 T0 R) ((']'))
                     (? ((conf_load G T R)(new_node conc G N T R)) ) (!) )
( (concept2 G N) --> (concept4 S) (('[')) (graphlist () L) ((']'))
                     (? ((new_node conc G N S L)) ) (!) )
( (concept2 G N) --> (('[')) (!) (reffield name R) ((']'))
                     (? ((new_node conc G N (name) R)) ) )

( (concept3 T0 R)     --> ((':')) (reffield T0 R) (!) )
( (concept3 T0 ('%')) --> ((':')) (('*')) (!) )
( (concept3 T0 ('%')) --> (cnull) )

( (concept4 '-')      --> (('NOT')) (!) )
( (concept4 '+')      --> (cnull) )

( (graphlist L1 L2)  --> (new_graph G) (cgraph G) (graphlist2 (G|L1) L2) )

( (graphlist2 L1 L2) --> (graphlist L1 L2) (!) )
( (graphlist2 L1 L2) --> (cnull) (? ((revlist L1 () L2)) ) )
)
grammar (
( (typefield T0 (lambda L G1) ) --> ((lambda)) (!) (varlabel L)
                                    (new_graph G1) (cgraph2 G1) (!)
                                    (? ((conc G1 _ (T0) (_|R) _ _)
                                        (member ('*' L) R)) ) )
( (typefield T0 (T0) )          --> (typelabel T0) )
( (typefield T0 T)              --> (subrange T0 T) )

( (subrange T0 (S|(T0 (R N U))) ) --> (subrange2 S) (typelabel T0)
                                      (relnship R) (measure N U) )
( (subrange2 (N U R) )            --> (measure N U) (relnship R) (!) )
( (subrange2 ())                  --> (cnull) )

( (reffield T0 (M) )           --> (markfield M) )
( (reffield T0 (M|R) )         --> (referent T0 () R) (markfield M) )
( (reffield T0 ('%' (cgr G)) ) --> (new_graph G) (cgraph2 G) )

( (markfield '?') --> (qmark) (!) )
( (markfield '!') --> (emark) (!) )
( (markfield '%') --> (cnull) )

( (referent name R1 R2)    --> (('"')) (!) (label N) (('"'))
                               (referent2 name (('"' N '"')|R1) R2) )
( (referent number R1 R2)  --> (realnumber N) (!)
                               (referent2 number ((N)|R1) R2) )
( (referent measure R1 R2) --> (measure2 N) (!) (measure3 U) (!)
                               (referent2 measure ((N U)|R1) R2) )
( (referent T0 R1 R2)      --> (indref R) (!) (referent2 T0 (R|R1) R2) )

( (referent2 T0 R1 R2)     --> (('=')) (referent T0 R1 R2) (!) )
( (referent2 T0 R1 R2)     --> (cnull) (? ((revlist R1 () R2)) ) )
)
grammar (
( (indref ('#' I))             --> (('#')) (integer I) )
( (indref ('#' () ))           --> (('#')) (!) )
( (indref ('*' L))             --> (('*')) (!) (varlabel L) )
( (indref ('@' N U))           --> (('@')) (measure2 N) (measure3 U) )
( (indref ('<*' S '*>' A I))   --> (('{')) (setref () S) (('}')) (indref2 A I))
( (indref ('<*' D '*>'))       --> (('{')) (!) (disjset () D) (('}')) )
( (indref ('Dist' '<*' S '*>' A I)) --> (('Dist')) (!) (('{')) (setref () S)
                                        (('}')) (indref2 A I) )
( (indref ('Resp' '<' S '>'))  --> (('Resp')) (!) (('<')) (sequence () S)
                                   (('>')) )
( (indref ('"' N '"'))         --> (('"')) (!) (label N) (('"')) )
( (indref (R))                 --> (label R) (!) )
( (indref ())                  --> (cnull) )

( (indref2 '@' L) --> (('@')) (disjlist () L) (!) )
( (indref2 () ()) --> (cnull) )

( (disjlist L1 L2)     --> (integer I) (disjlist2 (I|L1) L2) )

( (disjlist2 L1 L2)    --> (('|')) (disjlist ('|'|L1) L2) )
( (disjlist2 (L) (L) ) --> (cnull) )
( (disjlist2 L1 L2)    --> (cnull) (? ((revlist L1 () L2)) ) )
)
grammar (
( (relnship '=')  --> (('=')) )
( (relnship '<')  --> (('<')) )
( (relnship '>')  --> (('>')) )
( (relnship '<=') --> (('<=')) )
( (relnship '>=') --> (('>=')) )
( (relnship '~')  --> (('~')) )

( (measure N U) --> (realnumber N) (measure3 U) )

( (measure2 N)  --> (realnumber N) (!) )
( (measure2 ()) --> (cnull) )

( (measure3 U)  --> (unit U) (!) )
( (measure3 ()) --> (cnull) )

( (setref S1 S2)  --> (('*')) (!) (setref2 ('*'|S1) S2) )
( (setref S1 S2)  --> (indref X) (!) (setref2 (X|S1) S2) )
( (setref S1 S2)  --> (element E) (setref2 (E|S1) S2) )

( (setref2 S1 S2) --> ((',')) (setref (','|S1) S2) (!) )
( (setref2 S1 S2) --> (cnull) (? ((revlist S1 () S2)) ) )
)
grammar (
( (disjset D1 D2)  --> (element E) (disjset2 (E|D1) D2) )

( (disjset2 D1 D2) --> (('|')) (disjset ('|'|D1) D2) (!) )
( (disjset2 D1 D2) --> (cnull) (? ((revlist D1 () D2)) ) )

( (element E)       --> (label E) (!) )
( (element (cgr G)) --> (new_graph G) (cgraph2 G) )

( (sequence S1 S2)  --> (label E) (sequence2 (E|S1) S2) )

( (sequence2 S1 S2) --> ((',')) (sequence (','|S1) S2) (!) )
( (sequence2 S1 S2) --> (cnull) (? ((revlist S1 () S2)) ) )

( (newline) --> (()) )

( (cnull)    --> (()) )

( (indlabel ('#' L))   --> (('#')) (integer L) )
( (indlabel (L))       --> (label L) )

( (typelabel (not T) ) --> (negsymbol) (!) (label T) )
( (typelabel T)        --> (label T) )

( (relnlabel (not R) ) --> (negsymbol) (!) (label R) )
( (relnlabel R)        --> (label R) )

( (actlabel (not A) )  --> (negsymbol) (!) (label A) )
( (actlabel A)         --> (label A) )

( (graphname N)      --> ((graph)) (integer N) )
( (graphname N)      --> (integer N) )
( (graphname G)      --> (label G) )
( (graphname N)      --> (label G) (indlabel _ N) (get_gname G N) )

( (unit U)      --> (label U) )

( (varlabel V)  --> (label V) )
)

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