DataMuseum.dk

top - download

    Length: 7598 (0x1dae)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

separate (Syntaxe_1)

function Parse_Liste_Instruction return Boolean is
    Validation_Bloc : Boolean := False;

    function Parse_Instruction return Boolean;

    function Parse_Bloc_Instruction return Boolean is
        Ok : Boolean := False;
    begin
        if Token.Object'Pos (Lex.Lex_Get_Token) =
           Token.Object'Pos (Token.L_Faire) then
            Validation_Bloc := True;
            if Tds.Mknode_Faire then
                Lex.Lex_Next;
                if Parse_Liste_Instruction then
                    if Token.Object'Pos (Lex.Lex_Get_Token) =
                       Token.Object'Pos (Token.L_Fin) then
                        Lex.Lex_Next;
                        if Token.Object'Pos (Lex.Lex_Get_Token) =
                           Token.Object'Pos (Token.L_Faire) then
                            Lex.Lex_Next;
                            if Tds.Mknode_Fin_Faire then
                                Ok := True;
                            else
                                Ok := False;   -- Erreur systeme dans la TDS
                            end if;
                        else
                            Ok := False;
                        end if;
                    else
                        Ok := False;
                    end if;
                else
                    Ok := False;
                end if;
            else
                Ok := False;              -- Erreur sur la construction de FAIRE
            end if;
        else
            Ok := Parse_Instruction;
        end if;
        if Ok then
            return True;
        else
            Tds.Syntax_Error;
            return False;
        end if;
    end Parse_Bloc_Instruction;

    function Parse_Instruction return Boolean is
    begin
        Validation_Bloc := True;
        case Lex.Lex_Get_Token is
            when Token.L_Au =>
                Lex.Lex_Next;
                if Token.Object'Pos (Lex.Lex_Get_Token) =
                   Token.Object'Pos (Token.L_Temps) then
                    Lex.Lex_Next;
                    if Parse_Operande then
                        if Tds.Mknode_Au_Temps (Lex.Lex_Get_Value,
                                                Lex.Lex_Get_Token) then
                            Lex.Lex_Next;
                            return Parse_Bloc_Instruction;
                        else
                            return
                               False;  -- Erreur de construction du noeud AU TEMPS
                        end if;
                    else
                        return False;
                    end if;
                else
                    return False;
                end if;

            when Token.L_Si =>
                Lex.Lex_Next;
                if Tds.Mknode_Si_Cond then
                    if Parse_Condition then
                        if Token.Object'Pos (Lex.Lex_Get_Token) =
                           Token.Object'Pos (Token.L_Alors) then
                            Lex.Lex_Next;
                            if Tds.Mknode_Si_Alors then
                                if Parse_Liste_Instruction then
                                    if Token.Object'Pos (Lex.Lex_Get_Token) =
                                       Token.Object'Pos (Token.L_Fin) then
                                        Lex.Lex_Next;
                                        if Token.Object'Pos
                                              (Lex.Lex_Get_Token) =
                                           Token.Object'Pos (Token.L_Si) then
                                            Lex.Lex_Next;
                                            return Tds.Mknode_Fin_Si;
                                        else
                                            return False;
                                        end if;
                                    else
                                        return False;
                                    end if;
                                else
                                    return False;
                                end if;
                            else
                                return
                                   False;  -- Erreur construction noeud SI ALORS
                            end if;
                        else
                            return False;
                        end if;
                    else
                        Text_Io.Put_Line ("Erreur dans parse condition");
                        return False;
                    end if;
                else
                    return False;   -- Erreur dans construction noeud SI COND
                end if;

            when Token.L_Repeter =>
                Lex.Lex_Next;
                if Parse_Operande then
                    if Tds.Mknode_Repeter (Lex.Lex_Get_Value,
                                           Lex.Lex_Get_Token) then
                        Lex.Lex_Next;
                        if Token.Object'Pos (Lex.Lex_Get_Token) =
                           Token.Object'Pos (Token.L_Fois) then
                            Lex.Lex_Next;
                            if Parse_Liste_Instruction then
                                if Token.Object'Pos (Lex.Lex_Get_Token) =
                                   Token.Object'Pos (Token.L_Fin) then
                                    Lex.Lex_Next;
                                    if Token.Object'Pos (Lex.Lex_Get_Token) =
                                       Token.Object'Pos (Token.L_Repeter) then
                                        Lex.Lex_Next;
                                        return Tds.Mknode_Fin_Repeter;
                                    else
                                        return False;
                                    end if;
                                else
                                    return False;
                                end if;
                            else
                                return False;
                            end if;
                        else
                            return False;
                        end if;
                    else
                        return
                           False;   -- Erreur dans construction noeud REPETER
                    end if;
                else
                    Text_Io.Put_Line ("Erreur dans parse operande");
                    return False;
                end if;

            when Token.L_Puis =>
                Lex.Lex_Next;
                return Tds.Mknode_Puis;

            when others =>
                declare
                    Ok : Boolean;
                begin
                    Parse_Action (Validation_Bloc, Ok);
                    return Ok;
                end;
        end case;
    end Parse_Instruction;

-- DEBUT DU TRAITEMENT DE LA FONCTION PARSE LISTE INSTRUCTION

begin
    if Parse_Bloc_Instruction then
        if Parse_Liste_Instruction then
--         text_IO.Put_Line ("parse liste instruction est OK");
            return True;
        else
            Text_Io.Put_Line ("Erreur dans Parse liste instruction");
            return False;
        end if;

-- lors du retrait du texte, remplacer toute les instructions precedentes par :
-- RETURN Parse_Liste_Instruction

    else
        if Validation_Bloc then
            Text_Io.Put_Line ("erreur dans Parse bloc");
            return False;
        else
            return True;
        end if;
    end if;

-- lors du retrait du texte, remplacer toute les instructions precedentes par :
-- RETURN not Validation_Bloc

end Parse_Liste_Instruction;