NewsForumsCodeLogsGallerySpecsSearch

Code archives/Miscellaneous/APPP - Almost Pointless Preprocessor

This code has been declared by its author to be Public Domain code.

Download source code

APPP - Almost Pointless Preprocessor by N2004
APPP, not to be confused with point-to-point-protocol, stands for Almost Pointless PreProcessor.

Basically, what my pointless preprocessor does is it takes my own little syntax (which I'm very comfortable with, but I'm very strange so god knows what I'm thinking when I use it), parses it, and spits out a BB file.

It allows some very basic OO concepts, such as inheritance and in-type methods, but there's no multiple inheritance, interfaces, downcasting, etc. I intend(ed) to add a built-in deep copy function for copying types.

It also allows the use of simple operators like ++,+=,--,-=,*=, and /=, among other things.

The only unsupported loop is Repeat..Until/Forever and that's because I can't think of a way to end it.

In order to use this, you have to compile it and pass a file to it via the commandline (or set it in your IDE, your call).

Example code you can compile with it can be found in my 2d-in-3d GUI, Stre.

Keep in mind I'm not trying to make something special with this. I just sat down today and wrote this up in something like an hour, it's a hack-job of a translator and probably shouldn't be used unless you're bored and feel like screwing around.

If you see aCiD2, kick him in the nuts. He made me spend 30 minutes looking for a bug in the preprocessor when he forgot a \. 
;; In order to use this, you have to compile it and pass a file to it via the commandline (or set it in your IDE, your call).

Graphics 600,400,32,2

Const UseDelimitor=0
Global Quiet = 0

Global CurDef=0
Global DefCount
Dim Defined(511)
Defined(0) = 1

Type Def
	Field Name$
	Field Index
End Type

Type tType
	Field Name$
	Field Fields$
	Field Inherits$
End Type

Type tTypeObject
	Field Name$
	Field TypeName$
End Type

Type tTypeObjectField
	Field Name$
	Field TypeName$
End Type

Type Method
	Field Contents$
	Field Name$
	Field NameArgs$
	Field T.tType
	Field Body$
	Field Arguments%
End Type

Global NoParseOpen,T

Fnt = LoadFont( "Courier New", 16, 0, 0 )
SetFont Fnt
CMDL$ = CommandLine$()
;;If Quiet = 0 Then Print CMDL$
QuoteA = 0
QuoteB = 0

For N = 1 To Len(CMDL)
	C = Asc(Mid(CMDL,N,1))
	If C = 34 Then
		Quotes = Quotes + 1
		If Quotes = 1 Then
			QuoteA = N
		ElseIf Quotes = 2 Then
			QuoteB = N
			Exit
		EndIf
	EndIf
Next

If QuoteA = 0 And QuoteB = 0 Then End

FileIn$ = Mid(CMDL,QuoteA+1,QuoteB-QuoteA-1)
Arguments$ = Left(Cmdl,QuoteA-1)
Arguments=Arguments+Right(Cmdl,Len(cmdl)-QuoteB)

If Instr(Arguments,"+q") Or Instr(Arguments,"-q") Then Quiet = 1

Global Directory$ = Replace(FileIn$,"/","\")

For N = 1 To Len(Directory)
	If Mid(Directory,N,1) = "\" Then
		CDKA = N
	EndIf
Next

Directory = Left(Directory,CDKA)
ChangeDir Directory

If FileType(FileIn) <> 1 Then End
If Lower(Right(FileIn,3)) <> ".bc" Then NoRootParse = 1

FILE = ReadFile(FileIn)
If Not FILE Then End
	
TFile = WriteFile("Temp.A")
If Not TFile Then CloseFile(FILE) End

IncludeFile FILE,TFile,NoRootParse

LastMethod.Method = Last Method
For m.Method = Each Method
	ConTrue = 0
	CName$ = Trim(Left(m\Name,Instr(m\Name,"(")-1))
	If Lower(CName) = Lower(m\T\Name) Then
		ConTrue = 1
	EndIf
	WriteLine TFile,""
	InMeth = Instr(m\Name,"(")
	OutMeth = Instr(m\Name,")")
	NeedComma = 0
	If ConTrue = 1
		WriteLine TFile,"Function "+m\T\Name+Replace(m\Name,"(","."+m\T\Name+"(" )
		WriteLine TFile,"this."+m\T\Name+" = New "+m\T\Name+Chr(10)+m\Contents+"Return this"+Chr(10)+"End Function"
	Else
		For N2 = InMeth To OutMeth
			AC = Asc(Upper(Mid(m\Name,N2,1)))
			If (AC >= 64 And AC <= 90) Or (AC >= 48 And AC <= 57) Or (AC = 34) Then
				NeedComma = 1
				Exit
			EndIf
		Next
		If NeedComma Then
			WriteLine TFile,"Function "+m\T\Name+Replace(m\Name,"(","(this."+m\T\Name+", ")
		Else
			WriteLine TFile,"Function "+m\T\Name+Replace(m\Name,"(","(this."+m\T\Name)
		EndIf
		WriteLine TFile,m\Contents+"End Function"
	EndIf
Next

CloseFile FILE
CloseFile TFILE
FILE = OpenFile("Temp.A")
	
FileOut$ = Left(FileIn,Len(FileIn)-3)+".bb_p"
OUT = WriteFile(FileOut)
If Not OUT Then CloseFile(FILE) End
NCMDL$ = Replace(CMDL,FileIn,FileOut)
Local InheritOpen,Inherited.tType
Dim CurrentClose(1023)
While Not Eof(FILE)
	If Quiet = 0 Then
		PercentDone% = (Float(FilePos(FILE))/Float(FileSize("Temp.A")))*100
		AppTitle PercentDone+"%"
	EndIf
	
	Addition$ = ""
	Eol = 0
	SkipThisLine = 0
	StringOpen = 0
	CL$ = ReadLine(FILE)
	LC = LC + 1
	If Upper(Left(CL$,Len(";; NOPARSE"))) = ";; NOPARSE" Then NOPARSE = NoParse + 1 Eol = 1 SkipThisLine = 1
	If Upper(Left(CL$,Len(";; OPENPARSE"))) = ";; OPENPARSE" Then NoParse = NoParse - 1 Eol = 1 SkipThisLine = 1
	If StopNextLine = 1 Then Stop
	StopNextLine = 0
	If Upper(Left(CL$,Len(";; PARSESTOP"))) = ";; PARSESTOP" Then StopNextLine = 1 SkipThisLine = 1 Eol = 1
	If NOPARSE = 0 And SkipThisLine = 0 Then
		If InheritOpen Then
			WriteLine OUT,Inherited\Fields
			InheritOpen = 0
			Inherited = Null
		EndIf
		CommentStart = Instr(CL$,"//")
		If CommentStart Then CL$ = Left(CL$,CommentStart-1)
		CL$ = Trim(Replace(Replace( CL$, "	", "" ),"\"+Chr(34),Chr(3)+Chr(4)))
		
		For N = 1 To Len(CL$)
			KL$ = Mid(CL$,N,2)
			
			If Left(KL$,1) = Chr(34) Then StringOpen = Not StringOpen
				
			If N = Len(CL$) Then
				If Right(KL$,1) = Chr(34) Then StringOpen = Not StringOpen
			EndIf
			
			If KL$ = "//" And StringOpen = False Then
				CL$ = Left(CL$,N-1)
				
			ElseIf KL$ = "/*" And StringOpen = False
				CL$ = Left(CL$,N-1)
				CommentOpen = CommentOpen + 1
				
			ElseIf KL$ = "*/" And StringOpen = False
				CL$ = Right(CL$,Len(CL$)-(N+1))
				CommentOpen = CommentOpen - 1
				
			ElseIf CommentOpen > 0 Then
				CL$ = Right(CL$,Len(CL$)-1)
				
			ElseIf KL$ = "=="  And StringOpen = False Then
				CL$ = Left(CL$,N-1)+"= "+Right(CL$,Len(CL$)-(N+2))
				
			ElseIf KL$ = "!="  And StringOpen = False Then
				CL$ = Left(CL$,N-1)+"<> "+Right(CL$,Len(CL$)-(N+2))
				
			ElseIf KL$ = "++"  And StringOpen = False Then
				VarName$ = Trim(Left(CL$,N-1))
				CL$ = VarName+" = "+VarName+" + 1"
				Eol = 1
				
			ElseIf KL$ = "--"  And StringOpen = False Then
				VarName$ = Trim(Left(CL$,N-1))
				CL$ = VarName+" = "+VarName+" - 1"
				Eol = 1
				
			ElseIf KL$ = "+="  And StringOpen = False Then
				VarName$ = Trim(Left(CL$,N-1))
				If Right(CL$,1) = ";" Then
					CL$ = Left(CL$,Len(CL$)-1)
					Addition$ = ";"
				EndIf
				CL$ = VarName+" = "+VarName+" + "+Trim(Right(Cl$,Len(CL$)-(N+1))+Addition$)
				
			ElseIf KL$ = "-="  And StringOpen = False Then
				VarName$ = Trim(Left(CL$,N-1))
				If Right(CL$,1) = ";" Then
					CL$ = Left(CL$,Len(CL$)-1)
					Addition$ = ";"
				EndIf
				CL$ = VarName+" = "+VarName+" - "+Trim(Right(Cl$,Len(CL$)-(N+1))+Addition$)
				
			ElseIf KL$ = "*="  And StringOpen = False Then
				VarName$ = Trim(Left(CL$,N-1))
				If Right(CL$,1) = ";" Then
					CL$ = Left(CL$,Len(CL$)-1)
					Addition$ = ";"
				EndIf
				CL$ = VarName+" = "+VarName+" * ("+Trim(Right(Cl$,Len(CL$)-(N+1)))+" )"+Addition$
				
			ElseIf KL$ = "/="  And StringOpen = False Then
				VarName$ = Trim(Left(CL$,N-1))
				If Right(CL$,1) = ";" Then
					CL$ = Left(CL$,Len(CL$)-1)
					Addition$ = ";"
				EndIf
				CL$ = VarName+" = "+VarName+" / ("+Trim(Right(Cl$,Len(CL$)-(N+1)))+" )"+Addition$
				
			ElseIf KL$ = Chr(3)+Chr(4)  And StringOpen = True Then
				CL$ = Left(CL$,N-1)+Chr(34)+"+Chr(34)+"+Chr(34)+Right(CL$,Len(CL$)-(N+1))
				N = N + 11
			
			ElseIf KL$ = "->" And StringOpen = False Then
				CL$ = Left(CL$,N-1)+"\"+Right(CL$,Len(CL$)-(N+1))
				
			ElseIf KL$ = ">>" And StringOpen = False Then
				CL$ = Trim(Left(CL$,N-1))+" Shr "+Trim(Right(Cl$,Len(CL$)-(N+1)))
				
			ElseIf KL$ = "<<" And StringOpen = False Then
				CL$ = Trim(Left(CL$,N-1))+" Shl "+Trim(Right(Cl$,Len(CL$)-(N+1)))
				
			ElseIf KL$ = "||" And StringOpen = False Then
				CL$ = Trim(Left(CL$,N-1))+" Or "+Trim(Right(Cl$,Len(CL$)-(N+1)))
				
			ElseIf KL$ = "&&" And StringOpen = False Then
			CL$ = Trim(Left(CL$,N-1))+" And "+Trim(Right(Cl$,Len(CL$)-(N+1)))
			
			ElseIf Lower(Trim(Mid(CL$,N,7))) = "extends" Or Lower(Trim(Mid(CL$,N,8))) = "inherits" Then
				If Lower(Trim(Mid(CL$,N,7))) = "extends" Then
					Sub = 0
				Else
					Sub = 1
				EndIf
				InheritType$ = Lower(Trim(Right(CL$,Len(CL$)-(N+7+Sub))))
				If Right(InheritType,1) = ";" Then InheritType = Left(InheritType,Len(InheritType)-1)
				
				ThisStruct$ = Left(CL$,N-1)
				If Lower(Left(ThisStruct,5)) = "type " Then
					ThisStruct = Trim(Right(ThisStruct,Len(ThisStruct)-5))
				Else
					ThisStruct = Trim(Right(ThisStruct,Len(ThisStruct)-6))
				EndIf
				
				CL$ = Left(CL$,N-1)
				InheritOpen = 1
				
				For h.tType = Each tType
					If Lower(ThisStruct) = Lower(h\Name) Then Exit
				Next
				
				If h = Null Then RuntimeError "LINE: "+LC+Chr(10)+"COLUMN: "+N+Chr(10)+"Unable to find type "+thisStruct
				
				For Inherited.tType = Each tType
					If Trim(Lower(Inherited\Name)) = InheritType Then Exit
				Next
				
				If Inherited = Null Then RuntimeError "LINE: "+LC+Chr(10)+"COLUMN: "+N+Chr(10)+ThisStruct+" attempted to inherit nonexistant type "+InheritType
				
				h\Fields = h\Fields + Chr(10) + Inherited\Fields

				For m.Method = Each Method
					If m\T = Inherited Then
						thisMethodName$ = Left(m\Name,Instr(m\Name,"(")-1)
						If Right(thisMethodName,1) = "$" Or Right(thisMethodName,1) = "%" Or Right(thisMethodName,1) = "#" Then
							thisMethodName = Left(thisMethodName,Len(thisMethodName)-1)
						EndIf
							
						For jooba.Method = Each Method
							mName$ = Left(jooba\Name,Instr(jooba\Name,"(")-1)
							If Right(mName,1) = "$" Or Right(mName,1) = "%" Or Right(mName,1) = "#" Then
								mName = Left(mName,Len(mName)-1)
							EndIf
							
							If Lower(mName) = Lower(thisMethodName) And jooba\T = h Then Exit
						Next
						
						If jooba = Null Then
							dMt.Method = New Method
							For h.tType = Each tType
								If Lower(h\Name) = Lower(ThisStruct) Then
									dMt\T = h
									Exit
								EndIf
							Next
							dMt\Name = m\Name
							dMt\Contents = m\Contents
							If dMt\T = Null Then
								Delete dMt
								Exit
							EndIf
							POS = FilePos(FILE)
							CloseFile FILE
							FSize = FileSize("Temp.A")
							FILE = OpenFile("Temp.A")
							InMeth = Instr(dMt\Name,"(")
							OutMeth = Instr(dMt\Name,")")
							NeedComma = 0
							For N2 = InMeth To OutMeth
								AC = Asc(Upper(Mid(dMt\Name,N2,1)))
								If (AC >= 64 And AC <= 90) Or (AC >= 48 And AC <= 57) Or (AC = 34) Then
									NeedComma = 1
									Exit
								EndIf
							Next
							SeekFile FILE,FSize
							WriteLine FILE,""
							If NeedComma Then
								WriteLine FILE,"Function "+dMt\T\Name+Replace(dMt\Name,"(","(this."+dMt\T\Name+", ")
							Else
								WriteLine FILE,"Function "+dMt\T\Name+Replace(dMt\Name,"(","(this."+dMt\T\Name)
							EndIf
							WriteLine FILE,dMt\Contents+"End Function"
							SeekFile FILE,POS
						EndIf
					EndIf
				Next
			EndIf
			
			Previous$ = KL$
		Next
		VariableScope$ = ""
		
		If Lower(Left(Cl,7)) = "global " Then
			VariableScope$ = "Global "
			CL$ = Trim(Right(CL$,Len(CL$)-7))
			
		ElseIf Lower(Left(Cl,6)) = "local " Then
			VariableScope$ = "Local "
			CL$ = Trim(Right(CL$,Len(CL$)-6))
		EndIf
		
		For h.tType = Each tType
			Nem$ = Left(CL$,Len(h\Name)+1)
			If Lower(Nem$) = Lower(h\Name)+" " Then
				If Right(Cl$,1) = ";" Then
					Cl$ = Left(Cl$,Len(Cl$)-1)
					Addition = ";"
				EndIf
				VarName$ = Trim(Right(CL$,Len(CL$)-Len(Nem$)))
				CL$ = VarName+"."+Nem$+" = New "+Nem$+Addition
				For i.tTypeObject = Each tTypeObject
					If Lower(i\Name) = Lower(VarName)
						Exit
					EndIf
				Next
				
				If i = Null Then
					i.tTypeObject = New tTypeObject
					i\TypeName = h\Name
					i\Name = VarName
				EndIf
			EndIf
		Next
		
		For i.tTypeObject = Each tTypeObject
			For N = 1 To Len(CL$)
				GoOn = 0
				If N <= 1 Then
					GoOn = 1
				ElseIf Mid(CL,N-1,1) = "\" Then
					GoOn = 0
				Else
					GoOn = 1
				EndIf
				
				If N > 1 Then 
					If Trim(Mid(Cl,N-1,1)) <> "" Then
						Kooky = 0
					Else
						Kooky = 1
					EndIf
				Else
					Kooky = 1
				EndIf
				
				If Lower(Mid(CL$,N,Len(i\Name)+1)) = Lower(i\Name)+"\" And GoOn = 1 And Kooky = 1 Then
					
					LastSlash = N+Len(i\Name)
					InMeth = Instr(CL$,"(",N)
					If InMeth > N Then
						OutMeth = Instr(CL$,")",InMeth-1)
						MethodName$ = Trim(Mid(Cl$,N+Len(i\Name)+1,InMeth-(N+Len(i\Name)+1)))
						If Right(MethodName$,1) = "$" Or Right(MethodName$,1) = "#" Or Right(MethodName$,1) = "%" Then
							MethodName$ = Left(MethodName$,Len(MethodName$)-1)
						EndIf
						
						For m.Method = Each Method
							thisMethodName$ = Trim(Mid(m\Name,1,Instr(m\Name,"(")-1))
							If Right(thisMethodName$,1) = "$" Or Right(thisMethodName$,1) = "#" Or Right(thisMethodName$,1) = "%" Then
								thisMethodName$ = Left(thisMethodName$,Len(thisMethodName$)-1)
							EndIf
							If Lower(thisMethodName$) = Lower(MethodName$) And Lower(i\TypeName) = Lower(m\T\Name) Then
								If Quiet = 0 Then Print "Found call to known method "+MethodName$
								NeedComma = 0
								For N2 = InMeth To OutMeth
									AC = Asc(Upper(Mid(CL,N2,1)))
									If (AC >= 64 And AC <= 90) Or (AC >= 48 And AC <= 57) Or (AC = 34) Then
										NeedComma = 1
										Exit
									EndIf
								Next
								
								If NeedComma = 1
									CL$ = Left(CL$,N-1)+m\T\Name+thisMethodName+"("+i\Name+", "+Right(CL$,Len(CL)-InMeth)
								Else
									CL$ = Left(CL$,N-1)+m\T\Name+thisMethodName+"("+i\Name+" "+Right(CL$,Len(CL)-InMeth)
								EndIf
								Exit
							EndIf
						Next
					EndIf
				ElseIf Lower(Mid(Cl,N,4)) = "new " Then
					Constructor.Method = Null
					NewType = 1
					For m.Method = Each Method
						CName$ = Trim(Left(m\Name,Instr(m\Name,"(")-1))
						If Lower(i\TypeName) = Lower(m\T\Name) And Lower(CName) = Lower(m\T\Name) Then
							Constructor.Method = m
							Exit
						EndIf
					Next
					If Constructor <> Null Then
						For N3 = N To Len(CL$)
							If Lower(Mid(CL,N3,Len(CName)+2)) = " "+Lower(CName)+"(" Then
								LSide$ = Left(CL$,N-1)
								RSide$ = Right(CL$,Len(CL)-(N3+Len(CName)))
								CL$ = Trim(LSide)+" "+Constructor\T\Name+CName+Trim(RSide)
;								Stop
							EndIf
						Next
					EndIf
				EndIf
			Next
		Next
		NewType = 0
		CL$ = " "+Cl$
		
		For j.tTypeObjectField = Each tTypeObjectField
			For N = 1 To Len(CL$)
				If Mid(Cl$,N,1) = " " Then LastSpace = N
				If Lower(Mid(CL$,N,Len(j\Name)+1)) = "\"+Lower(j\Name) Then
					LastSlash = N+Len(j\Name)
					InMeth = Instr(CL$,"(",N)
					If InMeth > N Then
						OutMeth = Instr(CL$,")",InMeth-1)
						MethodName$ = Trim(Mid(Cl$,N+Len(j\Name)+2,InMeth-(N+1)-2))
						If Right(MethodName,1) = "(" Then MethodName = Left(MethodName,Len(MethodName)-1)
						If Right(MethodName$,1) = "$" Or Right(MethodName$,1) = "#" Or Right(MethodName$,1) = "%" Then
							MethodName$ = Left(MethodName$,Len(MethodName$)-1)
						EndIf
						
						For m.Method = Each Method
							thisMethodName$ = Trim(Mid(m\Name,1,Instr(m\Name,"(")-1))
							If Right(thisMethodName$,1) = "$" Or Right(thisMethodName$,1) = "#" Or Right(thisMethodName$,1) = "%" Then
								thisMethodName$ = Left(thisMethodName$,Len(thisMethodName$)-1)
							EndIf
							If Lower(thisMethodName$) = Lower(MethodName$) And Lower(j\TypeName) = Lower(m\T\Name) Then
								If Quiet = 0 Then Print "Found call to known method "+MethodName$
								NeedComma = 0
								For N2 = InMeth To OutMeth
									AC = Asc(Upper(Mid(CL,N2,1)))
									If (AC >= 64 And AC <= 90) Or (AC >= 48 And AC <= 57) Or (AC = 34) Then
										NeedComma = 1
										Exit
									EndIf
								Next
								If NeedComma = 1
									CL$ = Trim(Left(CL,LastSpace-1))+" "+m\T\Name+thisMethodName+"( "+Mid(CL,LastSpace,LastSlash-LastSpace+1)+", "+Trim(Right(CL$,Len(CL)-InMeth))
								Else
									CL$ = Trim(Left(CL,LastSpace-1))+" "+m\T\Name+thisMethodName+"( "+Mid(CL,LastSpace,LastSlash-LastSpace+1)+" "+Trim(Right(CL$,Len(CL)-InMeth))
								EndIf
								Exit
							EndIf
						Next
					EndIf
				ElseIf Lower(Mid(Cl,N,4)) = "new " Then
					Constructor.Method = Null
					NewType = 1
					For m.Method = Each Method
						CName$ = Trim(Left(m\Name,Instr(m\Name,"(")-1))
						If Lower(j\TypeName) = Lower(m\T\Name) And Lower(CName) = Lower(m\T\Name) Then
							Constructor.Method = m
							Exit
						EndIf
					Next
					If Constructor <> Null Then
						For N3 = N To Len(CL$)
							If Lower(Mid(CL,N3,Len(CName)+2)) = " "+Lower(CName)+"(" Then
								LSide$ = Left(CL$,N-1)
								RSide$ = Right(CL$,Len(CL)-(N3+Len(CName)))
								CL$ = Trim(LSide)+" "+Constructor\T\Name+CName+Trim(RSide)
;								Stop
							EndIf
						Next
					EndIf
				EndIf
			Next
		Next
		
		CL$ = Trim(CL$)
		
		NewType = 0
		
		Temp$ = Trim(Cl$)
		Temp2$ = Trim(Lower(Cl$))
		
		OpenScope = 0
		If Left( Temp2$,4 ) = "int " Then
			OpenArray = Instr(Temp2$,"[")
			If OpenArray = 1 Then
				NL$ = "Dim "+Trim(Replace(Replace(Right(Cl$,Len(Cl$)-4),"[","%("),"]",")"))
				Eol = 1
			Else
				L = L + 1
				CurrentClose(L) = 1
				NL$ = "Function "+Trim(Replace(Right(CL$,Len(CL$)-4),"(","%("))
				Scope = Scope + 1
				OpenScope = 1
				Eol = 1
			EndIf
		ElseIf Left( Temp2$,6 ) = "float " Then
			OpenArray = Instr(Temp2$,"[")
			If OpenArray = 1 Then
				NL$ = "Dim "+Trim(Replace(Replace(Right(Cl$,Len(Cl$)-6),"[","%("),"]",")"))
				Eol = 1
			Else
				L = L + 1
				CurrentClose(L) = 1
				NL$ = "Function "+Trim(Replace(Right(CL$,Len(CL$)-6),"(","%("))
				Scope = Scope + 1
				OpenScope = 1
				Eol = 1
			EndIf
		ElseIf Left( Temp2$,5 ) = "char " Then
			OpenArray = Instr(Temp2$,"[")
			If OpenArray = 1 Then
				NL$ = "Dim "+Trim(Replace(Replace(Right(Cl$,Len(Cl$)-5),"[","%("),"]",")"))
				Eol = 1
			Else
				L = L + 1
				CurrentClose(L) = 1
				NL$ = "Function "+Trim(Replace(Right(CL$,Len(CL$)-5),"(","%("))
				Scope = Scope + 1
				OpenScope = 2
				Eol = 1
			EndIf
		ElseIf Left( Temp2$, 7 ) = "switch " Or Left( Temp2$, 7 ) = "switch(" Or Left( Temp2$, 7 ) = "select " Then
			L = L + 1
			NL$ = "Select "+ Trim(Right(CL$,Len(CL$)-7))
			CurrentClose(L) = 4
			Scope = Scope + 2
			OpenScope = 2
			Eol = 1
		ElseIf Left( Temp2$, 3 ) = "if " Then
			NL$ = CL$
			If Right(Temp2,4) = "then" Then
				L = L + 1
				CurrentClose(L) = 2
				Scope = Scope + 1
				OpenScope = 1
			EndIf
			Eol = 1
		ElseIf Left( Temp2$,4) = "else" Or Left( Temp2$, 7 ) = "elseif " Then
			OpenScope = 1
			NL$ = CL$
		ElseIf Left( Temp2$, 6 ) = "while " Or Left( Temp2$, 6 ) = "while("
			L = L + 1
			NL$ = "While "+Trim(Right(CL$,Len(CL$)-6))
			CurrentClose(L) = 3
			Scope = Scope + 1
			OpenScope = 1
			Eol = 1
		ElseIf Left( Temp2$, 9 ) = "function " Then
			L = L + 1
			NL$ = CL$
			CurrentClose(L) = 1
			Scope = Scope + 1
			OpenScope = 1
			Eol = 1
		ElseIf Left( Temp2, 7 ) = "struct " Then
			L = L + 1
			NL$ = "Type "+Trim(Right(Cl$,Len(CL$)-7))
			CurrentClose(L) = 5
			Scope = Scope + 1
			OpenScope = 1
			Eol = 1
			StructOpen = 1
		ElseIf Left( Temp2, 5 ) = "type " Then
			L = L + 1
			NL$ = CL$
			CurrentClose(L) = 5
			Scope = Scope + 1
			OpenScope = 1
			Eol = 1
			StructOpen = 2
		ElseIf Left( Temp2, 4 ) = "for " Then
			L = L + 1
			NL$ = CL$
			CurrentClose(L) = 6
			Scope = Scope + 1
			Eol = 1
			OpenScope = 1
		ElseIf Left( Temp2, 6 ) = "repeat" Then
			L = L + 1
			NL$ = CL$
			CurrentClose(L) = 8
			Scope = Scope + 1
			Eol = 1
			OpenScope = 1
		ElseIf (Left( Temp2, 5 ) = "case " Or Left( Temp2, 7 ) = "default") And Right(Temp2, 1) = ":" Then
			EOL = 1
			OpenScope = 1
			NL$ = Left(CL,Len(CL)-1)
			L = L + 1
			CurrentClose(L) = 7
		ElseIf (Left(Temp2,5) = "case " Or Left( Temp2, 7 ) = "default") And Right(Temp2,1) <> ":" Then
			EOL = 1
			OpenScope = 1
			NL$ = CL$
			L = L + 1
			CurrentClose(L) = 7
		ElseIf Left( Temp2, 5 ) = "endif" Or Left( Temp2, 6 ) = "end if" Or Left( Temp2, 12 ) = "end function" Or Left( Temp2, 10 ) = "end select" Or Left( Temp2, 4 ) = "wend" Or Left( Temp2, 7 ) = "forever" Or Left( Temp2, 5 ) = "until" Or Left( Temp2, 4 ) = "next" Or Left( Temp2, 8 ) = "end type" Or Left( Temp2, 10 ) = "end switch" Then
			If Left( Temp2, 8 ) = "end type" Then StructOpen = 0
			EOL = 1
			Scope = Scope - 1
			If Left( Temp2$, 10 ) = "end switch" Or Left( Temp2$, 10 ) = "end select" Then Scope = Scope - 1
			NL$ = CL$
			If Left( Temp2$, 10 ) = "end switch" Then
				NL$ = "End Select"
				If Len(CL$)-10>0 Then
					NL$ = NL$ + Right(CL,Len(CL)-10)
				EndIf
			EndIf
			L = L - 1
		Else
			NL$ = CL$
		EndIf
		
		Temp$ = Trim(Cl$)
		Temp2$ = Trim(Lower(Cl$))
		
		If Left(Temp,1) = "}" Then
			Select CurrentClose(L)
				Case 1
					NL$ = "End Function"+Right(CL,Len(CL)-1)
				Case 2
					NL$ = "EndIf"+Right(CL,Len(CL)-1)
				Case 3
					NL$ = "Wend"+Right(CL,Len(CL)-1)
				Case 4
					NL$ = "End Select"+Right(CL,Len(CL)-1)
					Scope = Scope - 1
				Case 5
					NL$ = "End Type"+Right(CL,Len(CL)-1)
					StructOpen = 0
				Case 6
					NL$ = "Next"
				Case 7
					NL$ = ""
					SkipThisLine2 = 1
				Default
					NL$ = ""
					L = L + 1
					Scope = Scope + 1
			End Select
			L = L - 1
			Scope = Scope - 1
			Eol = 1	
		EndIf
		
		If StructOpen And OpenScope = False Then
			If Lower(Left(NL$,6)) <> "field " Then
				NL$ = "Field "+NL$
			EndIf
		EndIf
		
		CurrentLine$ = CurrentLine$ +" "+ VariableScope + NL$
		If (((Right(CurrentLine$,1) = ";" And UseDelimitor = 1) Or UseDelimitor = 0) Or Eol) And SkipThisLine2 = 0 Then
			CurrentLine$ = Trim(CurrentLine$)
			For N = 1 To Scope-OpenScope
				CurrentLine$ = "	"+CurrentLine$
			Next
			If Right(CurrentLine$,1) = ";" Then
				CurrentLine$ = Left(CurrentLine$,Len(CurrentLine$)-1)
			EndIf
			WriteLine OUT,Left(CurrentLine$,Len(CurrentLine$))
;			If Quiet = 0 Then Print Left(CurrentLine$,Len(CurrentLine$))
			CurrentLine$ = ""
		ElseIf Len(CL$) = 0 Then
			WriteLine( OUT, "" )
		EndIf
	ElseIf SkipThisLine = 0
		WriteLine OUT,CL$
	EndIf
	SkipThisLine2 = 0
Wend

CloseFile FILE
CloseFile OUT

ExecFile Chr(34)+Replace(GetEnv("blitzpath")+"\bin\blitzcc.exe","\\","\")+Chr(34)+" "+NCMDL$		;; uncomment and rename your blitzcc.exe to blitzcc_.exe and compile this as blitzcc.exe if you want to try your luck- it doesn't work for me, so i doubt it will for you.

Function IncludeFile(InStream,OutStream,NoParse)
	If Not InStream Then Return
	If Not OutStream Then Return
	Local h.tType,m.Method
	TFile = OutStream
	FILE = InStream
	If NoParse = 1  Then WriteLine TFile,";; NOPARSE"
	PO = NoParse
	While Not Eof(FILE)
		If Quiet = 0 Then
			T = T + 1	
			If T > 3
				AppTitle "Parsing..."
				T = 0
			ElseIf T > 2
				AppTitle "Parsing.."
			ElseIf T > 1 Then
				AppTitle "Parsing."
			EndIf
		EndIf
		CL$ = ReadLine(FILE)
			
		
		Temp$ = Trim(Replace(CL$,"	"," "))
		For N = 1 To Len(CL$)
			If (Mid(CL,N,1) = ";" And PO >= 1) Or (Mid(CL,N,2) = "//" And PO = 0) Then
				Temp$ = Trim(Left(CL,N-1))
				Exit
			EndIf
		Next
		Skippy = 0
		If Left(Temp,1) = "#" Then 	;;Preproc defs
			r$ = Lower(Right(Temp,Len(Temp)-1))
			If Left(r,7) = "define " Then
				DefVal$ = Trim(Right(r$,Len(r)-7))
				D.Def = New Def
				D\Name = DefVal
				DefCount = DefCount + 1
				D\Index = DefCount
			If Left(r,9) = "undefine "
				DefVal$ = Trim(Right(r$,Len(r)-7))
				For D.Def = Each Def
					If D\Name = DefVal Then
						Delete D
						Exit
					EndIf
				Next
			EndIf
			ElseIf Left(r,6) = "ifdef "
				DefVal$ = Trim(Right(r$,Len(r)-6))
				CurDef = CurDef + 1
				For D.Def = Each Def
					If D\Name = DefVal Then
						Defined(CurDef) = 1
						Exit
					Else
						Defined(CurDef) = 0
					EndIf
				Next
			ElseIf Left(r,7) = "ifndef "
				DefVal$ = Trim(Right(r$,Len(r)-7))
				CurDef = CurDef + 1
				For D.Def = Each Def
					If D\Name = DefVal Then
						Defined(CurDef) =0
						Exit
					Else
						Defined(CurDef) = 1
					EndIf
				Next
			ElseIf Left(r,4) = "else" And Left(r, 6) <> "elseif"
				Defined(CurDef) = Not Defined(CurDef)
			ElseIf Left(r,7) = "elseif "
				DefVal$ = Trim(Right(r$,Len(r)-7))
				If Left(DefVal$,1) = "!" Then
					Nono = 1
					DefVal = Right(DefVal,Len(DefVal)-1)
				EndIf
				If Defined(CurDef) = 0 Then
					If NoNo = 1 Then
						For D.Def = Each Def
							If D\Name = DefVal Then
								Defined(CurDef) =0
								Exit
							Else
								Defined(CurDef) = 1
							EndIf
						Next
					Else
						For D.Def = Each Def
							If D\Name = DefVal Then
								Defined(CurDef) =1
								Exit
							Else
								Defined(CurDef) = 0
							EndIf
						Next
					EndIf
				EndIf
			ElseIf Left(r,5) = "endif"
				CurDef = CurDef - 1
				CL$ = ""
			EndIf
			Skippy = 1
		EndIf
		If Skippy = 0 Then
			
			CL$ = Replace(Replace(Replace(CL$,","," , "),"(","( "),")"," )")
			If Left(Trim(Cl$),1) = "}" Or Left(Lower(Trim(CL$)),8) = "end type" Then
					TypeOpen = 0
			EndIf
			
			For N = 1 To Len(CL)
				If N < Len(CL)-2 Then
					Jd$ = Mid(CL$,N,3)
					LA = Asc(Upper(Left(Jd,1)))
					RA = Asc(Upper(Right(Jd,1)))
					MC$ = Mid(Jd,2,1)
					If ((LA >= 65 And LA <= 90) Or (LA >= 48 And LA <= 57) Or Chr(LA) = "\" Or Chr(LA) = "," Or Chr(LA) = "." Or Trim(Chr(LA)) = "" Or Chr(LA) = "(" Or Chr(LA) = ")" ) And ((RA >= 65 And RA <= 90) Or (RA >= 48 And RA <= 57) Or Chr(RA) = "\" Or Chr(RA) = "," Or Chr(RA) = "." Or Trim(Chr(RA)) = "" Or Chr(RA) = "(" Or Chr(RA) = ")" ) And Len(Trim(Chr(LA)))+Len(Trim(Chr(RA))) > 0
						If MC = "+" Or MC = "/" Or MC = "*" Or MC = "-" Then
							CL = Left(CL,N)+" "+MC+" "+Right(CL,Len(CL)-(N+1))
						EndIf
					EndIf
				EndIf
			Next
			
			If Lower(Left(Trim(Cl$),10)) = "end method" Then
				MethodOpen = 0
				m\Body = m\Body+Chr(10)+m\Contents+"End Function"
				MethodClosed = 1
			EndIf
			
			If Upper(Left(Trim(Cl$),10)) = ";; NOPARSE" Then PO = PO + 1
			If Upper(Left(Trim(CL$),12)) = ";; OPENPARSE" Then PO = PO - 1
	
			If Lower(Left(Temp$,8)) = "include " Then
				FName$ = Trim(Replace(Right(Temp$,Len(Temp$)-(8)),Chr(34),""))
				For N = 1 To Len(FName$)
					If Mid(FName$,N,1) = ";" Or Mid(FName,N,2) = "//" Then
						FName$ = Trim(Left(FName$,N-1))
						Exit
					EndIf
				Next
				Path$ = Directory+FName
				If Lower(Trim(Right(Path$,3))) = ".bb" Then
					PARSEOFF = 1
				Else
					PARSEOFF = 0
				EndIf
				NoParseOpen = PARSEOFF
				ICF = ReadFile(Path$)
				IncludeFile ICF,TFile,PARSEOFF
				If ICF Then CloseFile ICF
			ElseIf MethodOpen = 0 And MethodClosed = 0 And Defined(CurDef) = 1 Then
				If TypeOpen >= 1 Then
					If Lower(Left(Trim(Replace(CL$,"	"," ")),7)) <> "method " Then
						WriteLine TFile,CL$
					EndIf
				Else
					WriteLine TFile,CL$
				EndIf
			EndIf
			
			CL$ = Trim(Replace(CL$,"	"," "))
			
			If Lower(Left(CL$,6)) = "local " Then
				CL$ = Trim(Right(CL$,Len(CL$)-6))
			ElseIf Lower(Left(CL$,7)) = "global " Then
				CL$ = Trim(Right(CL$,Len(CL$)-7))
			ElseIf Left(CL$,4) = "for " Then
				CL$ = Trim(Right(CL$,Len(CL$)-4))
			EndIf
			NoDef = 0
			
			For N = 1 To Len(Cl$)
				If Mid(Cl$,N,2) = "//" Then
					Cl$ = Trim(Left(CL$,N-1))
					Exit
				ElseIf Mid(CL$,N,1) = "="
					NoDef = 1
				ElseIf Mid(Cl$,N,1) = " "
					NoDef = 1
				ElseIf Mid(CL$,N,1) = Chr(34)
					NoDef = 1
				ElseIf Mid(CL$,N,1) = "." And NoDef = 0
					j.tTypeObject = New tTypeObject
					j\Name = Left(CL,N-1)
					j\TypeName = Right(CL,Len(CL)-N)
					Eq = Instr(j\TypeName,"=")
					If Eq > 0 Then
						j\TypeName = Trim(Left(j\TypeName,Eq-1))
					EndIf
					If Quiet = 0 Then Print "Found type object "+j\Name+", struct "+j\TypeName
				EndIf
			Next
			
			If MethodOpen = 1 Then
				For N = 1 To Len(" "+Cl$)
					Kl$ = Mid(" "+Cl,N,2)
					If Mid(" "+Cl,N,1) = " \" And N > 4 Then
						If Lower(Mid(" "+Cl,N-4,4)) <> "this" Then
							Cl = Left(" "+Cl,N-1)+"this"+Right(" "+Cl,Len(Cl)-(N-1))
						EndIf
					ElseIf N > 1 And Mid(" "+Cl,N,2) = " \" Then
						Cl = Left(Cl,N-1)+"this"+Right(Cl,Len(Cl)-(N-1))
					ElseIf Mid(" "+Cl,N,2) = " \"
						Cl = "this"+Cl
					EndIf
				Next
				m\Contents = m\Contents + Cl$ + Chr(10)
			EndIf
			
			If MethodOpen = 0 And MethodClosed = 0 And TypeOpen > 0 Then
				NewField$ = Trim(Replace(Cl$,"	"," "))
				If Lower(Left(NewField$,7)) <> "method " Then
					If Lower(Left(NewField$,5)) = "field" Then
						NewField$ = "	"+NewField$
					Else
						NewField$ = "	Field "+NewField$
					EndIf
					If Instr(NewField,".") Then
						TypeName$ = Right(NewField,Len(NewField)-Instr(NewField,"."))
						Te.tTypeObjectField = New tTypeObjectField
						Te\TypeName = TypeName
						Te\Name = Trim(Replace(NewField,"	Field ",""))
						Te\Name = Left(Te\Name,Instr(Te\Name,".")-1)
					EndIf
					h\Fields = h\Fields+Chr(10)+NewField
					If Left(h\Fields,1) = Chr(10) Then h\Fields = Right(h\Fields,Len(h\Fields)-1)
					If Right(h\Fields,1) = ";" Then h\Fields = Left(h\Fields,Len(h\Fields)-1)
				EndIf
			EndIf
			
			If Left(Lower(Trim(Cl$)),7) = "method " Then
				MethodOpen = 1
				m.Method = New Method
				m\Name = Trim(Right(Trim(Cl$),Len(Trim(CL$))-7))
				m\T = h
				CName$ = Trim(Left(m\Name,Instr(m\Name,"(")-1))
				If Lower(CName) <> Lower(m\T\Name) Then m\Contents = "If this = Null Then Return False"+Chr(10)
				
				For N = 1 To Len(m\Name)
					If Mid(m\Name,N,1) = "," And ArgsOpen = 1 Then
						m\Arguments = m\Arguments + 1
					ElseIf Mid(m\Name,N,1) = "(" Then
						ArgsOpen = ArgsOpen + 1
					ElseIf Mid(m\Name,N,1) = ")" Then
						ArgsOpen = ArgsOpen - 1
					ElseIf Asc(Upper(Mid(m\Name,N,1))) >= 64 And Asc(Upper(Mid(m\Name,N,1))) <= 90 And ArgsOpen = 1 And m\Arguments = 0
						m\Arguments = 1
					EndIf
				Next
				ArgsOpen = 0
;				Stop
				
				If Quiet = 0 Then Print "Found method "+m\Name
			EndIf
			
			If Left(Lower(Trim(CL$)),7) = "inline " Then
				If Quiet = 0 Then Print "Inline function "+Trim(Right(Trim(CL$),Len(Trim(CL$))-7))+" found"
				CL$ = Right(Trim(CL$),Len(Trim(CL))-7)
			EndIf
			
			If Left(Lower(Trim(Cl$)),7) = "struct " Then
				h.tType = New tType
				h\Name = Trim(Right(Cl$,Len(Cl)-7))
				For N = 1 To Len(h\Name)
					If Mid(h\Name,N,1) = " " Then
						h\Name = Left(h\Name,N-1)
						h\Inherits = Trim(Right(CL$,Len(CL$)-7-Len(h\Name)))
						For N = 1 To Len(h\Inherits)
							If Lower(Mid(h\Inherits,N,9)) = "inherits" Or Lower(Mid(h\Inherits,N,8)) = "extends " Then
								If Lower(Mid(h\Inherits,N,9)) = "inherits " Then
									h\Inherits = Right(h\Inherits,Len(h\Inherits)-(N+8))
								Else
									h\Inherits = Right(h\Inherits,Len(h\Inherits)-(N+7))
								EndIf
							EndIf
						Next
						Exit
					EndIf
				Next
				TypeOpen = 2
				If Quiet = 0 Then Print "Found struct "+h\Name+", "+h\Inherits
			ElseIf Left(Lower(Trim(Cl$)),5) = "type " Then
				h.tType = New tType
				h\Name = Trim(Right(Cl$,Len(Cl)-4))
				For N = 1 To Len(h\Name)
					If Mid(h\Name,N,1) = " " Then
						h\Name = Left(h\Name,N-1)
						h\Inherits = Trim(Right(CL$,Len(CL$)-4-Len(h\Name)))
						For N = 1 To Len(h\Inherits)
							If Lower(Mid(h\Inherits,N,9)) = "inherits" Or Lower(Mid(h\Inherits,N,8)) = "extends " Then
								If Lower(Mid(h\Inherits,N,9)) = "inherits " Then
									h\Inherits = Right(h\Inherits,Len(h\Inherits)-(N+8))
								Else
									h\Inherits = Right(h\Inherits,Len(h\Inherits)-(N+7))
								EndIf
							EndIf
						Next
						j.tTypeObject = New tTypeObject
						j\TypeName = h\Name
						j\Name = "this"
						Exit
					EndIf
				Next
				TypeOpen = 1
				If Quiet = 0 Then Print "Found struct "+h\Name+", "+h\Inherits
			EndIf
			MethodClosed = 0
		EndIf
	Wend
	If NoParse = 1  Then WriteLine TFile,";; OPENPARSE"
	Return True
End Function

Comments

N2004
Added (as expected: hacked together) basic inheritance, you can't do multiple inheritance though, and inheriting properties from a type who has inherited properties from another type won't give you the properties of the first-inherited type. Yet.


N2004
Added basic methods. Methods can be inherited. Virtual methods aren't possible. You can't overload methods. Etc...

To access a field of a type inside of a method, you can either do \FieldName, this\FieldName, or this->FieldName.


AntonyWells2004
Perhaps an example?

It's not really clear how to use it or what use this has. Well, I suppose 'pointless' is an indication it has none..but still..;)


AntonyWells2004
oops, sorry, thought the first codebox was blitz code too, not the example.

nice work.


N2004
Fixed some problems with methods, made it so types that inherit a type that has already inherited another type inherits the type's new fields as well.

Though like in C/C++, you have to define the types 'in order'. And if you want to use methods with type objects, you have to predefine them (you don't have to initialize or create them though, just do "Local T.TypeName" or "Global T.TypeName" and it'll recognize it).

Methods are now somewhat properly inherited. I'm not sure if I should try to do operator overloading or not, it wouldn't be too difficult of a task. Also not sure about allowing virtual methods. Well, I'll test first and see how it works out.


Kram2004
Hi Noel,

Decided to test yours out..... Looks very interesting but im having problems getting it to work. I could use your oo parser with my blitzc parser. I compiled and ran your example code and ended up with 2 files. test.bc.bb_p and temp.a. The code in both of those files did not work with the blitzcc compiler... What am i doing wrong?

Here is the resultant code from test.bc.bb_p:

Type StructA
Field A%
Field B%
End Type

Type StructB Extends StructA
Field C%
Field D%
End Type

Type StructC Extends StructB
Field E$
Field F#
Field G%
End Type

SeedRnd(MilliSecs())

Dim K$(90)

A = 0
B = 0
C = 0

Local StructB I
Global StructA J
StructC Foo
Foo\E = "Mc^"
Foo\F = 123.456
Foo\G = 1024

Print Foo\StringItTogether()
I\A = 5
I\B += 6
I\B *= 4
I\C -= 7
I\D += 8
I\A++

F = I\Name(1)*J\Name(1)

A++
B--
C = Rand(1,20)

Print (A*C)
Print (B*C)
Print (A+B)

If (A = 1)
Print "\"A\" = 1"
Else
Print "\"A\" <> 1"
EndIf

Switch C
Case 1
Print "Case 1"

Case 2
Print "Case 2"

Case 3
Print "Case 3"

Case 4
Print "Case 4"

Default
Print "Default Case"
End Switch

Print C << 2
Print C << 3
Print C << 4
Print C << 5
Print C << 6

WaitKey

End

Function StructAName(this.StructA, Args)
If this = Null Then Return False
Return (this\A*this\B)*Args
End Function

Function StructBName2(this.StructB, Args2)
If this = Null Then Return False
this\D = this\D + Args2
End Function

Function StructCStringItTogether$(this.StructC)
If this = Null Then Return False
Print this\E+" "+this\F+" "+this\G
End Function


N2004
It looks like it's just having trouble parsing your BC file (which I assume is the same as the example code).

I'm going to take a wild guess and say that it just isn't parsing it at all as far as replacing certain blocks with useable code.

What is your BC file called? The one I took the test code is from called "fook.bc" (that is the exact case). Unfortunately, I can't do anything about this right now as far as fixing bugs goes 'cause I just replaced my two old hard drives and so I have to still reinstall everything.


N2004
Added basic preprocessor if conditions (#ifdef DEF, #ifndef DEF, #elseif [!]DEF, #else, #endif) and fixed an assortment of bugs.

Kram: I'd like to ask you to post the contents of the outputted Temp.A file or e-mail it to me.


N2004
Added constructors, fixed a lot of bugs, etc. Typical stuff.


Code Archives Forum