1% load.pl : Load Chat-80, for Quintus Prolog
    2
    3/*
    4 _________________________________________________________________________
    5|	Copyright (C) 1982						  |
    6|									  |
    7|	David Warren,							  |
    8|		SRI International, 333 Ravenswood Ave., Menlo Park,	  |
    9|		California 94025, USA;					  |
   10|									  |
   11|	Fernando Pereira,						  |
   12|		Dept. of Architecture, University of Edinburgh,		  |
   13|		20 Chambers St., Edinburgh EH1 1JZ, Scotland		  |
   14|									  |
   15|	This program may be used, copied, altered or included in other	  |
   16|	programs only for academic purposes and provided that the	  |
   17|	authorship of the initial program is aknowledged.		  |
   18|	Use for commercial purposes without the previous written 	  |
   19|	agreement of the authors is forbidden.				  |
   20|_________________________________________________________________________|
   21
   22*/
   23%:- '$set_source_module'(baseKB).
   24:- trace_or_throw('$set_typein_module'(baseKB)).   25
   26:- ensure_loaded(xgproc).	% XG generator
   27
   28:- load_plus_xg_file(parser_chat80,'clone.xg').   29:- load_plus_xg_file(parser_chat80,'lex.xg').   30
   31:- include(xgrun).	% XG runtimes
   32:- list('newg.pl').   33
   34% :- include(newg).		% clone + lex
   35:- include(clotab).	% attachment tables
   36:- include(newdict).	% syntactic dictionary
   37:- include(slots).	% fits arguments into predicates
   38:- include(scopes).	% quantification and scoping
   39:- include(templa).	% semantic dictionary
   40:- include(qplan).	% query planning
   41:- include(talkr).	% query evaluation
   42:- include(ndtabl).	% relation info.
   43:- include(readin).	% sentence80 input
   44:- include(ptree).	% print trees
   45:- include(aggreg).	% aggregation operators
   46:- include(world0).     	% data base
   47:- include(rivers).   48:- include(cities).   49:- include(countries).   50:- include(contain).   51:- include(borders).   52:- include(newtop).	% top level
   53
   54
   55
   56
   57bad_chat80 :-
   58  told,
   59  told,
   60   repeat,
   61   prompt(_,'Question: '),
   62   trace,readin80:read_sent(P),
   63      control80(report,P),
   64      end(user)