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

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

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

((conf_check load off))

((commadot G ('.') ('.') ))
((commadot G (',' | X) X)  (!))
((commadot _ (',' | X) _)  (errory 'comma usage' (','|X) _))

((qmark ('?' | X) X))

((emark ('!' | X) X))

((negsymbol ('*' | X) X)  (!))
((negsymbol ('NOT' |X) X) (!))
((negsymbol (C | X) X)    (charof C 170))

((integer N (N|X) X)       (int N))
((integer _Value (N|X) X)  (name L N) (digit_list L 0 _Value 10) (!))

((realnumber N (N|X) X)       (num N))
((realnumber _Value (N|X) X)  (name L N) (realnum2 L _Value))

((realnum2 L _Value)
        (digit_list L 0 _Value 10) (!))
((realnum2 L _Value)
        (append L1 (46 | L2) L) (digit_list L1 0 V1 10) (revlist L2 () L3)
        (digit_list L3 0 V2 0.1) (times V2 0.1 V3) (sum V1 V3 _Value) (!))

((digit_list () _Value _Value _)
        (!))
((digit_list (H|T) V1 V4 _Factor)
        (digit H) (sum V 48 H) (times V1 _Factor V2) (sum V2 V V3)
        (digit_list T V3 V4 _Factor))

((digit X)             (less 47 X) (less X 58) (!))

((label L (L|X) X)     (con L) (negg reserved_word L)
                       (name (H|_) L) (orr ((letter H)) ((digit H))) (!))

((letter X)            (orr ((lower_case X)) ((capital X)) ) (!))

((capital X)           (less 64 X) (less X 91) (!))

((lower_case X)        (less 96 X) (less X 123))

((lcletter L (L|X) X)  (charof L N) (lower_case N) (!))

(reserved_word (concept) (relation) (actor) (from) (to) (is) (in) )

(clookup (measure meas) (quantity qty) (name name) )

((new_graph G (T|X) (T|X) )
        (valid_gtok T) (new_graph2 G))

((new_graph2 G)
        (name_graph G) (gflush2 G)
        (del_matching_cl ((temp _ G | _)) )
        (del_matching_cl ((count _ G _)) )
        (!))

(valid_gtok ('[') ('(') ('<<') ('NOT') )

((name_graph G)  (delcl ((last_graph_num _Old)) )
                 (!) (sum _Old 1 G)
                 (addcl ((last_graph_num G)) ))
((name_graph 1)  (addcl ((last_graph_num 1)) ))

((del_matching_cl X)  (cl X) (delcl X) (fail))
((del_matching_cl _)  (kb_garbage))

((conf_load _ _ _)      (conf_check load off) (!))
((conf_load _ T R)      (conf_check load on) (conforms (_|R) T))
((conf_load _ T (_|R))  (errory 'type:referent combination' (R T) _))

((new_node conc G N T R)
        (cl ((temp conc G N T R)) )
        (member ('*' _) R)
        (!))
((new_node _Type G N1 A B)
        (cdict count)
        (delcl ((count _Type G N)) )
        (sum N 1 N1)
        (addcl ((count _Type G N1)) )
        (addcl ((temp _Type G N1 A B)) )
        (!))
((new_node _Type G 1 A B)
        (addcl ((count _Type G 1)) )
        (addcl ((temp _Type G 1 A B)) ))

((update_conc G N L1 R1)
        (delcl ((conc G N A B1 L2 R2)) )
        (delete_xref B1 B2)
        (append L1 L2 L)
        (append R1 R2 R)
        (addcl ((conc G N A B2 L R)) 0)
        (!))
((update_conc G N L R)
        (cl ((temp conc G N A B)) )
        (addcl ((conc G N A B L R)) 0))

((delete_xref R1 R2)  (fplist L) (!) (delete_xref2 R1 R2 L))
((delete_xref R1 R2)  (delete_xref2 R1 R2 () ))

((delete_xref2 R1 R2 L)
        (delete ('*' _Param) R1 R2) (negg member _Param L) (!))
((delete_xref2 R R _))

((update_reln G N L R)
        (order 0 N1 L L1)
        (order N1 _ R R1)
        (cl ((temp reln G N A B)) )
        (addcl ((reln G N A B L1 R1)) 0)
        (!))
((update_reln G N _ _)
        (cl ((temp reln G N A B)) )
        (errory 'arc numbering' (A B) _))

((order _ 1 ((_ N)) (N) )  (!))
((order C1 C2 L1 L1)       (order2 C1 C2 L1))

((order2 C C ())  (!))
((order2 C C2 L)  (sum C 1 C1) (delete (C1 _) L L1) (order2 C1 C2 L1))

((abstraction _Type _Label _Params G)
        (fplist L)
        (check_params L G)
        (addcl ((abstr _Type _Label _Params G)) ))

((check_params ('#' N) G)
        (!) (conc G _ _ (_|R) _ _) (member ('#' N) R))
((check_params () _))
((check_params (H|T) G)
        (conc G _ _ (_|R) _ _) (member ('*' H) R) (!) (check_params T G))
((check_params (H|_) G)
        (errory 'formal parameter usage' (H) _))

((errory _Name (H|T) _)
        (reading_graph G)
        (negg cl ((error_reported G)) )
        (p2 Syntax error ':' illegal _Name in conceptual graph G ':')(pp2)
        (error2 _Name H T)
        (!)
        (negg eq G '')
        (addcl ((error_reported G)) )
        (fail))

((error2 'outermost context' L1 L)
        (p2 L1)(print_head 200 L)(pp2))
((error2 'arc numbering' rel R)
        (p2 'Arcs badly numbered for relation  "' R '"')(pp2))
((error2 'arc numbering' act (A) )
        (p2 'Arcs badly numbered for actor  " <<')(p2 A)(p2 '>> "')(pp2))
((error2 'formal parameter usage' P _)
        (p2 Parameter P is not referenced in body of abstraction)(pp2))
((error2 'type:referent combination' R (T) )
        (p2 'Referent  "')(pref2 R)(p2 '"  does not conform to type  "')
        (pflat T)(p2 '"'))
((error2 _Name L1 L)
        (p2 'Sequence  "')(p2 L1)(print_head 7 L)(pp2 '"  not valid'))

((print_head 0 _)       (!))
((print_head _ ())      (!))
((print_head N (H|T) )  (p2) (p2 H) (sum N1 1 N) (print_head N1 T))

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

((gload _File |X)
        (resume)(pp2)
		(exists _File)
		(gload2 _File X)
        (pp2 'Graphs loaded :')
        (glist all))

((gload2 _File X)
        (open _File)
        (kill last_graph_num)
        (kill error_reported)
        (kill end_of_file)
        (gflush all)
        (read_graphs _File X)
        (close _File)
        (pp2)
        (error_reported _)
        (pp2 'Graphs not correctly loaded - edit and reload'))
((gload2 _ _))

((read_graphs _File (all) )
        (p2 'Loading graphs, please wait.')
        (repeat_eof)
        (snips read_tokens _File () S)
        (p2 '.')
        (end_graphs2 S)
        (snips parse_control 121 S)
        (p2 '.')
        (kb_garbage)
        (fail))
((read_graphs _File (demo) )
        (repeat_eof)
        (snips read_tokens _File () S)
        (end_graphs2 S)
        (snips parse_control 121 S)
        (kb_garbage)
        (fail))
((read_graphs _File ())
        (repeat2)
        (pp2)
        (p2 'Reading next graph :       ')
        (snips read_tokens _File () S)
        (end_graphs S)
        (p2 'Load graph (yes/no/quit) ? ')
        (flush stdin) (peekb stdin X) (charof C X)
        (plog stdin C) (getb3 stdin _)  	/* altered from getb3 stdin X */
        (snips parse_control X S)
        (kb_garbage)
        (fail))
((read_graphs _ _)
        (pp2) (kill end_of_file))

((repeat_eof))
((repeat_eof)  (negg end_of_file) (repeat_eof))

((repeat2))
((repeat2) (peekb stdin X) (negg eq X 113) (negg end_of_file) (repeat2))

((end_graphs (X|_))
        (var X) (pp2 'end of file') (addcl ((end_of_file)) ) (!) (fail))
((end_graphs (H|T) )
        (p2 H)(print_head 3 T)(pp2 '    .....'))

((end_graphs2 (X|_)) (var X) (addcl ((end_of_file)) ) (!) (fail))
((end_graphs2 _))

((parse_control _ () ))
((parse_control 113 _))
((parse_control 110 _))
((parse_control 116 S)  (tq ((cstring S ('.'))) ))
((parse_control _ S)    (cstring S ('.')) (kb_garbage))
((parse_control _ _))

((read_tokens _File (C1 C2) () )
        (peekb _File C) (eq C 10) (!) (frcomm _File (C2 C1) ))
((read_tokens _File (N graph|L1) L2)
        (peekb _File C) (eq C 10) (realnumber R (N) () ) (truncate R I)
        (revlist (I graph|L1) () L2))
((read_tokens stdin L1 L2)
        (peekb stdin C) (eq C 32) (getb stdin _) (read_tokens stdin L1 L2))
((read_tokens stdin L1 L2)
        (peekb stdin C1) (eq C1 10) (!) (getb2 stdin _) (p2 '        > ')
        (peekb stdin C2) (readt2 C2) (read_tokens stdin L1 L2))
((read_tokens _File L1 L2)
        (peekb _File C) (eq C 44) (!) (getb2 _File _) (plog _File ',') 
        (read_tokens _File (','|L1) L2))
((read_tokens _File L1 L2)
        (peekb _File C) (eq C 58) (!) (getb2 _File _) (plog _File ':')
        (read_tokens _File (':'|L1) L2))
((read_tokens _File L1 L2)
        (peekb _File C) (eq C 64) (!) (getb2 _File _) (plog _File '@')
        (read_tokens _File ('@'|L1) L2))
((read_tokens _File L1 L2)
        (peekb _File C) (eq C 34) (!)
        (plog _File '" ') (intok2 _File X) (plog _File '" ')
        (read_tokens _File ('"' X '"'|L1) L2))
((read_tokens _File L1 L2)
		(peek _File C) (capital C) (!)
		(read_word _File W) (plog _File W)
		(read_tokens _File (W|L1) L2))
((read_tokens _File L1 L2)
        (intok2 _File X) (!) (proc_tok _File X L1 L2))
((read_tokens _ _ _)
        (addcl ((end_of_file)) ))

((read_word _File W)
		(getb _File C)
		(peekb _File C1)
		(restword _File C1 L)
		(name (C|L) W))

((restword _File C (C|L))
		(in_word C)
		(!)
		(getb _File _)
		(peekb _File C1)
		(restword _File C1 L))
((restword _File _ () ))

((in_word 95) (!))		/* underscore '_' */
((in_word 45) (!))		/* hyphen '-' */
((in_word C) (letter C) (!))
((in_word C) (digit C))

((frcomm F X) (pplog F) (frcomm2 X))

((frcomm2 (exit '0') )  (exit 0))
((frcomm2 X)            (? (X) ))
((frcomm2 _)            (negg error_reported _) (pp2 'Illegal command')
                        (addcl ((error_reported command)) ))
((frcomm2 _))

((readt2 10)
        (pp2 'Terminate all conceptual graph commands and definitions with "."'))
((readt2 _))

((proc_tok _File '.' (C1 C2) () )  (!) (frcomm _File (C2 C1) ))
((proc_tok _ '.' L1 L2)            (revlist ('.'|L1) () L2))
((proc_tok _ '>>.' L1 L2)          (revlist ('.' '>>'|L1) () L2))
((proc_tok _File '?' () () )       (read _File X) (!) (frcomm _File ('?' X) ))
((proc_tok _File 'tq' () () )      (peekb _File X) (eq X 40)
                                   (read _File X) (!) (tq X))
((proc_tok _File '=*' L1 L2)       (read_tokens _File ('*' '='|L1) L2))
((proc_tok _File X L1 L2)          (read_tokens _File (X|L1) L2))

((gsave _File)
        (create _File) (gsave2 conc _File) (gsave2 reln _File)
        (gsave2 abstr _File) (close _File))

((gsave2 T _File)  (cl ((T | X)) ) (writeq _File ((T|X)) ) (fail))
((gsave2 _ _))

/* prints out the names of all the resident graphs */

((cgmenu X)
	(abstr _Type _Name _ G)
	(negg isa_tmp G)
	(p 'There is a ' _Type 'called' _Name (G) )
	(pp)
	(fail))
((cgmenu _))
	
/* ********************************************************************* */