{ $DEFINE ANALOGIZE}
{* S Compiler, ver 1.00.
   Copyright (C) 1994, Henri LESOURD.

   This software is free software; you can redistribute it and/or
   modify it under the terms of the GNU Library General Public License as
   published by the Free Software Foundation; either version 2 of the
   License, or (at your option) any later version.

   This compiler is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   You should have received a copy of the GNU Library General Public
   License along with the GNU C Library; see the file COPYING.LIB.  If not,
   write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  *}
Unit Digitizify;

{ ***************************************************************************
  GAFFE a l'init pour les analogize (est-on ds 1 ctx coh‚rent (Envir0...) ?).
  *************************************************************************** }

Interface

Uses
    Crt,Errorify,Symbolize,Lexify,Writify;

Function Digitize(Ptr0 : Word) : BoxPtr;
{$IFDEF ANALOGIZE}
Procedure AnalogizeLisp(B : BoxPtr);
Procedure Analogize(B : BoxPtr);
{$ENDIF}
Function DigitizeBlock(PVirgCassos : Boolean) : BoxPtr;
Var
   Indent : Word;
   Lisp : Boolean;
{$IFDEF ANALOGIZE}
Procedure AnalogizeBlock(B : BoxPtr);
{$ENDIF}
Function DigitizeBody : BoxPtr;
{$IFDEF ANALOGIZE}
Procedure AnalogizeBody(B : BoxPtr);
{$ENDIF}
Function DigitizePackage : BoxPtr;
{$IFDEF ANALOGIZE}
Procedure AnalogizePackage(B : BoxPtr);
{$ENDIF}
Procedure InvPrior(Op : Word);

Implementation

Var
   P : Array[0..45] of ShortInt;

Function Prior(A,B : Word) : Boolean;
Begin
  If Abs(P[A])>Abs(P[B]) Then Prior:=True
  Else
  If Abs(P[A])<Abs(P[B]) Then Prior:=False
  Else
    If P[A]>=0 Then Prior:=True
               Else Prior:=False;
End;

Const
     SizePileOp=256;
Var
   OpTop,BoxTmp : BoxPtr;
   PileOp : Array[0..SizePileOp-1] of BoxPtr; PtrOp : Word;

Function Digitize(Ptr0 : Word) : BoxPtr;
Label
     CassosW,Cassos,WithoutNext;
Var
   Current : BoxPtr;
Begin
  PtrOp:=Ptr0;
  Current:=Nil;
  While True Do
  Begin
    Case Nature(CurWord) Of { Gaffe : non compact }
      Symbol,Constant:
        If Current<>Nil Then
                        { Error('Alpha2') }
                        { Attention, la solution n'est pas
                          parfaite; Par exemple, ‡a chie sur
                          Locate -1,-1; V. ExprF }
                          Begin
                            BoxTmp:=NewBox(Operator Or OpPouvr);
                            BoxTmp^.Gauche:=Current;Current:=BoxTmp;
                            If EatCR Then
                              Begin
                                EatCR:=False;
                                Current^.Droite:=Digitize(PtrOp);
                                EatCR:=True;
                              End
                            Else
                              Begin
                                Current^.Droite:=Digitize(PtrOp);
                              End;
                            Goto WithoutNext;
                          End
                        Else
                          Current:=CurBox;
      Operator:
        Begin
          While PtrOp>Ptr0 Do
          Begin
            OpTop:=PileOp[PtrOp-1];
            If Prior(Name(OpTop^.Nature),Name(CurWord)) Then
              Begin
                Dec(PtrOp);
                OpTop^.Droite:=Current;
                Current:=OpTop;
              End
            Else
              Goto CassosW;
          End;
  CassosW:
          If Name(CurWord)=OpPouvr Then
            Begin
              If Current<>Nil Then
                Begin
                  CurBox:=NewBox(CurWord);
                  CurBox^.Gauche:=Current;Current:=CurBox;
                  If EatCR Then
                    Begin
                      NextWord;Current^.Droite:=Digitize(PtrOp);
                    End
                  Else
                    Begin
                      EatCR:=True;
                      NextWord;
                      Current^.Droite:=Digitize(PtrOp);
                      EatCR:=False;
                    End;
                End
              Else
                Begin
                  If EatCR Then
                    Begin
                      NextWord;Current:=Digitize(PtrOp);
                    End
                  Else
                    Begin
                      EatCR:=True;
                      NextWord;
                      Current:=Digitize(PtrOp);
                      EatCR:=False;
                    End;
                End;

              If Name(CurWord)<>KeyPFerm Then Error(') Expected');
            End
          Else
          If Name(CurWord)=OpCrouvr Then
            Begin
              If Current<>Nil Then
                Begin
                  CurBox:=NewBox(CurWord);
                  CurBox^.Gauche:=Current;Current:=CurBox;
                  If EatCR Then
                    Begin
                      NextWord;Current^.Droite:=Digitize(PtrOp);
                    End
                  Else
                    Begin
                      EatCR:=True;
                      NextWord;
                      Current^.Droite:=Digitize(PtrOp);
                      EatCR:=False;
                    End;
                End
              Else
                Error('Alpha [...]');

              If Name(CurWord)<>KeyCrFerm Then Error('] Expected');
            End
          Else
            Begin
              If PtrOp>=SizePileOp Then Error('String formula 2 complex')
              Else
                Begin
                  CurBox^.Gauche:=Current;
                  PileOp[PtrOp]:=CurBox;
                  Inc(PtrOp);Current:=Nil;
                End;
            End;
        End;

      KeyWord: Goto Cassos;
    End;
    NextWord;
WithoutNext:
  End;

Cassos:
  While PtrOp>Ptr0 Do
  Begin
    OpTop:=PileOp[PtrOp-1];
    Dec(PtrOp);OpTop^.Droite:=Current;
    Current:=OpTop;
  End;
  Digitize:=Current;
End;

{$IFDEF ANALOGIZE}
Procedure AnalogizeLisp(B : BoxPtr);
Begin
  If B=Nil Then Write('?')
  Else
    Case Nature(B^.Nature) Of
      Operator:
        Begin
          TextAttr:=7;Write('(');
          AnalogizeLisp(B^.Gauche);

          WriteOperator(B^.Nature);

          AnalogizeLisp(B^.Droite);
          TextAttr:=7;Write(')');
        End;
      Symbol: WriteSymbol(B);
      Constant : WriteConstant(B);
      Else
        Error('Bad Expr Tree');
    End;
End;

Procedure Analogize(B : BoxPtr);
Begin
  If B=Nil Then Write('?')
  Else
    Case Nature(B^.Nature) Of
      Operator:
        Begin
          If (B^.Gauche<>Nil) And
             (Nature(B^.Gauche^.Nature)=Operator) And
             (
                 ( Abs(P[Name(B^.Nature)])>Abs(P[Name(B^.Gauche^.Nature)])
                 )
               Or
                 ( (P[Name(B^.Nature)]=P[Name(B^.Gauche^.Nature)]) And
                   (P[Name(B^.Nature)]<0)
                 )
             )
          Then
            Begin
              TextAttr:=ColorOperator;Write('(');
              Analogize(B^.Gauche);
              TextAttr:=ColorOperator;Write(')');
            End
          Else
            Analogize(B^.Gauche);

          WriteOperator(B^.Nature);

          If Name(B^.Nature)=OpPouvr Then
            Begin
              Analogize(B^.Droite);
              TextAttr:=ColorOperator;Write(')');
            End
          Else
          If Name(B^.Nature)=OpCrouvr Then
            Begin
              Analogize(B^.Droite);
              TextAttr:=ColorOperator;Write(']');
            End
          Else
            If (B^.Droite<>Nil) And
               (Nature(B^.Droite^.Nature)=Operator) And
               (
                   ( Abs(P[Name(B^.Nature)])>Abs(P[Name(B^.Droite^.Nature)])
                   )
                 Or
                   ( (P[Name(B^.Nature)]=P[Name(B^.Droite^.Nature)]) And
                     (P[Name(B^.Nature)]>=0)
                   )
               )
            Then
              Begin
                TextAttr:=ColorOperator;Write('(');
                Analogize(B^.Droite);
                TextAttr:=ColorOperator;Write(')');
              End
            Else
              Analogize(B^.Droite);
        End;
      Symbol: WriteSymbol(B);
      Constant : WriteConstant(B);
      Else
        Error('Bad Expr Tree');
    End;
End;
{$ENDIF}

Var
   OldIncomplet,ElsePart,OldScratch1 : BoxPtr;

Function DigitizeBlock(PVirgCassos : Boolean) : BoxPtr;
Label
     Cassos,Lwhile,LItemCase,LItemElse;
Var
   Current,Incomplet,Result,AlwaysPart,Scratch1,Scratch2 : BoxPtr;
   W : Word;
Begin
  Result:=Nil;OldIncomplet:=Nil;
  Current:=Nil;Incomplet:=Nil;
  AlwaysPart:=Nil;
  While True Do
    If Nature(CurWord)<>KeyWord Then
      If Current<>Nil Then Error('Alpha2')
      Else
        Current:=Digitize(0)
    Else
      Case Name(CurWord) Of
        KeyDeuxPoints:
          If Current=Nil Then Error('Instruction expected')
          Else
            Begin
              OldIncomplet:=Incomplet;
              If Incomplet=Nil Then
                Begin
                  Result:=NewLiNode(CurWord);
                  Incomplet:=Result;
                End
              Else
                Begin
                  Incomplet^.Droite:=NewLiNode(CurWord);
                  Incomplet:=Incomplet^.Droite;
                End;
              Incomplet^.Gauche:=Current;
              Current:=Nil;NextWord;
            End;

        KeyCarriage:
          If Current=Nil Then
            Begin
              If (Incomplet<>Nil) And
                 (Incomplet^.Nature=KeyWord Or KeyDeuxPoints)
              Then
                Begin
                  Incomplet^.Droite:=NewLiNode(KeyLabel);
                  If Nature(Incomplet^.Gauche^.Nature)<>Symbol
                  Then
                    Error('CompileBlock : Label : Symbol expected')
                  ;
                  Incomplet^.Droite^.Gauche:=Incomplet^.Gauche;
                  Incomplet^.Gauche:=Incomplet^.Droite;
                  Incomplet^.Droite:=Nil;
                  Incomplet^.Nature:=KeyWord Or KeyCarriage;
                  W:=LiNodePtr(Incomplet)^.NbCR;
                  LiNodePtr(Incomplet)^.NbCR:=LiNodePtr(Incomplet^.Gauche)^.NbCR;
                  LiNodePtr(Incomplet^.Gauche)^.NbCR:=W;
                  NextWord;
                End
              Else
                NextWord
                ;
            End
          Else
            Begin
              OldIncomplet:=Incomplet;
              { Rajout ds l'arbre }
              If Incomplet=Nil Then
                Begin
                  Result:=NewLiNode(CurWord);
                  Incomplet:=Result;
                End
              Else
                Begin
                  Incomplet^.Droite:=NewLiNode(CurWord);
                  Incomplet:=Incomplet^.Droite;
                End;
              Incomplet^.Gauche:=Current;
              Current:=Nil;NextWord;
            End;

        KeyRecord:
          Begin
            If Current<>Nil Then Error('Alpha2');
            Current:=NewBox(CurWord);
            NextWord;
            IsIsOpIs:=False;
              Current^.Gauche:=Digitize(0);
            IsIsOpIs:=True;

            If CurWord<>(KeyWord Or KeyIs) Then Error('Is Expected');
            NextWord;
            Current^.Droite:=DigitizeBlock(False);

            If CurWord=(KeyWord Or KeyEnd) Then NextWord
            Else
              Error('End Expected');
          End;

        KeyInLine:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              Current:=NewBox(CurWord);

            NextWord;
            P[OpVirg]:=-P[OpVirg];
              Current^.Gauche:=Digitize(0);
            P[OpVirg]:=-P[OpVirg];
          End;

        KeyIf:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              Current:=NewBox(CurWord);

            EatCR:=True;EqualIsLet:=False;
              NextWord;
              Current^.Gauche:=Digitize(0);
            EatCR:=False;EqualIsLet:=True;

            If CurWord<>(KeyWord Or KeyThen) Then Error('Then Expected');

            EatCR:=True;
              NextWord;
            EatCR:=False;

            If CurWord=(KeyWord Or KeyBegin) Then
              Begin
                NextWord;
                Current^.Droite:=DigitizeBlock(False);
              End
            Else
              Current^.Droite:=DigitizeBlock(True);

            If CurWord=(KeyWord Or KeyElse) Then
            Begin
              ElsePart:=NewBox(CurWord);
              ElsePart^.Gauche:=Current^.Droite;
              Current^.Droite:=ElsePart;
              EatCR:=True;
                NextWord;
              EatCR:=False;
              If CurWord=(KeyWord Or KeyBegin) Then
                Begin
                  NextWord;
                  Current^.Droite^.Droite:=DigitizeBlock(False)
                End
              Else
                Current^.Droite^.Droite:=DigitizeBlock(True);
            End;
            If CurWord=(KeyWord Or KeyEnd) Then NextWord
            Else
            If CurWord=(KeyWord Or KeyElse) Then Goto Cassos
            Else
              If CurWord=(KeyWord Or KeyPVirg) Then
                If PVirgCassos And (Result=Nil) Then Goto Cassos
                                                Else NextWord
              Else
                Error('"End" Or ";" Expected');
          End;

        KeyAlways:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              AlwaysPart:=NewBox(CurWord);

            NextWord;
            AlwaysPart^.Gauche:=DigitizeBlock(False);

            If CurWord<>KeyWord Or KeyAwhile Then Error('Always : Awhile expected');

            Goto Lwhile;
          End;

        KeyWhile:
Lwhile:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              Current:=NewBox(KeyWord Or KeyWhile);

            EatCR:=True;EqualIsLet:=False;
              NextWord;
              Current^.Gauche:=Digitize(0);
            EatCR:=False;EqualIsLet:=True;

            If CurWord<>(KeyWord Or KeyDo) Then Error('Do Expected');

            EatCR:=True;
              NextWord;
            EatCR:=False;

            If CurWord=(KeyWord Or KeyBegin) Then
              Begin
                NextWord;
                Current^.Droite:=DigitizeBlock(False);
              End
            Else
              Current^.Droite:=DigitizeBlock(True);

            If AlwaysPart<>Nil Then
              Begin
                AlwaysPart^.Droite:=Current;
                Current:=AlwaysPart;
                AlwaysPart:=Nil;
              End;

            If CurWord=(KeyWord Or KeyWend) Then NextWord
            Else
              If CurWord=(KeyWord Or KeyPVirg) Then
                If PVirgCassos And (Result=Nil) Then Goto Cassos
                                                Else NextWord
              Else
                Error('"End" Or ";" Expected');
          End;

        KeyFor:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              Current:=NewBox(CurWord);

            EatCR:=True;
              NextWord;
              Current^.Gauche:=NewBox(KeyWord Or KeyTo);
              Current^.Gauche^.Gauche:=Digitize(0);
            EatCR:=False;

            If CurWord=KeyWord Or KeyDownTo Then Current^.Gauche^.Nature:=KeyWord Or KeyDownTo;
            If (CurWord<>KeyWord Or KeyTo) And (CurWord<>KeyWord Or KeyDownTo) Then Error('To/DownTo Expected')
            Else
              Begin
                EatCR:=True;
                  NextWord;
                EatCR:=False;
                Current^.Gauche^.Droite:=Digitize(0);
                If CurWord=KeyWord Or KeyStep Then
                Begin
                  ElsePart:=NewBox(KeyWord Or KeyStep);
                  ElsePart^.Gauche:=Current^.Gauche^.Droite;
                  Current^.Gauche^.Droite:=ElsePart;
                  EatCR:=True;
                    NextWord;
                  EatCR:=False;
                  Current^.Gauche^.Droite^.Droite:=Digitize(0);
                End;
                If CurWord<>(KeyWord Or KeyDo) Then Error('Do Expected');
              End;

            EatCR:=True;
              NextWord;
            EatCR:=False;

            If CurWord=(KeyWord Or KeyBegin) Then
              Begin
                NextWord;
                Current^.Droite:=DigitizeBlock(False);
              End
            Else
              Current^.Droite:=DigitizeBlock(True);

            If CurWord=(KeyWord Or KeyNext) Then NextWord
            Else
              If CurWord=(KeyWord Or KeyPVirg) Then
                If PVirgCassos And (Result=Nil) Then Goto Cassos
                                                Else NextWord
              Else
                Error('"End" Or ";" Expected');
          End;

        KeyGoto:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              Current:=NewBox(KeyWord Or KeyGoto)
              ;
            NextWord;
            If Nature(CurWord)<>Symbol Then Error('Goto : Symbol expected');
            Current^.Gauche:=CurBox;
            NextWord;
          End;

        KeyCase:
          Begin
            If Current<>Nil Then Error('Alpha2')
            Else
              Current:=NewBox(CurWord);

            EatCR:=True;EqualIsLet:=False;
              NextWord;
              Current^.Gauche:=Digitize(0);
            EatCR:=False;EqualIsLet:=True;

            If CurWord<>(KeyWord Or KeyOf) Then Error('Of Expected');

            Scratch1:=Nil;Scratch2:=Nil;

          LItemCase:
            EatCR:=True;
              NextWord;
            EatCR:=False;
            Case CurWord Of
              KeyWord Or KeyElse:
                Begin
LItemElse:
                  OldScratch1:=Scratch1;
                  Scratch1:=NewBox(KeyWord Or KeyElse);
                  Scratch1^.Gauche:=OldScratch1;
                  EatCR:=True;
                    NextWord;
                  EatCR:=False;
                  If CurWord=(KeyWord Or KeyBegin) Then
                    Begin
                      NextWord;
                      Scratch1^.Droite:=DigitizeBlock(False);
                    End
                  Else
                    Scratch1^.Droite:=DigitizeBlock(True);

                  If (CurWord<>KeyWord Or KeyPVirg)
                  And
                     (CurWord<>KeyWord Or KeyEnd)
                  Then
                    Error('Case (Else) : "End" or ";" expected')
                  ;
                  EatCR:=True;
                    NextWord;
                  EatCR:=False;
                  If CurWord<>KeyWord Or KeyEnd Then Error('Case : End expected');
                  NextWord;
                End;
              KeyWord Or KeyEnd: NextWord;
              Else
                Begin
                  If Nature(CurWord)=KeyWord Then Error('DigitizeBlock : Case : Syntax error');
                  Scratch2:=NewBox(KeyWord Or KeyDeuxPoints);
                  EatCR:=True;EqualIsLet:=False;
                    Scratch2^.Gauche:=Digitize(0);
                  EatCR:=False;EqualIsLet:=True;
                  If CurWord<>KeyWord Or KeyDeuxPoints Then Error('Case : ":" expected');
                  If Scratch2^.Gauche=Nil Then Error('Case : Nil cond');
                  EatCR:=True;
                    NextWord;
                  EatCR:=False;
                  If CurWord=(KeyWord Or KeyBegin) Then
                    Begin
                      NextWord;
                      Scratch2^.Droite:=DigitizeBlock(False);
                    End
                  Else
                    Scratch2^.Droite:=DigitizeBlock(True);

                  If (CurWord<>KeyWord Or KeyPVirg)
                  And
                     (CurWord<>KeyWord Or KeyElse)
                  And
                     (CurWord<>KeyWord Or KeyEnd)
                  Then
                    Error('Case (Item) : "End" or ";" expected')
                  ;
                  OldScratch1:=Scratch1;
                  Scratch1:=NewBox(KeyWord Or KeyDeuxPoints);
                  Scratch1^.Gauche:=OldScratch1;
                  Scratch1^.Droite:=Scratch2;
                  If CurWord=KeyWord Or KeyElse Then Goto LItemElse
                                                Else Goto LItemCase;
                End;
            End;

            If (Scratch1=Nil) Or (Scratch2=Nil) Then Error('Case : missing part(s)');
            Current^.Droite:=Scratch1;

          End;

        Else
          Goto Cassos;
      End;

Cassos:
  If Result=Nil Then Result:=Current
  Else
    If Current<>Nil Then Incomplet^.Droite:=Current
    Else
      If (Incomplet<>Nil) And
         (Nature(Incomplet^.Nature)=(KeyWord Or KeyDeuxPoints))
      Then
        Error('Instruction Expected')
      Else
        Begin
          If OldIncomplet=Nil Then Result:=Incomplet^.Gauche
          Else
            OldIncomplet^.Droite:=Incomplet^.Gauche;

          Dispose(Incomplet)
        End;

  DigitizeBlock:=Result;
End;

{$IFDEF ANALOGIZE}
Procedure WriteIndentedCarriage;
Var
   I : Integer;
Begin
  WriteCarriage;
  For I:=1 To Indent Do
                       Write(' ');
End;

Procedure AnalogizeBlock(B : BoxPtr);
Var
   Fini : Boolean;
   Scratch : BoxPtr;
Begin
  Fini:=False;
  While Not Fini Do
    Case (B^.Nature) Of
      KeyWord Or KeyDeuxPoints:

      { ******************************************** }
      { WARNING !!! Il manque KeyWord Or ds la suite }
      { ******************************************** }

        Begin
          AnalogizeBlock(B^.Gauche);
          WriteKeyWord(KeyWord Or KeyDeuxPoints);
          B:=B^.Droite;
        End;
      KeyWord Or KeyCarriage:
        Begin
          AnalogizeBlock(B^.Gauche);
          TextAttr:=7;
          WriteIndentedCarriage;
          B:=B^.Droite;
        End;
      KeyWord Or KeyLabel:
        Begin
          WriteKeyWord(KeyWord Or KeyLabel);
          Analogize(B^.Gauche);
          WriteKeyWord(KeyWord Or KeyDeuxPoints);
          Fini:=True;
        End;
      KeyRecord:
        Begin
          WriteKeyWord(B^.Nature);
          Analogize(B^.Gauche);
          WriteKeyWord(KeyWord Or KeyIs);
          Inc(Indent,9);
          WriteIndentedCarriage;
          AnalogizeBlock(B^.Droite);
          Dec(Indent,2);
          WriteIndentedCarriage;
          WriteKeyWord(KeyWord Or KeyEnd);
          Dec(Indent,7);
          Fini:=True;
        End;
      KeyInLine:
        Begin
          WriteKeyWord(B^.Nature);
          TextAttr:=ColorOperator;Write('(');
          P[OpVirg]:=-P[OpVirg];
            Analogize(B^.Gauche);
          P[OpVirg]:=-P[OpVirg];
          TextAttr:=ColorOperator;Write(')');
          Fini:=True;
        End;
      KeyIf:
        Begin
          WriteKeyWord(B^.Nature);
          Analogize(B^.Gauche);
          WriteKeyWord(KeyWord Or KeyThen);
          Inc(Indent,2);
          WriteIndentedCarriage;
          If (B^.Droite^.Nature=(KeyWord Or KeyElse)) Then
            Begin
              AnalogizeBlock(B^.Droite^.Gauche);
              Dec(Indent,2);
              WriteIndentedCarriage;
              WriteKeyWord(KeyWord Or KeyElse);
              Inc(Indent,2);
              WriteIndentedCarriage;
              AnalogizeBlock(B^.Droite^.Droite);
            End
          Else
            Begin
              AnalogizeBlock(B^.Droite);
            End;

          Dec(Indent,2);
          WriteIndentedCarriage;
          WriteKeyWord(KeyWord Or KeyEnd);
          Fini:=True;
        End;
      KeyWhile,KeyAlways:
        Begin
          If B^.Nature=KeyWord Or KeyAlways Then
          Begin
            WriteKeyWord(B^.Nature);
            Inc(Indent,2);
            WriteIndentedCarriage;
            AnalogizeBlock(B^.Gauche);
            Dec(Indent,2);
            WriteIndentedCarriage;
            WriteKeyWord(KeyWord Or KeyAwhile);
            B:=B^.Droite;
          End
          Else
            WriteKeyWord(B^.Nature)
          ;
          Analogize(B^.Gauche);
          WriteKeyWord(KeyWord Or KeyDo);
          Inc(Indent,2);
          WriteIndentedCarriage;
          AnalogizeBlock(B^.Droite);
          Dec(Indent,2);
          WriteIndentedCarriage;
          WriteKeyWord(KeyWord Or KeyWend);
          Fini:=True;
        End;
      KeyFor:
        Begin
          WriteKeyWord(B^.Nature);
          Analogize(B^.Gauche^.Gauche);
          WriteKeyWord(KeyWord Or KeyTo);

          If Name(B^.Gauche^.Droite^.Nature)=KeyStep Then
            Begin
              Analogize(B^.Gauche^.Droite^.Gauche);
              WriteKeyWord(KeyWord Or KeyStep);
              Analogize(B^.Gauche^.Droite^.Droite);
            End
          Else
            Analogize(B^.Gauche^.Droite);

          WriteKeyWord(KeyWord Or KeyDo);
          Inc(Indent,2);
          WriteIndentedCarriage;
          AnalogizeBlock(B^.Droite);
          Dec(Indent,2);
          WriteIndentedCarriage;
          WriteKeyWord(KeyWord Or KeyNext);
          Fini:=True;
        End;
      KeyGoto:
        Begin
          WriteKeyWord(B^.Nature);
          Analogize(B^.Gauche);
          Fini:=True;
        End;
      KeyCase:
        Begin
          WriteKeyWord(B^.Nature);
          Analogize(B^.Gauche);
          WriteKeyWord(KeyWord Or KeyOf);
          Inc(Indent,2);
          If (B^.Droite^.Nature=(KeyWord Or KeyElse)) Then
            Begin
              WriteIndentedCarriage;
              WriteKeyWord(KeyWord Or KeyElse);
              Inc(Indent,2);
              WriteIndentedCarriage;
              AnalogizeBlock(B^.Droite^.Droite);
              Dec(Indent,2);
              WriteIndentedCarriage;
              WriteKeyWord(KeyWord Or KeyEnd);
              Scratch:=B^.Droite^.Gauche;
            End
          Else
            Scratch:=B^.Droite;
          ;
          While Scratch<>Nil Do
          Begin
            WriteIndentedCarriage;
            Analogize(Scratch^.Droite^.Gauche);
            WriteKeyWord(KeyWord Or KeyDeuxPoints);
            Inc(Indent,2);
            WriteIndentedCarriage;
            AnalogizeBlock(Scratch^.Droite^.Droite);
            Dec(Indent,2);
            WriteIndentedCarriage;
            WriteKeyWord(KeyWord Or KeyEnd);
            Scratch:=Scratch^.Gauche;
          End;
          Dec(Indent,2);
          WriteIndentedCarriage;
          WriteKeyWord(KeyWord Or KeyEnd);
          Fini:=True;
        End;
      Else
        Begin
          If Lisp Then AnalogizeLisp(B)
                  Else Analogize(B);
          Fini:=True;
        End;
    End;
End;
{$ENDIF}

Procedure EnvirDecl;
Begin
  P[OpAdr]:=-5;
  P[OpFleche]:=-5;
  P[OpFlecheFleche]:=-5;
  P[OpVirg]:=-Abs(P[OpVirg]);
  OfIsOpOf:=True;
End;

Procedure EnvirProto;
Begin
  P[OpAdr]:=-5;
  P[OpFleche]:=-5;
  P[OpFlecheFleche]:=-5;
  P[OpVirg]:=-Abs(P[OpVirg]);
  PVirgIsOpPVirg:=True;
  OfIsOpOf:=True;
End;

Procedure Envir0;
Begin
  P[OpAdr]:=-15;
  P[OpFleche]:=17;
  P[OpFlecheFleche]:=17;
  P[OpVirg]:=Abs(P[OpVirg]);
  PVirgIsOpPVirg:=False;
  OfIsOpOf:=False;
End;

Function DigitizeBody : BoxPtr;
Label
     Test,InTheVar,InTheSubDef;
Var
   Incomplet,Current,Result : BoxPtr;
   PasFini : Boolean;
Begin
  Result:=Nil;
  Incomplet:=Nil;
  PasFini:=True;
  Envir0;

  While PasFini Do
Test:
    If Nature(CurWord)<>KeyWord Then
    { Omittible Var KeyWord }
      Begin
        Current:=NewBox(KeyWord Or KeyVar);
        Goto InTheVar;
      End
    Else
      Begin
        Case Name(CurWord) Of
          KeyConst,KeyType,KeyVar,KeyStatic:
          Begin
            Current:=NewBox(CurWord);
            NextWord;
InTheVar:
            EnvirDecl;
              Current^.Gauche:=DigitizeBlock(True);
            Envir0;
            If Current^.Gauche=Nil Then Error('Declaration Expected');
          End;
          KeyCarriage:
          Begin
            NextWord;
            Goto Test;
          End;
          KeyFar:
          Begin
            Current:=NewBox(CurWord);
            NextWord;
            If (CurWord<>KeySub) And (CurWord<>KeyDef)
            Then
              Error('Far::Sub/Def expected')
            ;
            Goto InTheSubDef;
          End;
          KeyDef,KeySub:
          Begin
            Current:=NewBox(CurWord);
          InTheSubDef:
            Current^.Gauche:=NewBox(CurWord);
            EnvirProto;
              NextWord;Current^.Gauche^.Gauche:=Digitize(0);
            Envir0;
            If (CurWord=(KeyWord Or KeyCarriage)) And
               (Current^.Gauche^.Gauche<>Nil)
            Then
              Begin
                NextWord;Current^.Gauche^.Droite:=DigitizeBody;
              End
            Else
              Error('Sub Declaration Syntax Error');
          End;
          KeyEnter:
          Begin
            NextWord;
            Current:=NewBox(KeyWord Or KeyEnter);
            Current^.Droite:=DigitizeBlock(False);
            If CurWord<>KeyWord Or KeyLeave Then Error('Leave Expected');
            NextWord;
            PasFini:=False;
          End;
          Else
            Error('Const, Type, Var, Def/Sub or Enter Expected');

        End;
        If Incomplet=Nil Then
          Begin
            Result:=Current;
            Incomplet:=Current;
          End
        Else
          Begin
            Incomplet^.Droite:=Current;
            Incomplet:=Incomplet^.Droite;
          End;
      End;

  DigitizeBody:=Result;
End;

Var I : Integer;

{$IFDEF ANALOGIZE}
Procedure AnalogizeBody(B : BoxPtr);
Label
     MainBlock;
Var
   PasFini : Boolean;
   Last : BoxPtr;
Begin
  PasFini:=True;
  Last:=Nil;
  While PasFini Do
  Begin
    If Nature(B^.Nature)<>KeyWord Then Goto MainBlock; { PLUS BESOIN }
    Case Name(B^.Nature) Of
      KeyConst,KeyType,KeyVar,KeyStatic:
      Begin
        I:=WhereX;
        WriteKeyWord(B^.Nature);
        I:=WhereX-I;Inc(Indent,I);
        WriteIndentedCarriage;
        EnvirDecl;
          AnalogizeBlock(B^.Gauche);
        Envir0;
        Dec(Indent,I);
        WriteIndentedCarriage;
        Last:=B;B:=B^.Droite;
      End;
      KeyDef,KeySub:
      Begin
        If (Last<>Nil) And
           (Name(Last^.Nature)<>KeyDef) And
           (Name(Last^.Nature)<>KeySub)
        Then
          WriteIndentedCarriage;

        WriteKeyWord(B^.Nature);
        EnvirProto;
          AnalogizeLisp(B^.Gauche^.Gauche);
        Envir0;
        WriteIndentedCarriage;
        AnalogizeBody(B^.Gauche^.Droite);
        WriteIndentedCarriage;
        Last:=B;B:=B^.Droite;
      End;
      KeyEnter:
      Begin
        If B^.Gauche<>Nil Then Error('AnalogizeBody : Enter');
        B:=B^.Droite;
MainBlock:
        WriteKeyWord(KeyWord Or KeyEnter);
        Inc(Indent,2);
        WriteIndentedCarriage;
        AnalogizeBlock(B);
        Dec(Indent,2);
        WriteIndentedCarriage;
        WriteKeyWord(KeyWord Or KeyLeave);
        WriteIndentedCarriage;
        PasFini:=False;
      End;
      Else
        Error('AnalogizeBody : Else');
    End;
  End;
End;
{$ENDIF}

Function DigitizePackage : BoxPtr;
Label
     Test;
Var
   Current,Incomplet,Result : BoxPtr;
   PasFini : Boolean;
Begin
  Current:=Nil;
  Incomplet:=Nil;
  PasFini:=True;
  Envir0;

  EatCR:=True;NextWord;EatCR:=False;
  If CurWord<>(KeyWord Or KeyPackage) Then
  Begin
    Result:=NewBox(KeyWord Or KeyPackage);
    Current:=Result;
    Current^.Gauche:=@SymbUnnamed;
  End
  Else
  Begin
    Result:=NewBox(CurWord);
    Current:=Result;NextWord;
    If Nature(CurWord)<>Symbol Then Error('Symbol Expected');
    Current^.Gauche:=CurBox;
    EatCR:=True;NextWord;EatCR:=False;
  End;

  If CurWord=(KeyWord or KeyUses) Then
    Begin
      EatCR:=True;NextWord;EatCR:=False;
      Current^.Droite:=NewBox(KeyWord Or KeyUses);
      EnvirDecl;
        Current^.Droite^.Gauche:=Digitize(0);
      Envir0;
      If CurWord<>KeyWord Or KeyCarriage Then Error('Carriage Expected');
      EatCR:=True;NextWord;EatCR:=False;
      Incomplet:=Current^.Droite;
    End
  Else
    Incomplet:=Current;

  If CurWord=(KeyWord Or KeyInterface) Then
  Begin
    Incomplet^.Droite:=NewBox(CurWord);
    Incomplet:=Incomplet^.Droite;
    NextWord;
    While PasFini Do
Test:
      If Nature(CurWord)<>KeyWord Then Error('KeyWord Expected')
      Else
        Begin
          Case Name(CurWord) Of
            KeyConst,KeyType,KeyVar,KeyStatic:
            Begin
              Current:=NewBox(CurWord);
              NextWord;
              EnvirDecl;
                Current^.Gauche:=DigitizeBlock(True);
              Envir0;
              If Current^.Gauche=Nil Then Error('Declaration Expected');
            End;
            KeyCarriage:
            Begin
              NextWord;
              Goto Test;
            End;
            KeyDef,KeySub:
            Begin
              Current:=NewBox(CurWord);
              EnvirProto;
                NextWord;Current^.Gauche:=Digitize(0);
              Envir0;
              If CurWord<>(KeyWord Or KeyCarriage) Then Error('<CR> Expected');
            End;
            KeyImplementation:
            Begin
              Current:=NewBox(CurWord);
              NextWord;
              PasFini:=False;
            End;
            Else
              Error('Const, Type, Var, Def/Sub or Implementation Expected');

          End;
          Incomplet^.Droite:=Current;
          Incomplet:=Incomplet^.Droite;
        End;

  End;

  Incomplet^.Droite:=DigitizeBody;

  DigitizePackage:=Result;
End;

{$IFDEF ANALOGIZE}
Procedure AnalogizePackage(B : BoxPtr);
Var
   PasFini : Boolean;
   Last : BoxPtr;
Begin
  Last:=Nil;
  If Name(B^.Nature)<>KeyWord Or KeyPackage Then Error('Bad Tree : "Package" Expected');
  WriteKeyword(B^.Nature);
  WriteSymbol(B^.Gauche);
  WriteIndentedCarriage;WriteIndentedCarriage;
  B:=B^.Droite;
  If B^.Nature=KeyWord Or KeyUses Then
  { WARNING : Un seul uses autoris‚ }
  Begin
    WriteKeyWord(B^.Nature);
    Inc(Indent,4);WriteIndentedCarriage;
    Analogize(B^.Gauche);
    Dec(Indent,4);WriteIndentedCarriage;WriteIndentedCarriage;
    B:=B^.Droite;
  End;
  If B^.Nature=KeyWord Or KeyInterface Then
  Begin
    WriteKeyWord(B^.Nature);
    WriteIndentedCarriage;WriteIndentedCarriage;
    Last:=B;B:=B^.Droite;
    While PasFini Do
      Case Name(B^.Nature) Of
        KeyConst,KeyType,KeyVar,KeyStatic:
        Begin
          I:=WhereX;
          WriteKeyWord(B^.Nature);
          I:=WhereX-I;Inc(Indent,I);
          WriteIndentedCarriage;
          EnvirDecl;
            AnalogizeBlock(B^.Gauche);
          EnvirProto;
          Dec(Indent,I);
          WriteIndentedCarriage;
          Last:=B;B:=B^.Droite;
        End;
        KeyDef,KeySub:
        Begin
          If (Name(Last^.Nature)<>KeyDef) And
             (Name(Last^.Nature)<>KeySub) And
             (Name(Last^.Nature)<>KeyInterface)
          Then
            WriteIndentedCarriage;

          WriteKeyWord(B^.Nature);
          EnvirProto;
            Analogize(B^.Gauche);
          Envir0;
          WriteIndentedCarriage;
          Last:=B;B:=B^.Droite;
        End;
        Else
          Begin
            WriteIndentedCarriage;
            PasFini:=False;
          End;
      End;

  End;
  If B^.Nature=KeyWord Or KeyImplementation Then
  Begin
    WriteKeyWord(B^.Nature);
    WriteIndentedCarriage;WriteIndentedCarriage;
    B:=B^.Droite;
  End;
  AnalogizeBody(B);
End;
{$ENDIF}

Procedure InvPrior(Op : Word);
Begin
  P[Op]:=-P[Op];
End;

Begin
{ Init vars }
  Indent:=0;
  Lisp:=False;
{ Init du tableau des priorites }
  P[OpPoint]:=17;P[OpFlechePoint]:=17;
  P[OpFleche]:=17;P[OpFlecheFleche]:=17;
  P[OpPouvr]:=16;P[OpCrouvr]:=16;
  P[OpAdr]:=-15;
  P[OpLogNot]:=-14;
  P[OpMoins]:=-14;P[OpPlus]:=-14;
  P[OpMul]:=13;P[OpDiv]:=13;P[OpMod]:=13;
  P[OpLeftShift]:=12;P[OpRightShift]:=12;
  P[OpAdd]:=11;P[OpSub]:=11;
  P[OpLogXor]:=11;
  P[OpLogOr]:=11;P[OpLogAnd]:=11;
  P[OpEq]:=10;P[OpNeq]:=10;P[OpInf]:=10;P[OpInfEq]:=10;P[OpSup]:=10;P[OpSupEq]:=10;
  P[OpNot]:=-9;
  P[OpAnd]:=-8;
  P[OpOr]:=-7;
  P[OpPointPoint]:=6;
  P[OpOf]:=-5;
  P[OpLet]:=-3;
  P[OpLogXorLet]:=-3;
  P[OpAddLet]:=-3;P[OpSubLet]:=-3;
  P[OpLogOrLet]:=-3;P[OpLogAndLet]:=-3;
  P[OpLeftShiftLet]:=-3;P[OpRightShiftLet]:=-3;
  P[OpMulLet]:=-3;P[OpDivLet]:=-3;P[OpModLet]:=-3;
  P[OpVirg]:=2;P[OpPVirg]:=-2;
  P[OpIs]:=-1;P[OpAs]:=-1;
End.