Melhorar a rotina

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Responder
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Melhorar a rotina

Mensagem por JoséQuintas »

Estou querendo melhorar esta rotina.
O que ela faz, um texto do tipo

LIST "FOR CODIGO=5 WHILE RecNo() < 100 NEXT 10"

A rotina serve pra separar os blocos FOR, WHILE, NEXT, RECORD, e ALL, se existirem, e em qualquer ordem.

Está funcionando, mas queria dar uma melhorada.
Por enquanto a idéia é deixar parecida, mas fazer tudo de uma vez, sem precisar de várias passagens.
Tem alguma coisa no Harbour que ajude nisso?

Código: Selecionar todos

   CASE mTipo == "escopo"
      DBASE_FOR    := ".T."
      DBASE_WHILE  := ".T."
      DBASE_NEXT   := 0
      DBASE_RECORD := 0
      DBASE_ALL    := .F.
      FOR mCont = 1 TO 5
         DO CASE
         CASE mCont = 1 ; mTipo := "all"
         CASE mCont = 2 ; mTipo := "next"
         CASE mCont = 3 ; mTipo := "record"
         CASE mCont = 4 ; mTipo := "for"
         CASE mCont = 5 ; mTipo := "while"
         ENDCASE
         cTextCmd := " " + cTextCmd + " "
         m_Posi := Array(6)
         mContfor  := At( " for ", Lower( cTextCmd ) )
         mContwhil := At( " while ", Lower( cTextCmd ) )
         IF mContwhil == 0
            mContwhil := At( " whil ", Lower( cTextCmd ) )
         ENDIF
         mContall  := At( " all ",  Lower( cTextCmd ) )
         mContnext := At( " next ", Lower( cTextCmd ) )
         mContReco := At( " record ", Lower( cTextCmd ) )
         IF mContReco == 0
            mContReco := At( " recor ", Lower( cTextCmd ) )
            IF mContReco == 0
               mContReco := At( " reco ", Lower( cTextCmd ) )
            ENDIF
         ENDIF
         m_Posi[ 1 ] := mContall
         m_Posi[ 2 ] := mContnext
         m_Posi[ 3 ] := mContReco
         m_Posi[ 4 ] := mContfor
         m_Posi[ 5 ] := mContwhil
         m_Posi[ 6 ] := Len( cTextCmd )
         aSort( m_Posi )
         // retira parametro all
         DO CASE
         CASE mTipo == "all" .AND. mContall != 0
            DBASE_ALL := .T.
            //m_Inicio := aScan( m_Posi, mContall )
            //m_Final  := m_Posi[ m_Inicio + 1 ]
            cTextCmd   := Stuff( cTextCmd, mContall, 4, "" )
            // retira e valida parametro next

         CASE mTipo == "next" .AND. mContnext != 0
            m_Inicio := aScan( m_Posi, mContnext )
            m_Final  := m_Posi[ m_Inicio + 1 ]
            DBASE_NEXT := Substr( cTextCmd, mContnext + 1, m_Final - mContnext )
            cTextCmd   := Stuff( cTextCmd, mContnext, m_Final - mContnext, "" )
            DBASE_NEXT := Substr( DBASE_NEXT, At( " ", DBASE_NEXT ) )
            DBASE_ALL := .F.
            IF MacroType( DBASE_NEXT ) != "N"
               SayScroll( "Invalid NEXT" )
               RETURN .F.
            ENDIF
            IF &( DBASE_NEXT ) < 0
               SayScroll( "Invalid NEXT" )
               RETURN .F.
            ENDIF
            DBASE_NEXT = &( DBASE_NEXT )

         // retira e valida parametro record
         CASE mTipo=="record" .AND. mContReco != 0
            m_Inicio := aScan( m_Posi, mContReco )
            m_Final  := m_Posi[ m_Inicio + 1 ]
            DBASE_RECORD := Substr( cTextCmd, mContReco + 1, m_Final - mContReco )
            cTextCmd   := Stuff( cTextCmd, mContReco, m_Final - mContReco, "" )
            DBASE_RECORD := Substr( DBASE_RECORD, At( " ", DBASE_RECORD ) )
            IF MacroType( DBASE_RECORD ) != "N"
               SayScroll( "Invalid RECORD" )
               RETURN .F.
            ENDIF
            DBASE_RECORD := &( DBASE_RECORD )
            IF DBASE_RECORD  < 1 .OR. DBASE_RECORD > LastRec()
               SayScroll( "Record not exist" )
               RETURN .F.
            ENDIF

         // retira e valida parametro for
         CASE mTipo=="for" .AND. mContfor != 0
            m_Inicio := aScan( m_Posi, mContfor )
            m_Final  := m_Posi[ m_Inicio + 1 ]
            DBASE_FOR := Substr( cTextCmd, mContfor + 1, m_Final - mContfor )
            cTextCmd   := Stuff( cTextCmd, mContfor, m_Final - mContfor, "" )
            DBASE_FOR := Substr( DBASE_FOR, At( " ", DBASE_FOR ) )
            DBASE_ALL := .T.
            IF MacroType( DBASE_FOR ) != "L"
               SayScroll( "Invalid FOR" )
               RETURN .F.
            ENDIF
         // retira e valida parametro while
         CASE mTipo=="while" .AND. mContwhil != 0
            m_Inicio := aScan( m_Posi, mContwhil )
            m_Final  := m_Posi[ m_Inicio + 1 ]
            DBASE_WHILE := Substr( cTextCmd, mContwhil + 1, m_Final - mContwhil )
            cTextCmd   := Stuff( cTextCmd, mContwhil, m_Final - mContwhil, "" )
            DBASE_WHILE := Substr( DBASE_WHILE, At( " ", DBASE_WHILE ) )
            DBASE_ALL := .F.
            IF MacroType( DBASE_WHILE ) != "L"
               SayScroll( "Invalid WHILE" )
               RETURN .F.
            ENDIF
         ENDCASE
         cTextCmd := Alltrim( cTextCmd )
      NEXT
      mParametro := .T.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Melhorar a rotina

Mensagem por JoséQuintas »

Acertei a primeira parte, de separar as "frases"
Falta ainda validação, e devolver do array para o respectivo comando, mas parece que não vai economizar fonte nenhum.

o teste:

Código: Selecionar todos

PROCEDURE Main
   LOCAL cTxtCmd := "LIST FOR XFOR=5 WHILE XWHILE=5 NEXT 5 RECORD 10 ALL"
   PegaCondicao( cTxtCmd )
   RETURN
o resultado na tela, tudo separado:

Código: Selecionar todos

for  FOR XFOR=5          6         17
while  WHILE XWHILE=5         17         32
next  NEXT 5         32         39
record  RECORD 10         39         49
all  ALL          49         54
═          54         54
A rotina, ainda incompleta, por faltar validar e passar para as variáveis correspondentes.

o que vai ser analisado:

Código: Selecionar todos

FUNCTION PegaCondicao( cTextCmd )

   LOCAL oElement, aParameters, nPos, cWord, nCont

   aParameters := Array( 6 )
   aParameters[ 1 ] := { "for",    "", 0, 0 }
   aParameters[ 2 ] := { "while",  "", 0, 0 }
   aParameters[ 3 ] := { "next",   "", 0, 0 }
   aParameters[ 4 ] := { "record", "", 0, 0 }
   aParameters[ 5 ] := { "all",    "", 0, 0 }
   aParameters[ 6 ] := { Chr(205), "", 0, 0 } // so pra ter o fim

   cTextCmd := " " + cTextCmd + "  "
pesquisa a posição das palavras chave, podendo ser abreviadas em 4 letras, igual dbase

Código: Selecionar todos

   FOR EACH oElement IN aParameters
      cWord := oElement[ 1 ]
      IF Len( cWord ) <= 4
         nPos := At( " " + cWord + " ", Lower( cTextCmd ) )
      ELSE
         FOR nCont = Len( cWord ) TO 4 STEP -1
            cWord := Substr( cWord, 1, nCont )
            nPos := At( " " + cWord + " ", Lower( cTextCmd ) )
            IF nPos != 0
               EXIT
            ENDIF
         NEXT
      ENDIF
      nPos := iif( nPos == 0, Len( cTextCmd ), nPos )
      oElement[ 3 ] := nPos
   NEXT
coloca em ordem de localização, assim as "frases" vão ficar sequenciais

Código: Selecionar todos

   ASort( aParameters, { | oElement | oElement[ 3 ] } )
pega o início de uma como sendo o final da outra

Código: Selecionar todos

   FOR nCont = 1 TO Len( aParameters ) - 1
      aParameters[ nCont, 4 ] := aParameters[ nCont + 1, 3 ]
   NEXT
   aParameters[ 6, 4 ] := Len( cTextCmd )
uma vez tendo posições iniciais e finais, só separar

Código: Selecionar todos

   FOR EACH oElement IN aParameters
      oElement[ 2 ] := Substr( cTextCmd, oElement[ 3 ], oElement[ 4 ] - oElement[ 3 ] )
   NEXT
e mostra na tela

Código: Selecionar todos

   FOR EACH oElement IN aParameters
      ? oElement[ 1 ], oElement[ 2 ], oElement[ 3 ], oElement[ 4 ]
   NEXT
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Melhorar a rotina

Mensagem por JoséQuintas »

Tem como facilitar isso com algo a mais no Harbour?

o fonte completo de teste

Código: Selecionar todos

PROCEDURE Main
   LOCAL cTxtCmd := "LIST FOR XFOR=5 WHILE XWHILE=5 NEXT 5 RECORD 10 ALL"
   PegaCondicao( cTxtCmd )
   RETURN

FUNCTION PegaCondicao( cTextCmd )

   LOCAL oElement, aParameters, nPos, cWord, nCont

   aParameters := Array( 6 )
   aParameters[ 1 ] := { "for",    "", 0, 0 }
   aParameters[ 2 ] := { "while",  "", 0, 0 }
   aParameters[ 3 ] := { "next",   "", 0, 0 }
   aParameters[ 4 ] := { "record", "", 0, 0 }
   aParameters[ 5 ] := { "all",    "", 0, 0 }
   aParameters[ 6 ] := { Chr(205), "", 0, 0 } // so pra ter o fim

   cTextCmd := " " + cTextCmd + "  "

   FOR EACH oElement IN aParameters
      cWord := oElement[ 1 ]
      IF Len( cWord ) <= 4
         nPos := At( " " + cWord + " ", Lower( cTextCmd ) )
      ELSE
         FOR nCont = Len( cWord ) TO 4 STEP -1
            cWord := Substr( cWord, 1, nCont )
            nPos := At( " " + cWord + " ", Lower( cTextCmd ) )
            IF nPos != 0
               EXIT
            ENDIF
         NEXT
      ENDIF
      nPos := iif( nPos == 0, Len( cTextCmd ), nPos )
      oElement[ 3 ] := nPos
   NEXT
   ASort( aParameters, { | oElement | oElement[ 3 ] } )
   FOR nCont = 1 TO Len( aParameters ) - 1
      aParameters[ nCont, 4 ] := aParameters[ nCont + 1, 3 ]
   NEXT
   aParameters[ 6, 4 ] := Len( cTextCmd )
   FOR EACH oElement IN aParameters
      oElement[ 2 ] := Substr( cTextCmd, oElement[ 3 ], oElement[ 4 ] - oElement[ 3 ] )
   NEXT
   FOR EACH oElement IN aParameters
      ? oElement[ 1 ], oElement[ 2 ], oElement[ 3 ], oElement[ 4 ]
   NEXT
   RETURN NIL
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Melhorar a rotina

Mensagem por JoséQuintas »

Já com as validações a mais:

Código: Selecionar todos


MEMVAR DBASE_FOR, DBASE_WHILE, DBASE_NEXT, DBASE_RECORD, DBASE_ALL

PROCEDURE Main

   LOCAL cTxtCmd := "LIST FOR XFOR=5 WHILE XWHILE=5 NEXT 5 RECORD 10 ALL"
   PRIVATE DBASE_FOR, DBASE_WHILE, DBASE_NEXT, DBASE_RECORD, DBASE_ALL

   PegaCondicao( cTxtCmd )

   ? "Parametro FOR:   " + DBASE_FOR
   ? "Parametro WHILE: " + DBASE_WHILE
   ? "Parametro NEXT:  " + DBASE_NEXT
   ? "Parametro RECORD:" + DBASE_RECORD
   ? "Parametro ALL:   " + DBASE_ALL

   RETURN

FUNCTION PegaCondicao( cTextCmd )

   LOCAL oElement, aParameters, nPos, cWord, nCont

   aParameters := Array( 6 )
   aParameters[ 1 ] := { "for",    "", 0, 0 }
   aParameters[ 2 ] := { "while",  "", 0, 0 }
   aParameters[ 3 ] := { "next",   "", 0, 0 }
   aParameters[ 4 ] := { "record", "", 0, 0 }
   aParameters[ 5 ] := { "all",    "", 0, 0 }
   aParameters[ 6 ] := { Chr(205), "", 0, 0 } // so pra ter o fim

   cTextCmd := " " + cTextCmd + "  "

   FOR EACH oElement IN aParameters
      cWord := oElement[ 1 ]
      IF Len( cWord ) <= 4
         nPos := At( " " + cWord + " ", Lower( cTextCmd ) )
      ELSE
         FOR nCont = Len( cWord ) TO 4 STEP -1
            cWord := Substr( cWord, 1, nCont )
            nPos := At( " " + cWord + " ", Lower( cTextCmd ) )
            IF nPos != 0
               EXIT
            ENDIF
         NEXT
      ENDIF
      nPos := iif( nPos == 0, Len( cTextCmd ), nPos )
      oElement[ 3 ] := nPos
   NEXT
   ASort( aParameters, { | oElement | oElement[ 3 ] } )
   FOR nCont = 1 TO Len( aParameters ) - 1
      aParameters[ nCont, 4 ] := aParameters[ nCont + 1, 3 ]
   NEXT
   aParameters[ 6, 4 ] := Len( cTextCmd )
   FOR EACH oElement IN aParameters
      oElement[ 2 ] := AllTrim( Substr( cTextCmd, oElement[ 3 ] + 1, oElement[ 4 ] - oElement[ 3 ] ) )
      DO CASE
      CASE oElement[ 1 ] == "for"    ; DBASE_FOR     := Substr( oElement[ 2 ], At( " ", oElement[ 2 ] ) )
      CASE oElement[ 1 ] == "while"  ; DBASE_WHILE   := Substr( oElement[ 2 ], At( " ", oElement[ 2 ] ) )
      CASE oElement[ 1 ] == "next"   ; DBASE_NEXT    := Substr( oElement[ 2 ], At( " ", oElement[ 2 ] ) )
      CASE oElement[ 1 ] == "record" ; DBASE_RECORD  := Substr( oElement[ 2 ], At( " ", oElement[ 2 ] ) )
      CASE oElement[ 1 ] == "all"    ; DBASE_ALL     := iif( Lower( oElement[ 2 ] ) == "all", ".T.", ".F." )
      ENDCASE
   NEXT
   IF MacroValType( DBASE_FOR ) != "L"
      ? "Expressao FOR não retorna verdadeiro/falso"
   ENDIF
   IF MacroValType( DBASE_WHILE ) != "L"
      ? "Expressao WHILE não retorna verdadeiro/falso"
   ENDIF
   IF MacroValType( DBASE_NEXT ) != "N"
      ? "Expressao NEXT não retorna número"
   ENDIF
   IF MacroValType( DBASE_RECORD ) != "N"
      ? "Expressão RECORD não retorna número"
   ENDIF
   RETURN NIL

FUNCTION MacroValType( cCmd )

   LOCAL cValType := " "

   BEGIN SEQUENCE WITH __BreakBlock()
      cValType := ValType( &cCmd )
   END SEQUENCE
   RETURN cValType

E o resultado:
Expressao FOR nπo retorna verdadeiro/falso
Expressao WHILE nπo retorna verdadeiro/falso
Parametro FOR: XFOR=5
Parametro WHILE: XWHILE=5
Parametro NEXT: 5
Parametro RECORD: 10
Parametro ALL: .T.
Normal, as variáveis usadas no FOR e WHILE não existem.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
rbonotto
Usuário Nível 3
Usuário Nível 3
Mensagens: 253
Registrado em: 06 Mai 2005 18:52

Melhorar a rotina

Mensagem por rbonotto »

JoséQuintas ! o dia que eu conseguir programar assim para melhorar um código deste nível te convido para um churrasco !!!

Show de bóla, parabéns !!
mixsistemas@gmail.com
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Melhorar a rotina

Mensagem por JoséQuintas »

Eu atribuo isso ao fato de simplificar fontes e usar -w3 -es2.

Não é só os fontes que ganham renovação, a gente também.

https://pctoledo.org/forum/viewto ... 43&t=16259

A gente nem percebe, mas vai ficando "mais craque".

Mas acho que dá pra melhorar talvez usando reg_ex... alguma coisa.

Esse fonte é dos tempos do Clipper, faz parte do meu "dbase" que embuto nos EXEs.
Talvez 20 anos depois, com a "renovação", é que consegui mexer.... rs

Por isso criei aquele tópico, porque percebi que não melhora só os fontes.

Mas valeu, é bom ler algo assim.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
rmlazzari
Usuário Nível 2
Usuário Nível 2
Mensagens: 64
Registrado em: 09 Dez 2013 14:18
Localização: são paulo

Melhorar a rotina

Mensagem por rmlazzari »

OFF TOPIC
Quem sabe, sabe!
Parabéns, mestre José Quintas!


ON TOPIC
:-o
Voltar ao topo
Responder

Voltar para “[x]Harbour”