1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%%                                                                           %%
    3%%      Version:  1.00   Date:  1/02/95   File: normalize_path.pl            %%
    4%% Last Version:                          File:                              %%
    5%% Changes:                                                                  %%
    6%%  1/02/95 Created                                                          %%
    7%%                                                                           %%
    8%% Purpose:                                                                  %%
    9%%                                                                           %%
   10%% Author:  Zoltan Rigo                                                      %%
   11%%                                                                           %%
   12%% Usage:   prolog normalize_path.pl                                         %%
   13%%                                                                           %%
   14%%                                                                           %%
   15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   16
   17/*%^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   18
   19\chapter
   20[Die Datei {\tt tom\_normalize\_path}]
   21{Die Datei {\Huge \tt tom\_normalize\_path}}
   22
   23\Predicate normalize_path/2(+Formula, -NormalizedFormula).
   24
   25This predicate normalises the path terms in the formula according to the
   26new convention introduced in Caen. (We co-operate, so this might explain
   27the mess.)
   28
   29This code was written by Gilbert Boyreau.
   30
   31\PL*/
   32normalize_path(Var,Var2) :-
   33	var(Var),
   34	!,
   35	Var = Var2.
   36normalize_path(Atom,Atom2) :-
   37	atomic(Atom),
   38	!,
   39	Atom = Atom2.
   40normalize_path(+(A1,Arg),
   41	      NormalArg) :-
   42	A1 == 0,
   43	!,
   44	normalize_path(Arg,NormalArg).
   45normalize_path(+(Arg,A2),
   46	      NormalArg) :-
   47	A2 == 0,
   48	!,
   49	normalize_path(Arg,NormalArg).
   50normalize_path(+(A1,C),
   51	      Normal) :-
   52	nonvar(A1),
   53	A1 = +(A,B),
   54	!,
   55	normalize_path(+(A,+(B,C)),
   56			Normal).
   57normalize_path(+(A,B),
   58	      +(NormalA,NormalB)) :-
   59	!,
   60	normalize_path(A,NormalA),
   61	normalize_path(B,NormalB).
   62
   63normalize_path(Term,NormalTerm) :-
   64	Term =.. [F|Args],
   65	normalize_path_list(Args,NormalArgs),
   66	NormalTerm =.. [F|NormalArgs].
   67
   68normalize_path_list([],[]).
   69normalize_path_list([H|T],[NormalH|NormalT]) :-
   70	!,
   71	normalize_path(H,NormalH),
   72	normalize_path_list(T,NormalT).
   73
   74/*PL%^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   75
   76\EndProlog */