Lexer for PB 4

Share your advanced PureBasic knowledge/code with the community.
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Lexer for PB 4

Post by remi_meier »

Code updated For 5.20+

Hi!
After I saw the tool SuperCool1*, I thought: Not like that!! This tool just
searched for known character sequences and this can lead to errors very
fast (I wont describe it any further here).
So, I programmed a lexer for PureBasic 4 which any preparser could
use (lexer: a program, that splits the input (here: PB-code) in logical
tokens).

This lexer creates the following tokens (examples in quotation marks like
the lexer returns them in strings):
- comments: "; test"
- strings: ""hello"", "'byte'"
- identifiers: "*Pointer", "ApiFunc_", "String$", "#Constant"
- pseudotypes: "p-ascii"
- numbers: "1414", "$A0FFf", "%1011"
- compound operators: "<=", "<<"
- NewLine as #LF$
- the rest are simple characters
It's possible that there are still some bugs. The code should work with
all files (BOM-header) and in unicode as well as ascii mode.

The code uses interfaces, but don't worry, it's very simple to use it:

Code: Select all

Define s.s

Define.iPBSC test
test = New_PBSC()

If test\SetFile("test.pb")
  While test\IsNextToken()
    Debug test\GetNextToken()
  Wend
  
  test\CloseFile()
EndIf
Have fun :)
Remi

*Name changed

Code: Select all

Get it here:
http://www.purebasic.fr/german/viewtopic.php?t=8691

Code: Select all

;- Design by Contract Macros
#CONTRACTS = #True


Macro require
EndMacro

Macro body
EndMacro

Macro ensure
EndMacro

Macro returns
  ProcedureReturn
EndMacro

Macro DQ
  "
EndMacro

Macro assert(cond, label="")
  CompilerIf #CONTRACTS
    If Not(cond)
      CompilerIf #PB_Compiler_Debugger
        Debug label+": Line "+Str(#PB_Compiler_Line)+": Contract violated: "+#DQUOTE$+DQ#cond#DQ+#DQUOTE$+" is false"
        CallDebugger
      CompilerElse
        MessageRequester("Contract violated", label+": Line "+Str(#PB_Compiler_Line)+": Contract violated "+DQ#cond#DQ+" is false")
      CompilerEndIf
    EndIf
  CompilerEndIf
EndMacro

Macro implies(a, b)
  ((Not (a)) Or (b))
EndMacro

EnableExplicit



Enumeration 0
  #PBSC_Other  ; Operators, other symbols
  #PBSC_Identifier ; all variables, structures, pseudotypes, functions, pointer, constants...
  #PBSC_Number ; 'numb', 466, $ FFFF, %10001, 1.0e-4, etc.
  #PBSC_String ; "this is a String!"
  #PBSC_Comment ; the whole rest of the line starting with a ';'
  #PBSC_NewLine ; a new line begins, Token = #LF$
  #PBSC_TypeEnumerationEnd
EndEnumeration

Interface iPBSC
  SetFile.l(FileName.s)
  SetFileString(FileAsString.s)
  SetFileLine(Line.l)
  IsNextToken.l()
  GetNextToken.s()
  GetCurrentLineNb.l()
  GetCurrentType.l()
  CloseFile()
EndInterface

Structure cPBSC
  *VTable
  
  File.s
  FileLine.l
  FileMaxLine.l
  
  Line.s
  Started.l
  
  CurrentType.l
  
  LastToken.s
  LastTokenType.l
  PreLastToken.s
  PreLastTokenType.l
  PrePreLastToken.s
  PrePreLastTokenType.l
EndStructure


Procedure _PBSC_SetLastToken(*this.cPBSC, s.s)
  require
  assert(*this <> 0 And Len(s) <> 0)
  body
  ;Static PreLastToken.s = #LF$
  If *this\PreLastToken = "" : *this\PreLastToken = #LF$ : EndIf
  *this\PrePreLastToken = *this\PreLastToken
  *this\PreLastToken = *this\LastToken
  *this\LastToken = s
  ensure
  assert(*this\LastToken = s)
  returns
EndProcedure

Procedure _PBSC_SetTokenType(*this.cPBSC, Type.l)
  require
  assert(Type >= -1 And Type < #PBSC_TypeEnumerationEnd)
  assert(*this <> 0)
  body
  If Type = -1
    *this\PrePreLastTokenType = #PBSC_Other
    *this\PreLastTokenType = #PBSC_Other
    *this\LastTokenType = #PBSC_Other
    *this\CurrentType = #PBSC_Other
  Else
    *this\PrePreLastTokenType = *this\PreLastTokenType
    *this\PreLastTokenType = *this\CurrentType
    *this\LastTokenType = Type
    *this\CurrentType = Type
  EndIf
  ensure
  
  returns
EndProcedure

Procedure.l PBSC_SetFile(*this.cPBSC, FileName.s)
  require
  assert(*this <> 0)
  assert(Len(FileName) <> 0 And FileSize(FileName) <> -1 And FileSize(FileName) <> -2)
  body
  Protected FileID.l, Format.l, Result.l = #False
  
  FileID = ReadFile(#PB_Any, FileName)
  If IsFile(FileID)
    *this\FileLine = 1
    _PBSC_SetLastToken(*this, #LF$)
    _PBSC_SetTokenType(*this, -1)
    *this\Line = ""
    *this\Started = #True
    
    Format = ReadStringFormat(FileID)
    Select Format
      Case #PB_Ascii, #PB_UTF8, #PB_Unicode
        
        *this\FileMaxLine = 0
        While Not Eof(FileID)
          *this\FileMaxLine + 1
          *this\File + ReadString(FileID, Format) + #LF$
        Wend
        
        CloseFile(FileID)
        Result = #True
        
      Default
        CloseFile(FileID)
        Result = #False
    EndSelect
  EndIf
  ensure
  assert(Result = #False Or Result = #True)
  returns Result
EndProcedure

Procedure PBSC_SetFileString(*this.cPBSC, FileAsString.s) ; lines separated with #LF$!
  require
  assert(*this <> 0)
  assert(Len(FileAsString) <> 0)
  body
  *this\File     = FileAsString
  *this\FileLine = 1
  _PBSC_SetLastToken(*this, #LF$)
  _PBSC_SetTokenType(*this, -1)
  *this\Line     = ""
  *this\Started  = #True
  *this\FileMaxLine = CountString(*this\File, #LF$) + 1
  ensure
  assert(*this\FileMaxLine >= *this\FileLine)
  returns
EndProcedure

Procedure PBSC_SetFileLine(*this.cPBSC, Line.l)
  require
  assert(*this <> 0)
  assert(Line <= *this\FileMaxLine + 1) ; +1 because a loop could use this feature
  ; to iterate through all the lines
  ; but more than +1 should be a bug
  body
  *this\FileLine = Line
  *this\Line     = ""
  *this\Started  = #True
  _PBSC_SetLastToken(*this, #LF$)
  _PBSC_SetTokenType(*this, -1)
  ensure
  
  returns
EndProcedure

Procedure.l PBSC_IsNextToken(*this.cPBSC)
  require
  assert(*this <> 0)
  ;assert(*this\File, "no file loaded")
  If *this\File = ""
    MessageRequester("Contract violated", "no file loaded"+": Line "+Str(#PB_Compiler_Line)+": Contract violated no file loaded is false")  
  EndIf
  
  body
  Protected Result.l
  If *this\File And (*this\FileLine <= *this\FileMaxLine Or Len(*this\Line) <> 0)
    Result = #True
  Else
    Result = #False
  EndIf
  ensure
  assert(Result = #True Or Result = #False)
  returns Result
EndProcedure

Procedure.s _PBSC_ReadLine(*this.cPBSC)
  require
  assert(*this <> 0)
  ;         assert(*this\File, "no file loaded")
  If *this\File = ""
    MessageRequester("Contract violated", "no file loaded"+": Line "+Str(#PB_Compiler_Line)+": Contract violated no file loaded is false")  
  EndIf
  body
  Protected Result.s
  
  If *this\File
    *this\FileLine + 1
    Result = StringField(*this\File, *this\FileLine - 1, #LF$)
  Else
    Result = ""
  EndIf
  ensure
  returns Result
EndProcedure

Procedure.s _PBSC_Trim(*this.cPBSC, s.s)
  require
  assert(*this <> 0)
  body
  Protected *p.CHARACTER, *n.CHARACTER, Result.s
  
  *p = @s
  While (*p\c = ' ' Or *p\c = #TAB) And *p\c
    *p + SizeOf(CHARACTER)
  Wend
  ; *p zeigt auf Start des Textes
  
  ; suche Ende
  *n = *p
  While *n\c <> 0
    *n + SizeOf(CHARACTER)
  Wend
  
  *n - SizeOf(CHARACTER)
  While (*n\c = ' ' Or *n\c = #TAB) And *n > *p
    *n - SizeOf(CHARACTER)
  Wend
  
  Result = PeekS(*p, (*n + SizeOf(CHARACTER) - *p)/SizeOf(CHARACTER))
  ensure
  assert(PeekC(@Result) <> ' ' And PeekC(@Result) <> #TAB, "l-trimming failed")
  assert(PeekC(@Result + (Len(Result) - 1)*SizeOf(CHARACTER)) <> ' ' And PeekC(@Result + (Len(Result) - 1)*SizeOf(CHARACTER)) <> #TAB, "r-trimming failed")
  returns Result
EndProcedure

Procedure.l _PBSC_GetIdentifier(*this.cPBSC, s.s)
  require
  assert(*this <> 0)
  assert(Len(s) <> 0)
  body
  Protected z.l, Len.l, ToLen.l = 0, Const.l = 0, PseudoType.l = 0, Temp.s
  Protected LastToken.s, notptr.l
  
  If *this\LastToken = "." And (PeekC(@s) = 'p' Or PeekC(@s) = 'P') And PeekC(@s+SizeOf(CHARACTER)) = '-'
    PseudoType = 1
    ToLen = 2
  EndIf
  
  If PseudoType = 0
    If PeekC(@s) = '#'
      If *this\LastTokenType = #PBSC_Identifier Or *this\LastTokenType = #PBSC_Other
        Temp = LCase(*this\LastToken)
        Select Temp
          Case "to", "procedurereturn", "select", "case", "if", "elseif", "compilerselect"
            Const = 1 : ToLen = 1
          Case "compilercase", "compilerif", "compilerelseif", "break", "while", "until", "with"
            Const = 1 : ToLen = 1
          Case "debug", "end", "and", "or", "xor", "not", "#", "includefile", "xincludefile", "includepath", "includebinary"
            Const = 1 : ToLen = 1
          Case ",","/","+","-","%","!","~","|","&","<<",">>","<",">","<=",">=","=","<>","(","[","{",":"
            Const = 1 : ToLen = 1
          Case "*"
            If *this\LastTokenType = #PBSC_Identifier
              ProcedureReturn 0
            Else
              Const = 1 : ToLen = 1
            EndIf
          Default
            ProcedureReturn 0
        EndSelect
      ElseIf *this\LastTokenType = #PBSC_NewLine
        Const = 1 : ToLen = 1
      Else
        ProcedureReturn 0
      EndIf
      
    ElseIf PeekC(@s) = '*'
      notptr = #True
      If *this\LastTokenType = #PBSC_Identifier Or *this\LastTokenType = #PBSC_Other
        Temp = LCase(*this\LastToken)
        Select Temp
          Case "to", "procedurereturn", "select", "case", "if", "elseif", "compilerselect"
            notptr = #False
          Case "while", "until", "protected", "define", "global", "shared", "static", "with"
            notptr = #False
          Case "debug", "end", "and", "or", "xor", "not", "#"
            notptr = #False
          Case ",","/","+","-","%","!","~","|","&","<<",">>","<",">","<=",">=","=","<>","@","(","[","{",":"
            notptr = #False
          Case "*"
            If *this\LastTokenType = #PBSC_Identifier
              notptr = #True
            Else
              notptr = #False
            EndIf
          Default
            notptr = #True
        EndSelect
      ElseIf *this\LastTokenType = #PBSC_NewLine
        notptr = #False
      EndIf
      If notptr And *this\PrePreLastTokenType = #PBSC_Identifier
        Temp = LCase(LastToken)
        Select Temp
          Case "protected", "define", "global", "shared", "static"
            notptr = #False
        EndSelect
      EndIf
      
      If notptr = #False
        Const = 1 : ToLen = 1
      EndIf
      
      If Const <> 1
        ProcedureReturn 0
      EndIf
    EndIf
    
    If Const
      z = 1
      While (PeekC(@s+z*SizeOf(CHARACTER)) = ' ' Or PeekC(@s+z*SizeOf(CHARACTER)) = 9)
        Const + 1
        z + 1
        ToLen + 1
      Wend
    EndIf
    
    Select PeekC(@s + Const*SizeOf(CHARACTER))
      Case '_', 'a' To 'z', 'A' To 'Z'
        ToLen + 1
      Default
        ProcedureReturn 0
    EndSelect
  EndIf
  
  Len = Len(s)
  For z = 2+Const+PseudoType To Len
    Select Asc(Mid(s, z, 1))
      Case '_', 'a' To 'z', 'A' To 'Z', '0' To '9', '$'
        ToLen + 1
      Default
        _PBSC_SetTokenType(*this, #PBSC_Identifier)
        ProcedureReturn ToLen
    EndSelect
  Next
  
  _PBSC_SetTokenType(*this, #PBSC_Identifier)
  ProcedureReturn ToLen
  ;   ensure
  ;   returns
EndProcedure

Procedure.l _PBSC_GetString(*this.cPBSC, s.s)
  require
  assert(*this <> 0)
  assert(Len(s) <> 0)
  body
  Protected z.l, Len.l, ToLen.l = 0, SearchString.l
  
  
  If PeekC(@s) = '"'
    SearchString = #True
    ToLen = 1
  ElseIf PeekC(@s) = Asc("'")
    SearchString = #False
    ToLen = 1
  Else
    ProcedureReturn 0
  EndIf
  
  Len = Len(s)
  For z = 2 To Len
    If SearchString
      Select Asc(Mid(s, z, 1))
        Case '"'
          _PBSC_SetTokenType(*this, #PBSC_String)
          ProcedureReturn ToLen + 1
        Default
          ToLen + 1
      EndSelect
    Else
      Select Asc(Mid(s, z, 1))
        Case Asc("'")
          _PBSC_SetTokenType(*this, #PBSC_Number)
          ProcedureReturn ToLen + 1
        Default
          ToLen + 1
      EndSelect
    EndIf
  Next
  
  _PBSC_SetTokenType(*this, #PBSC_String)
  ProcedureReturn ToLen
  ;   ensure
  ;   returns
EndProcedure

Procedure.l _PBSC_GetNumber(*this.cPBSC, s.s)
  require
  assert(*this)
  assert(Len(s) <> 0)
  body
  Protected z.l, Len.l, ToLen.l = 0, Digit.l = #False, Hex.l = #False, Spec.l = 0
  Protected lastChar.c
  
  If PeekC(@s) = '$'
    Hex = #True
    ToLen = 1
    Spec = 1
  ElseIf PeekC(@s) = '%'
    If *this\LastTokenType = #PBSC_Identifier Or *this\LastTokenType = #PBSC_Number
      ProcedureReturn 0
    ElseIf *this\LastToken = ")" Or *this\LastToken = "]"
      ProcedureReturn 0
    EndIf
    ToLen = 1
    Spec = 1
  EndIf
  
  Len = Len(s)
  For z = (1+Spec) To Len
    If Hex
      Select Asc(Mid(s, z, 1))
        Case '0' To '9', 'a' To 'f', 'A' To 'F'
          ToLen + 1
          Digit = #True
        Case ' ', 9
          If _PBSC_Trim(*this, Left(s, z-1)) = "$"
            ToLen + 1
          Else
            _PBSC_SetTokenType(*this, #PBSC_Number)
            ProcedureReturn ToLen
          EndIf
        Default
          If Digit
            _PBSC_SetTokenType(*this, #PBSC_Number)
            ProcedureReturn ToLen
          Else
            ProcedureReturn 0
          EndIf
      EndSelect
    Else
      Select Asc(Mid(s, z, 1))
        Case '0' To '9', '.', 'e', 'E'
          If Digit = #False And (Asc(Mid(s, z, 1)) = '.' Or Asc(LCase(Mid(s, z, 1))) = 'e')
            ProcedureReturn 0
          EndIf
          If LCase(Mid(s, z, 1)) = "e"
            Select Asc(Mid(s, z-1, 1))
              Case '0' To '9', '.'
              Default
                _PBSC_SetTokenType(*this, #PBSC_Number)
                ProcedureReturn ToLen
            EndSelect
          EndIf
          lastChar = Asc(Mid(s, z, 1))
          ToLen + 1
          Digit = #True
        Case '+', '-'
          If Digit
            If lastChar = 'e' Or lastChar = 'E'
              ToLen + 1
            Else
              _PBSC_SetTokenType(*this, #PBSC_Number)
              ProcedureReturn ToLen
            EndIf
          Else
            ProcedureReturn 0
          EndIf
        Case ' ', 9
          If _PBSC_Trim(*this, Left(s, z-1)) = "%"
            ToLen + 1
          Else
            _PBSC_SetTokenType(*this, #PBSC_Number)
            ProcedureReturn ToLen
          EndIf
        Default
          If Digit
            _PBSC_SetTokenType(*this, #PBSC_Number)
            ProcedureReturn ToLen
          Else
            ProcedureReturn 0
          EndIf
      EndSelect
    EndIf
  Next
  
  _PBSC_SetTokenType(*this, #PBSC_Number)
  ProcedureReturn ToLen
  ;ensure
  ;returns
EndProcedure

Procedure.l _PBSC_GetDOperator(*this.cPBSC, s.s)
  require
  assert(*this <> 0)
  assert(Len(s) <> 0)
  body
  Protected Result.l = -1
  
  Select PeekC(@s)
    Case '<', '>'
      Select PeekC(@s+SizeOf(CHARACTER))
        Case '>', '<', '='
          _PBSC_SetTokenType(*this, #PBSC_Other)
          Result = 2
      EndSelect
  EndSelect
  
  If Result <> 2
    Result = 0
  EndIf
  ensure
  assert(Result = 2 Or Result = 0)
  returns Result
EndProcedure

Procedure.l _PBSC_FindToken(*this.cPBSC, s.s)
  require
  assert(*this <> 0)
  assert(Len(s) <> 0)
  body
  ; ok: Kommentare als Ganzes
  ; ok: Strings als Ganzes (auch mit ' umklammerte)
  ; ok: Bezeichner als Ganzes (auch #KONST, String$, *Ptr)
  ; ok: Pseudotypen als Ganzes
  ; ok: Zahlen: 2001, $5461, %454
  ; ok: Doppeloperatoren
  Static RetVal.l = 0
  
  If PeekC(@s) = ';'
    _PBSC_SetLastToken(*this, s)
    _PBSC_SetTokenType(*this, #PBSC_Comment)
    RetVal = Len(s)
  Else
    RetVal = _PBSC_GetIdentifier(*this, s)
    If RetVal
      _PBSC_SetLastToken(*this, Left(s, RetVal))
    Else
      RetVal = _PBSC_GetString(*this, s)
      If RetVal
        _PBSC_SetLastToken(*this, Left(s, RetVal))
      Else
        RetVal = _PBSC_GetNumber(*this, s)
        If RetVal
          _PBSC_SetLastToken(*this, Left(s, RetVal))
        Else
          RetVal = _PBSC_GetDOperator(*this, s)
          If RetVal
            _PBSC_SetLastToken(*this, Left(s, RetVal))
          Else
            _PBSC_SetLastToken(*this, Mid(s, 1, 1))
            _PBSC_SetTokenType(*this, #PBSC_Other)
            RetVal = 1
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  ensure
  assert(RetVal > 0)
  returns RetVal
EndProcedure

Procedure.s PBSC_GetNextToken(*this.cPBSC)
  require
  assert(*this <> 0)
  assert(*this\FileLine <= *this\FileMaxLine + 1, "searching outside of file")
  body
  Protected s0.s, Token.s, Len.l, Result.s
  
  ; Line is trimmed or empty (if set by string and not by file)!
  If *this\File And (*this\FileLine <= *this\FileMaxLine Or Len(*this\Line) <> 0)
    
    If *this\Line = ""
      _PBSC_SetTokenType(*this, #PBSC_NewLine)
      _PBSC_SetLastToken(*this, #LF$)
      
      s0 = _PBSC_ReadLine(*this)
      *this\Line = _PBSC_Trim(*this, s0)
      
      If ( Not *this\Started) Or (*this\Started And *this\Line = "")
        Result = #LF$
      Else
        *this\Started = #False
      EndIf
    EndIf
    
    If Result <> #LF$
      Len = _PBSC_FindToken(*this.cPBSC, *this\Line)
      Token = Left(*this\Line, Len)
      
      *this\Line = _PBSC_Trim(*this, Mid(*this\Line, FindString(*this\Line, Token, 1)+Len(Token), Len(*this\Line)-Len(Token)))
      
      Result = _PBSC_Trim(*this, Token)
    EndIf
  Else
    Result = ""
  EndIf
  ensure
  returns Result
EndProcedure

Procedure.l PBSC_GetCurrentLineNb(*this.cPBSC)
  require
  assert(*this <> 0)
  assert(*this\FileMaxLine > 0, "no string loaded")
  body
  Protected Result.l
  
  If *this\Started = #False And *this\LastToken = #LF$
    Result = *this\FileLine - 2
  Else
    Result = *this\FileLine - 1
  EndIf
  ensure
  assert(Result > 0 And Result <= *this\FileMaxLine)
  returns Result
EndProcedure

Procedure.l PBSC_GetCurrentType(*this.cPBSC)
  require
  assert(*this <> 0)
  body
  Protected Result.l
  Result = *this\CurrentType
  ensure
  assert(Result >= 0 And Result < #PBSC_TypeEnumerationEnd)
  returns Result
EndProcedure

Procedure PBSC_CloseFile(*this.cPBSC)
  require
  assert(*this <> 0)
  assert(Len(*this\File) <> 0)
  body
  *this\File = ""
EndProcedure

DataSection
  cPBSC_VT:
  Data.l @PBSC_SetFile(), @PBSC_SetFileString(), @PBSC_SetFileLine(), @PBSC_IsNextToken(), @PBSC_GetNextToken()
  Data.l @PBSC_GetCurrentLineNb(), @PBSC_GetCurrentType(), @PBSC_CloseFile()
EndDataSection

Procedure.l New_PBSC()
  require
  body
  Protected *obj.cPBSC
  
  *obj = AllocateMemory(SizeOf(cPBSC))
  If *obj   
    *obj\VTable = ?cPBSC_VT
  EndIf
  ensure
  assert(*obj <> 0, "couldn't create object")
  returns *obj
EndProcedure



Edit: Fixed bugs, added functionality and workarounded a PB bug
Last edited by remi_meier on Sat Jun 10, 2006 7:08 pm, edited 6 times in total.
Athlon64 3700+, 1024MB Ram, Radeon X1600
benny
Enthusiast
Enthusiast
Posts: 465
Joined: Fri Apr 25, 2003 7:44 pm
Location: end of www
Contact:

Post by benny »

Excellent work, remi :!:
regards,
benny!
-
pe0ple ar3 str4nge!!!
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

Thanks!

Update: Fixed some bugs and added types for the tokens.
Athlon64 3700+, 1024MB Ram, Radeon X1600
User avatar
fsw
Addict
Addict
Posts: 1603
Joined: Tue Apr 29, 2003 9:18 pm
Location: North by Northwest

Re: Lexer for PB 4

Post by fsw »

remi_meier wrote:Hi!
After I saw the tool SuperCool1*, I thought: Not like that!! This tool just
searched for known character sequences and this can lead to errors very
fast (I wont describe it any further here).
I know there is no tokenizer in it :oops:

Actually I just started writing it to see how complicated something like that would be, and then it got bigger and bigger... and it still works :shock:

But the concept of "searching for known character sequences" is of course limited and not that flexible.

A real lexer and tokenizer is much better.
remi_meier wrote: *Name changed
Du kannst das Kind beim namen nennen, hab nichts dagegen :wink:

If something can be improved the better.

Any help or suggestions are truly appreciated.

Thanks.

:D
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

Thanks Remi.
It is great! :D
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

:P I wasn't sure if you would take it that easy.
fsw wrote:Actually I just started writing it to see how complicated something like that would be, and then it got bigger and bigger... and it still works
Yes, I know this situation. It's time for a rewrite.

And sorry, I won't help you because I'm still supporting edel with his tool.

Remember, you are developing open source, so if you want that some
others help you, code must be clean and easy manageable :)
Athlon64 3700+, 1024MB Ram, Radeon X1600
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

Posted here another OOP PB implementation:
http://www.purebasic.fr/english/viewtop ... 288#148288
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

Nice, but not my style :P

I have fixed some bugs (again) because I've forgotten some cases. And
I've rewritten some parts and added a micro description in the enumeration.
I hope I didn't add more bugs with the rewrite :wink:
Athlon64 3700+, 1024MB Ram, Radeon X1600
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

Again I solved some problems (most of them are related to the distinction
between pointers and multiplications as well as constants and macro con-
catenation).

So that it's not a mere double posting, I have made a short example of
how you can read out of a PB file the calls to interface methods:

Code: Select all

Structure TOKEN 
  LineNb.l 
  s.s 
  Type.l 
EndStructure 

NewList tokens.TOKEN() 

Define.iPBSC test 
test = New_PBSC() 


If test\SetFile("test.pb") 
  
  ; Read everything into a Linked List 
  While test\IsNextToken() 
    AddElement(tokens()) 
    tokens()\s      = test\GetNextToken() 
    tokens()\LineNb = test\GetCurrentLineNb() 
    tokens()\Type   = test\GetCurrentType() 
  Wend 
  
  ; Search for interface methods 
  ForEach tokens() 
    If tokens()\Type = #PBSC_Identifier 
      If NextElement(tokens()) And tokens()\s = "(" 
        If PreviousElement(tokens()) And PreviousElement(tokens()) And tokens()\s = "\" And NextElement(tokens()) 
          Debug "In line "+Str(tokens()\LineNb)+" somebody calls the method "+tokens()\s 
        Else 
          NextElement(tokens()) 
        EndIf 
      Else 
        PreviousElement(tokens()) 
      EndIf 
    EndIf 
  Next 
  
  test\CloseFile() 
EndIf
Athlon64 3700+, 1024MB Ram, Radeon X1600
User avatar
fsw
Addict
Addict
Posts: 1603
Joined: Tue Apr 29, 2003 9:18 pm
Location: North by Northwest

Post by fsw »

remi_meier wrote::P I wasn't sure if you would take it that easy.
Dont' worry, I know that my coding sucks :(

Take care
:D
inc.
Enthusiast
Enthusiast
Posts: 406
Joined: Thu May 06, 2004 4:28 pm
Location: Cologne/GER

Post by inc. »

fsw wrote:Dont' worry, I know that my coding sucks :(
?
Finally its the effort that counts, ya know ;)
Check out OOP support for PB here!
Fred
Administrator
Administrator
Posts: 18162
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Post by Fred »

Nice piece of code !
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

Thx :)
I would like to post a new version, but the board just shows
Internal Server Error
The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator, tech@ovh.net and inform them of the time the error occurred, and anything you might have done that may have caused the error.

More information about this error may be available in the server error log.

Apache/1.3.34 Server at www.purebasic.fr Port 80
Is there a problem with too big posts? The error shows when trying to edit
the first post or post the code in a new post.
Athlon64 3700+, 1024MB Ram, Radeon X1600
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

Error is still there :?
You can grab the current versions from
http://www.purebasic.fr/german/viewtopic.php?t=8691
Athlon64 3700+, 1024MB Ram, Radeon X1600
remi_meier
Enthusiast
Enthusiast
Posts: 468
Joined: Sat Dec 20, 2003 6:19 pm
Location: Switzerland

Post by remi_meier »

Athlon64 3700+, 1024MB Ram, Radeon X1600
Post Reply