Simple Expression Compiler

Monkey Forums/Monkey Code/Simple Expression Compiler

GW_	(Posted 2014) [#1]

I knocked this up yesterday and thought I would share.
The code parses basic style expressions and translates to x86 assembly.
I'm not sure if the generated asm is correct or not.

lex.monkey (the lexer)

#rem
	Simple Expression compiler v0.1 by Aaron Woodard, Feb 2014 [admin@...]
	
	
	TODO: 
		Add 'else' clause to 'if'
		Check if the generated asm is even remotely correct..
		better error handling
		fix 'Float2Hex' for in Monkey
#end

Strict

Const TOK_NUMBER%=1
Const TOK_FLOAT%=2
Const TOK_PLUS%=3
Const TOK_MINUS%=4
Const TOK_MUL%=5
Const TOK_DIV%=6
Const TOK_IDENT%=7
Const TOK_EQUALS%=8
Const TOK_DBLEQUALS%=9
Const TOK_LPAREN%=10
Const TOK_RPAREN%=11
Const TOK_LBRAC%=12
Const TOK_RBRAC%=13
Const TOK_STRING%=14
Const TOK_VAR%=15
Const TOK_SEMICOL%=16
Const TOK_IF%=17
Const TOK_ELSE%=18
Const TOK_ENDIF%=19
Const TOK_LT%=20
Const TOK_GT%=21
Const TOK_LTE%=22
Const TOK_GTE%=23
Const TOK_NE%=24
Const TOK_THEN%=25 '!

Const TOK_EOF%=100


'------------------------------------------------------------------------------------------------------------------------------
Class tToken
	Field Typ%
	Field Value$
	
	Method dump:void()
		'DebugLog("Typ:"+typ+ " > '" + Value + "'")
	End Method
	
	Function Create:tToken(_typ%,_value$)
		Local t:tToken = New tToken
		t.Typ=_typ
		t.Value=_value
		Return t
	End Function
End Class
'------------------------------------------------------------------------------------------------------------------------------
 
Global CurrIdx%=0
Global CurrToke:tToken
Global NextToke:tToken
Global CodeString$

'------------------------------------------------------------------------------------------------------------------------------
Function Consume:void()
	CurrToke = NextToke
	NextToke= Toke()
	'If CurrToke Then DebugLog("CT='"+CurrToke.Value+"'")
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function Toke:tToken()
	Local t:tToken=New tToken
	Local tmp$
	
	If CurrIdx+1 > CodeString.Length Then 
		t.Typ = TOK_EOF 
		Return t
	EndIf
	
	tmp = CodeString[CurrIdx..CurrIdx+1]
	While "~t~r~n ".Contains(tmp)
		CurrIdx += 1		
		tmp = CodeString[CurrIdx..CurrIdx+1]
		If CurrIdx+1 > CodeString.Length Then 
			t.Typ = TOK_EOF
			Return t
		EndIf 
	Wend
	
	'  NUMBER
	If "1234567890.".Contains(tmp) Then
		t = LexNumber()
		If Not t Then Error("null token!")
		Return t
	EndIf
	
	' +
	If tmp = "+" Then
		CurrIdx += 1
		Return tToken.Create(TOK_PLUS,tmp)
	EndIf
	
	' -
	If tmp = "-" Then
		CurrIdx += 1
		Return tToken.Create(TOK_MINUS,tmp)
	EndIf
	
	' *
	If tmp = "*" Then
		CurrIdx += 1
		Return tToken.Create(TOK_MUL,tmp)
	EndIf
	
	' /
	If tmp = "/" Then
		CurrIdx += 1
		Return tToken.Create(TOK_DIV,tmp)
	EndIf
	
	' WORD
	
	If "abcdefghijklmnopqrstuvwxyz_".Contains(tmp) Then
		t = LexWord()
		Select t.Value
			Case "var"
				Return tToken.Create(TOK_VAR,"var")
			Case "if"
				Return tToken.Create(TOK_IF,"if")
			Case "then"
				Return tToken.Create(TOK_THEN,"then")
			Case "else"
				Return tToken.Create(TOK_ELSE,"else")
			Case "endif"
				Return tToken.Create(TOK_ENDIF,"endif")
			Default
				Return t
				'Error("Unkown token '" + t.Value + "'" )
		End Select
	EndIf
	
	' == or =
	If tmp = "=" Then		
		If CodeString[CurrIdx..CurrIdx+2] = "==" Then
			CurrIdx += 2
			Return tToken.Create(TOK_DBLEQUALS,"==")
		Else
			CurrIdx += 1
			Return tToken.Create(TOK_EQUALS,tmp)
		EndIf
	EndIf
	
	' (
	If tmp = "(" Then
		CurrIdx += 1
		Return tToken.Create(TOK_LPAREN,tmp)
	EndIf
	
	' )
	If tmp = ")" Then
		CurrIdx += 1
		Return tToken.Create(TOK_RPAREN,tmp)
	EndIf
	
	' ;
	If tmp = ";" Then
		CurrIdx += 1
		Return tToken.Create(TOK_SEMICOL,tmp)
	EndIf
	
	
	' [
	If tmp = "[" Then
		CurrIdx += 1
		Return tToken.Create(TOK_LBRAC,tmp)
	EndIf
	
	' ]
	If tmp = "]" Then
		CurrIdx += 1
		Return tToken.Create(TOK_RBRAC,tmp)
	EndIf
	
	If tmp = "<" Then
		If CodeString[CurrIdx..CurrIdx+2] = "<=" Then
			CurrIdx += 2
			Return tToken.Create(TOK_LTE,"<=")
		ElseIf CodeString[CurrIdx..CurrIdx+2] = "<>" Then
			CurrIdx += 2
			Return tToken.Create(TOK_NE,"<>")
		Else
			CurrIdx += 1
			Return tToken.Create(TOK_LT,"<")
		EndIf
	EndIf
	
	If tmp = ">" Then
		If CodeString[CurrIdx..CurrIdx+2] = ">=" Then
			CurrIdx += 2
			Return tToken.Create(TOK_GTE,">=")
		Else
			CurrIdx += 1
			Return tToken.Create(TOK_GT,">")
		EndIf
	EndIf

	If tmp = "~q" Then
		t=LexString()
		CurrIdx += 1
		Return t 
	EndIf

	Error("Unknown Token '" + tmp + "'")
	Return null
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function LexNumber:tToken()
	Local t:tToken=New tToken
	Local tmp$
	Local dotcount%=0
	
	While "1234567890.".Contains(CodeString[CurrIdx..CurrIdx+1])
		If CodeString[CurrIdx..CurrIdx+1] = "." Then dotcount += 1
		If dotcount > 1 Then Error("Malformed number! '" + tmp + "'")
		tmp += CodeString[CurrIdx..CurrIdx+1]
		CurrIdx += 1
	Wend
	t.Typ = TOK_FLOAT
	t.Value = tmp
	Return t
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function LexWord:tToken()
	Local t:tToken=New tToken
	Local tmp$
	While "abcdefghijklmnopqrstuvwxyz_".Contains(CodeString[CurrIdx..CurrIdx+1])
		tmp += CodeString[CurrIdx..CurrIdx+1]
		CurrIdx += 1
	Wend
	t.Typ = TOK_IDENT
	t.Value = tmp
	Return t
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function LexString:tToken()
	Local t:tToken=New tToken
	Local tmp$
	Local endt$
	CurrIdx += 1

	Repeat
		tmp += CodeString[CurrIdx..CurrIdx+1]
		CurrIdx += 1
	Until "~r~n~q".Contains(CodeString[CurrIdx..CurrIdx+1])
	endt = CodeString[CurrIdx..CurrIdx+1]	
	
	If endt = "~q" Then
		t.Typ = TOK_STRING
		t.Value = tmp
		Return t
	EndIf
	
	If "~r~n".Contains(endt) Then
		Error("Malformed string literal '" + tmp + "'")
	Endif
	Return t
End Function
'------------------------------------------------------------------------------------------------------------------------------

parser.monkey

#rem
	Simple Expression compiler v0.1 by Aaron Woodard, Feb 2014 [admin@...]
	
	
	TODO: 
		Add 'else' clause to 'if'
		Check if the generated asm is even remotely correct..
		better error handling
		fix 'Float2Hex' for in Monkey
#end

Strict

Import lex

Global num_numbers#[]
Global vars$[]
Global cLabels%
Global asmstring$


Function Main:Int()
	Print("Parsing..")
	
	CodeString = 	"var x;~n"
	CodeString += 	"var myvar;~n"
	CodeString += 	"var anothervar;~n"
	CodeString += 	"x=0.5*2;~n"
	CodeString += 	"if(x>1) then~n"
	CodeString += 	"	myvar=1+2-3*4/5;~n"
	CodeString += 	"	if(myvar==1.1) then~n"
	CodeString += 	"		anothervar=x*(myvar+123.456)*0.1;~n"
	CodeString += 	"	endif~n"
	CodeString += 	"endif~n"
	
	
	Print "~n--------------------~n"+CodeString+"~n--------------------~n"
	Consume()
	Consume()
	Parse()
	
	Print prolog()
	Print asmstring
	Print epilog()
	Print datasec()
	
	
	Return 1
End Function




'------------------------------------------------------------------------------------------------------------------------------
Function Parse:Void()
	'// var... or x=... or if(...
	While  CurrToke.Typ <> TOK_EOF And (CurrToke.Typ = TOK_VAR Or (CurrToke.Typ = TOK_IDENT And NextToke.Typ = TOK_EQUALS) Or CurrToke.Typ = TOK_IF)
		If CurrToke.Typ = TOK_VAR Then
			DeclareVar()
		ElseIf CurrToke.Typ = TOK_IDENT And NextToke.Typ = TOK_EQUALS Then
			Assignment()		
		ElseIf CurrToke.Typ = TOK_IF Then
			IfExpression()		
		EndIf
	Wend
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function DeclareVar:void()
	Local idx%
	Local v$
	If CurrToke.Typ = TOK_VAR Then
		Consume()
		If CurrToke.Typ = TOK_IDENT Then 
			If checkvars(CurrToke.Value) Then DoError("Already Defined '"+CurrToke.Value+"'")
			v=CurrToke.Value
			'vars += [v]
			vars = AppendSArray(vars,v)
			Consume()
			If CurrToke.Typ <> TOK_SEMICOL Then DoError("missing ';'")
			Consume()
		EndIf
	EndIf
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function Assignment:void()
	Local idx%
	Local v$
	While CurrToke.Typ = TOK_IDENT And NextToke.Typ = TOK_EQUALS 
		v=CurrToke.Value
		Consume()
		If CurrToke.Typ = TOK_EQUALS Then	
			Consume()
			Expression()
			idx = getvarindex(v)
			If idx<0 Then DoError("invalid var  '"+v+"'")
			addasm("	fstp dword [ebp-" + (4+idx*4) + "]		;store in "+v )
			
			If CurrToke.Typ <> TOK_SEMICOL Then DoError("missing ';'")
			Consume()
		EndIf
	Wend
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function Expression:void()
	AddExpression()
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function IfExpression:void()
	Local labElseif$ 
	Local labEndif$
	Local cond$[1]
	 
	While CurrToke.Typ = TOK_IF 
		If CurrToke.Typ = TOK_IF Then

			labEndif= MakeLabel("_endif")
			
			Consume()
			If CurrToke.Typ <> TOK_LPAREN Then
				DoError("Expected '('" )
			EndIf
			Consume()
						
			CondExpression(cond)
			
			If CurrToke.Typ <> TOK_RPAREN Then
				DoError("Expected ')'" )
			EndIf
			Consume()
			'Then
			If CurrToke.Typ <> TOK_THEN Then
				DoError("Expected 'then'" )
			EndIf
			Consume()
			
			addasm("	fxch")
			addasm("	fucompp")
			addasm("	fnstsw ax")
			addasm("	sahf")
		
			Select cond[0]
				Case ">"
					addasm("	setbe al")
				Case "<"
					addasm("	setae al")
				Case ">="
					addasm("	setb al")
				Case "<="
					addasm("	seta al")
				Case "=="
					addasm("	setnz al")
				Case "<>"
					addasm("	setz al")
				Default
					DebugLog("What!?")
			End Select
			
			addasm("	movzx eax,al")
			addasm("	cmp eax,0")
			addasm("	jne "+labEndif)
			
			Parse()
			
			If CurrToke.Typ <> TOK_ENDIF Then
				DoError("Expected 'endif'" )
			EndIf
			addasm(labEndif)
			Consume()
		EndIf
	Wend
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function CondExpression:void(cond$[])
	Expression()
	If CurrToke.Typ <> TOK_LT And CurrToke.Typ <> TOK_GT And CurrToke.Typ <> TOK_LTE And CurrToke.Typ <> TOK_GTE And CurrToke.Typ <> TOK_NE And CurrToke.Typ <> TOK_DBLEQUALS Then
		DoError("Expected '<,>,<=,>=,<>,=='" )
	EndIf
	
	Select CurrToke.Value
		Case ">","<",">=","<=","==","<>"
			cond[0] = CurrToke.Value
		Default 
			DoError("Unkown token")
	End Select
	 
	Consume()
	Expression()
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function AddExpression:void()
	If CurrToke.Typ<>TOK_MINUS And CurrToke.Typ<> TOK_LPAREN And CurrToke.Typ<> TOK_FLOAT And CurrToke.Typ<>TOK_IDENT Then DoError("Expected '-' or '(' or number or ident'")
	 
	MulExpression()
	While CurrToke.Typ = TOK_PLUS 'Then
		Consume()
		MulExpression()
		addasm("	faddp ")
	Wend
	While CurrToke.Typ = TOK_MINUS 'Then
		Consume()
		MulExpression()
		addasm("	fsubp ")
	Wend
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function MulExpression:void()
	If CurrToke.Typ<>TOK_MINUS And CurrToke.Typ<> TOK_LPAREN And CurrToke.Typ<> TOK_FLOAT And CurrToke.Typ<>TOK_IDENT Then DoError("Expected '-' or '(' or number or ident'")
	Primary()
	While CurrToke.Typ = TOK_MUL 'Then
		Consume()
		Primary()
		addasm("	fmulp ")
	Wend
	While CurrToke.Typ = TOK_DIV 'Then
		Consume()
		Primary()
		addasm("	fdivp ")
	Wend
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function Primary:void()
	Local idx%,v$
	If CurrToke.Typ<>TOK_MINUS And CurrToke.Typ<> TOK_LPAREN And CurrToke.Typ<> TOK_FLOAT And CurrToke.Typ<>TOK_IDENT Then DoError("Expected '-' or '(' or number or ident'")
	While CurrToke.Typ = TOK_MINUS
		Consume()
		If CurrToke.Typ = TOK_FLOAT Then
			CurrToke.Value= String(-Float(CurrToke.Value))
		Else 
			Expression()
			addasm("	fchs")	
		End If
	Wend
	
	While CurrToke.Typ = TOK_LPAREN 		
		Consume()
		Expression()
		If CurrToke.Typ <> TOK_RPAREN Then DoError("!!")
		Consume() 
	Wend
	
	While CurrToke.Typ = TOK_FLOAT 
		addasm("	fld dword [_" + addorgetnum(CurrToke.Value) +"]")
		Consume()
	Wend
	
	While CurrToke.Typ = TOK_IDENT
		v=CurrToke.Value 
			idx = getvarindex(v)
			If idx<0 Then DoError("unkown var '"+v+"'")
			addasm("	fld dword [ebp-"+(4+idx*4)+"]			;load '"+v+"'" )
			Consume()
		Return 
	Wend
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function DoError:Void(s$)
	Local v$[] = vars
	Print("ERR!  " + s)
	DebugStop	
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function dbg:void(s$)
	'Print("dbg:  " + s)
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function FloatHex:String(num:Float) 
	Return num
'oh monkey.. u dirty beast!	
'	Local p:Float Ptr = Varptr num
'	Local bp:Byte Ptr = Int Ptr Int(p)
'	Local out:String = ""
	
'	out+=Right(Hex(bp[3]), 2)
'	out += Right(Hex(bp[2]),2)
'	out += Right(Hex(bp[1]),2)
'	out += Right(Hex(bp[0]),2)
'	Return "0x" + out
End Function 
'------------------------------------------------------------------------------------------------------------------------------
Function addorgetnum%(v$)
	For Local i% = 0 Until num_numbers.Length
		If num_numbers[i] = Float(v) Then
			Return i
		Endif
	Next
	num_numbers = AppendFArray( num_numbers,Float(v) )
	Return num_numbers.Length-1 'num_numbers[num_numbers.Length-1]
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function checkvars%(v$)
	If Not vars.Length Then Return False
	For Local i% = 0 Until vars.Length
		If v=vars[i] Then Return True
	Next
	Return False
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function getvarindex%(v$)
	For Local i% = 0 Until vars.Length
		If vars[i]=v Then 
			Return i
		EndIf
	Next
	Return -1
End Function

'------------------------------------------------------------------------------------------------------------------------------
Function addasm:void(s$)
	asmstring += s + "~n"
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function prolog$()
	Local tmp$
	tmp = ";------Begin------;~n_func:~n"
	tmp += "	push ebp~n~tmov ebp,esp~n"
	If vars.Length Then
		tmp += "	sub esp, " + (vars.Length*4)
	EndIf 
	Return tmp
End Function	
'------------------------------------------------------------------------------------------------------------------------------
Function epilog$()
	Local tmp$
	tmp = "	mov esp,ebp~n~tpop ebp~n~tret~n;------End------;"
	Return tmp
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function datasec$()
	Local tmp$
	tmp ="~nsection ~qdata~q~n"
	For Local i% = 0 Until num_numbers.Length
		tmp += "_"+i+":~n"
		tmp +="dw " + FloatHex(num_numbers[i]) + "~n"'"		;-> "+num_numbers[i]+"~n"
		tmp +="align 4~n"
	Next
	Return tmp
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function MakeLabel$(pre$="_")
	cLabels += 1
	Return pre + String(cLabels) +":"
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function AppendSArray$[](a$[], val$)
	a=a.Resize(a.Length+1) 
	a[a.Length-1]=val
	Return a
End Function
'------------------------------------------------------------------------------------------------------------------------------
Function AppendFArray#[](a#[], val#)
	a=a.Resize(a.Length+1)
	a[a.Length-1]=val
	Return a
End Function

Sammy

(Posted 2014) [#2]

I have no use for this whats-so-ever but I did enjoy flicking through the code, very interesting, thank you!