Arsip: Parser & Interpreter, ada yg pernah bikin?

 
user image
more 14 years ago

DelphiExpert

Uhuk-uhuk... Rekan2 semua... ada yg pernah develop script parser & interpreter ngga'? Sekilas mungkin pake stack utk evaluasi sekumpulan expression, berikut evaluate internal/external method, operasi subs, div, mod, if then etc. Tujuan knapa repot2 bikin ginian: Utk customisasi EXPERT-SYSTEM rules. Gue udah coba bikin, tapi jadinya terlalu spesifik :( , jadi utk nambai reserved-words baru dengan perilaku baru jadi ribet huhuhu... Ni sekilas snippet parsernya:

  procedure ProcessSymbol;
    procedure ProcessIF;
      function EvaluateExpression(Stack: TStrings): Boolean;
      const SYM_EXP = 'EXP'; // expression, need to evaluate
            SYM_VAL = 'VAL'; // value, just use
            SYM_CMP = 'CMP'; // comparator: =, <=, >=, <>
            SYM_OPR = 'OPR'; // logical operator: AND, OR
        function GetValue: string;
        begin
          Result:= Stack.Names[0];
          if (Result = SYM_VAL) or (Result = SYM_CMP) or (Result = SYM_OPR) then
            Result:= Stack.ValueFromIndex[0]
          else begin //if Result = SYM_EXP then
            Result:= Vars.Values]
          end;
          Stack.Delete(0);
        end;
        function EvalBlock: Boolean;
        var V1, V2, Cmp: string;
        begin
          Result:= False;
          V1:= GetValue;
          Cmp:= GetValue;
          V2:= GetValue;
          if Cmp = '=' then Result:= V1 = V2
          else if Cmp = '>' then Result:= V1 > V2
          else if Cmp = '<' then Result:= V1 < V2
          else if Cmp = '>=' then Result:= V1 >= V2
          else if Cmp = '<=' then Result:= V1 <= V2
          else if Cmp = '<>' then Result:= V1 <> V2
          else Parser.Error('Comparator expected: ' + Cmp);
        end;
      var Opr: string;
      begin
        Result:= False;
        try
          while Stack.Count > 0 do begin
            Result:= EvalBlock;
            if Stack.Count > 0 then Opr:= GetValue
            else Opr:= '';
            if Opr <> '' then begin
              if Opr = 'AND' then begin
                if not Result then Break;
                Result:= Result and EvalBlock;
              end else if Opr = 'OR' then begin
                if Result then Break;
                Result:= Result or EvalBlock;
              end else Parser.Error('Operator expected: ' + Opr);
            end;
          end;
        except
          Parser.Error('Identifier expected');
        end;
      end;
    var FStack: TStrings;
        Temp: string;
    begin
      FStack:= TStringList.Create;
      try
        Parser.NextToken;
        while (Parser.Token <>#0)and not Parser.TokenSymbolIs('THEN') do begin
          case Parser.Token of
          toSymbol: begin
                      Temp:= UpperCase(Parser.TokenComponentIdent);
                      if Parser.TokenSymbolIs('AND') or Parser.TokenSymbolIs('OR') then
                        FStack.Add('OPR=' + Temp)
                      else begin
                        FStack.Add('EXP=' + Temp);
                        AddVar(Temp);
                      end;
                    end;
          toString: FStack.Add('VAL=' + Parser.TokenString);
          '=': FStack.Add('CMP=' + Parser.Token);
          '>', '<': begin
                      Temp:= Parser.Token;
                      Parser.NextToken;
                      if Parser.Token in ['=', '>'] then
                        Temp:= Temp + Parser.Token
                      else begin
                        FStack.Add('CMP=' + Temp);
                        Continue;
                      end;
                      FStack.Add('CMP=' + Temp);
                      Parser.NextToken;
                      if Parser.Token in ['=', '<', '>'] then
                        Parser.CheckToken(toSymbol);
                      Continue;
                    end;
          end;
          Parser.NextToken;
          {if 'Saya' > 'Saya' then ShowMessage('sdfsdfsdf')
          else ShowMessage('FALSE');}
          //ShowMessage(FStack.Text);
          //Parser.CheckTokenSymbol('THEN');
        end;
        Parser.CheckTokenSymbol('THEN');
        Parser.NextToken;
        Parser.CheckTokenSymbol('BEGIN');
//        ShowMessage(FStack.Text);
        Parser.NextToken;
        if EvaluateExpression(FStack) then
          Result:= DoParse(Parser, Vars, 'END');
        //else ShowMessage('THE RESULT IS: FALSE');
        Parser.NextToken;
        while (Parser.Token <> toEOF) and not Parser.TokenSymbolIs('END') do
          Parser.NextToken;
      finally
        FreeAndNil(FStack);
      end;
    end;
  begin
    //Sym:= UpperCase(Parser.TokenComponentIdent);
    if Parser.TokenSymbolIs('IF') then begin
      ProcessIF;
    end else begin
      Sym:= UpperCase(Parser.TokenComponentIdent);
      if (Sym <> 'END') and (Sym <> 'ELSE') and (Sym <> 'BEGIN')then
        AddVar(Sym);
    end;
  end;
  procedure ProcessAssign(SymName: string);
  begin
    Parser.NextToken;
    case Parser.Token of
    toSymbol: begin
                ProcessSymbol;
                AssignVar(SymName, Vars.Values[Sym]);
              end;
    toString: AssignVar(SymName, Parser.TokenString);
    toInteger,
    toFloat:  AssignVar(SymName, FloatToStr(Parser.TokenFloat));
    end;
    {Parser.NextToken;
    Parser.CheckToken(';');}
  end;
  function DefFuncProc(FN: string; Par: TParser): Variant;
  var Pr: array of Variant;
      I: Integer;
    procedure CheckParamCount(Count: Integer);
    begin
      if I <> Count then Parser.Error(FN + ': Params count expected');
    end;
  begin
    SetLength(Pr, 10); // max params
    I:= 0;
    while not (Par.NextToken in [')', toEOF]) do begin
      //QuotedStr(GetVarValue(IdentName));
      case Par.Token of
      toSymbol: Pr[I]:= GetVarValue(Par.TokenComponentIdent);
      toString,
      toWString: Pr[I]:= Par.TokenWideString;
      toInteger, toFloat: Pr[I]:= Par.TokenFloat;
      end;
      if Par.NextToken <> ')' then
        Par.CheckToken(',');
      Inc(I);
    end;
    SetLength(Pr, I);
    try
      if FN = 'UPPER' then begin
        CheckParamCount(1);
        Result:= QuotedStr(UpperCase(Pr[0]));
      end else if FN = 'LOWER' then begin
        CheckParamCount(1);
        Result:= QuotedStr(LowerCase(Pr[0]));
      end else if FN = 'OUT' then begin
        Result:= QuotedStr(Pr[0]);
      end else if FN = 'SHOWMESSAGE' then begin
        CheckParamCount(1);
        MessageDlg(Pr[0], mtInformation, [mbOK], 0);
      end else
        Parser.Error(FN + ': Unknown method name');
    finally
      Pr:= nil;
    end;
  end;
  function EvaluateFunc(Code: string): Variant;
  var Par: TParser;
      S: TStream;
      FN: string;
  begin
    Result:= Null;
    S:= TStringStream.Create(Code);
    try
      Par:= TParser.Create(S);
      try
        //ShowMessage(Code);
        FN:= Par.TokenComponentIdent;
        Par.NextToken;
        Par.CheckToken('(');
        Result:= DefFuncProc(FN, Par);
      finally
        FreeAndNil(Par);
      end;
    finally
      FreeAndNil(S);
    end;
  end;
  function ProcessFunc(FuncName: string): Variant;
  var Func: string;
      IdentName: string;
  begin
    Parser.CheckToken('(');
    // Extract FUNCTION CALL;
    Func:= FuncName + Parser.Token; // (
    Parser.NextToken;
    if Parser.Token <> ')' then
      while True do begin
        IdentName:= '';
        case Parser.Token of
        toSymbol: //
                  begin
                    //Func:= Func + Parser.TokenComponentIdent;
                  //
                  IdentName:= UpperCase(Parser.TokenComponentIdent);
                  ProcessSymbol;
                  //Parser.NextToken;
                  end;
        toString: Func:= Func + QuotedStr(Parser.TokenString);
        toInteger, toFloat: Func:= Func + FloatToStr(Parser.TokenFloat);
        end;
        Parser.NextToken;
        if (IdentName <> '') and (Parser.Token <> '(') then
          //Func:= Func + QuotedStr(GetVarValue(IdentName));
          Func:= Func + IdentName;
        if Parser.Token = '(' then begin
          //Func:= FuncName + Func + ProcessFunc(Sym);
          Func:= Func + VarToStr(ProcessFunc(Sym));
          //FuncName:=
          //ProcessFunc(Sym);
          if Parser.NextToken = ')' then begin
            Func:= Func + {IdentName + }Parser.Token; // ) closed kurung
            Break;
          end;
        //end else if Parser.NextToken = ')' then begin
        end else if Parser.Token = ')' then begin
          Func:= Func + Parser.Token; // ) closed kurung
          Break;
        end;
        Parser.CheckToken(',');
        Func:= Func + {IdentName + }Parser.Token; // , comma
        if Parser.NextToken = toEOF then Break;
      end else Func:= Func + Parser.Token; // ) closed kurung
      //Parser.NextToken;
    //AssignVar('FUNC:' + FuncName, Func);
    //AssignVar(CurrAssign, EvaluateFunc(Func));
    Result:= EvaluateFunc(Func);
    if CurrAssign <> '' then
    AssignVar(CurrAssign, VarToStr(Result));
    // remove func sym in vars list
    Vars.Values[FuncName]:= '';
  end;
Masih berantakan, debug-mode hihi. Currently support if-then-else block, auto variable, var assign, evaluate expression by var ref & functions with params () & spell-check. Style script gue buat mirip pascal, dengan beberapa pengembangan utk explorasi ke expert-system rules nantinya. Sample:

Data:= 'Indra Gunawan';
Data:= Upper(Lower(Dataku));
if Data = 'Indra' or Data = Lower(Data) then begin
  Data:= 'True expression';
end else begin
  Data:= 'False experession';
end;
Bodohnya, knapa gue lupa kasi operasi subs, mult dsb (+, -, div, not, xor) dsb. huhu... naaah karena berangkat dari buru2 akhirnya parser jadi terlalu spesifik, misal mo tak tambai operasi subs, mult dsb musti ribet & kemungkinan mempengaruhi aturan yang udah ada diatas jadi ada! Ada ngga' yang bisa kasi solusi pake metode Push, Pop, Block execute dsb? Ehm... yang baru2 ni menyandang gelar OnProffesional hihihi Thankyu all wahahaha... 1 2 3 Hip hip huraaa...
user image
more 14 years ago

LuriDarmawan

jadi inget, dahulu kala waktu diriku masih imut-imut dan masih suka baca majalah mikrodata, pernah ada artikel dan produk indonesia soal intepreter berbahasa indonesia. coba seandainya majalah itu masih ada.
user image
more 14 years ago

deLogic

saya pernah bikin pake Engine GOLDParser.. enak lagi, kita bisa bikin gramar sendiri, dan impelemantasi / action handler untuk setiap token / statement, operation yang kita bikin bisa fleksibel...
user image
more 14 years ago

DelphiExpert

Wah bro deLogic, ane confuse ni gimana cara pake/interaksi/actions ama program kita? After di GoldParser.Parse kan menghasilkan TReduction, what should I do with this one? Ato kita handler di events OnMsgReduction & OnMsgTokenRead ? Terus pengoperasiannya gimana dunk? <sample please> Misal dari script berikut (ini adalah rules yg berlaku pada interpreter versi 1.0):

SEPARATORS= 
DEL=, 
DEL= tdk dpt#
MERGE_CHARS=
FIELDS=UPPER(ID):0.1, PRODUK:.2.3, NO_HP:.5, STATUS:.0;
// validations
STATUS=LIKE(Maafisi)
NO_HP=LEN_MIN(10), LEN_MAX(13)
// out var
$MSG=Cendana2000: GAGAL isi <PRODUK> pulsa <NO_HP> tdk dapat diproses
Yang ingin gue intercept adalah: 1. TStringList contains the FIELDS value (after evaluated by interpreter) contoh: ID=Maafisi pulsa PRODUK=IM3Rp20.000 NO_HP=6285648644633 STATUS=Maafisi 2. Dan TStringList contains extracted variables (saya menyebutnya demikian) contoh: $MSG=Cendana2000: GAGAL isi IM3 Rp20.000 pulsa 6285648644633 tdk dapat diproses $STATUS=GAGAL 3. Jika ada validasi yg tidak memenuhi syarat conditional seperti pada section "// validations" maka TStringList contains Error messages should exists for error details Thankyu uhu uhu... what should I do with GOLDParser then...?
user image
more 14 years ago

deLogic

After di GoldParser.Parse kan menghasilkan TReduction, what should I do with this one? Ato kita handler di events OnMsgReduction & OnMsgTokenRead ?
di OnMsgReduction mas...
Terus pengoperasiannya gimana dunk?
coba liat sample yang disertakan, ada kok gimana carany parsing dan interpreting, sorry gw udah lama gak main2, terakhir 2thn yg lalu, dah banyak lupa.. apalagi waktu itu campuran pake VB n Delphi.. :D oiya jangan lupa mampir di discussion-forum nya di yahoogroups.
user image
more 14 years ago

DelphiExpert

Ok deh thanks bro... case closed! Ato ada lagi saran rekan2 laen? Please ih ih Soalnya kalo saya lihat sekilas pake GoldParser agak lambat ya huehehehe... Mana lagi harus load grammar dari file uhu... Misal kalo Hit per Second nya tinggi kan jadi membebani tuh... Thanks bro!
user image
more 14 years ago

deLogic

GoldParser yg versi Delphi kayaknya belum di-optimize, kebanyakan cuman porting aja, kalo gak salah dulu base-nya dari VB.. btw untuk load gramar, cukup sekali aja pas pertama kali di-load dari file, biarkan residen di memori, seterusnya tinggal run script-nya aja. btw dah pernah coba2 yang model kayak PascalScripting belom, seperti punya TMS atau DelphiWebScript atau yg lain emang parser2 yang ada di Torry gak ada yg sesuai ya bro...?
user image
more 14 years ago

DelphiExpert

Avaliable scripting udah gue obok2, malah gue udah explorasi DelphiWebScript utk TA gue (Sebelum FastReport populer gue udah bikin report builder berbasis scripting) tahun 1999-an kalo ngga' salah. Hampir semua scripting sprti bro sebut berbasis language independent (Setau saya FastScript & beberapa scripting laen ada yg berbasis grammar), kalaupun diarahkan ke languange laen; misal DelphiWebScript seingat gue hampir semua aturan grammar harus ditulis ulang. Pernah denger VP-Expert ? aplikasi berbasis DOS yg dikhususkan utk expert system. Nah yang ginian ni maunya gue porting. Pendefinisian rules (kalo di GoldParser, grammar dianggap sebagai rules) menggunakan scripting, sekumpulan data yang dapat mengambil kesimpulan sendiri. Eh, btw sample peng-interpreteran GoldParser dimana ya bro, sample2 yg gue D/W semuanya sample pembuatan grammar hahaha...
user image
more 14 years ago

deLogic

VP-Expert, kayaknya malah gw nih baru denger.. :) ntar gw coba buka deh, siapa tau menarik... :) sample parsing n interpreter kayaknya ada di web nya juga kok... di sourceforge juga ada, saya dah lupa nama project-nya secara tepat, tapi yang saya inget, dia bikin contoh interpreter kalkulattor, pake C++, kalo gak salah ini " wxGoldParser engine skeleton for wxWidgets"
user image
more 14 years ago

LuriDarmawan

kalo pake Pascal Script™ 3.0 bgmn? sudah memadai tidak ya? ref: http://www.remobjects.com/page.asp?id={9A30A672-62C8-4131-BA89-EEBBE7E302E6}
more ...
  • Pages:
  • 1
  • 2
Share to

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com