examples/logic/gentzen.log

   1 Program Evaluationdepropositionslogiques;\r
   2  \r
   3 (********************************************)\r
   4 (*           ARDANTZ  Jean-Michel           *)\r
   5 (*           CAZAUBON Eric                  *)\r
   6 (*           TOURNIER Vincent               *)\r
   7 (********************************************)\r
   8  \r
   9 Const moinsun = -1,\r
  10       moins59 = -59,\r
  11       moins60 = -60,\r
  12       moins61 = -61,\r
  13       moins62 = -62,\r
  14       moins68 = -68;\r
  15 Var ch                  : Chaine,\r
  16     l                   : Liste,\r
  17     e                   : Elem,\r
  18     racine              : Noeud,\r
  19     i,longueur,xx,y,Z   : Integer,\r
  20     H                   : Boolean,\r
  21     Valeur              : ArrayOf Char,\r
  22     Courant,Diagramme,X : Node;\r
  23  \r
  24  \r
  25 (******************************************)\r
  26 (*   Lecture d'une chaine de caracteres   *)\r
  27 (******************************************)\r
  28  \r
  29 (*  Cette classe lit une chaine de caract\8ares  *)\r
  30 (*  et la met dans un tableau "Valeur"            *)\r
  31  \r
  32 Unit Chaine : Class;\r
  33 Var c,d : integer,\r
  34     i,X : Integer;\r
  35 Begin\r
  36 Pref IIUWGRAPH Block\r
  37 Begin\r
  38     X:=110+(longueur*8);\r
  39     i := 1+longueur;\r
  40     C:=0 ;\r
  41     do\r
  42        Call Color (12) ;\r
  43        C := 0 ;\r
  44        while C=0\r
  45        Do\r
  46          Call Texte(X,184,0," ");\r
  47          c:=inkey;\r
  48          Call Texte(X,184,15,"-");\r
  49        Od;\r
  50        Call Color (12) ;\r
  51        Call move(X,180) ;\r
  52        If (c=97)or(c=98)or(c=99)or(c=100)or(c=120)or(c=121)\r
  53           or(c=122)or(c=40)or(c=41)\r
  54        Then d:=c;\r
  55             c:=0;\r
  56        Fi;\r
  57        Case C\r
  58        When 13 :\r
  59                  Exit ;\r
  60        When moins59 :\r
  61               If X < 486 Then\r
  62                       Call dessine_et(X,180);\r
  63                       valeur(i):='&' ;\r
  64                       i:=i+1 ;\r
  65                       X:=X+8 ;\r
  66               Fi;\r
  67        When moins60 :\r
  68               If X < 486 Then\r
  69                       Call dessine_ou(X,180);\r
  70                       valeur(i):='%' ;\r
  71                       i:=i+1 ;\r
  72                       X:=X+8 ;\r
  73               Fi;\r
  74        When moins61 :\r
  75               If X < 486 Then\r
  76                       Call dessine_implique(X,180);\r
  77                       valeur(i):='>' ;\r
  78                       i:=i+1 ;\r
  79                       X:=X+8 ;\r
  80               Fi;\r
  81        When moins62 :\r
  82               If X < 486 Then\r
  83                       Call dessine_non(X,180);\r
  84                       valeur(i):='|' ;\r
  85                       i:=i+1 ;\r
  86                       X:=X+8 ;\r
  87               Fi;\r
  88        When moins68 :\r
  89             Call groff;\r
  90             Writeln;\r
  91             Writeln("    pa pa !   ");\r
  92             Call Endrun;\r
  93        When 8 : If X > 110 Then\r
  94                   i:=i-1;\r
  95                   X:=X-8;\r
  96                   Call move(X,180);\r
  97                   Call Hascii(0);\r
  98                   Call texte(X,184,15,"-");\r
  99                   Call move(X,180);\r
 100                 Fi;\r
 101        When 0 :\r
 102            If X < 486 Then\r
 103               Call Hascii (0) ;\r
 104               Call Hascii (d);\r
 105               valeur(i):=chr(d);\r
 106               i:=i+1;\r
 107               X:=X+8;\r
 108            Fi;\r
 109        Otherwise\r
 110            Call texte(105,258,15,"Caract\8are ill\82gal");\r
 111            Call texte(105,274,15,"Appuyez sur une touche pour continuer");\r
 112            while inkey=0 do od;\r
 113            Call Fill (101,251,398,38,0) ;\r
 114            Call move(110+(longueur*8),180);\r
 115        esac;\r
 116        if i=48 then\r
 117        Call texte(105,258,15,"Chaine trop longue ");\r
 118        Call texte(105,274,15,"Appuyez sur une touche pour continuer");\r
 119        while inkey=0 do od;\r
 120        Call Fill (101,251,398,38,0) ;\r
 121        Call move(110+(longueur*8),180);\r
 122        fi;\r
 123     od;\r
 124     longueur:=i-1;\r
 125 End;\r
 126 End Chaine;\r
 127  \r
 128 (************************************************)\r
 129 (*              Analyseur lexical               *)\r
 130 (************************************************)\r
 131  \r
 132 (*  Ces deux proc\82dures v\82rifient la validit\82   *)\r
 133 (*  syntaxique de la chaine                     *)\r
 134  \r
 135 Unit Evolution : procedure(inout etat:Integer; inout nbre:Integer;\r
 136                            inout nbcar:Integer; input c:Char);\r
 137 Begin\r
 138   case etat\r
 139      when 1 : case c\r
 140                 when '(' : nbcar := 0;\r
 141                            nbre:=nbre+1;\r
 142                            etat := 1 ;\r
 143                 when 'a','b','c','d','x','y','z' : nbcar := nbcar + 1;\r
 144                                    etat := 2 ;\r
 145                 when '|' : etat := 3 ;\r
 146                 otherwise etat := 0;\r
 147               esac;\r
 148      when 2 : case c\r
 149                 when '&','%','>' : etat := 1 ;\r
 150                 when ')' : nbcar := 0;\r
 151                            nbre:=nbre-1;\r
 152                            etat := 2 ;\r
 153                 otherwise etat := 0;\r
 154               esac;\r
 155      when 3 : case c\r
 156                 when '(' : nbre:=nbre+1;\r
 157                            etat := 1 ;\r
 158                 otherwise etat := 0;\r
 159               esac;\r
 160   esac;\r
 161 End Evolution;\r
 162  \r
 163  \r
 164 (*La fonction analyseur retourne un booleen selon que la formule\r
 165   propositionnel est correcte ou non *)\r
 166  \r
 167  \r
 168 Unit Analyseur : function(longueur : Integer) : Boolean;\r
 169 Var etat,nbre,nbcar,i : Integer,\r
 170     b : boolean,\r
 171     c : Char;\r
 172 Begin\r
 173   B:=False;\r
 174   etat:=1;\r
 175   nbre:=0;\r
 176   nbcar:=0;\r
 177   i:=1;\r
 178   while (( etat > 0 ) and (i <= longueur ))\r
 179     do\r
 180       c := valeur(i);\r
 181       If C='>' Or C='&' Or C='%' Or C='|' Then B:=True; Fi;\r
 182       call Evolution(etat,nbre,nbcar,c);\r
 183       if nbcar>2 then\r
 184          etat := -1;\r
 185       fi;\r
 186       i := i+1;\r
 187     Od;\r
 188   result:=false;\r
 189   If Not B Then\r
 190      Call Texte(105,266,15,"Erreur de s\82mantique");\r
 191   Else\r
 192      case etat\r
 193        when 0 : Call texte(105,266,15,"Erreur de syntaxe");\r
 194        when moinsun : Call texte(105,266,15,\r
 195                 "Chaine incorrecte, parenth\82sez vos expressions !");\r
 196        otherwise if nbre < 0 then\r
 197                     Call texte(105,266,15,\r
 198                     "Chaine incorrecte, caract\8are(s)  (  absent(s)");\r
 199                  else if nbre > 0 then\r
 200                          Call texte(105,266,15,\r
 201                       "Chaine incorrecte, caract\8are(s)  )  absent(s)");\r
 202                       fi;\r
 203                   fi;\r
 204      esac;\r
 205      If ((etat > 0) and (nbre=0)) then\r
 206         Call texte(105,266,15,"Chaine correcte");\r
 207         result:=true;\r
 208      Fi;\r
 209   Fi;\r
 210 End Analyseur;\r
 211  \r
 212 (***********************************************)\r
 213 (*           Impl\82mentation de la pile         *)\r
 214 (***********************************************)\r
 215  \r
 216 Unit Unepile : Class(type telem);\r
 217 Var p1,p2 : Pile;\r
 218  \r
 219    Unit Link : Class;\r
 220    Var next : Link,\r
 221        valeur : telem;\r
 222    End Link;\r
 223  \r
 224    Unit Pile : Class;\r
 225    Var top : Link;\r
 226    End Pile;\r
 227  \r
 228    Unit Push : Function (E : Telem ; S : Pile) : Pile;\r
 229    Var aux : Link;\r
 230    Begin\r
 231       aux := New Link;\r
 232       aux.valeur := E;\r
 233       if Empty_Pile(S)\r
 234       then\r
 235            aux.next := None;\r
 236       else\r
 237            aux.next := S.top;\r
 238       fi;\r
 239       Result := New Pile;\r
 240       result.top := aux;\r
 241    End Push;\r
 242  \r
 243    Unit Empty_Pile : Function (S : Pile) : Boolean;\r
 244    Begin\r
 245       Result := (S=None);\r
 246    End Empty_Pile;\r
 247  \r
 248    Unit Top : Function (S : Pile) : Telem;\r
 249    Begin\r
 250       Result := S.top.valeur;\r
 251    End Top;\r
 252  \r
 253    Unit Down : Function (S : Pile) : Pile;\r
 254    Begin\r
 255        if s.top.next <> none\r
 256        then Result := New Pile;\r
 257             Result.top := S.top.next;\r
 258        else\r
 259             Result:=none;\r
 260        fi;\r
 261    End Down;\r
 262  \r
 263 End Unepile;\r
 264  \r
 265 (************************************************)\r
 266 (*     Recherche des operateurs principaux      *)\r
 267 (************************************************)\r
 268  \r
 269 (*   Cette proc\82dure construit l'arbre associ\82  *)\r
 270 (*   la formule entr\82e par l'utilisateur        *)\r
 271  \r
 272 Unit Elem : Class;\r
 273      Var Valeur:Char;\r
 274 End Elem;\r
 275  \r
 276  \r
 277 Unit Noeud : Class;\r
 278 Var left , right : Noeud,\r
 279     Valeur : Char ;\r
 280 End Noeud ;\r
 281  \r
 282  \r
 283 Unit Operateur : procedure(longueur : Integer; output racine : Noeud);\r
 284 Var i : Integer,\r
 285     n,p,ng,nd : Noeud,\r
 286     up1,up2 : UnePile,\r
 287     e,aux : Elem,\r
 288     c : Char;\r
 289  \r
 290 Begin\r
 291  \r
 292 up1 := new UnePile(Noeud);\r
 293 up2 := new UnePile(Elem);\r
 294 for i:=1 to longueur\r
 295 do\r
 296  \r
 297 c:=valeur(i);\r
 298 case c\r
 299      When 'a','b','c','d','x','y','z' : n := New Noeud;\r
 300                         n.valeur := c;\r
 301                         up1.p1 := up1.Push(n,up1.p1);\r
 302      when '&','%','>','|' : e := new elem;\r
 303                             e.valeur := c;\r
 304                             up2.p2 := up2.Push(e,up2.p2);\r
 305      when ')' : if not up2.Empty_Pile(up2.p2)\r
 306                 then\r
 307                      aux := up2.top(up2.p2);\r
 308                      up2.p2 := up2.down(up2.p2);\r
 309                      nd := up1.top(up1.p1);\r
 310                      up1.p1 := up1.down(up1.p1);\r
 311                      if aux.valeur <> '|'\r
 312                      then ng := up1.top(up1.p1);\r
 313                           up1.p1 := up1.down(up1.p1);\r
 314                      else\r
 315                           ng := none;\r
 316                      fi;\r
 317                      p := new Noeud;\r
 318                      p.left := ng;\r
 319                      p.right := nd;\r
 320                      p.valeur := aux.valeur;\r
 321                      up1.p1 := up1.push(p,up1.p1);\r
 322                 fi;\r
 323 esac;\r
 324 od;\r
 325 if not up2.Empty_Pile(up2.p2)\r
 326 then aux := up2.top(up2.p2);\r
 327      up2.p2 := up2.down(up2.p2);\r
 328      nd := up1.top(up1.p1);\r
 329      up1.p1 := up1.down(up1.p1);\r
 330      if aux.valeur <> '|' then\r
 331         ng := up1.top(up1.p1);\r
 332         up1.p1 := up1.down(up1.p1);\r
 333      else\r
 334         ng := none;\r
 335      fi;\r
 336      p := new Noeud;\r
 337      p.left := ng;\r
 338      p.right := nd;\r
 339      p.valeur := aux.valeur;\r
 340 fi;\r
 341 racine := p;\r
 342 End;\r
 343  \r
 344  \r
 345  \r
 346  \r
 347 (************************************************)\r
 348 (*           Impl\82mentation de la liste         *)\r
 349 (************************************************)\r
 350  \r
 351 (*   Cette impl\82mentation de liste permettra    *)\r
 352 (*   d'ins\82rer les variables en fin de liste    *)\r
 353 (*   et les op\82rateurs au d\82but                 *)\r
 354  \r
 355 Unit Node : Class ;\r
 356      Var Val: Sequence ,\r
 357      Left, Right: Node ;\r
 358 End Node;\r
 359  \r
 360 Unit Sequence : Class;\r
 361      Var Gauche, Droite: Liste ;\r
 362 End Sequence;\r
 363  \r
 364 Unit Liste : Class;\r
 365 Var Debut: Noeud,\r
 366     suivant : Liste;\r
 367 End Liste;\r
 368  \r
 369  \r
 370 Unit Empty_Liste : function(l:Liste) : Boolean;\r
 371 Begin\r
 372    result := l=none;\r
 373 End Empty_Liste;\r
 374  \r
 375  \r
 376 Unit Insert : Function (E:Noeud;L:Liste) : Liste ;\r
 377 Var l1,aux : Liste;\r
 378 Begin\r
 379     If Empty_Liste(l)\r
 380     Then L := new Liste;\r
 381          L.Debut:=New Noeud;\r
 382          L.Debut := E;\r
 383     Else\r
 384          l1:=L;\r
 385          aux:=new Liste ;\r
 386          If E.Valeur<>'|' Andif E.Valeur<>'%'\r
 387             Andif E.Valeur<>'&' Andif E.Valeur<>'>'\r
 388          Then\r
 389               Aux.Debut := E ;\r
 390               While L1.Suivant <> None\r
 391               Do\r
 392                 l1 := L1.Suivant ;\r
 393               Od ;\r
 394               L1.Suivant := Aux ;\r
 395          Else\r
 396               Aux.Debut := E ;\r
 397               Aux.Suivant := L ;\r
 398               L := Aux ;\r
 399          Fi ;\r
 400     Fi;\r
 401     Result := L ;\r
 402  \r
 403 End Insert;\r
 404  \r
 405  \r
 406 Unit Delete : Function(L:Liste): Liste;\r
 407 Begin\r
 408      Result := L.suivant;\r
 409 End Delete;\r
 410  \r
 411  \r
 412 (************************************************************)\r
 413 (*  Procedures de d\82composition d'une expression bool\82enne  *)\r
 414 (************************************************************)\r
 415  \r
 416 (*     Ces proc\82dures permettent de d\82composer la liste     *)\r
 417 (*     initiale gr\85ce \85 la m\82thode de GENTZEN de mani\8are     *)\r
 418 (*     \85 n'obtenir que des variables aux feuilles           *)\r
 419  \r
 420  \r
 421  \r
 422 Unit Copie_Liste : Function (L:Liste) : Liste ;\r
 423 Var Der,Aux:Liste ;\r
 424 Begin\r
 425      Result := New Liste ;\r
 426      if L<>None Then Der := New Liste ;\r
 427                      Der := Copy (L) ;\r
 428                      l := L.Suivant ;\r
 429      Fi ;\r
 430      Result := Der ;\r
 431      While L <> None\r
 432      Do\r
 433        Aux := New Liste ;\r
 434        Aux := Copy (L) ;\r
 435        Der.Suivant := Aux ;\r
 436        L := L.Suivant ;\r
 437        Der :=Aux ;\r
 438      Od ;\r
 439 End Copie_Liste ;\r
 440  \r
 441  \r
 442  \r
 443 Unit Op_Negation_G : Procedure(Input Racine:Noeud;Inout D:Node) ;\r
 444 Var L,R : Liste ,\r
 445     X   : Node ;\r
 446 Begin\r
 447  \r
 448      X := new Node ;\r
 449      X.Val := New Sequence ;\r
 450      L := Copie_Liste (D.Val.Gauche) ;\r
 451      R := Copie_Liste (D.Val.Droite) ;\r
 452      L := Delete (L) ;\r
 453      R := Insert (Racine.Right,R) ;\r
 454      X.Val.Droite:=Copie_Liste (R);\r
 455      X.Val.Gauche:=Copie_Liste (L) ;\r
 456      D.Right:=New Node;\r
 457      D.Right:=X;\r
 458      Kill (L) ;\r
 459      Kill (R) ;\r
 460  \r
 461 End Op_Negation_G ;\r
 462  \r
 463  \r
 464 Unit Op_Alternative_G : Procedure(Input Racine:Noeud;Inout D:Node ) ;\r
 465 Var L,S : Liste ,\r
 466     X,Y : Node ;\r
 467 Begin\r
 468  \r
 469      X := new Node ;\r
 470      X.Val := New Sequence ;\r
 471      Y := new Node ;\r
 472      Y.Val := New Sequence ;\r
 473      X.Val.Droite:= Copie_Liste (D.Val.Droite) ;\r
 474      Y.Val.Droite:= Copie_Liste (D.Val.Droite) ;\r
 475      l := Copie_Liste (D.Val.Gauche) ;\r
 476      L := Delete (L) ;\r
 477      S := Copie_Liste (L) ;\r
 478      L := Insert (Racine.Left,L) ;\r
 479      S := Insert (Racine.Right,S) ;\r
 480      X.Val.Gauche:= Copie_Liste (L) ;\r
 481      Y.Val.Gauche:= Copie_Liste (S) ;\r
 482      D.Left := New Node ;\r
 483      D.Right := New Node ;\r
 484      D.Left:= X ;\r
 485      D.Right:= Y ;\r
 486      Kill (L) ;\r
 487      Kill (S) ;\r
 488  \r
 489 End Op_Alternative_G ;\r
 490  \r
 491 Unit Op_Conjonction_G : Procedure (Input Racine:Noeud;Inout D : Node);\r
 492 Var L : Liste ,\r
 493     X   : Node;\r
 494 Begin\r
 495       X := new Node ;\r
 496       X.Val := New Sequence ;\r
 497       L := Copie_Liste (D.val.Gauche) ;\r
 498       L := Delete (L) ;\r
 499       L := Insert (Racine.Left,L) ;\r
 500       L := Insert (Racine.Right,L) ;\r
 501       X.Val.Gauche:=Copie_Liste (L) ;\r
 502       X.Val.Droite:=Copie_Liste (D.Val.Droite) ;\r
 503       D.Right:=New Node ;\r
 504       D.Right:=X ;\r
 505       Kill (L) ;\r
 506  \r
 507 End Op_Conjonction_G ;\r
 508  \r
 509 Unit Op_Implique_G : Procedure (Input Racine:Noeud;Inout D:Node ) ;\r
 510 Var L,R : Liste ,\r
 511     X,Y : Node ;\r
 512 Begin\r
 513       X := new Node ;\r
 514       X.Val := New Sequence ;\r
 515       Y := new Node ;\r
 516       Y.Val := New Sequence ;\r
 517       L := Copie_Liste (D.Val.Gauche) ;\r
 518       R := Copie_Liste (D.Val.Droite) ;\r
 519       X.val.Droite := Copie_Liste (R) ;\r
 520       L := Delete (L) ;\r
 521       Y.Val.Gauche := Copie_Liste (L) ;\r
 522       Y.Val.Droite := Copie_Liste (Insert (Racine.Left,R)) ;\r
 523       X.Val.Gauche := Copie_Liste (Insert (Racine.Right,L)) ;\r
 524       D.Left := New Node ;\r
 525       D.Right := New Node ;\r
 526       D.Left := X ;\r
 527       D.Right := Y ;\r
 528       Kill (L) ;\r
 529       Kill (R) ;\r
 530  \r
 531 End Op_Implique_G ;\r
 532  \r
 533  \r
 534 Unit Op_Negation_D : Procedure(Input Racine:Noeud; Inout D : Node ) ;\r
 535 Var L,R : Liste ,\r
 536     X   : Node ;\r
 537 Begin\r
 538  \r
 539       X := new Node ;\r
 540       X.Val := New Sequence ;\r
 541       L := Copie_Liste (D.Val.Gauche) ;\r
 542       R := Copie_Liste (D.val.Droite) ;\r
 543       L := Insert (Racine.Right,L) ;\r
 544       R := Delete (R) ;\r
 545       X.Val.Droite:=Copie_Liste (R);\r
 546       X.Val.Gauche:=Copie_Liste (L) ;\r
 547       D.Right := New Node ;\r
 548       D.Right:=X;\r
 549       Kill (L) ;\r
 550       Kill (R) ;\r
 551  \r
 552 End Op_Negation_D ;\r
 553  \r
 554  \r
 555 Unit Op_Alternative_D : Procedure(Input Racine:Noeud;Inout D:Node ) ;\r
 556 Var R : Liste ,\r
 557     X : Node ;\r
 558 Begin\r
 559  \r
 560       X := new Node ;\r
 561       X.Val := New Sequence ;\r
 562       R := Copie_Liste (D.Val.Droite) ;\r
 563       R := Delete (R) ;\r
 564       R := Insert (Racine.Left,R) ;\r
 565       R := Insert (Racine.Right,R) ;\r
 566       X.Val.Gauche := Copie_Liste (D.Val.Gauche) ;\r
 567       X.Val.Droite := Copie_Liste (R) ;\r
 568       D.Right := New Node ;\r
 569       D.Right := X ;\r
 570       Kill (R) ;\r
 571  \r
 572 End Op_Alternative_D ;\r
 573  \r
 574  \r
 575 Unit Op_Conjonction_D : Procedure (Input Racine:Noeud;\r
 576                                    Inout D : Node) ;\r
 577 Var S,R : Liste ,\r
 578     X,Y   : Node ;\r
 579 Begin\r
 580  \r
 581       X := new Node ;\r
 582       X.Val := New Sequence ;\r
 583       Y := new Node ;\r
 584       Y.Val := New Sequence ;\r
 585       R := Copie_Liste (D.Val.Droite) ;\r
 586       R := Delete (R) ;\r
 587       S := Copie_Liste (R) ;\r
 588       S := Insert (Racine.Left,S) ;\r
 589       R := Insert (Racine.Right,R) ;\r
 590       X.Val.Gauche := Copie_Liste (D.Val.Gauche) ;\r
 591       X.Val.Droite := Copie_Liste (S) ;\r
 592       Y.val.Gauche := Copie_Liste (D.Val.Gauche) ;\r
 593       Y.Val.Droite := Copie_Liste (R) ;\r
 594       D.Left := New Node ;\r
 595       D.Right := New Node ;\r
 596       D.Left := X ;\r
 597       D.Right := Y ;\r
 598       Kill (R) ;\r
 599       Kill (S) ;\r
 600  \r
 601 End Op_Conjonction_D ;\r
 602  \r
 603  \r
 604 Unit Op_Implique_D : Procedure (Input Racine:Noeud;Inout D:Node ) ;\r
 605 Var L,R : Liste ,\r
 606     X   : Node ;\r
 607 Begin\r
 608  \r
 609       X := new Node ;\r
 610       X.Val := New Sequence ;\r
 611       L := Copie_Liste (D.Val.Gauche) ;\r
 612       R := Copie_Liste (D.val.Droite) ;\r
 613       X.Val.Gauche := Copie_Liste (Insert (Racine.Left,L)) ;\r
 614       R := Delete (R) ;\r
 615       X.Val.Droite := Copie_Liste (Insert (Racine.Right,R)) ;\r
 616       D.Right := New Node ;\r
 617       D.Right := X ;\r
 618       Kill (L) ;\r
 619       Kill (R) ;\r
 620  \r
 621 End Op_Implique_D ;\r
 622  \r
 623  \r
 624 Unit Trait_List_G : Procedure (Racine:Noeud;Inout D:Node);\r
 625 Begin\r
 626  \r
 627      Case Racine.Valeur\r
 628           When '|' : Call Op_Negation_G (Racine,D) ;\r
 629           When '%' : Call Op_Alternative_G (Racine,D) ;\r
 630           When '&' : Call Op_Conjonction_G (Racine,D) ;\r
 631           When '>' : Call Op_Implique_G (Racine,D) ;\r
 632      Esac;\r
 633  \r
 634 End trait_List_G ;\r
 635  \r
 636 Unit Trait_List_D : Procedure (Racine:Noeud;Inout D:Node);\r
 637  \r
 638 Begin\r
 639  \r
 640      Case Racine.Valeur\r
 641           When '|' : Call Op_Negation_D (Racine,D) ;\r
 642           When '%' : Call Op_Alternative_D (Racine,D) ;\r
 643           When '&' : Call Op_Conjonction_D (Racine,D) ;\r
 644           When '>' : Call Op_Implique_D (Racine,D) ;\r
 645      Esac;\r
 646  \r
 647 End trait_List_D ;\r
 648  \r
 649  \r
 650  \r
 651  \r
 652 Unit Decompose : Procedure (Inout Diagramme : Node);\r
 653 Var D,X,Y:Node,\r
 654     Courant,L : Liste ,\r
 655     Fin,Trouve : Boolean ,\r
 656     Racine : Noeud ;\r
 657 Begin\r
 658     D := Diagramme ;\r
 659     If D<>None\r
 660     Then\r
 661        If D.Val.Gauche<>None AndIf (D.Val.Gauche.Debut.Valeur='&'\r
 662                                  Or D.Val.Gauche.Debut.Valeur='%'\r
 663                                  Or D.Val.Gauche.Debut.Valeur='>'\r
 664                                  Or D.Val.Gauche.Debut.Valeur='|')\r
 665        Then\r
 666             Racine := Copy (D.Val.Gauche.Debut) ;\r
 667             Call Trait_List_G (Racine,D) ;\r
 668  \r
 669        Else\r
 670        If D.Val.Droite<>None AndIf (D.Val.Droite.Debut.Valeur='&'\r
 671                                     Or D.Val.Droite.Debut.Valeur='%'\r
 672                                     Or D.Val.Droite.Debut.Valeur='>'\r
 673                                     Or D.Val.Droite.Debut.Valeur='|')\r
 674             Then Racine := Copy (D.Val.Droite.Debut) ;\r
 675                  Call Trait_List_D (Racine,D) ;\r
 676             Fi ;\r
 677        Fi;\r
 678        WriteLn ;\r
 679        Call Decompose (D.Left) ;\r
 680        Call Decompose (D.right) ;\r
 681        Diagramme := D ;\r
 682     Fi ;\r
 683 End Decompose ;\r
 684  \r
 685  \r
 686  \r
 687 Unit Parcours_Arbre_Right : Procedure(racine : Noeud;Sens,I,J:Integer;\r
 688                                       Inout Z:Integer);\r
 689 Var P : Noeud ;\r
 690 Begin\r
 691 Pref IIUWGRAPH Block\r
 692 Begin\r
 693    p:=racine;\r
 694    If p <> none Then\r
 695       If P.Left<>None\r
 696       Then Call Move (I+8*Z,J) ;\r
 697            Call Hascii (0) ;\r
 698            Call Hascii (40) ;\r
 699            Z:=Z+1 ;\r
 700       Fi ;\r
 701       Call Parcours_Arbre_Right(p.Left,Sens,I,J,Z);\r
 702       Call Move (I+8*Z,J);\r
 703       Call Hascii (0) ;\r
 704       Case P.Valeur\r
 705            When '&' : Call dessine_et(I+8*Z,J);\r
 706            When '%' : Call dessine_ou(I+8*Z,J);\r
 707            When '>' : Call dessine_implique(I+8*Z,J);\r
 708            When '|' : Call dessine_non(I+8*Z,J);\r
 709            otherwise  Call Hascii(Ord(P.Valeur));\r
 710       esac;\r
 711       Z:=Z+1;\r
 712       If P.Valeur='|'\r
 713       Then Call Move (I+8*Z,J) ;\r
 714            Call Hascii (0) ;\r
 715            Call Hascii (40) ;\r
 716            Z:=Z+1 ;\r
 717       Fi;\r
 718       call parcours_Arbre_Right(p.Right,Sens,I,J,Z);\r
 719       If P.Right<>None Or P.Valeur='|'\r
 720       Then Call Move (I+8*Z,J) ;\r
 721            Call Hascii (0) ;\r
 722            Call Hascii (41) ;\r
 723            Z:=Z+1 ;\r
 724       Fi ;\r
 725   Fi ;\r
 726 End;\r
 727 End Parcours_Arbre_Right;\r
 728  \r
 729  \r
 730  \r
 731 Unit Parcours_Arbre_Left : procedure(racine : Noeud;Sens,I,J:Integer;\r
 732                                      InOut Z:Integer);\r
 733 Var P : Noeud ;\r
 734 Begin\r
 735 Pref IIUWGRAPH Block\r
 736 Begin\r
 737    p:=racine;\r
 738    If p <> none Then\r
 739       If P.Left<>None Or P.Valeur='|'\r
 740       Then Call Move (I+8*Z,J) ;\r
 741            Call Hascii (0) ;\r
 742            Call Hascii (41) ;\r
 743            Z:=Z-1 ;\r
 744       Fi ;\r
 745       Call parcours_Arbre_Left(p.Right,Sens,I,J,Z);\r
 746       If P.Valeur='|'\r
 747       Then Call Move (I+8*Z,J) ;\r
 748            Call Hascii (0) ;\r
 749            Call Hascii (40) ;\r
 750            Z:=Z-1 ;\r
 751       Fi;\r
 752       Call Move (I+8*Z,J);\r
 753       Call Hascii (0) ;\r
 754       Case P.Valeur\r
 755            When '&' : Call dessine_et(I+8*Z,J);\r
 756            When '%' : Call dessine_ou(I+8*Z,J);\r
 757            When '>' : Call dessine_implique(I+8*Z,J);\r
 758            When '|' : Call dessine_non(I+8*Z,J);\r
 759            otherwise  Call Hascii(Ord(P.Valeur));\r
 760       esac;\r
 761       Z:=Z-1;\r
 762       Call parcours_Arbre_Left(p.Left,Sens,I,J,Z);\r
 763       If P.Right<>None And P.Valeur<>'|'\r
 764       Then Call Move (I+8*Z,J) ;\r
 765            Call Hascii (0) ;\r
 766            Call Hascii (40) ;\r
 767            Z:=Z-1 ;\r
 768       Fi ;\r
 769   Fi ;\r
 770 End;\r
 771 End Parcours_Arbre_Left;\r
 772  \r
 773  \r
 774  \r
 775 Unit Affiche_Liste : Procedure (Input L:Liste;I,J,Sens:Integer );\r
 776 Var Z : Integer ;\r
 777 Begin\r
 778   Pref IIUWGRAPH Block\r
 779   Begin\r
 780        Call color(12);\r
 781        Call Move (I,J) ;\r
 782        Call dessine_fleche(I,J);\r
 783        Z:=0;\r
 784        Call color(15);\r
 785      If L=None\r
 786      Then Call Move(I+Sens,J);\r
 787           Call dessine_vide(I+sens,J);\r
 788      Fi ;\r
 789      While L<>None\r
 790      Do\r
 791        Z:=0;\r
 792        I:=I+Sens;\r
 793        Call Move (I,J) ;\r
 794        If Sens =-8\r
 795        Then Call Parcours_Arbre_Left (L.Debut,Sens,I,J,Z);\r
 796        Else Call Parcours_Arbre_Right(L.Debut,Sens,I,J,Z);\r
 797        Fi ;\r
 798        L := L.Suivant ;\r
 799        If L<>None\r
 800        Then I:=I+8*Z;\r
 801             Call Move (I,J);\r
 802             Call Hascii (0) ;\r
 803             Call Hascii (44);\r
 804        Fi ;\r
 805      Od ;\r
 806   End;\r
 807 End Affiche_Liste ;\r
 808  \r
 809  \r
 810 Unit Parcours : Procedure(Racine:Node;X,Y,Z:integer);\r
 811 Var P : Node ;\r
 812 Begin\r
 813   Pref IIUWGRAPH Block\r
 814   Begin\r
 815    P := Racine;\r
 816    If P <> None Then\r
 817       Call Affiche_Liste (P.Val.Gauche,X,Y,-8) ;\r
 818       Call Affiche_Liste (P.Val.Droite,X,Y,+8) ;\r
 819       Call Parcours(P.Left,X-Z,Y+32,Z/2) ;\r
 820       If P.Left<>None Then Call color(11);\r
 821                            Call Move (X,Y+8) ;\r
 822                            Call Draw (X-Z,Y+30) ;\r
 823                            Call Move (X,Y+8) ;\r
 824                            Call Draw (X+Z,Y+30) ;\r
 825                            Call color(15);\r
 826                            Call Parcours(P.Right,X+Z,Y+32,Z/2) ;\r
 827                       Else If P.Right<>None\r
 828                            Then Call color(11);\r
 829                                 Call Move (X,Y+8) ;\r
 830                                 Call Draw (X,Y+30) ;\r
 831                                 Call color(15);\r
 832                            Fi ;\r
 833                            Call Parcours(P.Right,X,Y+32,Z/2) ;\r
 834       Fi;\r
 835    Fi;\r
 836   End;\r
 837 End Parcours;\r
 838  \r
 839  \r
 840 (****************************************************)\r
 841 (*  Evaluation de la Tautologicit\82 de la formule    *)\r
 842 (****************************************************)\r
 843  \r
 844  \r
 845 Unit Recherche_Tautologie : Procedure(Left,Right:Liste;X,Y,Z:Integer;\r
 846                                       OutPut H:Boolean) ;\r
 847 Var Element : Char,\r
 848     Large,Xx: Integer,\r
 849     Totaul  : Boolean,\r
 850     L,R     : Liste;\r
 851  \r
 852 Begin\r
 853      Totaul := False ;\r
 854      Large := 24;\r
 855      Xx:=x;\r
 856      X := X-8;\r
 857      H := False ;\r
 858      L := Copie_Liste (Left);\r
 859      R := Copie_Liste (Right);\r
 860      If (Left=None) Or (Right=None)\r
 861      Then\r
 862           call texte(150,Y+20,11,\r
 863                "Cette expression n'est pas une tautologie.") ;\r
 864      Else Element := Left.Debut.valeur ;\r
 865           Do\r
 866             Do\r
 867               If Element = Right.Debut.Valeur Then Exit; Fi;\r
 868               Right := Right.Suivant ;\r
 869               If Right = None Then Exit; Fi;\r
 870             Od;\r
 871             If Right<>None Then\r
 872                      call texte(150,Y+20,11,\r
 873                      "Cette expression est une tautologie.");\r
 874                                 Totaul:=True ;\r
 875                                 H := True ;\r
 876             Fi ;\r
 877             If Totaul Then Exit; Fi;\r
 878             Left := Left.Suivant ;\r
 879             If Left = None Then\r
 880                 call texte(150,Y+20,11,\r
 881                 "Cette expression n'est pas une tautologie.");\r
 882                                 Exit;\r
 883             Fi;\r
 884             Right := Copie_Liste(R);\r
 885           Od;\r
 886      Fi ;\r
 887      If Not Totaul\r
 888      Then While L<>None\r
 889           Do L:=L.Suivant ;\r
 890              If L<>None Then X:=X-16;\r
 891                              Large:=Large+16;\r
 892              Fi;\r
 893          Od;\r
 894          While R<>None\r
 895           Do R:=R.Suivant ;\r
 896              If R<>None Then Large:=Large+16;\r
 897              Fi;\r
 898          Od;\r
 899          Call Rectangle (X-1,Y,Large+2,8,15) ;\r
 900      Fi;\r
 901  \r
 902 End Recherche_Tautologie;\r
 903  \r
 904  \r
 905 Unit Affiche_Feuille:Procedure (D:Node;X,Y,Z:Integer;Inout H:Boolean);\r
 906 Begin\r
 907      If D<>None\r
 908      Then If Not H Then Return;\r
 909           Fi;\r
 910           Call Affiche_Feuille (D.Left,X-Z,Y+32,Z/2,H) ;\r
 911           If D.Left<>None\r
 912           Then Call Affiche_Feuille (D.Right,X+Z,Y+32,Z/2,H) ;\r
 913           Else Call Affiche_Feuille (D.Right,X,Y+32,Z/2,H) ;\r
 914           Fi ;\r
 915           If (D.Left=None) And (D.Right=None)\r
 916           Then\r
 917           Call Recherche_Tautologie(D.Val.Gauche,D.Val.Droite,X,Y,Z,H);\r
 918           Fi ;\r
 919      Fi;\r
 920 End Affiche_Feuille ;\r
 921  \r
 922  \r
 923 (************************************)\r
 924 (*      Proc\82dures Graphiques       *)\r
 925 (************************************)\r
 926  \r
 927  \r
 928  \r
 929 Unit Rectangle : Procedure (X,Y,Large,Haut,Col:Integer) ;\r
 930 Begin\r
 931 Pref IIUWGRAPH Block\r
 932 Begin\r
 933      Call Color(Col) ;\r
 934      Call Move (X,Y) ;\r
 935      Call Draw (X+Large,Y) ;\r
 936      Call Draw (X+Large,Y+Haut) ;\r
 937      Call Draw (X,Y+haut) ;\r
 938      Call Draw (X,Y) ;\r
 939 End ;\r
 940 End ;\r
 941  \r
 942  \r
 943  \r
 944 Unit Fill : Procedure (X,Y,Large,Haut,Col:Integer) ;\r
 945 Var I:Integer ;\r
 946 Begin\r
 947 Pref IIUWGRAPH Block\r
 948 Begin\r
 949      Call Color (Col) ;\r
 950      For I:=Y To Y+Haut\r
 951      Do\r
 952        Call Move(X,I) ;\r
 953        Call Draw(X+Large,I) ;\r
 954      Od ;\r
 955 End ;\r
 956 End ;\r
 957  \r
 958  \r
 959 Unit Texte : Procedure (X,Y,col : integer; s : string);\r
 960 Begin\r
 961 Pref IIUWGRAPH Block\r
 962 Begin\r
 963      Call Color (Col) ;\r
 964      Call Move (X,Y);\r
 965      Call outstring(s);\r
 966 End ;\r
 967 End ;\r
 968  \r
 969  \r
 970 Unit dessine_et : Procedure(X,Y : integer);\r
 971 Begin\r
 972 Pref IIUWGRAPH Block\r
 973 Begin\r
 974    Call Hascii(0);\r
 975    Call move(X,Y+6);\r
 976    Call draw(X+3,Y+2);\r
 977    Call draw(X+6,Y+6);\r
 978 End;\r
 979 End;\r
 980  \r
 981  \r
 982 Unit dessine_ou : Procedure(X,Y : integer);\r
 983 Begin\r
 984 Pref IIUWGRAPH Block\r
 985 Begin\r
 986    Call Hascii(0);\r
 987    Call move(X,Y+2);\r
 988    Call draw(X+3,Y+6);\r
 989    Call draw(X+6,Y+2);\r
 990 End;\r
 991 End;\r
 992  \r
 993  \r
 994 Unit dessine_implique : Procedure(X,Y : integer);\r
 995 Begin\r
 996 Pref IIUWGRAPH Block\r
 997 Begin\r
 998    Call Hascii(0);\r
 999    Call move(X,Y+2);\r
1000    Call draw(X+4,Y+2);\r
1001    Call move(X,Y+4);\r
1002    Call draw(X+4,Y+4);\r
1003    Call move(X+3,Y);\r
1004    Call draw(X+6,Y+3);\r
1005    Call draw(X+3,Y+6);\r
1006  \r
1007 End;\r
1008 End;\r
1009  \r
1010  \r
1011 Unit dessine_non : Procedure(X,Y : integer);\r
1012 Begin\r
1013 Pref IIUWGRAPH Block\r
1014 Begin\r
1015    Call Hascii(0);\r
1016    Call move(X+1,Y);\r
1017    Call draw(X+3,Y);\r
1018    Call draw(X+3,Y+6);\r
1019 End;\r
1020 End;\r
1021  \r
1022  \r
1023 Unit dessine_vide : Procedure(X,Y : integer);\r
1024 Begin\r
1025 Pref IIUWGRAPH Block\r
1026 Begin\r
1027    Call Hascii(0);\r
1028    Call cirb(X+3,Y+4,3,0,0,15,0,1,1);\r
1029    Call move(X,Y+7);\r
1030    Call draw(X+8,Y);\r
1031 End;\r
1032 End;\r
1033  \r
1034  \r
1035 Unit dessine_fleche : Procedure(X,Y : integer);\r
1036 Begin\r
1037 Pref IIUWGRAPH Block\r
1038 Begin\r
1039    Call Hascii(0);\r
1040    Call move(X+1,Y+4);\r
1041    Call draw(X+7,Y+4);\r
1042    Call move(X+4,Y+1);\r
1043    Call draw(X+7,Y+4);\r
1044    Call draw(X+4,Y+7);\r
1045 End;\r
1046 End;\r
1047  \r
1048  \r
1049 (********************************)\r
1050 (*      Programe Principal      *)\r
1051 (********************************)\r
1052  \r
1053 Begin\r
1054      array valeur dim(1:47);\r
1055      Pref IIUWGRAPH Block\r
1056      Begin\r
1057        Call Gron (0) ;\r
1058        Do\r
1059          Call Cls ;\r
1060          Call Rectangle (120,10,344,40,15);\r
1061          Call Rectangle (125,51,345,6,15);\r
1062          Call Rectangle (465,15,6,42,15);\r
1063          Call Fill (126,51,344,5,9);\r
1064          Call Fill (465,16,5,37,9);\r
1065          Call texte(121,27,15,\r
1066                     "    EVALUATION DE PROPOSITIONS LOGIQUES   ");\r
1067          Call Rectangle (100,150,400,72,15) ;\r
1068          Call move(100,200);\r
1069          Call draw(500,200);\r
1070          Call Rectangle (144,200,44,22,15);\r
1071          Call Rectangle (232,200,44,22,15);\r
1072          Call texte(105,208,12,"F1:");\r
1073          Call dessine_et(131,208);\r
1074          Call texte(149,208,12,"F2:");\r
1075          Call dessine_ou(175,208);\r
1076          Call texte(193,208,12,"F3:");\r
1077          Call dessine_implique(219,208);\r
1078          Call texte(237,208,12,"F4:");\r
1079          Call dessine_non(263,208);\r
1080          Call texte(285,208,12,"Variables : a,b,c,d,x,y,z");\r
1081          Call texte(105,160,15,"Entrez la proposition : (");\r
1082          Call texte(308,160,12,"F10 ");\r
1083          Call texte(340,160,15,"pour quitter)");\r
1084          Call texte(110,184,15,\r
1085                    "------------------------------------------------");\r
1086          Call Rectangle (100,250,400,60,15) ;\r
1087          Call Move (100,290) ;\r
1088          Call Draw (500,290) ;\r
1089          Call Texte (225,297,12,"Fen\88tre de messages");\r
1090          Call Move(110,180);\r
1091          longueur:=0;\r
1092  \r
1093   Do\r
1094     Ch := New Chaine;\r
1095     If Analyseur(Longueur) Then\r
1096        Call texte(153,280,15,"Appuyez sur une touche pour continuer");\r
1097        while inkey=0 do od;\r
1098        Exit;\r
1099     else\r
1100        Call texte(153,280,15,"Appuyez sur une touche pour continuer");\r
1101        while inkey=0 do od;\r
1102        Call Fill (101,251,398,38,0) ;\r
1103        Call move(110+(longueur*8),180);\r
1104     Fi;\r
1105   Od;\r
1106  \r
1107   call cls ;\r
1108   call color(15);\r
1109   H := True ;\r
1110   i:=1;\r
1111   call Operateur(longueur,racine);\r
1112   xx :=320;\r
1113   Y := 80;\r
1114   Z:=256;\r
1115   Diagramme := New Node;\r
1116   Diagramme.Val := New Sequence ;\r
1117   Diagramme.Val.Droite := Insert (Racine,Diagramme.Val.Droite) ;\r
1118   Courant := Diagramme ;\r
1119   Call decompose(Diagramme) ;\r
1120   Call texte(105,32,12,\r
1121        "Evolution de la formule suivant la methode de GENTZEN") ;\r
1122   Call texte(97,40,12,\r
1123        "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ") ;\r
1124   Call color(15);\r
1125   Call parcours(Courant,xx,y,Z);\r
1126   Call texte(130,320,12,"Appuyez sur une touche pour continuer");\r
1127   While inkey=0 do od;\r
1128   Call Texte(130,320,12,"                                     ");\r
1129   Call Affiche_Feuille (Diagramme,320,80,256,H) ;\r
1130   While inkey=0 do od;\r
1131 Od;\r
1132   Call Groff;\r
1133 End ;\r
1134 End Evaluationdepropositionslogiques;\r
1135  \r