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

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

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

((run cg)
        (resume) (pp2)
        (pp2 'Terminate all conceptual graph commands and definitions with "."')
        (repeat)
        (snips run_loop)
        (fail))
((run demo)
        (gload2 'cg_demo.frl' (demo) ))

((pclearscreen) (clear_current_window))

((demo cls) (!) (demo3) (pclearscreen) (pp2))
((demo X)   (demo3) (pp2) (p2 'C-Graph >' X) (pp2))

((demo2 cls) (!) (pclearscreen) (pp2))
((demo2 X)  (p2 'C-Graph >' X) (pp2))

((demo3)
		(pp)
        (p '             Pausing, hit <Enter> to continue...')
        (flush stdin) (getb stdin X) (eq X 115) (statistics)
        (demo '')
		(fail))
((demo3))

((run_loop)
        (pp2) 
        (resume) (p2 'C-Graph > ')
        (kill error_reported)
        (kb_garbage)
        (flush stdin)
        (!)
        (snips read_tokens stdin () C)
        (command C))

((command () )          (!))
((command (exit '.') )  (pp2) (abort))
((command (quit '.') )  (pp2) (abort))
((command (tq | C) )    (!) (tq ((cstring C ('.') )) ))
((command C)            (pplog stdin) (cstring C ('.') ))
((command C)            (negg error_reported _)
                        (append C2 ('.') C)
                        (? (C2)) )
((command (H|T) )       (negg error_reported _) (pp2 'Illegal command'))

/* 'gcopy' copies a complete conceptual graph */

((gcopy G1 G2)
        (resume) (abstr _ G1 _ G3)
        (new_graph2 G4)
        (gcopy2 G3 G4)
        (addcl ((abstr graph G2 () G4)) ))

((gcopy2 G1 G2)
        (gflush2 G2)
        (del_matching_cl ((xref G2 _ _)) )
        (gcopy3 reln G1 G2)
        (gcopy3 conc G1 G2)
        (kb_garbage))

((gcopy3 _Node G1 G2)
        (cl ((_Node G1 | X)) )
        (addcl ((_Node G2 | X)) )
        (fail))
((gcopy3 _ _ _))

((simplify G1)
        (resume)
		(get_gname G1 G2)
        (simplify2 G2))

((simplify2 G)
        (cl ((reln G N1 A B L1 R1)) 1 P1)
        (sum P1 1 P2)
        (cl ((reln G N2 A B L2 R2)) P2 _)
        (list_eq L1 L2)
        (list_eq R1 R2)
        (delreln G N2)
		(!)
        (simplify2 G))
((simplify2 _))

((list_eq (N) (N) ))
((list_eq S1 S2)
        (subset S1 S2)
        (subset S2 S1))

((join T1 R1 G1 T2 R2 G2 G3)
        (resume)
        (unique conc G1 G4 N1 T1 R1)
        (unique conc G2 G5 N2 T2 R2)
        (conc G4 N1 T4 R4 _ _)
        (conc G5 N2 T5 R5 _ _)
        (unify T4 R4 T5 R5 T3 R3 _)
        (new_graph2 G6)
        (gcopy2 G4 G6)
        (gadd G5 G6 C)
        (sum N2 C N3)
        (merge_node G6 N3 N1 T3 R3)
        (extend_join G6 N1)
        (addcl ((abstr graph G3 () G6)) ))

((extend_join G N)
        (resume) (extend2 G (N) ))

((extend2 G () ))
((extend2 G (N|T) )
        (conc G N _ _ L R)
        (snips pfindcons G N L R () F)
        (append _ (N1 F1|F2) F)
        (conc G N1 T1 R1 _ _)
        (member N2 (F1|F2) )
        (conc G N2 T2 R2 _ _)
        (unify T1 R1 T2 R2 T3 R3 _)
        (merge_node G N1 N2 T3 R3)
        (append (N|T) (N2) L2)
        (extend2 G L2))
((extend2 G (_|T) )
        (extend2 G T))

((restrict T1 R1 T2 R2 G)
        (resume) 
        (unique conc G G2 N T1 R1)
        (conc G2 N T3 R3 L R)
        (unify T3 R3 T2 R2 _ _ _)
        (delcl ((conc G2 N T3 R3 L R)) )
        (addcl ((conc G2 N T2 R2 L R)) ))

((expand qty T R G)
        (resume)
        (unique conc G G2 N2 T R)
        (conc G2 N2 T2 (M|R2) L1 R1)
        (delete ('<*' L '*>' '@' N) R2 R3)
        (eq _Ref (('<*' L '*>')|R3) )
        (!) (gcount G2 _Concs _Relns)
        (sum _Relns 1 N3) (sum _Concs 1 N4)
        (delcl ((conc G2 N2 |_)) )
        (addcl ((conc G2 N2 T2 (M|_Ref) L1 (N3|R1) )) )
        (addcl ((reln G2 N3 rel qty (N2) (N4) )) )
        (addcl ((conc G2 N4 (number) ('%' (N)) (N3) () )) ))
((expand meas T R G)
        (resume)
        (unique conc G G2 N2 T R)
        (conc G2 N2 T2 (M|R2) L1 R1)
        (delete ('@' N U) R2 _Ref)
        (!) (gcount G2 _Concs _Relns)
        (sum _Relns 1 N3) (sum _Concs 1 N4)
        (delcl ((conc G2 N2 |_)) )
        (addcl ((conc G2 N2 T2 (M|_Ref) L1 (N3|R1) )) )
        (addcl ((reln G2 N3 rel meas (N2) (N4) )) )
        (addcl ((conc G2 N4 (measure) ('%' (N U)) (N3) () )) ))
((expand name T R G)
        (resume)
        (unique conc G G2 N2 T R)
        (conc G2 N2 T2 (M|R2) L1 R1)
        (delete (_Name) R2 _Ref) (label _Name (_Name|_) _)
        (!) (gcount G2 _Concs _Relns)
        (sum _Relns 1 N3) (sum _Concs 1 N4)
        (delcl ((conc G2 N2 |_)) )
        (addcl ((conc G2 N2 T2 (M|_Ref) L1 (N3|R1) )) )
        (addcl ((reln G2 N3 rel name (N2) (N4) )) )
        (addcl ((conc G2 N4 (name) ('%' ('"' _Name '"')) (N3) () )) ))


((expand conc (_Type) _Ref G)
        (resume)
        (unique conc G G2 N2 (_Type) _Ref)
        (abstr type _Type (_Param) G3)
        (conc G3 N3 T2 ('%' ('*' _Param)) _ _)
        (new_graph2 G4)
        (gcopy2 G2 G4)
        (gadd G3 G4 C)
        (sum N3 C N4)
        (merge_node G4 N4 N2 T2 _Ref)
        (abstr T _Name P G2)
        (addcl ((abstr T _Name P G4)) )
        (gflush2 G2))
((expand conc (_Type) _Ref G)
	(negg abstr type _Type _ _)
	(p 'Error - There is no type definition for ' _Type)(pp)
	(!)(fail))

((expand reln A B G)  (unique reln G G2 N A B) (resume) (rexpand A N G2))

((rexpand rel N G)
        (reln G N rel _Relation L R)
        (abstr relation _Relation _Params G2)
        (append _In_params (_Out_param) _Params)
        (rexpand2 G G2 N _In_params (_Out_param) L R))

((rexpand act N G)
        (reln G N act _Actor L R)
        (abstr actor _Actor (_In_params _Out_params) G2)
        (rexpand2 G G2 N _In_params _Out_params L R))

((rexpand2 G G2 N _In_params _Out_params L R)
        (new_graph2 G3)
        (gcopy2 G G3)
        (gadd G2 G3 _)
        (delreln G3 N)
        (!)
        (snips link_concs G3 G2 _In_params L 0 N1)
        (snips link_concs G3 G2 _Out_params R N1 _)
        (abstr T _Name P G)
        (addcl ((abstr T _Name P G3)) )
        (gflush2 G))

((delreln G N)
        (delcl ((reln G N _ _ L R)) )
        (delrefs left G N L)
        (delrefs right G N R))

((delrefs _ _ _ () ))
((delrefs D G N1 ((_ N2)|T) )
        (!)
        (delref2 D G N1 N2)
        (delrefs D G N1 T))
((delrefs D G N1 (N2) )
        (delref2 D G N1 N2))

((delref2 left G N1 N2)
        (delcl ((conc G N2 A B L R1)) )
        (delete N1 R1 R2)
        (addcl ((conc G N2 A B L R2)) ))
((delref2 right G N1 N2)
        (delcl ((conc G N2 A B L1 R)) )
        (delete N1 L1 L2)
        (addcl ((conc G N2 A B L2 R)) ))

((link_concs G G2 (_Param) (C1) _ 1)
        (conc G C2 T2 ('%' ('*' _Param)) _ _)
        (link_conpair G G2 C1 C2 T2))
((link_concs _ _ () () _ _))
((link_concs G G2 (_Param|T) L1 A1 A3)
        (sum A1 1 A2)
        (delete (A2 C1) L1 L2)
        (conc G C2 T2 ('%' ('*' _Param)) _ _)
        (!)
        (link_conpair G G2 C1 C2 T2)
        (snips link_concs G G2 T L2 A2 A3))

((link_conpair G _ C1 C2 T2)
        (conc G C1 T1 R1 _ _)
        (unify T1 R1 T2 ('%') _ _ _)
        (merge_node G C2 C1 T1 R1))
((link_conpair G G2 C1 _ T2)
        (conc G C1 T1 R1 _ _)
        (abstr _Type _Name _ G2)
        (pp2) (p2 Error in _Type expansion ': concept ') (pconc T2 ('%') )
        (p2 ' in' _Type definition for _Name) (pp2)
        (p2 'does not unify with concept ') (pconc T1 R1) (pp2)
        (gflush2 G)
        (addcl ((error_reported command)) )
        (!) (fail))

((gflush all) (!) (kill conc) (kill reln) (kill abstr))
((gflush G1)  (get_gname G1 G2) (gflush2 G2))

((gflush2 G)
        (del_matching_cl ((conc G | _)) )
        (del_matching_cl ((reln G | _)) )
        (del_matching_cl ((abstr _ _ _ G)) ))

((unique _ G G2 N _ N)
        (int N) (!)
        (get_gname G G2))
((unique _Type G G2 N2 A B)
        (get_gname G G2)
        (findall N ((_Type G2 N A B _ _)) L)
        (kb_garbage)
        (unique2 _Type G G2 L)
        (cl ((_Type G2 N2 A B _ _)) )
        (!))

((unique2 _ _ _ (N) ))
((unique2 _Type G G2 (N1|N) )
        (nlookup _Type G2 N1 _Name)
        (pp2)
        (p2 'Ambiguous command : The following' _Name)
        (p2 s in graph G match '') (pnode _Type G2 N1) (pp2)
        (show_list4 _Type G2 (N1|N))
        (pp2) (p2 Re-enter command, specifying _Name by number)
        (addcl ((error_reported command)) )
        (pp2) (!) (fail))

((nlookup conc _ _ concept) (!))
((nlookup reln G N R)       (reln G N R _ _ _))

((gadd G1 G2 C)
        (negg eq G1 G2)
        (gcount G2 C R)
        (offset conc G1 G2 C R)
        (offset reln G1 G2 R C))

((gcount G _Concs _Relns)
        (gcount2 conc G 0 _Concs 1)
        (gcount2 reln G 0 _Relns 1))

((gcount2 _Type G N1 N3 S)
        (cl ((_Type G N2 _ _ _ _)) S S1)
        (less N1 N2)
        (sum S1 1 S2)
        (gcount2 _Type G N2 N3 S2))
((gcount2 _ _ N N _))

((offset _Type G1 G2 V1 V2)
        (cl ((_Type G1 N1 A B L1 R1)) )
        (sum N1 V1 N2)
        (addoff V2 L1 () L2)
        (addoff V2 R1 () R2)
        (addcl ((_Type G2 N2 A B L2 R2)) )
        (fail))
((offset _ _ _ _ _))

((addoff _ () L1 L2)
        (!)
        (revlist L1 () L2))
((addoff V ((A N1)|T) L1 L2)
        (!)
        (int N1)
        (sum N1 V N2)
        (addoff V T ((A N2)|L1) L2))
((addoff V (N1|T) L1 L2)
        (int N1)
        (sum N1 V N2)
        (addoff V T (N2|L1) L2))

((merge_node G N1 N2 T R)
        (delcl ((conc G N1 _ _ L1 R1)) )
        (delcl ((conc G N2 _ _ L2 R2)) )
        (union L1 L2 L3)
        (union R1 R2 R3)
        (addcl ((conc G N2 T R L3 R3)) )
        (relupdate G N1 N2))

((relupdate G C1 C2)
        (reln G N _ _ L1 _)
        (snips subst C1 L1 C2 L2)
        (delcl ((reln G N A B _ R)) )
        (addcl ((reln G N A B L2 R)) 0)
        (relupdate G C1 C2))
((relupdate G C1 C2)
        (reln G N _ _ _ R1)
        (snips subst C1 R1 C2 R2)
        (delcl ((reln G N A B L _)) )
        (addcl ((reln G N A B L R2)) 0)
        (relupdate G C1 C2))
((relupdate _ _ _))

((subst C1 ((A1 N1)|T1) C2 L2)
        (!)
        (append L1 ((A2 C1)|T2) ((A1 N1)|T1) )
        (append L1 ((A2 C2)|T2) L2))
((subst C1 L1 C2 L2)
        (append L3 (C1|T1) L1)
        (append L3 (C2|T1) L2))