UNIT RPN;

INTERFACE

CONST ALPHA=['A'..'Z','a'..'z'];
      NUM  =['0'..'9'];
      ALPHANUM=ALPHA+NUM;
      LISTE=',+-*/^';

TYPE
 EXPRESS=
  RECORD
   SIG:STRING;
   FRERE,FILS:POINTER;
  END;

 PEXP=^EXPRESS;

VAR
    COMPT,PARENTH:BYTE;
    CHAINE:STRING;
    ERREUR:BOOLEAN;

PROCEDURE CONSTRUIT_ARBRE(VAR S:STRING;VAR P:EXPRESS);
PROCEDURE KILL(VAR P:EXPRESS);
PROCEDURE TO_RPN(VAR P:EXPRESS;VAR RESULT:STRING);


IMPLEMENTATION

FUNCTION CAR:CHAR;
 BEGIN
  CAR:=CHAINE[COMPT];
{  IF COMPT>LENGTH(CHAINE) THEN ERREUR:=TRUE;}
 END;

FUNCTION LAST:CHAR;
 BEGIN
  LAST:=CHAINE[COMPT-1]
 END;


PROCEDURE CONSTRUIT(VAR P:EXPRESS;DER:BOOLEAN);

VAR SIGNES:STRING;
    FIN:BOOLEAN;
VAR DEUX,Z:PEXP;


BEGIN
 FIN:=FALSE;
 P.SIG:='';
 P.FILS:=NIL;
 IF DER
  THEN
   BEGIN
    P.SIG:=CAR;
    INC(COMPT);
    WHILE CAR IN ALPHANUM DO
     BEGIN
      P.SIG:=P.SIG+CAR; {WRITE(CAR);}
      INC(COMPT)
     END;
   END
  ELSE
   BEGIN
    REPEAT

     IF (CAR IN ALPHANUM) OR ( (CAR='-') AND (LAST='(') )
      THEN
       BEGIN
        NEW(DEUX);
        DEUX^.FRERE:=P.FILS;
        P.FILS:=DEUX;
        CONSTRUIT(DEUX^,TRUE);
       END
       ELSE

        IF CAR=#26
        THEN
         IF (PARENTH=0) AND (POS(LAST,LISTE+'(')=0)
          THEN FIN:=TRUE ELSE ERREUR:=TRUE
        ELSE

        BEGIN
         IF CAR=')' THEN
          BEGIN
           IF (PARENTH=0) OR (POS(LAST,LISTE+'(')<>0)
            THEN ERREUR:=TRUE
            ELSE
             BEGIN
              FIN:=TRUE;
              DEC(PARENTH);
              INC(COMPT);
             END;
          END
         ELSE

          IF CAR='(' THEN BEGIN
            IF (COMPT>1) AND (POS(LAST,LISTE+'(')=0)
             THEN BEGIN
              DEUX^.SIG:='~'+DEUX^.SIG;
              NEW(Z);
              DEUX^.FILS:=Z;
              Z^.FRERE:=NIL;
              Z^.FILS:=NIL;
            INC(COMPT);
            INC(PARENTH);
            CONSTRUIT(Z^,FALSE);
              END ELSE BEGIN
            NEW(DEUX);
            DEUX^.FRERE:=P.FILS;
            P.FILS:=DEUX;
            INC(COMPT);
            INC(PARENTH);
            CONSTRUIT(DEUX^,FALSE);
           END              END
        ELSE
         IF (POS(CAR,LISTE)>0) AND (POS(LAST,LISTE)=0) THEN
          BEGIN
           P.SIG:=P.SIG+CAR;
           INC(COMPT);
          END
       ELSE ERREUR:=TRUE;
       END;
    UNTIL FIN OR ERREUR;
   END;
  END;


PROCEDURE KILL(VAR P:EXPRESS);
VAR AD:PEXP;
     N:POINTER;
 BEGIN
{  WRITELN(P.SIG);} { Pour afficher l'arborescence }
  AD:=PEXP(P.FILS);
  WHILE AD<>NIL DO
   BEGIN
    KILL(AD^);
    N:=AD^.FRERE;
    DISPOSE(AD);   { si l'on veut d‚truire la structure }
    AD:=PEXP(N);
   END;
 END;

PROCEDURE TO_RPN(VAR P:EXPRESS;VAR RESULT:STRING);
 VAR C:BYTE;
      AD:PEXP;
      FEXP:EXPRESS;
      I,N:BYTE;
      FN:BOOLEAN;
 BEGIN
  IF P.FILS=NIL
   THEN
    BEGIN
     RESULT:=RESULT+P.SIG+' ';

{ Appel au compilateur : PUSH nombre  PUSH_NOMBRE(P.SIG);}

    END
   ELSE
   BEGIN
    FN:=(P.SIG[1]='~');
    AD:=PEXP(P.FILS);
    IF NOT FN THEN FOR I:=1 TO LENGTH(P.SIG) DO AD:=AD^.FRERE;
    TO_RPN(AD^,RESULT);
    IF FN THEN
     RESULT:=RESULT+P.SIG+' ' { AJOUTER : CALL function }
    ELSE
   IF LENGTH(P.SIG)=1 THEN
    BEGIN
    AD:=PEXP(P.FILS);
    TO_RPN(AD^,RESULT);
     RESULT:=RESULT+P.SIG+' ';

{ Appel au compilateur de code : op‚rande   COP(P.SIG[1]);}

    END
   ELSE BEGIN
   WHILE P.SIG<>''  DO
    BEGIN
     N:=POS(P.SIG[1],LISTE);
     C:=1;
     REPEAT INC(C) UNTIL (POS(P.SIG[C],LISTE)<=N) OR (C>=LENGTH(P.SIG));

     IF (POS(P.SIG[C],LISTE)>N) OR (LENGTH(P.SIG)=1)
      THEN
         C:=LENGTH(P.SIG)+1;
     AD:=PEXP(P.FILS);
     FOR I:=1 TO LENGTH(P.SIG)-C+1 DO AD:=AD^.FRERE;
     FEXP.FRERE:=NIL;
     FEXP.FILS:=AD;
     FEXP.SIG:=COPY(P.SIG,2,C-2);

     TO_RPN(FEXP,RESULT);
      RESULT:=RESULT+P.SIG[1]+' ';

{ Appel au compilateur de code : op‚rande        COP(P.SIG[1]);}

     DELETE(P.SIG,1,C-1);
    END;                     END;
   END;
 END;

PROCEDURE ADD_ZERO(VAR S:STRING);
 VAR I:BYTE;
 BEGIN
  IF S[1]='-' THEN S:='0'+S;
  REPEAT
   I:=POS('(-',S);
   IF I>0 THEN INSERT('0',S,I+2);
  UNTIL I=0;
 END;

PROCEDURE CONSTRUIT_ARBRE(VAR S:STRING;VAR P:EXPRESS);
 VAR NOM:STRING;
       C:CHAR;
 BEGIN
  CHAINE:=S+#26;
  ADD_ZERO(CHAINE);
  PARENTH:=0;
  COMPT:=1;
  ERREUR:=FALSE;
  P.FRERE:=NIL;
  CONSTRUIT(P,FALSE);
 END;

END.