unit uinfrais;

interface
  procedure infrais;

implementation
uses umoslog;

(*****************)
		(**  moslog	**)
		(**  infrais	**)
		(*****************)

procedure ecrmot(d:integer);
begin	(* ecriture du mot d
	avec changement de je en tu et de tu en je *)
if d <> 0
then	begin
	repo := 1;
	if d < 0	then	d := -d;
	if (mot_[d] = 'je') or (mot_[d] = 'j')
	then	write(output,'tu ')
	else	begin
		if mot_[d] = 'tu'
		then	write(output,'je ')
		else	write(output,mot_[d],' ');
		end;
	end;
end;

procedure ecrgn1;
var	h:integer;
begin		(* impression du groupe nominal  1
		**********************************)
if (esp1 <> etre) and (esp1 <> 0)
then	begin	(* ecriture du 1er verbe si pas verbe etre *)
	write(output,'celui qui ');
	if esp1 < 0	then	write(output,'ne ');
	ecrmot(esp1);
	if esp1 < 0	then	write(output,'pas ');
	end;
ecrmot(esl1);
ecrmot(esar1);	(* l'article *)
if esn1 < 0	then	h := 1	else	h := 0;
if esb1 <> 0	then	h := 1-h;
if h <> 0	then	write(output,'non ');
ecrmot(esn1);	(* le nom *)
ecrmot(esah1);
if esa1 < 0	then	write(output,'non ');
ecrmot(esa1);	(* l'adjectif *)
end;



procedure ecrgn2;
var	h:integer;	(* impression du groupe nominal 2 *)
begin			(**********************************)
ecrmot(esl2);
ecrmot(esar2);	(* l'article *)
if esb2 <> 0	then	h := 1	else	h := 0;
if esn2 < 0	then	h := 1-h;
if h <> 0	then	write(output,'non ');
ecrmot(esn2);	(* le nom *)
ecrmot(esah2);
if esa2 < 0	then	write(output,'non ');
ecrmot(esa2);	(* l'adjectif *)
end;

procedure ecrverbe;
var	h:integer;	(* impression du verbe *)
begin			(***********************)
if esnegav <> 0	then	h := 1	else	h := 0;
if esverbe < 0	then	h := 1-h;
if h <> 0	then	write(output,'ne ');
ecrmot(espro);		(* pr‚position *)
ecrmot(esverbe);	(* le verbe *)
if h <> 0	then	write(output,'pas ');
end;
function semantik(mot:integer) : integer;
begin	(* rend la valeur semantique de mot *)
if mot > 0	then	semantik:=vam[mot]	else	semantik:=-vam[-mot];
end;

procedure infrais;
procedure infere;	(* comparaison de la phrase avec la ieme stokee *)
var       x:integer;

procedure compare;
	(* comparaison d'une phrase stokee transformee avec la phrase *)
var	qq:integer;

procedure compar;	(* comparaison de msx.. avec mx.. *)

procedure compsuit;
begin	(* comparaison de mx.. avec x..et reponse eventuelle *)
if (adj = 0) or (adj = -1) or (madj = msa2)
then	begin
	repo := 0;
	nb_rep := nb_rep+1;
	if (verbe <> -1) and (mverbe <> msverbe)
	then	begin
		if (non = 0) and (snom <> -1) and (sadj <> -1)
		and (nom <> -1) and (adj <> -1) and (ques <> 1)
		then	begin		(* contradiction *)
			writeln(output,'non');
			non := 1;
			end;
		end
	else	begin
		if (snom = -1) or (sadj = -1) or (verbe = -1)
		then	begin
			ecrgn1;		(* r‚ponse *)
			if ( (snom = -1) and (nom = -1) ) or (verbe = -1)
			then	ecrverbe;
			end;
		if (nom = -1) or (adj = -1)  then	ecrgn2;  (* reponse *)
		if repo = 1
		then	begin
			writeln(output);
			oui := 1;
			end;
		if oui = 0
		then	begin
			write(output,'oui');	(* reponse *)
			writeln(output);
			oui := 1;
			end;
		end;
	end;
end;


begin	(* code de compar *)	(* comparaison de ms.. avec m.. *)
if (mverbe1 = -1) or (esp1 = mverbe1)
then	begin
	if (verbe = -1) or (abs(mverbe) = abs(msverbe) )
	then	begin
		if (snom = 0) or (snom = -1) or (msnom = msn1)
		then	begin
			if (sadj = 0) or (sadj = -1) or (msadj = msa1)
			then	begin
				if (nom = 0) or (nom = -1) or (mnom = msn2)
				then	compsuit
				else	begin
					if (mnom = -msn2) and (mverbe = etre)
					and (ques <> 1)
					then	begin
						nb_rep := nb_rep+1;
						writeln(output,'non');
						end;
					end;
				end;
			end;
		end;
	end;
end;



	(* comparaison d'une phrase stokee transformee avec la phrase *)
begin			(* code de compare *)
if esnegav <> 0		(*******************)
then	begin
	if code[esverbe] <> tyetre
	then	esverbe := -esverbe
	else	esb2 := 1-esb2;
	esnegav := 0;
	end;
if (esb2 = 1) and (esa2 = 0)
then	begin
	esn2 := -esn2;
	esb2 := 0;
	end;
if (esb1 = 1) and (esa1 = 0)
then	begin
	esn1 := -esn1;
	esb1 := 0;
	end;
msn1 := semantik(esn1);
msa1 := semantik(esa1);
msn2 := semantik(esn2);
msa2 := semantik(esa2);
msp1 := semantik(esp1);
msverbe := semantik(esverbe);
qq := -1;
while qq < nb_equi do
	begin
	qq := qq+1;
	if qq = 0
	then	begin
		snom := dn;	sadj := da;	snegan := db;
		verbe1 := dp;		negav1 := dq;
		end
	else	begin
		K := equi[qq];
		snom := sn2[K];		sadj := sa2[K];	snegan := sb2[K];
		verbe1 := sverbe[K];	negav1 := snegav[K];
		if verbe1 = etre	then	verbe1 := 0;
		end;

	msnom := semantik(snom);
	msadj := semantik(sadj);
	mverbe1 := semantik(verbe1);

	compar;

	if (ques = 0) and (nb_rep <> 0)	then	qq := nb_equi;
	end;
end;

begin	(* code de infere *)
	(* comparaison de la phrase avec la ieme stokee *)

(* on extrait la ieme phrase stokee *)
esl1 := sl1[i];	  esb1 := sb1[i];	esn1 := sn1[i];	    esa1 := sa1[i];
esar1 := sar1[i]; esp1 := sp1[i];	esah1 := sah1[i];   esah2 := sah2[i];
espro := spro[i]; esverbe := sverbe[i]; esnegav := snegav[i]; esl2 := sl2[i];
esb2 := sb2[i];	  esn2 := sn2[i];	esa2 := sa2[i];	    esar2 := sar2[i];

compare;		(* on compare la phrase telle que *)

if code[abs(esverbe)] = tyetre
then	begin	(* le verbe est le verbe etre *)
	x := rel[abs(esn2)];
	if x <> 0
	then	begin	(* transformation : nom reflexif *)
		J := esn1;	esn1 := esa2;	esa2 := J;

		compare;	(* n1 est reflexif de n2
				n2 est reflexif de n1 *)
		end;
	x := pas[abs(esn2)];
	if x <> 0
	then	begin	(* transformation : nom sym‚trique *)
		J := esn1;
		esn1 := esa2;
		esa2 := J;
		esn2 := x;

		compare;	(* n1 est sym‚trique de n2
				n2 est 'sym‚trique' de n1 *)
		end;
	end;
x := pas[abs(esverbe)];
if x <> 0
then	begin		(* transformation : verbe sym‚trique *)
	j := esn1;
	esn1 := esa2;
	esa2 := j;
	if esverbe > 0	then	esverbe := x	else	esverbe := -x;

	compare;	(* n1 sym‚trique n2 n3
			n3 'sym‚trique' n2 n3 *)
	end;
end;

procedure equiv;  (* recherche des equivalences liees au verbe etre et
	aux rŠgles celui qui : de   a est b  on rajoute b … la liste de a
	le nombre d'equivalence est nb_equi, equi contient les equivalences *)
var	equival,goon	:boolean;
	x,y,jj,l,k	:integer;
begin
nb_equi := 0;
if snom <> -1
then	begin	(* le gn1 est specifie, c'est pas : qui *)
	goon := true;
	while goon do
		begin
		JJ := nb_equi;		K := 0;
		while K < nb_aff do
			begin	(* on regarde dans toutes les phrases *)
			K := K+1;
			equival := false;
			if (snom = sn1[k]) and (sadj = sa1[k])
			and (snegan = sb1[k]) and (verbe1 = sp1[k])
			then	equival := true	(* gn1 est ‚gal *)
			else	begin
				l := 0;
				while l < nb_equi do
					begin
					l := l+1;
					x := equi[l];
					y := sp1[K];
					if y = 0
					then	y := etre;
					if (sn1[k]=sn2[x]) and (sa1[k]=sa2[x])
					and (sb1[k]=sb2[x]) and (y=sverbe[x])
					then	begin
						(* gn1 est equivalent *)
						l := nb_equi;
						equival := true;
						end;
					end;
				end;
			if equival	(* on verifie si l'equivalence *)
			then	begin	(* trouvee n'est pas deja notee *)
				if nb_equi <> 0	(* dans equi *)
				then	begin
					l := 0;
					while l < nb_equi do
						begin
						l := l+1;
						if equi[l] = K
						then	begin (* deja la *)
							l := nb_equi;
							equival := false;
							end;
						end;
					end;
				if equival
				then	begin (* on ajoute l'equivalence *)
					nb_equi:=nb_equi+1; equi[nb_equi]:=K;
					end;
				end;
			end;
		if JJ = nb_equi  then  goon := false	else	goon := true;
		end;
	end;
end;
			(**********************)
begin			(* code de infrais    *)
			(* moteur d'inférence *)
nb_rep := 0;		(**********************)
oui := 0;
non := 0;
equiv;	(* recherche des equivalences du v1 gn1  *)
if test <> 0	then	writeln(output,'.. equiv ',nb_equi);

if nom = -1	Then	verbe1 := -1;
if (verbe <> -1) and (negav <> 0)
then	begin
	if code[abs(verbe)] <> tyetre
	then	verbe := -verbe
	else	negan := 1-negan;
	negav := 0;
	end;
if negav1 = 1
then	begin
	verbe1 := -verbe1;	negav1 := 0;
	end;
if (negan <> 0) and (nom <> -1)
then	begin
	nom := -nom;	negan := 0;
	end;
if (snegan <> 0) and (snom <> -1)
then	begin
	snom := -snom;	snegan := 0;
	end;

(* on planque la phrase avant transformation : *)
dn := snom;	da := sadj;	db := snegan;	dp := verbe1;	dq := negav1;

(* on calcule les valeurs s‚mantiques des elements de la phrase : *)
mnom := semantik(nom);
madj := semantik(adj);
mverbe := semantik(verbe);

i := 0;
while i < nb_aff do
	begin	(* on compare avec les phrases stokees *)
	i := i+1;	(* en tenant compte des equivalences trouvees *)
	infere;
	if (ques = 0) and (nb_rep <> 0)	then	i := nb_aff;
	end;

(* on remet la phrase en l'‚tat d'avant les transformations *)
snom := dn;	sadj := da;	snegan := db;	verbe1 := dp;	negav1 := dq;
if ques <> 0
then	begin	(* c'etait une question *)
	if nb_rep = 0	then	writeln(output,'je ne sais pas');
	end
else	begin	(* c'etait une affirmation *)
	if nb_rep = 0
	then	ok := 0	(* on peut la stoker *)
	else	begin
		ok := 1;
		if oui = 1  then	writeln(output,'je le savais deja');
		if non = 1  then	writeln(output,'c''est pas vrai');
		end;
	end;
end;

end.
