Math function graph

[Michael Vogel]

Please feel free to use this math parser in your code. It handles all basic math expressions correctly, including those mentioned above by Stargate.

Thanks John, this could be a big help.
As soon I've more time I will look into it in detail. I am not sure how to continue with the program, maybe it would be more effective to convert the expression to RPN logic so calculating each dot would not need extra parsing. This should speed everything up hopefully.

Before that the expression logic should be defined, adding some math functions wouldn't be a big deal, but I don't know if I should change the actual syntax which for example looks like (x<4&x>0)*sqr(x) + (x>=4)*(sin(x-4)/4+2) to something like 0<x<4: sqr(x), 4<=x: sin(x-4)/4+2. Otherwise this would block ":" which is used actually to split expressions.

Anyhow your code could do the parsing already (except variable names) and there's another fine code by jacdelad here - so I'd like to have much more time now .

[infratec]

Still if I implement all your changes the code stucks:

(x+5)*(x-3)*(x-10)/25.0
Path 1
Path 2
Sin(-PI/2/(X+0.2))
Path 1
Path 2
1/x
Path 1

Depth is increased endless inside

Code: Select all

If tuning And Abs((*P1\Y+*P3\Y-2*P2\Y)) > Resolution/Abs(*P1\X-*P3\X)

PB 6.20 b2 x86 and x64 assembler backend on Win10 x64.
But I think it is not a problem of the OS.

The only possibility to avoid this is:

Code: Select all

If tuning And Abs((*P1\Y+*P3\Y-2*P2\Y)) > Resolution/Abs(*P1\X-*P3\X) And Abs(*P1\Y) < Plot\MaxY

But also your plot is wrong. There should be no connection between -y and +y at x=0

https://www.geogebra.org/graphing

[Michael Vogel]

As said, there are no endless loops here, see program (PB6.04/Windows/64bit).

The plot is done by using all numeric results and so it wont show the algebraic reality. As said before, the vector drawing library seems to have problems with high numbers as well and there is no intention to ignore this fact (e.g. see DontPanic). So the resulting plot does look as expected.

[infratec]

As said, there are no endless loops here, see program (PB6.04/Windows/64bit).

The plot is done by using all numeric results and so it wont show the algebraic reality. As said before, the vector drawing library seems to have problems with high numbers as well and there is no intention to ignore this fact (e.g. see DontPanic). So the resulting plot does look as expected.

Sorry to say this, but ....
the plot is wrong. Even if ths is expected by you, the result is not usable. If your child draw this in this way in a test in school: 0 points.
What sense does this math plot have, if the algebraic result does not show the reality?

Picture from your exe (6.04):


And if there is no possibility for an endless loop, then PB 6.20 b2 has a bug.

[infratec]

With PB 6.20 b2 asm backend endless loop:



The value of *P1 never changes again.

[AZJIO]

I've tried it several times, only now I decided to try "C Backend", now it works.

[Michael Vogel]

Actually I don't have enough time to change the evalution method to an optimized version (parsing, converting from infix to postfix, calculating). When I'll have some time to do so, it could be that I'll change the dynamic point creation to something like this:

Code: Select all

depth=2

Structure xtype
	x.d
	y.d
EndStructure

Procedure half(depth,List X.xtype(),*A.xtype,*B.xtype)
	
	Protected *M.xtype
	
	ChangeCurrentElement(X(),*A)
	AddElement(X())
	X()\x=(*A\x+*B\x)/2
	X()\y=X()\x*X()\x
	*M=X()
	
	If depth>1
		If Abs(*A\y-*M\Y)>15
			half(depth-1,X(),*A,*M)
		EndIf
		If Abs(*M\Y-*B\Y)>15
			half(depth-1,X(),*M,*B)
		EndIf
	EndIf

EndProcedure


NewList x.xtype()

AddElement(x())
x()\x=9
x()\y=81
*P1=x()

AddElement(x())
x()\x=17
x()\y=289
*P2=x()

half(depth,x(),*P1,*P2)

ResetList(X())
While NextElement(X())
	Debug StrD(X()\x,2)+" -- "+StrD(X()\y,2)
	n+1
Wend
Debug Str(n)+" dots, "+Str(Pow(2,depth)+1-n)+" removed."

Actually, I'd need to unwrap the recursion because the calculation has do be done there to decide if an additional point is needed or not.

Meanwhile there might be a simple possibility to avoid the problem of an endless loop: increase the (static) samples but set the dynamic precision to zero. In the exe file this can be easily done because it includes some additional keyboard shortcuts and creates a preference file as well.

Maybe I will post the full source here when all things are done. Before doing so, a warning message should also be added that the program is not recommended for children without supervision.

Parsing will be done in two steps, within the first path the string will be grouped into items (variable names, functions, numbers, brackets), then in the second path a full syntax check will be done. Because I had some minutes I started to write a simple version which should handle numbers correctly - hopefully...

Code: Select all

; Define

	EnumerationBinary
		#FlagSign;		-
		#FlagNumber;		0-9
		#FlagNumberActive;				number.s
		#FlagDot;			.
		#FlagNoDot;					no . allowed
		#FlagExponent;		e
		#FlagExponentSign;	e-
		#FlagNumberNeeded;				value after exponent
		#FlagNoExponent;				no more e allowed
		#FlagFunction;		-+*/^!%\
		#FlagSymbol;		a,b,c, sin
		#FlagSymbolActive;				symbol.s
		#FlagOpenBracket;	(
		#FlagCloseBracket;	)
	EndEnumeration

	#FlagStart=#FlagSign|#FlagNumber|#FlagSymbol|#FlagOpenBracket

	#BinaryMaxBits=SizeOf(Integer)<<3-1
	#BinaryBitMask=1<<#BinaryMaxBits-1

	Procedure SetFlag(*value.Integer,flag)

		*value\i | (flag)

	EndProcedure
	Procedure ClrFlag(*value.Integer,flag)

		*value\i & (#BinaryBitMask!(flag))

	EndProcedure

; EndDefine

Macro EvalNumber()

	If flag&#FlagNumberActive
		If flag&#FlagNumberNeeded
			Debug "ERROR - Number missing"
			Break
		Else
			ClrFlag(@flag,#FlagNumberActive|#FlagExponent|#FlagNoExponent|#FlagExponentSign|#FlagDot|#FlagNoDot)
			Debug "NUMBER "+number
			number=""
		EndIf
	EndIf

EndMacro
Macro EvalSymbol(mode=#Null)

	If flag&#FlagSymbolActive
		ClrFlag(@flag,#FlagSymbolActive)
		If mode
			Debug "FUNCTN "+symbol+"("
		Else
			Debug "SYMBOL "+symbol
		EndIf
		symbol=""
	EndIf

EndMacro

Procedure EvalParser(f.s)

	Protected *c.Character
	Protected flag
	Protected number.s
	Protected symbol.s

	f=LCase(f)

	*c=@f
	flag=#FlagStart


	Repeat
		;Debug Chr(*c\c)
		Select *c\c

		Case '-'
			If flag&#FlagExponentSign
				flag!#FlagExponentSign
				Debug "Exponent Sign"
				number+"-"

			ElseIf flag&#FlagSign
				Debug "(SIGN) -"
				If number="-"
					number=""; Remove mutiple minus
				Else
					number+"-"
				EndIf

			ElseIf flag&#FlagFunction
				EvalNumber()
				Debug "SYMBOL -"
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
			Else
				Debug "Error - No '-' allowed"
				Break
			EndIf


		Case '+','*','/','^','%','!','='
			EvalNumber()
			EvalSymbol()

			If flag&#FlagFunction
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				Debug "SYMBOL "+Chr(*c\c)
			Else
				Debug "Error - no math symbol allowed"
				Break
			EndIf


		Case '0' To '9'
			If flag&#FlagNumber
				number+Chr(*c\c)
				SetFlag(@flag,#FlagFunction|#FlagNumberActive|#FlagCloseBracket)
				ClrFlag(@flag,#FlagNumberNeeded|#FlagSign|#FlagOpenBracket)
				If flag&(#FlagDot|#FlagNoDot)=0
					SetFlag(@flag,#FlagDot)
				EndIf
				If flag&#FlagNoExponent
					ClrFlag(@flag,#FlagExponentSign)
				ElseIf flag&#FlagNoExponent=0
					SetFlag(@flag,#FlagExponent)
				EndIf
			Else
				Debug "ERROR - no digit expected"
				Break
			EndIf


		Case '.'
			If flag&#FlagDot
				number+"."
				flag!#FlagDot|#FlagNoDot
			Else
				Debug "Error - No '.' allowed"
				Break
			EndIf

		Case 'a' To 'z'
			If *c\c='e' And flag&#FlagExponent
				number+"e"
				flag=#FlagExponentSign|#FlagNoExponent|#FlagNumber|#FlagNoDot|#FlagNumberNeeded
			ElseIf flag|#FlagSymbol
				symbol+Chr(*c\c)
				SetFlag(@flag,#FlagFunction|#FlagSymbolActive|#FlagCloseBracket)
			Else
				Debug "Error - No character allowed"
			EndIf

		Case '('
			If flag&#FlagOpenBracket
				If flag&#FlagSymbolActive
					EvalSymbol(#True)
					;Debug "FUNCTN ("
				Else
					Debug "BRACKT ("
				EndIf
			Else
				Debug "Error - No '(' allowed"
				Break
			EndIf
		Case ')'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagCloseBracket
				Debug "BRACKT )"
				ClrFlag(@flag,#FlagNumber)
			Else
				Debug "Error - No ')' allowed"
				Break
			EndIf


		Case #Null
			EvalNumber()
			EvalSymbol()
			Break

		EndSelect

		*c+SizeOf(Character)
	ForEver


EndProcedure

EvalParser("abc+(sin(123))-1.23+(-1.e1)+2*3-7+8)")

[Michael Vogel]

Parsing of a single expression does work fine now (not perfect) and creates already a code which could easily be used for calculating.

At the end something like the following code should be created for an expression like -10<x<=5: a=pi/2; y=sin(a*x); 5<x: 1/x:

Code: Select all

	; Code:
	;	Command	Info	Value		Remarks
	;	--------------------------------------------------------------
	; 	RangeMin	GT	-10.000
	;	RangeMin	LEQ	5.000
	;	Next		line 			*
	;	Recall	3				pi
	;	Value		2.000
	;	Operation	/
	;	Store	4				a (dynamic register number)
	;	Recall	4
	;	Recall	1				X
	;	Operation	*
	;	Function	sin
	;	Result					Store Y -> exit
	;*	RangeMin	GT	5.000
	;	RangeMax	LT	+Infinity
	;	Next		0				no more expressions
	;	Value		1.000
	;	Recall	1				X
	;	Operation	/
	;	Result					Store Y -> exit
	;	End

After the code has been created it will be very fast to calculate Y for each X values. The result of the expression will be "saved" to Y (or register '0') if there no other assignment is done (e.g. test=2*pi).

Actually only one expression is converted to code (so ';' and ':' aren't checked), also the intervall for X (e.g. -10<x<10) is not interesting for now.

I am not sure if my source code does contain errors, but it should work fine for the following things:

• recognize numbers (1, -2.5, 1e10, 1e-5) and number errors (1.2.2, 1e2.2,...)
• knows math operations and some functions (+, -, *, /, ^, !, sin, cos,...)
• should understand brackets ( and )
• I have added two functions (min, max) which should accept any number of parameters (e.g. min(1,2,3,4,5) ).

There's (at least) one unsolved problem, the program does NOT catch unfinished expressions for now, so "1+" or "1+(" does not show an error at the moment.

Maybe someone will have some additional time for testing (or even better: optimizing) the code, my next time slot for doing so is far away...
...when parsing and code generation seems to be bullet proof, multiple expressions and the intervall check has to be done before the fun part will take place: a "Calculator" which executes the code and the integration in the function graph program.

Code: Select all

; Define

	EnableExplicit

	#MaxEvalRegisters=	100;			y,x,e,pi,affe,baer,cebu,...
	#MaxEvalHeap=		100;			Stack
	#MaxEvalBrackets=	50;			([{...}])
	#MaxEvalParameter=	25;			Min(p1,p2,...pn)


	Structure TokenType
		Type.i
		Content.s
	EndStructure

	Structure CodeType
		Command.i
		Info.i
		Value.d
	EndStructure

	Structure EvalType
		Register.i
	EndStructure

	Global Eval.EvalType
	Global Dim EvalRegValue.d(#MaxEvalRegisters)
	Global Dim EvalRegNames.s(#MaxEvalRegisters)

	EvalRegNames(0)="y"
	EvalRegNames(1)="x"
	EvalRegNames(2)="e"
	EvalRegNames(3)="pi"
	Eval\Register=3

	Enumeration
		#TypeNumber
		#TypeSymbol
		#TypeFunction
		#TypeOperation
		#TypeAssignment
		#TypeOpenBracket
		#TypeCloseBracket
		#TypeComma
	EndEnumeration

	Enumeration
		; Doubles
		#CmndValue;			123.456e78
		
		; Range for X
		#CmndRangeMin;			-10<x
		#CmndRangeMax;			x<10
		#CmndRangeNext;		Code line (für nächste Range)
		
		; Operations
		#CmndPlus;			+
		#CmndMinus;			-
		#CmndMultiply;			*
		#CmndDivide;			/
		#CmndPower;			^
		#CmndFactorize;		!
		
		; Special functions
		#CmndRecall;			x, pi, e, a,...
		#CmndStore;			a=
		#CmndBracket;			(			Heap only
		#CmndComma;			,			Heap only?
		
		; Functions with one parameter
		#CmndFnSin;			sin(
		#CmndFnCos;			cos(
		#CmndFnTan;			tan(
		#CmndFnLog;			log(
		#CmndFnLn;			ln(
		
		; Functions with multiple parameters
		#CmndFnMin;			max(a,...)
		#CmndFnMax;			max(a,...)
		
		; Function list ends here.
		#CmndFnEnd;			----
	EndEnumeration

	Enumeration
		#LevelNil
		#LevelBracket;			( ( ( (
		#LevelOne;			+ -
		#LevelTwo;			* /
		#LevelThree;			^
		#LevelFour;			!
	EndEnumeration

	Enumeration -666
		;#ErrorNoErrors
		#ErrorMissingNumber
		#ErrorWrongMinus
		#ErrorWrongOperator
		#ErrorWrongNumber
		#ErrorWrongDot
		#ErrorWrongComma
		#ErrorWrongCharacter
		#ErrorWrongOpenBracket
		#ErrorWrongCloseBracket
		#ErrorWrongAssignment
		#ErrorIllegalCharacter
		#ErrorIllegalAssignment
		#ErrorToManyRegisters
		#ErrorVariableLocked;			Recall Y forbidden
		#ErrorExpressionToComplex
		#ErrorUnknownFunction
		#ErrorUnknownError
	EndEnumeration

	EnumerationBinary
		#FlagSign;		-
		#FlagNumber;		0-9
		#FlagNumberActive;				number.s
		#FlagDot;			.
		#FlagNoDot;					no . allowed
		#FlagExponent;		e
		#FlagExponentSign;	e-
		#FlagNumberNeeded;				value after exponent
		#FlagNoExponent;				no more e allowed
		#FlagFunction;		-+*/^!%\
		#FlagSymbol;		a,b,c, sin
		#FlagSymbolActive;				symbol.s
		#FlagOpenBracket;	(
		#FlagCloseBracket;	)
	EndEnumeration

	#FlagStart=#FlagSign|#FlagNumber|#FlagSymbol|#FlagOpenBracket

	#BinaryMaxBits=SizeOf(Integer)<<3-1
	#BinaryBitMask=1<<#BinaryMaxBits-1

	Procedure SetFlag(*value.Integer,flag)

		*value\i | (flag)

	EndProcedure
	Procedure ClrFlag(*value.Integer,flag)

		*value\i & (#BinaryBitMask!(flag))

	EndProcedure

	Macro ExitIf(condition)
		If condition
			Break
		EndIf
	EndMacro

; EndDefine

CompilerIf #PB_Compiler_Debugger
	Macro CmdStr(number); Debug
		StringField("Val.Rg-.Rg+.Gto.'+'.'-'.'*'.'/'.'^'.'!'.Rcl.Sto.'('.','.Sin.Cos.Tan.Log.Ln .Min.Max.???",(number)+1,".")
	EndMacro
CompilerEndIf

Macro AddCode(vcmnd,vinfo,vvalue)

	Debug "Add Code "+Str(line)+" = "+CmdStr(vcmnd)+", "+Str(vinfo)+", "+StrD(vvalue)

	ReDim Code(line)
	Code(line)\Command=		vcmnd
	Code(line)\Info=		vinfo
	Code(line)\Value=		vvalue
	line+1

EndMacro
Macro AddHeap(vcmnd,vinfo)

	heap+1
	
	If heap>#MaxEvalHeap
		ProcedureReturn #ErrorExpressionToComplex
	EndIf
	
	Debug "Add Heap "+Str(heap)+" = "+CmdStr(vcmnd)+", Level "+Str(vinfo)

	; ReDim Heap(heap)
	Heap(heap)\Command=		vcmnd
	Heap(heap)\Info=		vinfo

EndMacro

Macro AddToken(vtype,vcontent)

	Debug "Add Token "+Str(count)+" = "+Str(vtype)+", "+vcontent

	ReDim Token(count)
	Token(count)\Type=		vtype
	Token(count)\Content=	vcontent
	count+1

EndMacro
Macro EvalNumber()

	If flag&#FlagNumberActive
		If flag&#FlagNumberNeeded
			Debug "ERROR - Number missing"
			ProcedureReturn #ErrorMissingNumber
		Else
			ClrFlag(@flag,#FlagNumberActive|#FlagExponent|#FlagNoExponent|#FlagExponentSign|#FlagDot|#FlagNoDot)
			AddToken(#TypeNumber,number)
			Debug "NUMBER "+number
			number=""
		EndIf
	EndIf

EndMacro
Macro EvalSymbol(mode=#Null)

	If flag&#FlagSymbolActive
		ClrFlag(@flag,#FlagSymbolActive)
		If mode
			AddToken(#TypeFunction,symbol+"(")
			Debug "FUNCTN "+symbol+"("
		Else
			AddToken(#TypeSymbol,symbol)
			Debug "SYMBOL "+symbol
		EndIf
		symbol=""
	EndIf

EndMacro

Procedure.i EvalRegister(name.s)

	Protected n=Eval\Register

	While n>=0
		ExitIf (name=EvalRegNames(n))
		n-1
	Wend

	If n>=0
		ProcedureReturn n
	EndIf

	If Eval\Register=#MaxEvalRegisters
		ProcedureReturn #ErrorToManyRegisters
	EndIf

	Eval\Register+1
	EvalRegNames(Eval\Register)=name

	Debug "Add Var  "+Str(Eval\Register)+" = '"+name+"'"

	ProcedureReturn Eval\Register

EndProcedure
Procedure.i EvalCoder(count.i,Array Token.TokenType(#True),Array Code.CodeType(#True))

	Protected n
	Protected r
	Protected line
	Protected cmnd
	Protected info
	Protected heap
	Protected open
	Protected save
	Protected levl
	Protected Dim Heap.CodeType(#MaxEvalHeap)
	Protected Dim Comm.i(#MaxEvalBrackets)

	Heap(#Null)\Info=#Null

	While n<count
		Select Token(n)\Type

		Case #TypeNumber
			AddCode(#CmndValue,#Null,ValD(Token(n)\Content))

		Case #TypeOperation
			Select Token(n)\Content
			Case "+"
				cmnd=#CmndPlus
				info=#LevelOne
			Case "-"
				cmnd=#CmndMinus
				info=#LevelOne
			Case "*"
				cmnd=#CmndMultiply
				info=#LevelTwo
			Case "/"
				cmnd=#CmndDivide
				info=#LevelTwo
			Case "^"
				cmnd=#CmndPower
				info=#LevelThree
			Case "!"
				cmnd=#CmndFactorize
				info=#LevelFour
			Default
				line=#ErrorUnknownError
				Break
			EndSelect

			While info<Heap(heap)\Info
				AddCode(Heap(heap)\Command,#Null,#Null)
				heap-1
			Wend
			AddHeap(cmnd,info)

		Case #TypeOpenBracket
			levl+1
			If levl>#MaxEvalBrackets
				ProcedureReturn #ErrorExpressionToComplex
			EndIf
			AddHeap(#CmndBracket,#LevelBracket)

		Case #TypeCloseBracket
			While heap
				Select Heap(heap)\Command
				Case #CmndFnSin To #CmndFnEnd
					AddCode(Heap(heap)\Command,Comm(levl)+1,#Null)
					heap-1
					Break
				Case #CmndBracket;,#cmnd
					heap-1
					Break
				Default
					AddCode(Heap(heap)\Command,#Null,#Null)
					heap-1
					If heap=#Null
						Debug "ERROR - Brackets"
						line=#ErrorWrongCloseBracket
						Break
					EndIf
				EndSelect
			Wend
			Comm(levl)=0
			levl-1

		Case #TypeSymbol,#TypeAssignment
			r=EvalRegister(Token(n)\Content)
			If Token(n)\Type=#TypeAssignment
				save=r
			ElseIf r>0
				AddCode(#CmndRecall,r,#Null)
			ElseIf r
				ProcedureReturn #ErrorToManyRegisters
			Else
				ProcedureReturn #ErrorVariableLocked
			EndIf

		Case #TypeFunction
			levl+1
			If levl>#MaxEvalBrackets
				ProcedureReturn #ErrorExpressionToComplex
			EndIf
			Select Token(n)\Content
			Case "sin("
				AddHeap(#CmndFnSin,#Null)
			Case "cos("
				AddHeap(#CmndFnCos,#Null)
			Case "tan("
				AddHeap(#CmndFnTan,#Null)
			Case "log("
				AddHeap(#CmndFnLog,#Null)
			Case "ln("
				AddHeap(#CmndFnLn,#Null)
			Case "min("
				AddHeap(#CmndFnMin,#Null)
			Case "max("
				AddHeap(#CmndFnMax,#Null)
			Default
				ProcedureReturn #ErrorUnknownFunction
			EndSelect
			
		Case #TypeComma
			While heap
				Select Heap(heap)\Command
				Case #CmndFnMin To #CmndFnMax,#CmndComma
					Comm(levl)+1
					Debug "Found... "+Str(Comm(levl))
					Break
				Case #CmndBracket
					Debug "Error - Comma / Bracket order"
					ProcedureReturn #ErrorWrongComma
				Default
					AddCode(Heap(heap)\Command,#Null,#Null)
					heap-1
					If heap=#Null
						Debug "ERROR - No function"
						line=#ErrorWrongComma
						Break
					EndIf
				EndSelect
			Wend
			
		Default
			Debug Token(n)\Type
			Debug "???"

		EndSelect
		n+1

	Wend

	If line>0
		While heap
			AddCode(Heap(heap)\Command,#Null,#Null)
			heap-1
		Wend
		AddCode(#CmndStore,save,#Null)
	EndIf

	ProcedureReturn line

EndProcedure
Procedure.i EvalParser(f.s,Array Token.TokenType(#True))

	Protected *c.Character
	Protected flag
	Protected number.s
	Protected symbol.s
	Protected count.i

	f=LCase(f)

	*c=@f
	flag=#FlagStart


	Repeat
		;Debug Chr(*c\c)
		Select *c\c

		Case '-'
			If flag&#FlagExponentSign
				flag!#FlagExponentSign
				Debug "Exponent Sign"
				number+"-"

			ElseIf flag&#FlagSign
				Debug "(SIGN) -"
				If number="-"
					number=""; Remove mutiple minus
				Else
					number+"-"
				EndIf

			ElseIf flag&#FlagFunction
				EvalNumber()
				AddToken(#TypeOperation,"-")
				Debug "OPERAT -"
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
			Else
				Debug "Error - No '-' allowed"
				ProcedureReturn #ErrorWrongMinus
			EndIf


		Case '+','*','/','^','%'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagFunction
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				AddToken(#TypeOperation,Chr(*c\c))
				Debug "OPERAT "+Chr(*c\c)
			Else
				Debug "Error - no math symbol allowed"
				ProcedureReturn #ErrorWrongOperator
			EndIf


		Case '0' To '9'
			If flag&#FlagNumber
				number+Chr(*c\c)
				SetFlag(@flag,#FlagFunction|#FlagNumberActive|#FlagCloseBracket)
				ClrFlag(@flag,#FlagNumberNeeded|#FlagSign|#FlagOpenBracket)
				If flag&(#FlagDot|#FlagNoDot)=0
					SetFlag(@flag,#FlagDot)
				EndIf
				If flag&#FlagNoExponent
					ClrFlag(@flag,#FlagExponentSign)
				ElseIf flag&#FlagNoExponent=0
					SetFlag(@flag,#FlagExponent)
				EndIf
			Else
				Debug "ERROR - no digit expected"
				ProcedureReturn #ErrorWrongNumber
			EndIf

		Case '!'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagFunction
				;ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				;SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				AddToken(#TypeOperation,Chr(*c\c))
				Debug "OPERAT "+Chr(*c\c)
			Else
				Debug "Error - no math symbol allowed"
				ProcedureReturn #ErrorWrongOperator
			EndIf

		Case '='
			EvalNumber()
			EvalSymbol()
			If flag&#FlagFunction
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				If count<>1 Or Token(#Null)\Type<>#TypeSymbol
					Debug "Only simple assignments are allowed, like a=pi/2, not a+1=2"
					ProcedureReturn #ErrorIllegalAssignment
				Else
					;AddToken(#TypeAssignment,Chr(*c\c))
					Token(#Null)\Type=#TypeAssignment
					Debug "Changed to assignment"
				EndIf
			Else
				Debug "Error - no assignment allowed"
				ProcedureReturn #ErrorWrongAssignment
			EndIf

		Case '.'
			If flag&#FlagDot
				number+"."
				flag!#FlagDot|#FlagNoDot
			Else
				Debug "Error - No '.' allowed"
				ProcedureReturn #ErrorWrongDot
			EndIf
			
		Case 'a' To 'z'
			If *c\c='e' And flag&#FlagExponent
				number+"e"
				flag=#FlagExponentSign|#FlagNoExponent|#FlagNumber|#FlagNoDot|#FlagNumberNeeded
			ElseIf flag|#FlagSymbol
				symbol+Chr(*c\c)
				SetFlag(@flag,#FlagFunction|#FlagSymbolActive|#FlagCloseBracket)
			Else
				Debug "Error - No character allowed"
				ProcedureReturn #ErrorWrongCharacter
			EndIf

		Case '('
			If flag&#FlagOpenBracket
				If flag&#FlagSymbolActive
					EvalSymbol(#True)
					;AddToken(#TypeOpenBracket,"(");	Funktion mit einem='sin(' oder zwei='sin','(' Token
					;Debug "FUNCTN ("
				Else
					AddToken(#TypeOpenBracket,"(")
					Debug "BRACKT ("
				EndIf
			Else
				Debug "Error - No '(' allowed"
				ProcedureReturn #ErrorWrongOpenBracket
			EndIf
			
		Case ')'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagCloseBracket
				AddToken(#TypeCloseBracket,")")
				Debug "BRACKT )"
				ClrFlag(@flag,#FlagNumber)
			Else
				Debug "Error - No ')' allowed"
				ProcedureReturn #ErrorWrongCloseBracket
			EndIf
			
		Case ','
			EvalNumber()
			EvalSymbol()
			If flag&#FlagCloseBracket
				AddToken(#TypeComma,",")
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
			Else
				Debug "Error - No ',' allowed"
				ProcedureReturn #ErrorWrongComma
			EndIf
			
		Case #Null
			EvalNumber()
			EvalSymbol()
			ProcedureReturn count

		Case ' '

		Default
			Debug "Error - Illegal character"
			ProcedureReturn #ErrorIllegalCharacter

		EndSelect

		*c+SizeOf(Character)
	ForEver

EndProcedure

; Define Main

	Dim Token.TokenType(0)
	Dim Code.CodeType(0)
	Define e,i
	Define s.s

	e=EvalParser("-1e2*(2+3^4)!+2*pi*e*x*z*zorro",Token())
	;e=EvalParser("1*min(max(min(1,2,3,4),2,2*pi,9+5),max(2,3))",Token())
	;e=EvalParser("1+(",Token());										Unfinishied expressions aren't recognized for now.
	;e=EvalParser("max(min(1,2,3,4),2,2*pi,9+5)",Token())
	;e=EvalParser("abc+(sin(123))---1.23+(-1.e1)+2*3-7+8*pi^e)",Token())

	If e>0
		Debug "-------------------------"
		For i=0 To e-1
			Debug "T"+RSet(Str(i),2)+": "+Str(Token(i)\Type)+" "+Token(i)\Content
		Next i
		e=EvalCoder(e,Token(),Code())
		If e>0
			Debug "-------------------------"
			For i=0 To e-1
				CompilerIf #PB_Compiler_Debugger
					s="C"+RSet(Str(i),2)+": #"+Str(Code(i)\Command)+" = "
					If Code(i)\Command<#CmndRangeNext
						s+StrD(Code(i)\Value,10)
					Else
						s+CmdStr(Code(i)\Command)
						Select Code(i)\Command
						Case #CmndRecall,#CmndStore
							s+" "+EvalRegNames(Code(i)\Info)
					EndSelect
					s+" ("+Str(Code(i)\Info)+")"
					EndIf
					Debug s
				CompilerEndIf
			Next i
			Debug "-------------------------"
		Else
			Debug "Coding Error "+e
		EndIf
	Else
		Debug "Parsing Error "+e
	EndIf

; EndDefine

[jacdelad]

There are more than one parsers already realized in PureBasic, one by me. Wouldn't it be easier to take one of these instead of reinventing the wheel?

[Michael Vogel]

There are more than one parsers already realized in PureBasic, one by me. Wouldn't it be easier to take one of these instead of reinventing the wheel?

Be assured I am the laziest programmer on earth so I checked the forum and was happy to find multiple parsers, many of them are brilliant.
At the end, none was doing all I need (symbols, assigning variables, functions with multiple parameters) but the most important thing: when calling them many thousand times they aren't fast enough - because full parsing needs to be done each time. So I just wrote the code above - which was done very quickly - and hopefully I will have finished my office work until tomorrow to have some time to finish this job

[Michael Vogel]

Small update - I don't have very much time actually. I am not sure it is very robust - even main parsing seems to be around 99% to 100% okay, there's a risk that unfinished expressions won't be recognized as wrong (something like "1*(2+2)+" or so). Converting to a code should be correct, so a RPN program is done at the end which looks similar to the information I have written above:

Code: Select all

	; Function string:
	; 	-10<x<=5: a=pi/2; y=sin(a*x); 5<x: 1/x

	; Code:
	;	Command	Info	Value		Remarks
	;	--------------------------------------------------------------
	; 	RangeMin	GT	-10.000
	;	RangeMin	LEQ	5.000
	;	Next		line 			*
	;	Recall	3				pi (0=Y, 1=X, 2=e, 3=pi) Store 0..3 has to be blocked within code
	;	Value		2.000
	;	Operation	/
	;	Store	4				a (dynamic register number)
	;	Recall	4
	;	Recall	1				X
	;	Operation	*
	;	Function	sin
	;	Result					Store Y -> exit
	;*	RangeMin	GT	5.000
	;	RangeMax	LT	+Infinity
	;	Next		0				no more expressions
	;	Value		1.000
	;	Recall	1				X
	;	Operation	/
	;	Result					Store Y -> exit
	;	End

Some additional functions need to be completed (Min, Max), some should be added (Atan, Asin, Acos,...) - but in principle everything should work.

So the EvalText at the end of the code can be used for testing:
# EvalText("x+2",3) does show 5 (calculates x+2 for x=3)
# EvalText("a=x : a+2",3) is 5 again (assigns 3 to a and calculates a+2)
# EvalText("x=1 : 99 : x<10 : x : x<1000 : x*x",3) shows 3, because x is calculated for values below 10)
# EvalText("x=1 : 99 : x<10 : x : x<1000 : x*x",30) shows 900, because x*x is calculated for values below 1000)
# EvalText("x=1 : 99 : x<10 : x : x<1000 : x*x",1) shows 99)

Here's the code, maybe some of you like to do some tests to get the code bug free

Code: Select all

; Define

	EnableExplicit

	#DebugVerbose=1

	#MaxEvalRegisters=	100;			y,x,e,pi,affe,baer,cebu,...
	#MaxEvalHeap=		100;			Stack
	#MaxEvalBrackets=	50;			([{...}])
	#MaxEvalParameter=	25;			Min(p1,p2,...pn)

	#MaxFunctions=		6
	#MaxProgramLines=	1000;
	#MaxProgramStack=	100;
	#MaxProgramRgstr=	100;			#MaxEvalRegisters

	Structure TokenType
		Type.i
		Content.s
	EndStructure

	Structure CodeType
		Command.i
		Info.i
		Value.d
	EndStructure

	Structure EvalType
		Register.i
	EndStructure

	Structure StateType
		ProgramLines.i
		LineWidth.d
		; :
		; :
	EndStructure

	Global Eval.EvalType
	Global Dim EvalRegValue.d(#MaxEvalRegisters)
	Global Dim EvalRegNames.s(#MaxEvalRegisters)

	Global Dim State.StateType(#MaxFunctions)
	Global Dim Program.CodeType(#MaxFunctions,#MaxProgramLines)
	Global Dim Stack.d(#MaxProgramStack)
	Global Dim Rgstr.d(#MaxProgramRgstr)

	EvalRegNames(0)="y"
	EvalRegNames(1)="x"
	EvalRegNames(2)="e"
	EvalRegNames(3)="pi"
	Eval\Register=3

	Rgstr(2)=#E
	Rgstr(3)=#PI

	Enumeration
		#TypeNoCode
		#TypeNumber
		#TypeSymbol
		#TypeFunction
		#TypeOperation
		#TypeAssignment
		#TypeOpenBracket
		#TypeCloseBracket
		#TypeComma
	EndEnumeration

	Enumeration
		; Values & Register
		#CmndValue;			123.456e78
		#CmndRecall;			x, pi, e, a,...
		#CmndStore;			a=

		; Range for X
		#CmndRangeMin;			-10<x
		#CmndRangeMax;			x<10
		#CmndRangeNxt;			Code line (für nächste Range)
		#CmndNoCode;

		; Operations
		#CmndPlus;			+
		#CmndMinus;			-
		#CmndMultiply;			*
		#CmndDivide;			/
		#CmndPower;			^
		#CmndFactorize;		!

		; Functions with one parameter
		#CmndFnSin;			sin(
		#CmndFnCos;			cos(
		#CmndFnTan;			tan(
		#CmndFnLog;			log(
		#CmndFnLn;			ln(
		#CmndFnAbs;			abs(
		#CmndFnSqr;			sqr(
		#CmndFnGamma;			gamma(

		; Functions with multiple parameters
		#CmndFnMin;			max(a,...)
		#CmndFnMax;			max(a,...)

		; Function list ends here.
		#CmndFnEnd;			----

		; Special functions
		#CmndBracket;			(			Heap only
		#CmndComma;			,			Heap only?

	EndEnumeration

	Enumeration
		#LevelNil
		#LevelBracket;			( ( ( (
		#LevelOne;			+ -
		#LevelTwo;			* /
		#LevelThree;			^
		#LevelFour;			!
	EndEnumeration

	#ErrorNoErrors=#Null

	Enumeration -666
		#ErrorMissingNumber
		#ErrorWrongMinus
		#ErrorWrongOperator
		#ErrorWrongNumber
		#ErrorWrongDot
		#ErrorWrongComma
		#ErrorWrongCharacter
		#ErrorWrongOpenBracket
		#ErrorWrongCloseBracket
		#ErrorWrongAssignment
		#ErrorWrongRange
		#ErrorWrongMinMax
		#ErrorWrongRelation;			>
		#ErrorIllegalCharacter
		#ErrorIllegalAssignment
		#ErrorIllegalCommand
		#ErrorIllegalOperation
		#ErrorIllegalFunction
		#ErrorIllegalExtendedFunction
		#ErrorIllegalValue
		#ErrorStackOverlow
		#ErrorStackUnderflow
		#ErrorRegisterOverlow
		#ErrorToManyRegisters
		#ErrorToManyProgramLines
		#ErrorLockedRegisterY
		#ErrorVariableLocked;			Recall Y forbidden
		#ErrorExpressionToComplex
		#ErrorNothingToCalculate
		#ErrorUnfinishedExpression
		#ErrorUnknownFunction
		#ErrorDivisionByZero
		#ErrorUnknownError
	EndEnumeration

	CompilerIf #ErrorUnknownError>-#MaxEvalRegisters
		Debug "Conflict with constants - decrease Error enumeration values"
		End
	CompilerEndIf


	EnumerationBinary
		#FlagSign;		-
		#FlagNumber;		0-9
		#FlagNumberActive;				number.s
		#FlagDot;			.
		#FlagNoDot;					no . allowed
		#FlagExponent;		e
		#FlagExponentSign;	e-
		#FlagNumberNeeded;				value after exponent
		#FlagNoExponent;				no more e allowed
		#FlagFunction;		-+*/^!%\
		#FlagSymbol;		a,b,c, sin
		#FlagSymbolActive;				symbol.s
		#FlagOpenBracket;	(
		#FlagCloseBracket;	)
		;
		#FlagLowerNumber;		123
		#FlagLowerRangeSet;		123<x
		#FlagRangeX;			x
		#FlagUpperRange;		x<2 or x=3
		#FlagRelationActive;	<
		#FlagRelationPossible;	<
		#FlagRelationSet;		<
		#FlagEqualSignPossible;	=
		#FlagEqualSignSet;		=
		#FlagInverseSign;		>
	EndEnumeration

	Enumeration
		#RelationEqual
		#RelationLessThan
		#RelationLessEqual
	EndEnumeration


	#FlagStart=#FlagSign|#FlagNumber|#FlagSymbol|#FlagOpenBracket

	#BinaryMaxBits=SizeOf(Integer)<<3-1
	#BinaryBitMask=1<<#BinaryMaxBits-1

	Procedure SetFlag(*value.Integer,flag)

		*value\i | (flag)

	EndProcedure
	Procedure ClrFlag(*value.Integer,flag)

		*value\i & (#BinaryBitMask!(flag))

	EndProcedure

	Macro ExitIf(condition)
		If condition
			Break
		EndIf
	EndMacro

	CompilerIf #DebugVerbose
		Macro Syslog(message,level=1)
			If level<=#DebugVerbose
				Debug message
			EndIf
		EndMacro
	CompilerElse
		Macro Syslog(message,level=1)
		EndMacro
	CompilerEndIf

	CompilerIf #PB_Compiler_Debugger
		Macro CmdStr(number); Debug
			StringField("Val.Rcl.Sto.Rg-.Rg+.Jmp.{} .'+'.'-'.'*'.'/'.'^'.'!'.Sin.Cos.Tan.Log.Ln .Abs.Sqr.Gam.Min.Max.End.'('.','.",(number)+1,".")
		EndMacro
	CompilerEndIf


	#CharByte=#PB_Compiler_Unicode

; EndDefine

Procedure.i StrSplit(String.s, Array StringArray.s(#True))

	Protected *s.Character
	Protected *m
	Protected n

	*s=@String
	*m=*s

	n=-1
	Repeat

		Select *s\c
		Case ':',';'
			n+1
			ReDim StringArray(n)
			StringArray(n)=PeekS(*m,(*s-*m)>>#CharByte)
			*m=*s+SizeOf(Character)

		Case #Null
			If *m<>*s
				n+1
				ReDim StringArray(n)
				StringArray(n)=PeekS(*m,(*s-*m)>>#CharByte)
			EndIf
			ProcedureReturn n+1

		EndSelect

		*s+SizeOf(Character)
	ForEver

	ProcedureReturn #Null

EndProcedure
Procedure.s StrError(code)

	Select code
	Case #ErrorMissingNumber
		ProcedureReturn "Number is missing"
	Case #ErrorWrongMinus
		ProcedureReturn "NEVER SEEN - 665"
	Case #ErrorWrongOperator
		ProcedureReturn "Wrong mathematical operator symbol"
	Case #ErrorWrongNumber
		ProcedureReturn "NEVER SEEN - 663"
	Case #ErrorWrongDot
		ProcedureReturn "Wrong placement of character '.'"
	Case #ErrorWrongComma
		ProcedureReturn "Wrong placement of character ','"
	Case #ErrorWrongCharacter
		ProcedureReturn "NEVER SEEN - 660"
	Case #ErrorWrongOpenBracket
		ProcedureReturn "Unexpected bracket character '('"
	Case #ErrorWrongCloseBracket
		ProcedureReturn "Unexpected bracket character ')'"
	Case #ErrorWrongAssignment
		ProcedureReturn "NEVER SEEN - 657"
	Case #ErrorWrongRange
		ProcedureReturn "Illegal Range"
	Case #ErrorWrongMinMax
		ProcedureReturn "Illegal X range (left side must be smaller than right side)"
	Case #ErrorWrongRelation
		ProcedureReturn "Wrong relation character for X range (-10 < X <= 10)"
	Case #ErrorIllegalCharacter
		ProcedureReturn "Unexpected character (symbols like $, %, &)"
	Case #ErrorIllegalAssignment
		ProcedureReturn "Illegal assignment (has to be 'variable=expression')"
	Case #ErrorIllegalCommand
		ProcedureReturn "NEVER SEEN - 651"
	Case #ErrorIllegalOperation
		ProcedureReturn "NEVER SEEN - 650"
	Case #ErrorIllegalFunction
		ProcedureReturn "NEVER SEEN - 649"
	Case #ErrorIllegalExtendedFunction
		ProcedureReturn "Illegal expression - wrong number of function parameters"
	Case #ErrorIllegalValue
		ProcedureReturn "Illegal value (e.g. root of negative number)"
	Case #ErrorStackOverlow
		ProcedureReturn "NEVER SEEN - 646"
	Case #ErrorStackUnderflow
		ProcedureReturn "Illegal expression - to many operations (missing parameter)"
	Case #ErrorRegisterOverlow
		ProcedureReturn "NEVER SEEN - 644"
	Case #ErrorToManyRegisters
		ProcedureReturn "NEVER SEEN - 643"
	Case #ErrorToManyProgramLines
		ProcedureReturn "NEVER SEEN - 642"
	Case #ErrorLockedRegisterY
		ProcedureReturn "Variable Y can't be used on right side of an expression"
	Case #ErrorVariableLocked
		ProcedureReturn "NEVER SEEN - 640"
	Case #ErrorExpressionToComplex
		ProcedureReturn "NEVER SEEN - 639"
	Case #ErrorNothingToCalculate
		ProcedureReturn "Nothing do calculate (empty expression)"
	Case #ErrorUnfinishedExpression
		ProcedureReturn "Unfinished expression"
	Case #ErrorUnknownFunction
		ProcedureReturn "NEVER SEEN - 636"
	Case #ErrorDivisionByZero
		ProcedureReturn "Division by Zero"
	Case #ErrorUnknownError
		ProcedureReturn "NEVER SEEN - 634"
	EndSelect

	ProcedureReturn "/!\ Unknown error code "+Str(code)

EndProcedure

Macro AddCode(vcmnd,vinfo,vvalue)

	Syslog("Add Code "+Str(line)+" = "+CmdStr(vcmnd)+", "+Str(vinfo)+", "+StrD(vvalue),4)

	ReDim Code(line)
	Code(line)\Command=		vcmnd
	Code(line)\Info=		vinfo
	Code(line)\Value=		vvalue
	line+1

EndMacro
Macro AddHeap(vcmnd,vinfo)

	heap+1

	If heap>#MaxEvalHeap
		ProcedureReturn #ErrorExpressionToComplex
	EndIf

	Syslog("Add Heap "+Str(heap)+" = "+CmdStr(vcmnd)+", Level "+Str(vinfo),4)

	; ReDim Heap(heap)
	Heap(heap)\Command=		vcmnd
	Heap(heap)\Info=		vinfo

EndMacro

Macro AddToken(vtype,vcontent)

	Syslog("Add Token "+Str(count)+" = "+Str(vtype)+", "+vcontent,3)

	ReDim Token(count)
	Token(count)\Type=		vtype
	Token(count)\Content=	vcontent
	count+1

EndMacro
Macro EvalNumber()

	If flag&#FlagNumberActive
		If flag&#FlagNumberNeeded
			Syslog("ERROR - Number missing",3)
			ProcedureReturn #ErrorMissingNumber
		Else
			ClrFlag(@flag,#FlagNumberActive|#FlagExponent|#FlagNoExponent|#FlagExponentSign|#FlagDot|#FlagNoDot)
			AddToken(#TypeNumber,number)
			Syslog("NUMBER "+number,3)
			number=""
		EndIf
	EndIf

EndMacro
Macro EvalSymbol(mode=#Null)

	If flag&#FlagSymbolActive
		ClrFlag(@flag,#FlagSymbolActive)
		If mode
			If number="-"
				AddToken(#TypeNumber,"-1")
				AddToken(#TypeOperation,"*")
				number=""
			EndIf
			AddToken(#TypeFunction,symbol+"(")
			Syslog("FUNCTN "+symbol+"(",3)
		Else
			If number="-"
				symbol="-"+symbol
				number=""
			EndIf
			AddToken(#TypeSymbol,symbol)
			Syslog("SYMBOL "+symbol,3)
		EndIf
		symbol=""
	EndIf

EndMacro

Procedure.d EvalGamma(x.d)

	Protected.d y,mul,sum
	Protected.i n
	Protected.d Dim A(28)

	A(0)= 1.0
	A(1)= 0.5772156649015328606
	A(2)=-0.6558780715202538811
	A(3)=-0.0420026350340952355
	A(4)= 0.1665386113822914895
	A(5)=-0.0421977345555443368
	A(6)=-0.0096219715278769736
	A(7)= 0.0072189432466630995
	A(8)=-0.0011651675918590651
	A(9)=-0.0002152416741149510
	A(10)= 0.0001280502823881162
	A(11)=-0.0000201348547807882
	A(12)=-0.0000012504934821427
	A(13)= 0.0000011330272319817
	A(14)=-0.0000002056338416978
	A(15)= 0.0000000061160951045
	A(16)= 0.0000000050020076445
	A(17)=-0.0000000011812745705
	A(18)= 0.0000000001043426712
	A(19)= 0.0000000000077822634
	A(20)=-0.0000000000036968056
	A(21)= 0.0000000000005100370
	A(22)=-0.0000000000000205833
	A(23)=-0.0000000000000053481
	A(24)= 0.0000000000000012268
	A(25)=-0.0000000000000001181
	A(26)= 0.0000000000000000012
	A(27)= 0.0000000000000000014
	A(28)=-0.0000000000000000002
	;A(29)= 0.00000000000000000002

	If x>0.0
		y=	x-1.0
		mul=	1.0

		While y>=1.0
			mul*y
			y-1.0
		Wend

		sum=A(28)
		For N = 27 To 0 Step -1
			Sum*y+A(N)
		Next N

		If Sum>0.0
			ProcedureReturn mul/sum
		Else
			ProcedureReturn Infinity()
		EndIf

	Else
		ProcedureReturn 0.0;	Error

	EndIf

EndProcedure
Procedure.i EvalRegister(name.s)


	Protected n=Eval\Register
	Protected fneg

	If PeekC(@name)='-'
		name=Mid(name,2)
		fneg=-#True
	Else
		fneg=#True
	EndIf

	While n=>0
		ExitIf (name=EvalRegNames(n))
		n-1
	Wend

	If n>=0
		Syslog("Found register name: '"+name+"' ["+StringField("-..+",fneg+2,".")+" "+Str(n)+"]",2)
		ProcedureReturn fneg*n
	EndIf

	If Eval\Register=#MaxEvalRegisters
		ProcedureReturn #ErrorToManyRegisters
	EndIf

	Eval\Register+1
	EvalRegNames(Eval\Register)=name

	Syslog("Add Var  "+Str(Eval\Register)+" = '"+name+"'",2)

	Syslog("New register name: '"+name+"' ["+StringField("-..+",fneg+2,".")+" "+Str(Eval\Register)+"]",2)
	ProcedureReturn fneg*Eval\Register

EndProcedure
Procedure.i EvalCoder(count.i,Array Token.TokenType(#True),Array Code.CodeType(#True))

	Protected n
	Protected r
	Protected line
	Protected cmnd
	Protected info
	Protected heap
	Protected open
	Protected save
	Protected levl
	Protected Dim Heap.CodeType(#MaxEvalHeap)
	Protected Dim Comm.i(#MaxEvalBrackets)

	Heap(#Null)\Info=#Null

	While n<count
		Select Token(n)\Type

		Case #TypeNumber
			AddCode(#CmndValue,#TypeNumber,ValD(Token(n)\Content))

		Case #TypeOperation
			Select Token(n)\Content
			Case "+"
				cmnd=#CmndPlus
				info=#LevelOne
			Case "-"
				cmnd=#CmndMinus
				info=#LevelOne
			Case "*"
				cmnd=#CmndMultiply
				info=#LevelTwo
			Case "/"
				cmnd=#CmndDivide
				info=#LevelTwo
			Case "^"
				cmnd=#CmndPower
				info=#LevelThree
			Case "!"
				cmnd=#CmndFactorize
				info=#LevelFour
			Default
				line=#ErrorUnknownError
				Break
			EndSelect

			While info<Heap(heap)\Info
				AddCode(Heap(heap)\Command,#Null,#Null)
				heap-1
			Wend
			AddHeap(cmnd,info)

		Case #TypeOpenBracket
			levl+1
			If levl>#MaxEvalBrackets
				ProcedureReturn #ErrorExpressionToComplex
			EndIf
			AddHeap(#CmndBracket,#LevelBracket)

		Case #TypeCloseBracket
			While heap
				Select Heap(heap)\Command
				Case #CmndFnSin To #CmndFnEnd
					AddCode(Heap(heap)\Command,Comm(levl)+1,#Null)
					heap-1
					Break
				Case #CmndBracket;,#cmnd
					heap-1
					Break
				Default
					AddCode(Heap(heap)\Command,#Null,#Null)
					heap-1
					If heap=#Null
						Syslog("ERROR - Brackets",3)
						line=#ErrorWrongCloseBracket
						Break
					EndIf
				EndSelect
			Wend
			Comm(levl)=0
			levl-1

		Case #TypeSymbol,#TypeAssignment
			r=EvalRegister(Token(n)\Content)
			If Token(n)\Type=#TypeAssignment
				save=r
			ElseIf r=#ErrorToManyRegisters
				ProcedureReturn #ErrorToManyRegisters
			ElseIf r
				AddCode(#CmndRecall,r,#Null)
			Else
				ProcedureReturn #ErrorLockedRegisterY
			EndIf

		Case #TypeFunction
			levl+1
			If levl>#MaxEvalBrackets
				ProcedureReturn #ErrorExpressionToComplex
			EndIf
			Select Token(n)\Content
			Case "sin("
				AddHeap(#CmndFnSin,#Null)
			Case "cos("
				AddHeap(#CmndFnCos,#Null)
			Case "tan("
				AddHeap(#CmndFnTan,#Null)
			Case "log("
				AddHeap(#CmndFnLog,#Null)
			Case "ln("
				AddHeap(#CmndFnLn,#Null)
			Case "abs("
				AddHeap(#CmndFnAbs,#Null)
			Case "sqr("
				AddHeap(#CmndFnSqr,#Null)
			Case "gamma("
				AddHeap(#CmndFnGamma,#Null)
			Case "min("
				AddHeap(#CmndFnMin,#Null)
			Case "max("
				AddHeap(#CmndFnMax,#Null)
			Default
				ProcedureReturn #ErrorUnknownFunction
			EndSelect

		Case #TypeComma
			While heap
				Select Heap(heap)\Command
				Case #CmndFnMin To #CmndFnMax,#CmndComma
					Comm(levl)+1
					Syslog("Found... "+Str(Comm(levl)),3)
					Break
				Case #CmndBracket
					Syslog("Error - Comma / Bracket order",3)
					ProcedureReturn #ErrorWrongComma
				Default
					AddCode(Heap(heap)\Command,#Null,#Null)
					heap-1
					If heap=#Null
						Syslog("ERROR - No function",3)
						line=#ErrorWrongComma
						Break
					EndIf
				EndSelect
			Wend

		Default
			Syslog("Error - Unknown Token "+Str(Token(n)\Type),1)
			Debug "???"

		EndSelect
		n+1

	Wend

	If line>0
		While heap
			AddCode(Heap(heap)\Command,#Null,#Null)
			heap-1
		Wend
		AddCode(#CmndStore,save,#Null)
	EndIf

	ProcedureReturn line

EndProcedure
Procedure.i EvalParser(f.s,Array Token.TokenType(#True))

	Protected *c.Character
	Protected flag,copy
	Protected number.s
	Protected symbol.s
	Protected count.i

	f=LCase(f)
	Syslog("Parse: "+Trim(f))

	*c=@f
	flag=#FlagStart


	Repeat
		;Debug Chr(*c\c)
		Select *c\c

		Case '-'
			If flag&#FlagExponentSign
				flag!#FlagExponentSign
				Syslog("Exponent Sign",3)
				number+"-"

			ElseIf flag&#FlagSign
				Syslog("(SIGN) -",4)
				If number="-"
					number=""; Remove mutiple minus
				Else
					number+"-"
				EndIf

			ElseIf flag&#FlagFunction
				EvalNumber()
				AddToken(#TypeOperation,"-")
				Syslog("OPERAT -",3)
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
			Else
				Syslog("Error - No '-' allowed",2)
				ProcedureReturn #ErrorWrongMinus
			EndIf


		Case '+','*','/','^','%'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagFunction
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				AddToken(#TypeOperation,Chr(*c\c))
				Syslog("OPERAT "+Chr(*c\c),3)
			Else
				Syslog("Error - no math symbol allowed",2)
				ProcedureReturn #ErrorWrongOperator
			EndIf


		Case '0' To '9'
			If flag&#FlagNumber
				number+Chr(*c\c)
				SetFlag(@flag,#FlagFunction|#FlagNumberActive|#FlagCloseBracket)
				ClrFlag(@flag,#FlagNumberNeeded|#FlagSign|#FlagOpenBracket)
				If flag&(#FlagDot|#FlagNoDot)=0
					SetFlag(@flag,#FlagDot)
				EndIf
				If flag&#FlagNoExponent
					ClrFlag(@flag,#FlagExponentSign)
				ElseIf flag&#FlagNoExponent=0
					SetFlag(@flag,#FlagExponent)
				EndIf
			Else
				Syslog("ERROR - no digit expected",2)
				ProcedureReturn #ErrorWrongNumber
			EndIf

		Case '!'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagFunction
				;ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				;SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				AddToken(#TypeOperation,Chr(*c\c))
				Syslog("OPERAT "+Chr(*c\c),3)
			Else
				Syslog("Error - no math symbol allowed",2)
				ProcedureReturn #ErrorWrongOperator
			EndIf

		Case '='
			EvalNumber()
			EvalSymbol()
			If flag&#FlagFunction
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
				If count<>1 Or Token(#Null)\Type<>#TypeSymbol
					Syslog("Only simple assignments are allowed, like a=pi/2, not a+1=2",2)
					ProcedureReturn #ErrorIllegalAssignment
				Else
					;AddToken(#TypeAssignment,Chr(*c\c))
					Token(#Null)\Type=#TypeAssignment
					Syslog("Changed to assignment",3)
				EndIf
			Else
				Syslog("Error - no assignment allowed",2)
				ProcedureReturn #ErrorWrongAssignment
			EndIf

		Case '.'
			If flag&#FlagDot
				number+"."
				flag!#FlagDot|#FlagNoDot
			Else
				Syslog("Error - No '.' allowed",2)
				ProcedureReturn #ErrorWrongDot
			EndIf

		Case 'a' To 'z'
			If *c\c='e' And flag&#FlagExponent
				number+"e"
				flag=#FlagExponentSign|#FlagNoExponent|#FlagNumber|#FlagNoDot|#FlagNumberNeeded
			ElseIf flag|#FlagSymbol
				symbol+Chr(*c\c)
				SetFlag(@flag,#FlagFunction|#FlagSymbolActive|#FlagCloseBracket)
			Else
				Syslog("Error - No character allowed",2)
				ProcedureReturn #ErrorWrongCharacter
			EndIf

		Case '('
			If flag&#FlagOpenBracket
				If flag&#FlagSymbolActive
					EvalSymbol(#True)
					;AddToken(#TypeOpenBracket,"(");	Funktion mit einem='sin(' oder zwei='sin','(' Token
					;Debug "FUNCTN ("
				Else
					AddToken(#TypeOpenBracket,"(")
					Syslog("BRACKT (",3)
				EndIf
			Else
				Syslog("Error - No '(' allowed",2)
				ProcedureReturn #ErrorWrongOpenBracket
			EndIf

		Case ')'
			EvalNumber()
			EvalSymbol()
			If flag&#FlagCloseBracket
				AddToken(#TypeCloseBracket,")")
				Syslog("BRACKT )",3)
				ClrFlag(@flag,#FlagNumber)
			Else
				Syslog("Error - No ')' allowed",2)
				ProcedureReturn #ErrorWrongCloseBracket
			EndIf

		Case ','
			EvalNumber()
			EvalSymbol()
			If flag&#FlagCloseBracket
				AddToken(#TypeComma,",")
				ClrFlag(@flag,#FlagFunction|#FlagCloseBracket)
				SetFlag(@flag,#FlagSign|#FlagNumber|#FlagOpenBracket)
			Else
				Syslog("Error - No ',' allowed",2)
				ProcedureReturn #ErrorWrongComma
			EndIf

		Case #Null
			Syslog(")(_sfn#-en._#-",5)
			Syslog(RSet(Bin(flag),14,"0"),5)
			copy=flag
			EvalNumber()
			EvalSymbol()

			Syslog("----UNRELIABLE CODE----",4)
			If flag&(#FlagSign|#FlagNumberNeeded)
				Syslog("----CHECK 1----",4)
				If copy&#FlagSymbolActive=#Null
					Syslog("----CHECK 2----",4)
					If flag&#FlagOpenBracket=#Null And flag&#FlagCloseBracket=#Null
						Syslog("----CHECK 3----",4)
						ProcedureReturn #ErrorUnfinishedExpression
					EndIf
				EndIf
			EndIf

			Syslog(")(_sfn#-en._#-",5)
			Syslog(RSet(Bin(flag),14,"0"),5)

			ProcedureReturn count

		Case ' '

		Default
			Syslog("Error - Illegal character",2)
			ProcedureReturn #ErrorIllegalCharacter

		EndSelect

		*c+SizeOf(Character)
	ForEver

EndProcedure
Procedure.i EvalRange(f.s,Array Code.CodeType(#True))

	; allowed expressions are:
	;
	;	x =  number					x = 12
	;	x <= number					x < 34	x <= 56
	;	x >= number					x > 78	x >= 90
	;	number <= x <= number			123 < x <= 456

	; not allowed:
	;
	;	number < number
	;	number > x
	;	number < x > number
	;	number < x = number
	;	abc < x

	Protected *c.Character
	Protected.d lower,upper
	Protected.i ltype,utype
	Protected.i flag,line
	Protected.s number

	f=LCase(f)
	Syslog("Range: "+Trim(f))

	*c=@f

	flag=#FlagNumber|#FlagSign

	Repeat
		;Debug Chr(*c\c)
		Select *c\c

		Case 'x'
			If flag&#FlagRangeX
				Syslog("ERROR - only one X allowed",2)
				End
			Else
				ltype=Bool(flag&#FlagRelationSet)*(1+Bool(flag&#FlagEqualSignSet))
				lower=ValD(number)
				;Debug "OK "+number+" "+Left("<",Bool(flag&#FlagRelationPossible))+Left("=",Bool(flag&#FlagEqualSignPossible)!1)+" X"
				flag=(Bool(flag&#FlagRelationActive And flag&#FlagLowerNumber) * #FlagLowerRangeSet) | #FlagRangeX|#FlagRelationPossible|#FlagEqualSignPossible
				number=""
			EndIf

		Case '-'
			If flag&#FlagExponentSign
				flag!#FlagExponentSign
				number+"-"
			ElseIf flag&#FlagSign And number=""
				number="-"
			Else
				Syslog("Error - No '-' allowed",2)
				ProcedureReturn #ErrorWrongMinus
			EndIf

		Case '0' To '9'
			If flag&#FlagNumber
				number+Chr(*c\c)
				SetFlag(@flag,#FlagRelationPossible|#FlagNumberActive)
				ClrFlag(@flag,#FlagSign|#FlagNumberNeeded)
				If flag&(#FlagDot|#FlagNoDot)=0
					SetFlag(@flag,#FlagDot)
				EndIf
				If flag&#FlagNoExponent
					ClrFlag(@flag,#FlagExponentSign)
				ElseIf flag&#FlagNoExponent=0
					SetFlag(@flag,#FlagExponent)
				EndIf
			Else
				Syslog("ERROR - no digit expected",2)
				ProcedureReturn #ErrorWrongNumber
			EndIf

		Case '.'
			If flag&#FlagNumberActive And flag&#FlagNoDot=0
				number+"."
				SetFlag(@flag,#FlagNoDot)
			EndIf

		Case 'e'
			If flag&#FlagExponent
				number+"e"
				SetFlag(@flag,#FlagExponentSign|#FlagNoExponent|#FlagNumber|#FlagNoDot|#FlagNumberNeeded)
			EndIf

		Case '>'
			If flag=#FlagRangeX|#FlagRelationPossible|#FlagEqualSignPossible And flag&#FlagInverseSign=0 And number=""
				SetFlag(@flag,#FlagNumber|#FlagNumberNeeded|#FlagRelationActive|#FlagRelationSet|#FlagLowerRangeSet|#FlagInverseSign)
				ClrFlag(@flag,#FlagRelationPossible)
			Else
				ProcedureReturn #ErrorWrongRelation
			EndIf

		Case '<'
			If flag|#FlagRelationPossible And flag&#FlagInverseSign=#Null
				If flag&#FlagNumberActive And flag&#FlagLowerRangeSet=#Null;	123 <
					SetFlag(@flag,#FlagEqualSignPossible|#FlagLowerNumber|#FlagRelationActive|#FlagRelationSet)
					ClrFlag(@flag,#FlagNumberActive|#FlagNumber)
				ElseIf flag&#FlagRangeX And flag&#FlagRelationPossible;		[123 <[=]] X
					SetFlag(@flag,#FlagNumber|#FlagNumberNeeded|#FlagSign|#FlagRelationActive|#FlagRelationSet)
					ClrFlag(@flag,#FlagRelationPossible)
				Else
					ProcedureReturn #ErrorWrongRange
				EndIf
			Else
				ProcedureReturn #ErrorWrongRelation
			EndIf

		Case '='
			If flag&#FlagLowerRangeSet And flag&#FlagRelationActive=0
				Syslog("1<x=2 not allowed",2)
				ProcedureReturn #ErrorWrongRange
			ElseIf flag&#FlagEqualSignPossible
				SetFlag(@flag,#FlagNumber|#FlagNumberNeeded|#FlagEqualSignSet)
				ClrFlag(@flag,#FlagEqualSignPossible);|#FlagRelationActive)
			Else
				Syslog("= not allowed",2)
				ProcedureReturn #ErrorWrongRange
			EndIf

		Case #Null
			If flag&#FlagNumberNeeded
				Syslog("Number missing",2)
				ProcedureReturn #ErrorMissingNumber
			Else
				If flag&#FlagNumberActive
					utype=Bool(flag&#FlagRelationSet)*(1+Bool(flag&#FlagEqualSignSet))
					upper=ValD(number)
					If flag&#FlagInverseSign;										x>...
						ltype=utype
						lower=upper
						utype=#RelationLessEqual
						upper=Infinity()
					ElseIf ltype=0 And utype&1 And utype<4;							x<...
						ltype=1
						lower=-Infinity()
					ElseIf lower>=upper;											2< x <1
						If ltype=2 And ltype=2 And lower=upper;						2<=x<=2
							ltype=#Null
							utype=#RelationEqual
						Else
							ProcedureReturn #ErrorWrongMinMax
						EndIf
					EndIf
				Else
					utype=#RelationLessEqual
					upper=Infinity()
				EndIf
				If ltype
					AddCode(#CmndRangeMin,ltype,lower)
					Syslog("Lower ("+Str(ltype)+"): "+StrD(lower)+" "+StringField("X.<.<=",ltype+1,".")+" X ",3)
				EndIf
				AddCode(#CmndRangeMax,utype,upper)
				AddCode(#CmndRangeNxt,#Null,#Null)
				Syslog("Upper ("+Str(utype)+"): X "+StringField("=.<.<=",utype+1,".")+" "+StrD(upper),3)
				ProcedureReturn line
			EndIf

		Case ' '

		EndSelect

		*c+SizeOf(Character)

	ForEver

EndProcedure
Procedure.i EvalType(s.s)

	Protected.i x,r
	Protected.i typ

	typ=FindString(s,"<")

	If typ=0
		typ=FindString(s,">")
		If typ=0
			s=LCase(s)
			x=FindString(s,"x")
			If x And FindString(s,"=")>x
				typ=#True
			EndIf
		EndIf
	EndIf

	ProcedureReturn Bool(typ)

EndProcedure
Procedure.i EvalCode(program.i,*result.Double)

	Protected.i code
	Protected.i line
	Protected.i stck
	Protected.d val,x
	Protected.d minx,maxx
	Protected.i mint,maxt
	Protected.i rangeok

	minx=	-Infinity()
	mint=	#RelationLessEqual
	maxx=	Infinity()
	maxt=	#RelationLessEqual

	x=Rgstr(#True)

	Repeat
		With Program(program,line)
			code=\Command

			; -----------------------------------------------------------------------------------------------------------------

			If code<=#CmndNoCode
				Select code
				Case #CmndValue
					If \Info=#TypeNumber
						Stack(stck)=\Value
						stck+1
						If stck>#MaxProgramStack
							ProcedureReturn #ErrorStackOverlow
						EndIf
					Else
						ProcedureReturn #ErrorNoErrors
					EndIf

				Case #CmndRecall
					If \Info<=#MaxProgramRgstr
						If \Info
							If \Info>0
								Stack(stck)=Rgstr(\Info)
							Else
								Stack(stck)=-Rgstr(-\Info)
							EndIf
							stck+1
							If stck>#MaxProgramStack
								ProcedureReturn #ErrorStackOverlow
							EndIf
						Else
							ProcedureReturn #ErrorLockedRegisterY
						EndIf
					Else
						ProcedureReturn #ErrorRegisterOverlow
					EndIf

				Case #CmndStore
					If stck=#Null
						ProcedureReturn #ErrorStackUnderflow
					ElseIf \Info>=#Null And \Info<#MaxProgramRgstr
						Rgstr(\Info)=Stack(stck-1)
						stck-1
						If \Info=#Null
							*result\d=Rgstr(#Null)
							ProcedureReturn #ErrorNoErrors
						EndIf
					Else
						ProcedureReturn #ErrorRegisterOverlow
					EndIf

				Case #CmndRangeMin
					minx=\Value
					mint=\Info
					maxx=Infinity()
					maxt=#RelationLessEqual

				Case #CmndRangeMax
					maxx=\Value
					maxt=\Info

				Case #CmndRangeNxt
					rangeok=#True
					Select mint
					Case #RelationLessThan
						rangeok & Bool(minx<x)
					Case #RelationLessEqual
						rangeok & Bool(minx<=x)
					EndSelect
					Select maxt
					Case #RelationEqual
						rangeok & Bool(maxx=x)
					Case #RelationLessThan
						rangeok & Bool(x<maxx)
					Case #RelationLessEqual
						rangeok & Bool(x<=maxx)
					EndSelect
					Syslog(StringField("XXX.<X .<=X",mint+1,".")+" "+StrD(minx,10),4)
					Syslog(StringField("X= .X< .X<=",maxt+1,".")+" "+StrD(maxx,10),4)
					If rangeok=#Null
						line=\Info-1
						If line<0
							Syslog("NOTHING TO DO",3)
							ProcedureReturn #ErrorNothingToCalculate
						EndIf
						Syslog("JUMP to "+line,3)
					EndIf

				Case #CmndNoCode
					ProcedureReturn #ErrorNothingToCalculate

				Default
					ProcedureReturn #ErrorIllegalCommand
				EndSelect

				; -----------------------------------------------------------------------------------------------------------------

			ElseIf code<=#CmndFactorize
				Select code
				Case #CmndPlus
					If stck>1
						stck-1
						Stack(stck-1)+Stack(stck)
					Else
						ProcedureReturn #ErrorStackUnderflow
					EndIf
				Case #CmndMinus
					If stck>1
						stck-1
						Stack(stck-1)-Stack(stck)
					Else
						ProcedureReturn #ErrorStackUnderflow
					EndIf
				Case #CmndMultiply
					If stck>1
						stck-1
						Stack(stck-1)*Stack(stck)
					Else
						ProcedureReturn #ErrorStackUnderflow
					EndIf
				Case #CmndDivide
					If stck>1
						stck-1
						If Stack(stck)<>0.0
							Stack(stck-1)/Stack(stck)
						Else
							ProcedureReturn #ErrorDivisionByZero
						EndIf
					Else
						ProcedureReturn #ErrorStackUnderflow
					EndIf
				Case #CmndPower
					If stck>1
						stck-1
						Stack(stck-1)=Pow(Stack(stck-1),Stack(stck))
					Else
						ProcedureReturn #ErrorStackUnderflow
					EndIf
				Case #CmndFactorize
					If stck
						val=Stack(stck-1)
						If val=Int(val) And val>=0
							Stack(stck-1)=EvalGamma(val+1)
						Else
							ProcedureReturn #ErrorIllegalValue
						EndIf
					Else
						ProcedureReturn #ErrorStackUnderflow
					EndIf
				Default
					ProcedureReturn #ErrorIllegalOperation
				EndSelect

				; -----------------------------------------------------------------------------------------------------------------

			ElseIf code<=#CmndFnGamma
				If stck
					val=Stack(stck-1)
					Select code
					Case #CmndFnSin
						If 0 : val=Radian(Val) : EndIf
						Stack(stck-1)=Sin(val)
					Case #CmndFnCos
						If 0 : val=Radian(Val) : EndIf
						Stack(stck-1)=Cos(val)
					Case #CmndFnTan
						If 0 : val=Radian(Val) : EndIf
						Stack(stck-1)=Tan(val)
					Case #CmndFnLog
						If val>=0
							Stack(stck-1)=Log10(val)
						Else
							ProcedureReturn #ErrorIllegalValue
						EndIf
					Case #CmndFnLn
						If val>=0
							Stack(stck-1)=Log(val)
						Else
							ProcedureReturn #ErrorIllegalValue
						EndIf
					Case #CmndFnAbs
						If val<0
							Stack(stck-1)=-val
						EndIf
					Case #CmndFnSqr
						If val>=0
							Stack(stck-1)=Sqr(val)
						Else
							ProcedureReturn #ErrorIllegalValue
						EndIf
					Case #CmndFnGamma
					Default
						ProcedureReturn #ErrorIllegalFunction
					EndSelect
				Else
					ProcedureReturn #ErrorStackUnderflow
				EndIf

				; -----------------------------------------------------------------------------------------------------------------

			Else
				Select code
				Case #CmndFnMin
				Case #CmndFnMax
				Default
					ProcedureReturn #ErrorIllegalExtendedFunction
				EndSelect

			EndIf

			; -----------------------------------------------------------------------------------------------------------------

			If line=#MaxProgramLines
				Debug ":("
				ProcedureReturn #ErrorToManyProgramLines
			EndIf

		EndWith

		line+1
	ForEver

EndProcedure
Procedure.i EvalText(s.s,x.d,number=0)

	Protected Dim s.s(0)
	Protected Dim Token.TokenType(0)
	Protected Dim Code.CodeType(0)
	Protected e,i,n,l,t,z
	Protected line

	Protected.d val; TEST

	n=StrSplit(s,s())
	If n
		While i<n And e>=0
			t=EvalType(s(i));						-10<x<10 or sin(x)*e
			If t
				e=EvalRange(s(i),Code());			Range -> Code
			Else
				e=EvalParser(s(i),Token());			Formula -> Token
				If e>0
					e=EvalCoder(e,Token(),Code());	Token -> Code
				EndIf
			EndIf
			If e>0;								Code lines
				If t=#True And l=#True;				Two Ranges with no code inbetween
					Program(number,line)\Command=#CmndNoCode
					line+1
				EndIf
				l=t
				z=0
				While z<e
					Program(number,line)=Code(z)
					z+1
					line+1
				Wend
			EndIf

			i+1
		Wend

		If e<0
			Debug StrError(e)
		Else
			If t;								Range at the end
				Program(number,line)\Command=#CmndNoCode
				line+1
			EndIf

			i=line;								Backtrack to set jump targets
			l=#Null
			t=#Null
			While i
				i-1
				Select Program(number,i)\Command
				Case #CmndRangeMax,#CmndRangeMin
					If t
						l=i;						remember target
					EndIf
				Case #CmndRangeNxt
					Syslog(Str(i)+" -> "+Str(l),3)
					Program(number,i)\Info=l;		set target
					t=#True
				EndSelect
			Wend

			State(number)\ProgramLines=line

			Syslog("[ x="+StrD(x)+" ]")
			Syslog(Str(line)+" Code lines")

			Rgstr(1)=x
			e=EvalCode(#Null,@val)
			If e>=0
				Debug val
			Else
				Debug StrError(e)
			EndIf
		EndIf
	EndIf

EndProcedure

EvalText("-3<x<3:x*x",12)
EvalText("sqr(x);",121)
EvalText("a=-sqr(-x)+x;a*2",-121)
EvalText("-1<x<1:10000+x; -10<x<10:20000+sqr(x)/ln(x); -100<x<100:30000+x*x;",3)
End

[SMaag]

Maybe a RPN-Processor 'reverse polish notation" might be a solution for processing math expressions 1000's of times very quickly.

I did a quick implementation of a RPN Processor to show how it works.
It supports unlimited user parameters in a very easy way. So expressions like : ax² + bx +c can be processed by changing paramaters
at runtime.

The implementation is only the RPN-Processor not the converter/compiler from String expressions to RPN form. That's an other thing.

here the Link to RPN Processor Task

viewtopic.php?t=86054

[Michael Vogel]

Hi, Smaag...
...yes, RPN is what I did (see the posting above) - meanwhie the program does what it should do (hopefully ) so here's the result for downloading:

Function Grapher (Windows 64 Bit)

There are still some small things to get polished, anyhow I am satisfied for now. Mainly the first posting has been merged with the RPN logic (the second post above this one), anyhow I also added quite a lot routines for doing a "smarter" output (formatted numbers, formatted text, etc.)