Voici une base de Language Interprété

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Voici une base de Language Interprété

Message par Thyphoon »

Bonjour,
je viens de mettre a jour un bout de code que j'avais pondu il y a quelques temps ...
Je sais qu'on m'aide plus que je n'aide les autres, et donc pour me faire un peu pardonner je partage avec vous ce code.
il s'agit d'un interpréteur de script, que j'avais conçu avec l'aide de Dobro, que je remercie une fois encore pour l'aide de départ. L'exercice est très enrichissant, et on comprend vite que faire un langage n'est pas aussi simple, surtout si on veut des performances.
Si vous avez des idées pour améliorer le code ou si vous détectez des bugs n’hésitez pas.
Je mettrais a jour le code au fur et a mesure de l'avancement.
Historique
ToDo List
  • Nettoyage et commenter au maximum le code
  • Gestion des procédures extérieurs pour intégrer de nouveau mots clefs
  • Gestion des boucles for/next
  • Gestion des Variables textes
  • Optimisation
06-06-2011
  • Support des boucles while/wend
05-06-2011
  • Version compatible 4.60B3
  • Utilisation de lists et maps au lieu de tableau
  • amélioration de la gestion des conditions dans un IF (on peut maintenant utilisé des parenthèses et des portes logiques AND / OR )
16-03-2007
  • première version avec l'aide de Dobro
2 fichiers:
Note: le code du 1er fichier (eval.pbi) n'est pas de moi, ça vient du forum allemand ... mais j'ai perdu le nom de l'auteur (j’espère qu'il ne m'en voudra pas)
eval.pbi

Code : Tout sélectionner

#NUM = "0123456789"
#STRIN ="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"

; *************************************************************
;-*** D E C L A R E ***




;Operanten-Codes
#OP_UNKNOWN         = -1
#OP_NONE            = 0
#OP_PLUS            = 1
#OP_MINUS           = 2
#OP_MULT            = 3
#OP_DIV             = 4
#OP_POT             = 5
#OP_FUNC            = 6

;Funktions-Codes
#FUNC_SQR           = 1
#FUNC_SIN           = 2
#FUNC_ASIN          = 3
#FUNC_COS           = 4
#FUNC_ACOS          = 5
#FUNC_TAN           = 6
#FUNC_ATAN          = 7
#FUNC_INT           = 8
#FUNC_ABS           = 9
#FUNC_LOG10         = 10
#FUNC_LOG           = 11

;Konstanten
#CONST_PI           = "3.1415926"   ;PI
#CONST_E            = "2.7182818"   ;Eulersche Zahl

;Error-Codes
#CALC_ERR_NONE          = 0         ;kein Fehler
#CALC_ERR_SYNTAX        = 1         ;Allgemeiner Syntax-Fehler (fehlender Wert)
#CALC_ERR_DIVNULL       = 2         ;Division / 0 aufgetreten
#CALC_ERR_OPNOTFOUND    = 3         ;Operant nicht gefunden
#CALC_ERR_FUNCNOTFOUND  = 4         ;Funktion nicht gefunden

#PRIORITY_STEP      = 4             ;entspricht der höchsten Prioritätsstufe der Operanten
#MAX_TREENODES      = 100           ;Maximale Anzahl an SyntaxBaum-Knoten

#OPERAND            = 1
#VALUE              = 2

Structure SyntaxTreeNode
    *parent.SyntaxTreeNode
    *child.SyntaxTreeNode[2]
    operand.l
    prior.l
    Value.f
EndStructure

Structure SyntaxTree
    *root.SyntaxTreeNode
    node.SyntaxTreeNode[#MAX_TREENODES]
    remark$ ;frei verwendbar
EndStructure





; *************************************************************************************
Declare.l Calc_Modulo(a.l, b.l)
Declare Calc_SetOperand(operand$, *node.SyntaxTreeNode)
Declare.s Calc_GetContent(*expression, type.l, *pos.Long)
Declare Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
Declare Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
Declare.f Calc_GetNodeValueF(*node.SyntaxTreeNode)
Declare Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l)
Declare Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
Declare CreateSyntaxTree(*tree.SyntaxTree, expression$)
Declare.f CalculateSyntaxTreeF(*tree.SyntaxTree)
Declare.l CalculateSyntaxTreeL(*tree.SyntaxTree)
Declare.l CalculateL(expression$)
Declare.f CalculateF(expression$)
Declare.l GetCalculationError()
Declare EnableFunctionCalculation(bool.b)
Declare EnableConstantCalculation(bool.b)
EnableFunctionCalculation(1)
EnableConstantCalculation(1)

; *************************************************************************************

Procedure.l Calc_Modulo(a.l, b.l)
    ProcedureReturn a - a / b * b
EndProcedure
 
Procedure Calc_SetOperand(operand$, *node.SyntaxTreeNode)
    Shared priorMod.l
   
    While PeekB(@operand$) = 41 ;Left(operand$, 1) = ")"
        operand$ = Mid(operand$, 2, Len(operand$))
        priorMod - #PRIORITY_STEP
    Wend
   
    While PeekB(@operand$ + Len(operand$) - 1) = 40 ;Right(operand$, 1) = "("
        operand$ = Left(operand$, Len(operand$) - 1)
        changePrior.l + #PRIORITY_STEP
    Wend
   
    Select operand$
        Case "+"
            *node\operand = #OP_PLUS
            *node\prior = priorMod + 1
        Case "-"
            *node\operand = #OP_MINUS
            *node\prior = priorMod + 1
        Case "*"
            *node\operand = #OP_MULT
            *node\prior = priorMod + 2
        Case "/"
            *node\operand = #OP_DIV
            *node\prior = priorMod + 2
        Case "^"
            *node\operand = #OP_POT
            *node\prior = priorMod + 3
           
           
        Case "~"
            *node\operand = #OP_FUNC
            ;ACHTUNG: Funktionen müssen IMMMER die höchste Priorität besitzen
            *node\prior = priorMod + 4
        Default
            *node\operand = #OP_UNKNOWN
    EndSelect
   
    priorMod + changePrior
EndProcedure
 
Procedure.s Calc_GetContent(*expression, type.l, *pos.Long)
    *pointer.Byte = *expression + *pos\l
   
    If type = #VALUE
        ;(-x) Ausrdrücke zulassen
        If PeekB(*pointer) = 45 ; '-'
            *pointer + 1
        EndIf
       
        ;) + - * / ^ ~ \0
        ;Ascii-Wert eines neuen Operators hier mit einfügen
        While (*pointer\b < 97 Or *pointer\b > 122) And *pointer\b <> 41 And *pointer\b <> 42 And *pointer\b <> 43  And *pointer\b <> 45 And *pointer\b <> 47 And *pointer\b <> 94 And *pointer\b <> 126 And *pointer\b <> 0
            *pointer + 1
        Wend
    Else
        ;0-9 .
        While (*pointer\b < 48 Or *pointer\b > 57) And *pointer\b <> 46 And *pointer\b <> 0
            *pointer + 1
        Wend
        ;(-x) Ausrdrücke zulassen
        If PeekB(*pointer - 1) = 45 And PeekB(*pointer - 2) = 40 ; '(-'
            *pointer - 1
        EndIf
    EndIf
   
    a_RET$ = PeekS(*expression + *pos\l, (*pointer - *expression) - *pos\l)
   
    If *pointer\b
        *pos\l = *pointer - *expression
    Else
        *pos\l = -1
    EndIf
   
    ProcedureReturn a_RET$
EndProcedure
 
Procedure Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
    child.l
   
    If *nodeTarget\parent
        If *nodeTarget\parent\child[0] = *nodeTarget
            child = 0
        ElseIf *nodeTarget\parent\child[1] = *nodeTarget
            child = 1
        EndIf
        *nodeTarget\parent\child[child] = *nodeInsert
        *nodeInsert\parent = *nodeTarget\parent
    EndIf
    *nodeTarget\parent = *nodeInsert
    *nodeInsert\child[0] = *nodeTarget
EndProcedure
 
Procedure Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
    If *nodeTarget\child[child]
        *nodeChild.SyntaxTreeNode = *nodeTarget\child[child]
        *nodeChild\parent = *nodeInsert
        *nodeInsert\child[0] = *nodeTarget\child[child]
    EndIf
   
    *nodeTarget\child[child] = *nodeInsert
    *nodeInsert\parent = *nodeTarget
EndProcedure
 
Procedure.f Calc_GetNodeValueF(*node.SyntaxTreeNode)
    Shared calculationErrorOccured.b
    Result.f
   
    If *node
        If *node\operand
            valueOne.f = Calc_GetNodeValueF(*node\child[0])
            valueTwo.f = Calc_GetNodeValueF(*node\child[1])
            Select *node\operand
                Case #OP_PLUS
                    Result = valueOne + valueTwo
                Case #OP_MINUS
                    Result = valueOne - valueTwo
                Case #OP_MULT
                    Result = valueOne * valueTwo
                Case #OP_DIV
                    Result = valueOne / valueTwo
                    If valueTwo = 0 And calculationErrorOccured = 0
                        calculationErrorOccured = #CALC_ERR_DIVNULL
                    EndIf
                Case #OP_POT
                    Result = Pow(valueOne, valueTwo)
                   
                Case #OP_FUNC
                    Select valueOne ;steht für den Funktionstyp
                        Case #FUNC_SQR
                            Result = Sqr(valueTwo)
                        Case #FUNC_SIN
                            Result = Sin(valueTwo)
                        Case #FUNC_ASIN
                            Result = ASin(valueTwo)
                        Case #FUNC_COS
                            Result = Cos(valueTwo)
                        Case #FUNC_ACOS
                            Result = ACos(valueTwo)
                        Case #FUNC_TAN
                            Result = Tan(valueTwo)
                        Case #FUNC_ATAN
                            Result = ATan(valueTwo)
                        Case #FUNC_INT
                            Result = Int(valueTwo)
                        Case #FUNC_ABS
                            Result = Abs(valueTwo)
                        Case #FUNC_LOG10
                            Result = Log10(valueTwo)
                        Case #FUNC_LOG
                            Result = Log(valueTwo)
                        Default
                            calculationErrorOccured = #CALC_ERR_FUNCNOTFOUND
                    EndSelect
                   
                Case #OP_UNKNOWN
                    calculationErrorOccured = #CALC_ERR_OPNOTFOUND
            EndSelect
            ProcedureReturn Result
        Else
            ProcedureReturn *node\Value
        EndIf
    Else
        calculationErrorOccured = 1
    EndIf
EndProcedure
 
Procedure Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l)
    ;für Debugging und Veranschaulischungszwecke
    Shared isFunction.b
   
    If *node
       
        If  *node\operand
            If *node\operand = #OP_PLUS
                PrintN(Space(level * 2) + "+")
            ElseIf *node\operand = #OP_MINUS
                PrintN(Space(level * 2) + "-")
            ElseIf *node\operand = #OP_MULT
                PrintN(Space(level * 2) + "*")
            ElseIf *node\operand = #OP_DIV
                PrintN(Space(level * 2) + "/")
            ElseIf *node\operand = #OP_POT
                PrintN(Space(level * 2) + "^")
            ElseIf *node\operand = #OP_FUNC
                isFunction = 1
            EndIf
        Else
            If isFunction
                Print(Space((level-1) * 2))
                Select *node\Value
                    Case #FUNC_SQR
                        PrintN("SQR")
                    Case #FUNC_SIN
                        PrintN("SIN")
                    Case #FUNC_ASIN
                        PrintN("ASIN")
                    Case #FUNC_COS
                        PrintN("COS")
                    Case #FUNC_ACOS
                        PrintN("ACOS")
                    Case #FUNC_TAN
                        PrintN("TAN")
                    Case #FUNC_ATAN
                        PrintN("ATAN")
                    Case #FUNC_INT
                        PrintN("INT")
                    Case #FUNC_ABS
                        PrintN("ABS")
                    Case #FUNC_LOG10
                        PrintN("LOGTEN")
                    Case #FUNC_LOG
                        PrintN("LOG")
                EndSelect
            Else
                PrintN(Space(level * 2) + StrF(*node\Value))
            EndIf
        EndIf
       
        If *node\child[0]
            Calc_ConsoleOutSyntaxNode(*node\child[0], level + 1)
            isFunction = 0
        EndIf
        If *node\child[1]
            Calc_ConsoleOutSyntaxNode(*node\child[1], level + 1)
        EndIf
    EndIf
EndProcedure
 
Procedure Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
    ;für Debugging und Veranschaulischungszwecke
    Calc_ConsoleOutSyntaxNode(*tree\root, 0)
EndProcedure
 
  ;--    Public
 
Procedure CreateSyntaxTree(*tree.SyntaxTree, expression$)
    Shared priorMod.l, functionCalculationEnabled.b, constantCalculationEnabled.b
   
    priorMod = 0
    nodeCount.l = 0
    Position.l = 0
   
    *nodeLastValue.SyntaxTreeNode
    *nodeCurrentValue.SyntaxTreeNode
    *nodeLastOperand.SyntaxTreeNode
    *nodeCurrentOperand.SyntaxTreeNode
   
    expression$ = LCase(ReplaceString(expression$, " ", ""))
   
    While Left(expression$, 1) = "("
        expression$ = Mid(expression$, 2, Len(expression$))
        priorMod + #PRIORITY_STEP
    Wend
    While Right(expression$, 1) = ")"
        expression$ = Left(expression$, Len(expression$) - 1)
    Wend
   
    If functionCalculationEnabled
        expression$ = ReplaceString(expression$, "sqr",   Str(#FUNC_SQR) + "~")
        expression$ = ReplaceString(expression$, "asin",  Str(#FUNC_ASIN) + "~")
        expression$ = ReplaceString(expression$, "sin",   Str(#FUNC_SIN) + "~")
        expression$ = ReplaceString(expression$, "acos",  Str(#FUNC_ACOS) + "~")
        expression$ = ReplaceString(expression$, "cos",   Str(#FUNC_COS) + "~")
        expression$ = ReplaceString(expression$, "atan",  Str(#FUNC_ATAN) + "~")
        expression$ = ReplaceString(expression$, "tan",   Str(#FUNC_TAN) + "~")
        expression$ = ReplaceString(expression$, "int",   Str(#FUNC_INT) + "~")
        expression$ = ReplaceString(expression$, "abs",   Str(#FUNC_ABS) + "~")
        expression$ = ReplaceString(expression$, "logten",Str(#FUNC_LOG10) + "~")
        expression$ = ReplaceString(expression$, "log",   Str(#FUNC_LOG) + "~")
    EndIf
   
    If constantCalculationEnabled
        expression$ = ReplaceString(expression$, "pi", #CONST_PI)
        expression$ = ReplaceString(expression$, "e",  #CONST_E)
    EndIf
   
    ;Debug expression$
   
    Repeat
        nodeCount + 1
       
        If Calc_Modulo(nodeCount, 2) ;Wert
            node$ = Calc_GetContent(@expression$, #VALUE, @Position)
            *tree\node[nodeCount]\Value = ValF(node$)
            *nodeCurrentValue = *tree\node[nodeCount]
            ;Debug node$
           
            If nodeCount > 1
                Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentValue)
            EndIf
           
            *nodeLastValue = *nodeCurrentValue
        Else ;Operator
            node$ = Calc_GetContent(@expression$, #OPERAND, @Position)
            Calc_SetOperand(node$, *tree\node[nodeCount])
           
            *nodeCurrentOperand = *tree\node[nodeCount]
            ;Debug node$ + " :: " + Str(*nodeCurrentOperand\prior)
           
            If *nodeLastOperand
                If *nodeCurrentOperand\prior > *nodeLastOperand\prior
                    Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentOperand)
                ElseIf *nodeCurrentOperand\prior = *nodeLastOperand\prior
                    Calc_InsertNodeAsParent(*nodeLastOperand, *nodeCurrentOperand)
                Else
                    *node.SyntaxTreeNode = *nodeLastOperand
                    While *node\parent And *node\prior > *nodeCurrentOperand\prior
                        *node = *node\parent
                    Wend
                   
                    If *node\prior = *nodeCurrentOperand\prior
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
                    ElseIf *node\prior < *nodeCurrentOperand\prior
                        Calc_InsertNodeAsChild(*node, 1, *nodeCurrentOperand)
                    Else
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
                    EndIf
                EndIf
            Else
                Calc_InsertNodeAsParent(*nodeLastValue, *nodeCurrentOperand)
            EndIf
           
            *nodeLastOperand = *nodeCurrentOperand
        EndIf
       
    Until Position = -1
   
    If *nodeLastOperand
        While *nodeLastOperand\parent
            *nodeLastOperand = *nodeLastOperand\parent
        Wend
        *tree\root = *nodeLastOperand
    ElseIf nodeCount = 1
        *tree\root = *nodeLastValue
    Else
        *tree\root = 0
    EndIf
   
EndProcedure
 
Procedure.f CalculateSyntaxTreeF(*tree.SyntaxTree)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    If *tree\root
        Result.f = Calc_GetNodeValueF(*tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
        Result.f = 0 / Result
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l CalculateSyntaxTreeL(*tree.SyntaxTree)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    If *tree\root
        Result.l = Calc_GetNodeValueF(*tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l CalculateL(expression$)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    tree.SyntaxTree
    CreateSyntaxTree(@tree, expression$)
   
    If tree\root
        Result.l = Calc_GetNodeValueF(tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.f CalculateF(expression$)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    tree.SyntaxTree
    CreateSyntaxTree(tree, expression$)
   
    If tree\root 
        ;Shared-Variable und If-Abfrage ist nur für das Beispiel und kann rausgenommen werden
        Shared outputSyntaxTree.b
        If outputSyntaxTree
            Calc_ConsoleOutSyntaxTree(tree)
        EndIf
       
        Result.f = Calc_GetNodeValueF(tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
        Result.f = 0 / Result
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l GetCalculationError()
    Shared calculationErrorOccured.b
    ProcedureReturn calculationErrorOccured
EndProcedure
 
Procedure EnableFunctionCalculation(bool.b)
    Shared functionCalculationEnabled.b
    functionCalculationEnabled = bool
EndProcedure
 
Procedure EnableConstantCalculation(bool.b)
    Shared constantCalculationEnabled.b
    constantCalculationEnabled = bool
EndProcedure


Debug CalculateF("200>10 and 200>10")

  ; ******************************************************************************************

; IDE Options = PureBasic v4.00 (Windows - x86)
; Folding = --
script.pb

Code : Tout sélectionner

;EnableExplicit
IncludeFile("eval.pbi")
Structure TS_Env
  *mem
  Nb_Command.l
  Nb_Variable.l
EndStructure

Structure TS_Pile
  Cmd.s
  List Param.s()
  true.b
  en_cour.b
  pos_start.l ; pour le retour a While avec Wend
  pos_else.l
  pos_endif.l
  numero.l
EndStructure

Structure TS_Command
  address.l
  params.l
EndStructure
;Init
Global TS_Env.TS_Env
Global NewMap TS_VarNum.f()
Global NewMap TS_VarAlpha.s()
Global NewMap TS_Command.TS_Command()
;Global NewList TS_Pile.TS_Pile()

;Pour rajouter les commandes connu part le language
Procedure AddCommand(name.s,address.l=-1)
  TS_Command(UCase(name))\address=address
EndProcedure

;Initialisation des commandes connu
Procedure InitScript()
  AddCommand("LET")
  AddCommand("If")
  AddCommand("Else")
  AddCommand("EndIf")
  AddCommand("While")
  AddCommand("Wend")
  AddCommand("Print")
  
  AddCommand("Execute")

EndProcedure

Macro IsCommand(__name)
 FindMapElement(TS_Command(), UCase(__name))
EndMacro

Procedure.s 	InsulateCmd(param.s)
  Define z.b,c.s,code.s=""
  For z=1 To Len(param)
    c=Mid(param,z,1)
    If c="(" Or c=" " Or (Asc(c)>=Asc("0") And Asc(c)<=Asc("9"))
      Break;
    Else
     code+c
    EndIf
  Next
  Debug code
  ProcedureReturn code
EndProcedure

Procedure ReadScript(Script.s,List TS_Pile.TS_Pile())
  Define delimiteur.s,script.s,l.l,line.s,commentaire.l,code.s,p.l,parametre.s
  delimiteur=Chr(13)+Chr(10) ;Le retour a la ligne quoi
  script.s=ReplaceString(script,delimiteur , ":") ;":" c'est le separateur de ligne
  script.s=ReplaceString(script,Chr(9) , "") 
  ;CheckedLine=0
  For l=1 To CountString(script,":")+1
    line=StringField(script, l, ":")
    ;Si on a des commentaires on les supprimes
    commentaire=FindString(line, ";", 0)
    If commentaire>0
      code=Left(line,commentaire)  
    ;Si pas de commentaire alors on prend tout la ligne
    Else
      code=line  
    EndIf
    code=Trim(code)
    ;On traite uniquement si on a du code sur la ligne
    If Len(Trim(code))>0
      ;CheckedLine+1
      AddElement(TS_Pile())
      Debug ">"+code
      ;On ajoute les paramètres dans la pile
      
      For p=0 To CountString(code,",")+1
        ;le premier paramètre étant une commande alors c'est un peu spécial
        If p=0:
          parametre=InsulateCmd(code); StringField(code,1,",") ; recupere le 1 er  parametre apres la commande
          parametre=UCase(StringField(parametre,1," "))
          code=Trim(Right(code,Len(code)-Len(parametre))) ;On retir la commande de la ligne de code car on ne vas traiter apres que ses paramètres
          ;on supprime les parenthèse exterrieur si il y en a
          If Mid(code,1,1)="(" And Mid(code,Len(code),1)=")"
           code=Mid(code,2,Len(code)-2)
         EndIf
         Debug "command:"+parametre
         TS_Pile()\Cmd=Trim(parametre)

          ;On verifie si la commande existe bien
          If IsCommand(parametre)=0:Debug("Error Script > "+parametre+": Invalid Command ligne "+Str(ListIndex(TS_Pile()))):Debug ">"+code:Break 2:EndIf
          ;preparation des si
          
          
       ;Si ce n'est pas une commande alors...
      Else
        AddElement(TS_Pile()\Param())
        TS_Pile()\Param()=Trim(StringField(code,p,","))
      EndIf
        
        ;If parametre="":parametre="0":EndIf
      Next p
    EndIf    
  Next l

 ;Preparation du code pour les If et Else
  NewList MemLine.l()
 
  ForEach TS_Pile()
    ;Si j'ai un "IF", je mémorise la ligne
    Debug "analyse:"+TS_Pile()\Cmd
    If TS_Pile()\Cmd="IF"
      AddElement(MemLine())
      MemLine()=ListIndex(TS_Pile())
      Debug "IF trouvé ligne "+Str(MemLine())
     ;Si j'ai un "ELSE" je vais renseigné a la ligne "IF" a quel ligne se trouve le "ELSE "
    ElseIf TS_Pile()\Cmd="ELSE"
       swapList=ListIndex(TS_Pile())
       SelectElement(TS_Pile(),MemLine())
       TS_Pile()\pos_else=swapList
       SelectElement(TS_Pile(),swapList)
       Debug "Else trouvé ligne "+Str(swapList)+" ligne(IF) "+Str(MemLine())+" renseigné"
      
    ;Si j'ai un "ENDIF" je vais renseigné a la ligne "IF" a quel ligne se trouve le "ENDIF"
    ElseIf TS_Pile()\Cmd="ENDIF"
       swapList=ListIndex(TS_Pile())
       SelectElement(TS_Pile(),MemLine())
       TS_Pile()\pos_endif=swapList
       Debug "ENDIF trouvé ligne "+Str(swapList)+" ligne(IF) "+Str(MemLine())+" renseigné"
       ;Si j'ai un "ELSE" je vais lui renseigné a quel ligne se trouve le "ENDIF"
       If TS_Pile()\pos_else>0
         SelectElement(TS_Pile(),TS_Pile()\pos_else)
         TS_Pile()\pos_endif=swapList
         
         
         Debug "ENDIF trouvé ligne "+Str(swapList)+" ligne(ELSE) "+Str(TS_Pile()\pos_else)+" renseigné"
      EndIf
      ; A la fin du "ENDIF" le "IF" a été traité je le retire de la pile       
       SelectElement(TS_Pile(),swapList)
       DeleteElement(MemLine())
    ElseIf TS_Pile()\Cmd="WHILE"  
      AddElement(MemLine())
      MemLine()=ListIndex(TS_Pile())
      Debug "WHILE trouvé ligne "+Str(MemLine())
    ElseIf TS_Pile()\Cmd="WEND" 
      TS_Pile()\pos_start=MemLine()
      pos_end=ListIndex(TS_Pile())
      PushListPosition(TS_Pile())
      SelectElement(TS_Pile(),MemLine())
      TS_Pile()\pos_endif=pos_end
      PopListPosition(TS_Pile())
       DeleteElement(MemLine())
      
    EndIf
  Next
  If ListSize(MemLine())>0:Debug "Erreur dans les IF":EndIf
    
EndProcedure


Procedure.s TestParam(param.s)
  Debug"__TestParam__:"+param
  ;Debug "traitement de param:"+param
  ;D'abord je test les variables
  word.s="";
  z=0;
  Repeat
    z+1 ;on incrémente
    ;Debug"z:"+Str(z)+" "+Str(Len(param))
    c$=Mid(param,z,1)
    If Asc(c$)>=Asc("A") And Asc(c$)<=Asc("z") And  z <= Len(param)
      word+c$
    ElseIf word<>"" ;And word<>"AND" And word<>"OR"
     
      Found=0
      ;On test si c'est une variable
      
      If FindMapElement(TS_VarNum(), word)
        Debug "Variable trouvé:"+MapKey(TS_VarNum())+ " : "+StrF(TS_VarNum())
        param=Mid(param,1,z-Len(word)-1)+Str(TS_VarNum())+Mid(param,z,Len(param)-z+1) ;on rempalce la variable part son contenu
        Debug param
        z=z-Len(word)+Len(Str(TS_VarNum())) ;On replace le curseur la ou il faut
        word="";
        Found=1
      
      EndIf

      
      ;On test si on une fonction ...
      
      ;Si on a toujours pas trouvé c'est qu'il y a une erreur
      If Found=0:Debug"Erreur Var:"+param:EndIf
    EndIf
   
  Until z > Len(param)
  ;Debug "Result >"+param
  ProcedureReturn param
EndProcedure

Declare .b TestExpression(param.s)
Declare .b TestLogique(param.s)
Procedure TestParenthese(param.s)
  Debug "__TESTPARENTHESE__:"+param
  NewList par.l()
  For z=1 To Len(param)
    c.s=Mid(param,z,1)
    If c="("
      AddElement(par())
      par()=z
    ElseIf  c=")"
      If ListSize(par())<1:Debug "Erreur Parenthese manque (":EndIf
      newparam.s=Mid(param,par()+1,z-par()-1)
      Debug "Found Para S:"+Str(par())+" E:"+Str(z)
      Debug "testlogique:"+newparam
      param=Mid(param,0,par()-1)+Str(TestLogique(newparam))+Mid(param,z+1,Len(param)-z)
      Debug param
      z=par()
      DeleteElement(par())
   EndIf
 Next
 Debug ListSize(par())
 If ListSize(par())>0:Debug "Erreur Parenthese manque )":EndIf
 Debug "dernier testlogique:"+param
 ProcedureReturn TestLogique(param)
EndProcedure


Procedure.b TestLogique(param.s)
  Debug"__TestLogique__:"+param
  Symbol.s="AND|OR";
  For z=1 To CountString(Symbol,"|")+1
    Symb.s=StringField(Symbol,z,"|")
    Pos=FindString(param.s, Symb, 0)
    If Pos>0
      Break
    EndIf
  Next
  
  If Pos=0:ProcedureReturn TestExpression(param):EndIf
  Debug "Symb:"+Symb
  PartA.s=Left(param,Pos-1)
  PartB.s=Right(param,Len(param)-Pos-Len(Symb)+1)
  Debug "PartA:"+PartA
  Debug "PartB:"+PartB
  Select Symb
    Case "AND"
      ProcedureReturn TestExpression(PartA) And TestExpression(PartB)
    Case "OR"
      ProcedureReturn TestExpression(PartA) Or TestExpression(PartB)
  EndSelect
EndProcedure

Procedure.b TestExpression(param.s)
  Debug"__TestExpression__:"+param
  Symbol.s="=|>|>=|<|<=|<>";
  ;On separe la verification a savoir C1 / le symbole de comparaison / C2
  For z=1 To CountString(Symbol,"|")+1
    Symb.s=StringField(Symbol,z,"|")
    Pos=FindString(param.s, Symb, 0)
    If Pos>0
      Break
    EndIf
  Next
  ;si pas d'expresion
  If Pos=0:ProcedureReturn CalculateL(TestParam(param)):EndIf
  
  ;On sépare nos 2 parties
  ;PartA.s=StringField(param,1,Symb) ;Ne fonctionne pas car StringField n'utilise qu'un seul caractère
  ;PartB.s=StringField(param,2,Symb)
  PartA.s=Left(param,Pos-1)
  PartB.s=Right(param,Len(param)-Pos-Len(Symb)+1)
  ;on verifie et remplace variable et autre fonction
  PartA=TestParam(PartA.s)
  PartB=TestParam(PartB.s)
  Debug "Symb:"+Symb
  Debug "PartA:"+PartA
  Debug "PartB:"+PartB

  
  
  ;On verification si l'expression est vrai
  Select Symb
    Case "="
      If CalculateL(PartA)=CalculateL(PartB):ProcedureReturn 1:EndIf
     Case ">"
      If CalculateL(PartA)>CalculateL(PartB):ProcedureReturn 1:EndIf
     Case ">="
      If CalculateL(PartA)>=CalculateL(PartB):ProcedureReturn 1:EndIf
     Case "<"
      If CalculateL(PartA)<CalculateL(PartB):ProcedureReturn 1:EndIf  
     Case "<="
      If CalculateL(PartA)<=CalculateL(PartB):ProcedureReturn 1:EndIf   
     Case "<>"
       If CalculateL(PartA)<>CalculateL(PartB):ProcedureReturn 1:EndIf
  EndSelect
  
  ProcedureReturn 0

  
EndProcedure

Procedure IsVariable(var.s)
  ProcedureReturn FindMapElement(TS_VarNum(), var)
EndProcedure

Procedure CMD_Let(param.s)
  Debug "__CMD_Let__:"+param
  var.s= StringField(param,1,"=")
  TS_VarNum(var)=CalculateF(TestParam(StringField(param,2,"=")))
EndProcedure


Procedure CMD_Print(param.s)
  param=TestParam(param)
  MessageRequester("CMD_Print",param,#PB_MessageRequester_Ok)
  Debug "PRINT:"+param
EndProcedure

Declare ExecuteScript(List TS_Pile.TS_Pile())

Procedure CMD_Ext(name.s,param.s)

  Select name.s
    Case "EXECUTE"
      ;ExecuteScript(1)
  EndSelect
EndProcedure

Procedure ExecuteScript(List TS_Pile.TS_Pile())
Debug "__START EXECUTE__"
time.l=ElapsedMilliseconds()
;Dim parametre.s(#NbparametreMax) ; On definie la variable qui vas récuperer les parametre
  ForEach TS_Pile()
        
  If TS_Pile()\Cmd<>""
    ;On gère les commandes de base
    ;Debug "Analyse commande:"+pile(l)\Cmd
    Select TS_Pile()\Cmd
      Case "LET"
        FirstElement(TS_Pile()\Param())
        CMD_Let(TS_Pile()\Param())
     Case "IF"
       ;Si la condition n'est pas rempli alors on saute au prochain Else ou Endif
       FirstElement(TS_Pile()\Param())
        If TestParenthese(TS_Pile()\Param())=#True:
          Debug "La condition est Vrai"
        ElseIf TS_Pile()\pos_else>0
          SelectElement(TS_Pile(),TS_Pile()\pos_else)
          Debug "La condition est Fausse ELSE"
        Else
          SelectElement(TS_Pile(),TS_Pile()\pos_endif)
          Debug "La condition est Fausse ENDIF"
        EndIf
     Case "ELSE"
        SelectElement(TS_Pile(),TS_Pile()\pos_endif)       
     Case "WHILE"
       FirstElement(TS_Pile()\Param())
       If TestParenthese(TS_Pile()\Param())=#False
         Debug "La condition est Fausse WHILE on arrête la boucle"
         PushListPosition(TS_Pile())
         SelectElement(TS_Pile(),TS_Pile()\pos_endif)
         TS_Pile()\true=#False
         PopListPosition(TS_Pile())
       Else
         PushListPosition(TS_Pile())
         SelectElement(TS_Pile(),TS_Pile()\pos_endif)
         TS_Pile()\true=#True
         PopListPosition(TS_Pile())
         Debug "La condition est Vrai WHILE"
        EndIf
     Case "WEND"
       If TS_Pile()\true=#True
         SelectElement(TS_Pile(),TS_Pile()\pos_start-1)
         Debug "On Boucle et retourne a WHILE"
       Else
         TS_Pile()\true=#False
         Debug "On arrêt de boucler"
       EndIf
     Case "PRINT"
        FirstElement(TS_Pile()\Param())
       CMD_Print(TS_Pile()\Param())
     
     ;Ensuite on gère les autres fonction
     Default
      n=IsCommand(TS_Pile()\Cmd)
      
      ;If n>0 
          CMD_Ext(TS_Pile()\Cmd,"")
      ;EndIf
    EndSelect
  EndIf 
  
Next
Debug "__END EXECUTE__"
MessageRequester("Executing Time",Str(ElapsedMilliseconds()-Time)+" ms",#PB_MessageRequester_Ok)
  ;Debug("Executing Time :"+Str(ElapsedMilliseconds()-Time)+" ms")
EndProcedure
InitScript()
script.s="LET Yann=100"+Chr(13)+Chr(10)
script+"LET Boule=Yann+100"+Chr(13)+Chr(10)
script+"IF ((Boule>Yann) OR (3=(1+1+1)))"+Chr(13)+Chr(10)
script+"  PRINT NIVEAU1"+Chr(13)+Chr(10)
script+"IF 1=1"+Chr(13)+Chr(10)
script+"  PRINT NIVEAU2"+Chr(13)+Chr(10)
script+"ENDIF"+Chr(13)+Chr(10)
script+"ELSE"+Chr(13)+Chr(10)
script+"PRINT PASNIVEAU"+Chr(13)+Chr(10)
script+"ENDIF"+Chr(13)+Chr(10)
NewList TS_Pile.TS_Pile()
ReadScript(script.s,@TS_Pile())
 ExecuteScript(@TS_Pile())
 ;Debug TS_VarNum("Yann");
 ;ForEach TS_VarNum()
 ;  Debug MapKey(TS_VarNum())+"="+StrF(TS_VarNum())
 ;Next
 
; ForEach TS_Pile()
;   Debug "Line "+Str(ListIndex(TS_Pile()))+" "+TS_Pile()\Cmd+" EndIf:"+Str(TS_Pile()\pos_endif)
; Next
Dernière modification par Thyphoon le lun. 06/juin/2011 20:25, modifié 3 fois.
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Voici une base de Language Interprété

Message par Backup »

il s'agit d'un interpréteur de script, que j'avais conçu avec l'aide de Dorbo,
une petite correction please .... ;)
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Re: Voici une base de Language Interprété

Message par Thyphoon »

Dobro a écrit :
Dorbo,
une petite correction please .... ;)
Oups désolé, faut vraiment que j'aille me coucher :roll: c'est corrigé... surtout que dans 5H je suis debout ...pfff.... :cry:
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Voici une base de Language Interprété

Message par Backup »

merci :)
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Re: Voici une base de Language Interprété

Message par Thyphoon »

Nouvelle version avec la gestion des boucles while/wend (j'ai modifier le code du premier post)

vous pouvez tester ce script pour tester les performances ! mais il faudra compiler sans le débugger sinon ça vas être très long vu tout ce qui s'affiche dans le débugger

Code : Tout sélectionner

script.s="LET qwe=10"+Chr(13)+Chr(10)
script+"WHILE qwe>0"+Chr(13)+Chr(10)
script+"  LET asd=100"+Chr(13)+Chr(10)
script+"	WHILE asd>0"+Chr(13)+Chr(10)
script+"		LET zxc=100"+Chr(13)+Chr(10)
script+"		WHILE zxc>0"+Chr(13)+Chr(10)
script+"			LET zxc=zxc-1"+Chr(13)+Chr(10)
script+"		WEND"+Chr(13)+Chr(10)
script+"		LET asd=asd-1"+Chr(13)+Chr(10)
script+"	WEND"+Chr(13)+Chr(10)
script+"	LET qwe=qwe-1"+Chr(13)+Chr(10)
script+"WEND"+Chr(13)+Chr(10)
Haut
Répondre

Revenir à « Trucs et astuces »