% GULP -- Graph Unification and Logic Programming % Michael A. Covington % Artificial Intelligence Programs % University of Georgia % Athens, Georgia 30602 % For documentation see "GULP 2.0: An Extension of Prolog % for Unification-Based Grammar," available as a research % report from the above address. % DO NOT EDIT WITH AHED -- % EDIT ONLY WITH AN EDITOR THAT PRESERVES ASCII TAB CHARACTERS. % This is the Quintus Prolog version. % To obtain the Arity Prolog version, perform the % following editing changes: % % change all /*-A*/ to %-A % change all %+A to /*+A*/ % change all /*+Q*/ to %+Q % change all %-Q to /*-Q*/ % % The ALS Prolog version (which we are not sure is complete!) % can be obtained analogously, reading A as L above. % (At Georgia we use a program called GULPMAKE to make these changes.) % Notation: %+X or /*+X*/ means 'add this line in version X'. % %-X or /*-X*/ means 'remove this line in version X'. % Here X is A for Arity, Q for Quintus, L for ALS, % and/or T for a version that prints test messages. % ----------------------------------------------------------------- % GULP is a syntactic extension of Prolog for handling % feature structures. % GULP accepts a Prolog program containing a special notation % for feature structures, and translates it into a standard % Prolog program which is placed into the knowledge base. % Feature structures are converted into an internal data type % known as value lists. % New in version 1.2: % Correction of a serious bug that prevented g_translate from % translating internal to external representation in Quintus. % Correction of a bug that prevented ed/1 from working in Quintus. % Deletion of some rarely used predicates (g_ed, g_listing, etc.) % which had more commonly used synonyms (ed, list, etc.). % Modification of list/1 to translate feature structures back into GULP % notation before displaying them. % Introduction of new utilities: list/0, g_error/1, writeln/1. % New in version 2.0: % The separator for feature-value pairs is .. rather than ::. For % compatibility, :: is still accepted. % A completely different method of translation using stored schemas, % resulting in much faster translation of GULP notation into % the internal representation for feature structures and vice versa. % The g_features clause is OPTIONAL. % Many minor changes have been made to the utility predicates % available to the user. % Backtranslation of feature structures containing variables is % now correct. % Nested loads are now supported. That is, a file being loaded can % contain a directive such as ':- load file2.' which will be % executed correctly. /******************************* * Source file integrity check * *******************************/ % If GULPMAKE is run correctly, the following % lines will be commented out in all versions. /*-A*/ %-Q /*-L*/ :- write('NOT A CORRECTLY PREPARED SOURCE FILE!'), /*-A*/ %-Q /*-L*/ put(7), put(7). /********************** * Version identifier * **********************/ %+A g_version('> GULP 2.0d for Arity Prolog 4.0'). /*+Q*/ g_version('> GULP 2.0d for Quintus Prolog 2.0'). %+L g_version('> GULP 2.0d for ALS Prolog 1.2'). /*+Q*/ :- g_version(X), version(X). /************************* * Operator declarations * *************************/ %+A :- reset_op. :- op(600,xfy,':'). :- op(601,xfy,'..'). :- op(601,xfy,'::'). /* Deprive 'case' of its operator status in Arity Prolog. This makes the 'case' statement unusable but allows us to use 'case' without quotes as a feature name. */ %+A :- op(0,fx,'case'). /****************************************************************** * Translation of feature structures to value lists or vice versa * ******************************************************************/ /*-L*/ :- public g_translate/2. %+A :- visible g_translate/2. g_translate(X,X) :- var(X), !. /* Rare case, but not covered by other clauses */ g_translate(Structure,List) :- var(List), !, nonvar(Structure), g_tf(Structure,List). g_translate(Structure,List) :- nonvar(List), g_tb(Structure,List). /************************************************************* * Translation backward -- value lists to feature structures * *************************************************************/ /* * g_tb(FeatureStructure,ValueList) "Translate Backward" * * Translates backward using g_backward_schema. */ g_tb(Value,Value) :- ( var(Value) ; atom(Value) ; number(Value) %+A ; %+A string(Value) ), !. /* Variables and atomic terms do not need any conversion. */ g_tb(FS,Term) :- %-Q Term \= g_(_,_), /*+Q*/ \+ (Term = g_(_,_)), !, Term =.. [Functor | Args], g_tb_list(NewArgs,Args), FS =.. [Functor | NewArgs]. /* Term is a structure, but not a value list. Recursively convert all its arguments, which may be, or contain, value lists. */ g_tb(FS,Term) :- call(g_backward_schema(RawFS,Term)), g_tb_fixup(RawFS,FS). /* If we get here, we know Term is a value list. */ /* * g_tb_fixup(RawFeatureStructure,FeatureStructure) * * Reverses the order of the feature:value pairs. * Recursively backtranslates the values. * Also discards pairs with uninstantiated value. */ g_tb_fixup(F:V,Result) :- /* Singleton case */ g_tb_fixup_rest(F:V,_,Result). g_tb_fixup(F:V..Rest,Result) :- g_tb(BTV,V), g_tb_add(F:BTV,_,FV), g_tb_fixup_rest(Rest,FV,Result). /* Start the recursion */ g_tb_fixup_rest(F:V..Rest,ResultSoFar,Result) :- g_tb(BTV,V), g_tb_add(F:BTV,ResultSoFar,FVR), g_tb_fixup_rest(Rest,FVR,Result). /* Continue the recursion */ g_tb_fixup_rest(F:V,ResultSoFar,FVR) :- g_tb(BTV,V), g_tb_add(F:BTV,ResultSoFar,FVR). /* End the recursion */ g_tb_add(_:V,R,R) :- var(V), !. /* Unmentioned variable */ g_tb_add(F:g_(V),R,F:V) :- var(R). /* First contribution to empty R */ g_tb_add(F:g_(V),R,F:V..R) :- nonvar(R). /* Ordinary case */ /* * g_tb_list(FeatureStructureList,ValueListList) * * Applies g_tb to ValueListList giving FeatureStructureList. */ g_tb_list([],[]). g_tb_list([FH|FT],[VH|VT]) :- g_tb(FH,VH), g_tb_list(FT,VT). /************************************************************ * Translation forward -- feature structures to value lists * ************************************************************/ /* * This is more complicated than translation backward because any * feature can occur anywhere in the feature structure. If several * features are specified, separate value lists are constructed * for them and then unified. Recursion is performed because the * the value of a feature structure may itself be a feature structure. */ /* * g_tf(FeatureStructure,ValueList) "Translate Forward" * * Recursively examines FeatureStructure and replaces all * feature structures with equivalent value lists. */ g_tf(Term,Term) :- ( var(Term) ; atom(Term) ; number(Term) %+A ; %+A string(Term) ), !. /* Simplest and most frequent case: Term is atomic. */ g_tf(Term,_) :- g_not_fs(Term), Term =.. [X|_], (X = ':' ; X = '..' ; X = '::'), !, g_error(['Invalid GULP punctuation: ' ,Term]). /* If Term is a structure with a colon as its functor, but is not a valid feature structure, then we have a syntax error. */ /* This clause is presently a time-waster. It needs to be combined with the following clause. */ g_tf(Term,NewTerm) :- g_not_fs(Term), !, Term =.. [Functor|Args], g_tf_list(Args,NewArgs), NewTerm =.. [Functor|NewArgs]. /* Term is a structure, but not a feature structure. Recurse on all its arguments, which may be, or contain, feature structures. */ g_tf(Feature:Value,ValueList) :- !, g_tf(Value,NewValue), g_tfsf(Feature,g_(NewValue),ValueList). /* We have a Feature:Value pair. Recursively translate the value, which may itself be or contain a feature structure, and then convert Feature:NewValue into a value list in which only one value is specified. */ /* In Version 2, this adds g_/1 in front of every value actually mentioned in the program. */ g_tf(FeatureStructure .. Rest,ValueList) :- !, g_tf(FeatureStructure,VL1), g_tf(Rest,VL2), g_unify(FeatureStructure..Rest,VL1,VL2,ValueList). /* A compound feature structure is handled by translating all the feature structures individually and then unifying the resulting value lists. */ g_tf(FeatureStructure :: Rest,ValueList) :- g_tf(FeatureStructure .. Rest,ValueList). /* Older notation is still accepted for compatibility. */ /* * g_tf_list(ListOfTerms,ListOfResults) "Translate Forward List" * * Applies g_tf to a list of arguments giving a list of results. */ g_tf_list([],[]). g_tf_list([H|T],[NewH|NewT]) :- g_tf(H,NewH), g_tf_list(T,NewT). /* * g_tfsf(Keyword,Value,ValueList) "Translate Forward Single Feature" * * Turns a keyword and a value into a value list in which * only one feature is specified. */ /* Totally new in version 2.0 */ /*+Q*/ :- dynamic g_forward_schema/3. g_tfsf(Keyword,Value,ValueList) :- call_if_possible(g_forward_schema(Keyword,Value,ValueList)), !. g_tfsf(Keyword,Value,ValueList) :- %+T nl, %+T writeln(['Generating declaration for feature: ',Keyword]), ( retract(g_features(List)) ; List = [] ), !, /* the above line should not generate alternatives */ append(List,[Keyword],NewList), asserta(g_features(NewList)), g_make_forward_schema(Keyword,NewList,X,Schema), assertz(g_forward_schema(Keyword,X,Schema)), g_make_backward_schema, !, g_tfsf(Keyword,Value,ValueList). /* Try again, and this time succeed! */ /* Query: Will Quintus handle this right??? */ /******************************** * Output of feature structures * ********************************/ /* * g_display(X) * * Equivalent to display_feature_structure(X). * Retained for compatibility. * */ /*-L*/ :- public g_display/1. %+A :- visible g_display/1. g_display(X) :- display_feature_structure(X). /* * display_feature_structure(X) * * Writes out a feature structure in a neat indented format. * Feature structure can be in either Feature:Value notation * or internal representation. */ /*-L*/ :- public display_feature_structure/1. %+A :- visible display_feature_structure/1. display_feature_structure(Term) :- g_tb(FS,Term), /* Convert value lists into feature structures */ g_di(0,0,FS). /* Display them */ /* * g_di(CurPos,Indent,FS) "Display Indented" * * CurPos is the current position on the line; * Indent is the indentation at which this item should be printed. */ % This could be made more efficient by changing the order of % arguments so that indexing on the first argument would work. g_di(CurPos,Indent,Variable) :- var(Variable), !, g_di_tab(Indent,CurPos), write(Variable), nl. g_di(CurPos,Indent,F:V..Rest) :- !, g_di(CurPos,Indent,F:V), g_di(0,Indent,Rest). g_di(CurPos,Indent,F:V::Rest) :- !, g_di(CurPos,Indent,F:V..Rest). /* For compatibility */ g_di(CurPos,Indent,F:V) :- !, g_di_tab(Indent,CurPos), write(F), write(': '), g_printlength(F,PL), NewIndent is Indent+PL+2, g_di(NewIndent,NewIndent,V). g_di(CurPos,Indent,OrdinaryTerm) :- g_di_tab(Indent,CurPos), write(OrdinaryTerm), nl. g_di_tab(Indent,CurPos) :- Tabs is Indent-CurPos, tab(Tabs). /************************************ * Management of the knowledge base * ************************************/ /* Dynamic predicate declarations for Quintus */ /*+Q*/ :- dynamic g_loaded/1. /*+Q*/ :- dynamic g_preloaded/1. /*+Q*/ :- dynamic g_editing/1. /*+Q*/ :- dynamic g_ed_command/1. /* * list * * Displays all clauses that are known to have been * loaded from the user's file. * * Note that DCG grammar rules will * be displayed as Prolog clauses. */ /*-L*/ :- public list/0. %+A :- visible list/0. list :- call_if_possible(g_loaded(P/A)), list(P/A), nl, fail. list. /*-L*/ :- public list/1. %+A :- visible list/1. :- op(850,fx,list). /* * list(Predicate/Arity) * like list/0 but lists only one predicate. */ list(P/A) :- functor(Struct,P,A), clause(Struct,Body), g_tb(FSStruct,Struct), g_tb(FSBody,Body), g_list_clause((FSStruct :- FSBody)), fail. /* * list(Predicate) * lists all predicates with this name, regardless of arity. */ list(P) :- /*+Q*/ \+ (P = _/_), %-Q P \= _/_, /*+Q*/ current_predicate(P,Term), functor(Term,P,A), %-Q current_predicate(P/A), list(P/A), fail. list(_). /* Catch-all for both list(P/A) and list(P). */ g_list_clause((Head :- true)) :- !, write(Head), write('.'), nl. g_list_clause((Head :- Tail)) :- write(Head), write(' :- '), nl, g_list_aux(Tail). g_list_aux((A,B)) :- !, write(' '), write(A), write(','), nl, g_list_aux(B). g_list_aux(B) :- write(' '), write(B), write('.'), nl. /* * ed(File) * * Invokes the editor, which must be accessible by the * currently defined edit command (g_ed_command/1), * and then loads the file. * * If the filename does not contain a period, '.GLP' * is appended. * * File name can be given as either atom or string. * If omitted, the same file name is used as on the * previous call. */ /*-L*/ :- public ed/0. %+A :- visible ed/0. ed :- call_if_possible(g_editing(File)), !, ed(File). ed :- writeln('No file specified'), !, fail. /*-L*/ :- public ed/1. %+A :- visible ed/1. :- op(850,fy,ed). ed(FN) :- g_ed_fixup(FN,File), (call(g_ed_command(Com)) ; g_ed_command(Com)), append(Com,File,CommandString), name(Command,CommandString), write(Command),nl, shell(Command), write('[Finished editing]'),nl, load(File). /*-L*/ :- public g_ed_command/1. %+A :- visible g_ed_command/1. %-Q g_ed_command("edit "). /*+Q*/ % on VAX: g_ed_command("$ fresh_emacs "). /*+Q*/ g_ed_command("ue "). /* Assert your own command ahead of this one to change it. */ /* * g_ed_fixup(String1,String2) * * takes filename String1 and adds suffix, if needed, * giving String2. (In GULP 1, String2 was an atom.) */ g_ed_fixup(FN,FN) :- FN = [_|_], member(46,FN), /* period */ !. g_ed_fixup(FN,NewFN) :- FN = [_|_], !, append(FN,".glp",NewFN). g_ed_fixup(FN,File) :- name(FN,FNList), !, g_ed_fixup(FNList,File). /* * new * * Abolishes all user-loaded predicate definitions, * regardless of what file they were loaded from. * Also clears all feature definitions out of memory. */ /*-L*/ :- public new/0. %+A :- visible new/0. new :- call_if_possible(g_loaded(P/A)), functor(Str,P,A), retractall(Str), %+T write('[Abolished '),write(P/A),write(']'),nl, fail. new :- retractall(g_loaded(_)), retractall(g_preloaded(_)), retractall(g_forward_schema(_,_,_)), retractall(g_backward_schema(_,_)), retractall(g_features(_)), %+T write('[Abolished g_loaded/1, g_preloaded/1, features, and schemas]'), %+T nl, fail. new :- /* g_clear_screen, */ g_herald. /* * load(File) * * Like reconsult, but clauses for a predicate need not be * contiguous. Embedded queries begin with ':-'. */ /*-L*/ :- public load/0. %+A :- visible load/0. load :- call_if_possible(g_editing(File)), !, load(File). load :- writeln('No file specified'), !, fail. /*-L*/ :- public load/1. %+A :- visible load/1. :- op(850,fx,load). load(F) :- g_ed_fixup(F,FN), name(File,FN), g_load_file(File), (retract(g_editing(_)) ; true), assert(g_editing(File)). /* g_editing is asserted AFTER load so that if there are nested loads, the last file will win out. */ /* * g_load_file(File) * * Given an atom as a filename, actually loads the file through * the GULP translator. Called by load/1. */ g_load_file(_) :- nl, retractall(g_preloaded(_)), %+T writeln(['[Abolished g_preloaded/1]']), fail. g_load_file(_) :- call_if_possible(g_loaded(PA)), assertz(g_preloaded(PA)), %+T writeln(['[Noted that ',PA,' was already there.]']), fail. g_load_file(File) :- %+A open(Handle,File,r), /* Arity */ /*+Q*/ open(File,read,Handle), /* Quintus */ write('> Reading '),write(File), !, repeat, read(Handle,Clause), g_assert(Clause), Clause == end_of_file, !, close(Handle), nl, write('> Features used: '), ( setof(X,Y^Z^g_forward_schema(X,Y,Z),FL) ; FL='(None)' ), write(FL),nl, write('> Finished loading '),write(File). g_load_file(File) :- g_error(['Unable to complete loading file ',File]). /* Should the file be closed here? */ /* * g_assert(Clause) * * Processes a newly read clause or embedded goal. */ g_assert(end_of_file) :- !. g_assert((:-X)) :- !, /* Do not use another clause */ g_tf(X,NewX), expand_term(NewX,NewNewX), call(NewNewX), /* not call_if_possible, which would miss system predicates */ !. /* Do not resatisfy NewNewX */ g_assert(g_features(List)) :- /* * Combine new g_features * with any pre-existing ones */ (retract(g_features(Old)) ; Old = []), !, append(Old,List,New), remove_duplicates(New,NewNew), /* * Discard pre-existing schemas * and make a whole new set. * (This wastes some time; * later version should only * generate the ones needed.) */ abolish(g_forward_schema/3), g_make_forward_schemas(NewNew), abolish(g_backward_schema/2), g_make_backward_schema, /* * Place the new g_features * clause in the database. */ g_note_loaded(g_features/1), assertz(g_features(NewNew)). g_assert(Clause) :- g_pred(Clause,PA), g_abolish_if_preloaded(PA), g_note_loaded(PA), g_tf(Clause,NewClause), expand_term(NewClause,NewNewClause), assertz(NewNewClause). /* * g_make_backward_schema * * Makes a backtranslation schema containing all * possible features in both external and internal notation, * e.g., g_backward_schema(c:Z..b:Y..a:X,g_(X,g_(Y,g_(Z,_)))). */ g_make_backward_schema :- retractall(g_backward_schema(_,_)), bagof((Feature:Value)/Schema, g_forward_schema(Feature,Value,Schema), [((F:V)/S)|Rest]), g_make_whole_aux(Rest,F:V,S). g_make_whole_aux([],FSSoFar,SchemaSoFar) :- assert(g_backward_schema(FSSoFar,SchemaSoFar)). g_make_whole_aux([((F:V)/S)|Rest],FSSoFar,SchemaSoFar) :- NewFS = (F:V .. FSSoFar), SchemaSoFar = S, /* unify SchemaSoFar with S */ g_make_whole_aux(Rest,NewFS,SchemaSoFar). /* * g_make_forward_schemas(List) * * Given a list of feature names, makes and stores a * set of forward translation schemas for them. */ g_make_forward_schemas(List) :- g_make_forward_schema(Feature,List,Variable,Schema), assertz(g_forward_schema(Feature,Variable,Schema)), fail. g_make_forward_schemas(_). /* * g_make_forward_schema(Feature,List,Variable,Schema) * * Given List, returns as alternatives all the schemas * for the various features. Variable is a variable * occurring in Schema to contain the feature value. */ g_make_forward_schema(Feature,[Feature|_],X,g_(X,_)). g_make_forward_schema(Feature,[_|Tail],X,g_(_,Schema)) :- g_make_forward_schema(Feature,Tail,X,Schema). /* This is very much like using member/2 on backtracking to find all members of a list. */ /* * g_pred(Clause,Pred/Arity) * * Determines the predicate and arity of a clause. */ g_pred(Clause,Pred/Arity) :- expand_term(Clause,(Head :- _)), !, functor(Head,Pred,Arity). g_pred(Clause,Pred/Arity) :- expand_term(Clause,NewClause), functor(NewClause,Pred,Arity). /* * g_abolish_if_preloaded(Pred/Arity) * * Abolishes a predicate if it is marked as "preloaded," i.e., * was loaded from same file on a previous call to g_load. */ g_abolish_if_preloaded(P/A) :- retract(g_preloaded(P/A)), (retract(g_loaded(P/A)) ; true), abolish(P/A), %+T nl,write('[Abolished '),write(P/A),write(']'), !. g_abolish_if_preloaded(_). /* * g_note_loaded(PA) * */ g_note_loaded(PA) :- call_if_possible(g_loaded(PA)), !, write('.'), /*+Q*/ ttyflush, true. g_note_loaded(PA) :- assertz(g_loaded(PA)), nl, write(PA). /**************************** * Miscellaneous predicates * ****************************/ /* * g_fs(X) "Feature Structure" * * Succeeds if X is a feature structure. */ /*-L*/ :- public g_fs/1. %+A :- visible g_fs/1. g_fs(X:_) :- atom(X). g_fs(X..Y) :- g_fs(X), g_fs(Y). g_fs(X::Y) :- g_fs(X), g_fs(Y). /* For compatibility */ /* * g_not_fs(X) "Not a Feature Structure" * (Avoids use of "not" in compiled Arity Prolog.) */ /*-L*/ :- public g_not_fs/1. %+A :- visible g_not_fs/1. g_not_fs(X) :- g_fs(X), !, fail. g_not_fs(_). /* * g_vl(X) "Value List" * * Succeeds if X is a value list. */ /*-L*/ :- public g_vl/1. %+A :- visible g_vl/1. g_vl(g_(_,Y)) :- var(Y). g_vl(g_(_,Y)) :- g_vl(Y). /* * g_unify(Text,X,Y,Z) * Unifies X and Y giving Z. * If this cannot be done, Text is used in an * error message. */ g_unify(_,X,X,X) :- !. g_unify(Text,X,Y,_) :- /*+Q*/ \+ (X = Y), %-Q X \= Y, g_error(['Inconsistency in ',Text]). /* * g_printlength(Term,N) * * N is the length of the printed representation of Term. */ /*-L*/ :- public g_printlength/2. %+A :- visible g_printlength/2. g_printlength(Term,N) :- name(Term,List), !, length(List,N). g_printlength(_,0). /* if not computable, we probably don't need an accurate value anyhow */ /* * g_error(List) * Ensures that i/o is not redirected, * then displays a message and aborts program. */ g_error(List) :- repeat, seen, seeing(user), !, repeat, told, telling(user), !, writeln(['ERROR: '|List]), abort. /************************************** * I/O utilities * **************************************/ /* * g_clear_screen */ g_clear_screen :- %+A cls. /*-A*/ nl,nl,nl,nl,nl,nl,nl,nl. /* * writeln(List) * writes the elements of List on a line, then * starts a new line. If the argument is not a list, * it is written on a line and then a new line is started. * Any feature structures found in List are converted * to Feature:Value notation. */ /*-L*/ :- public writeln/1. %+A :- visible writeln/1. writeln(X) :- g_tb(TranslatedX,X), writeln_aux(TranslatedX). writeln_aux(X) :- var(X), !, write(X), nl. writeln_aux([]) :- !, nl. writeln_aux([H|T]) :- !, write(H), writeln(T). writeln_aux(X) :- write(X), nl. /************************************** * Filling gaps in particular Prologs * **************************************/ /* These are built-in predicates from other Prologs that are defined here for implementations that lack them. */ /* * shell(Command) * passes Command (an atom) to the operating system. */ /*+Q*/ :- public shell/1. /*+Q*/ /*+Q*/ %VAX shell(Command) :- vms(dcl(Command)),nl. /*+Q*/ shell(Command) :- unix(system(Command)),nl. /* * append(X,Y,Z) * concatenates lists X and Y giving Z. * Has interchangeability of unknowns. */ /*-L*/ :- public append/3. %+A :- visible append/3. append([],X,X). append([H|T],X,[H|Y]) :- append(T,X,Y). /* * member(Element,List) * succeeds if Element is in List. * Has interchangeability of unknowns. */ /*-L*/ :- public member/2. %+A :- visible member/2. member(X,[X|_]). member(X,[_|Y]) :- member(X,Y). /* * remove_duplicates(List1,List2) * makes a copy of List1 in which only the * first occurrence of each element is present. * List1 must be instantiated at time of call. */ /*-L*/ :- public remove_duplicates/2. %+A :- visible remove_duplicates/2. remove_duplicates(X,Y) :- rem_dup_aux(X,Y,[]). rem_dup_aux([],[],_). rem_dup_aux([H|T],X,Seen) :- member(H,Seen), !, rem_dup_aux(T,X,Seen). rem_dup_aux([H|T],[H|X],Seen) :- rem_dup_aux(T,X,[H|Seen]). /* * retractall(Predicate) * retracts all clauses of Predicate, if any. * Always succeeds. */ %+A :- public retractall/1. %+A :- visible retractall/1. %-Q retractall(Head) :- functor(Head,Functor,Arity), %-Q abolish(Functor/Arity). /* * phrase(PhraseType,InputString) * Initiates DCG parsing. * For example, ?- phrase(s,[the,dog,barks]) is * equivalent to ?- s([the,dog,barks],[]). */ %+A :- public phrase/2. %+A :- visible phrase/2. %-Q phrase(X,Y) :- X =.. XL, %-Q append(XL,[Y,[]],GL), %-Q Goal =.. GL, %-Q call(Goal). /* * copy(A,B) * B is the same as A except that all the * uninstantiated variables have been replaced * by fresh variables, preserving the pattern * of their occurrence. */ /*-L*/ :- public copy/2. %+A :- visible copy/2. copy(X,Y) :- asserta(copy_aux(X)), retract(copy_aux(Y)). /* * call_if_possible(Goal) * Calls Goal. * If there are no clauses for the predicate, * the call fails but an error condition is not raised. */ /*-L*/ :- public call_if_possible/1. %+A :- visible call_if_possible/1. call_if_possible(Goal) :- %-Q call(Goal). /*+Q*/ current_predicate(_,Goal), call(Goal). /********** * Herald * **********/ /*-L*/ :- public g_herald/0. %+A :- visible g_herald/0. g_herald :- put(13), g_version(X), write(X), nl. /*-A*/ :- g_herald. /*************** * End of GULP * ***************/ /*+Q*/ % * GULP COMPILATION UTILITY * /*+Q*/ /*+Q*/ % Hastily hacked together (for Quintus Prolog only) /*+Q*/ % by Michael Covington, April 4, 1988. /*+Q*/ /*+Q*/ % By typing /*+Q*/ % ?- g_compile. /*+Q*/ % you can get GULP to write out the translated clauses /*+Q*/ % to a file named G_COMPILE.TMP, then compile them back /*+Q*/ % into memory. This is a good way to get a debugged /*+Q*/ % GULP program (or part of a program) to run much faster. /*+Q*/ /*+Q*/ % No guarantees -- this is a kludge! */ /*+Q*/ /*+Q*/ /*+Q*/ g_compile :- /*+Q*/ write('Writing translated clauses. DO NOT INTERRUPT.'),nl, /*+Q*/ (g_editing(F) ; F = 'unnamed file'), /*+Q*/ tell('G_COMPILE.TMP'), /*+Q*/ write(':- version(''Contains compiled code from '), /*+Q*/ write(F), /*+Q*/ write(' '').'),nl, /*+Q*/ nl, /*+Q*/ g_compile_aux, /*+Q*/ told, /*+Q*/ write('Invoking compiler...'),nl, /*+Q*/ no_style_check(single_var), /*+Q*/ compile('G_COMPILE.TMP'), /*+Q*/ style_check(single_var), /*+Q*/ write('Done.'),nl, /*+Q*/ write('You may now save all the clauses in your workspace'),nl, /*+Q*/ write('(both interpreted and compiled,'),nl, /*+Q*/ write('including the entire GULP system)'),nl, /*+Q*/ write('with the command'),nl, /*+Q*/ write(' ?- save_program(yourfilename). '),nl, /*+Q*/ write('The resulting file can be loaded with'),nl, /*+Q*/ write(' ?- restore(yourfilename).'),nl, /*+Q*/ write('or by entering Prolog with the command'),nl, /*+Q*/ write(' $ prolog yourfilename'),nl, /*+Q*/ nl. /*+Q*/ /*+Q*/ g_compile_aux :- g_loaded(P/A,_), /*+Q*/ listing(P/A), /*+Q*/ fail. /*+Q*/ /*+Q*/ g_compile_aux. /* always succeeds */