Archive version of: parse-equation.r ... version: 3 ... fvzv 14-Mar-2011

REBOL [
	File: %parse-equation.r
	Date: 14-Mar-2011
	Title: "Equation Dialect Parser"
	Author: "Francois Vanzeveren"
	Purpose: {Converts a mathematical equation into a block of rebol code that can be evaluated.}
	Version: 0.9.2
	History: [
		0.9.2 14-Mar-2011 "Francois Vanzeveren"
			{-IMPROVEMENT: much more readable and elegant recursive implementation.
			- BUG FIX: precedence between '**' and '*' fixed, e.g 2**3*6 will now return 
				[multiply power 2 3 6] instead of [power 2 multiply 3 6]}
		0.9.1 13-Mar-2011 "Francois Vanzeveren"
			{New functions implemented:
				abs(), arcos(), acos(), arcsin(), asin(), arctan(), atan(), cos(), exp(),
				log(), ln(), sin(), sqrt(), tan()}
		0.9.0 13-Mar-2011 "Francois Vanzeveren" 
			"First public release. Future versions will provide additional functions."
	]
	TO-DO: {
		Version 1.0.0
			- Equation syntax error handling to return usefull messages to the user when
			she/he makes syntax errors in the equation.
	}
	Library: [
		level: 'intermediate
		platform: 'all
		type: [dialect function]
		domain: 'math
		tested-under: [windows linux]
		license: 'lgpl
	]
]

parse-equation: func [
	p_equation [string!] "The equation to parse."
	/local eq retval parent-depth str tmp char
] [
	eq: trim/all lowercase copy p_equation
	
	retval: copy []
	parent-depth: 0
	str: copy ""
	
	; Avons-nous à faire à un nombre?
	if tmp: attempt [to-decimal eq] [
		append retval tmp
		return retval
	] 
		
	; We first search for operators of first precedence (+ and -)
	parse/all eq [
		any [
			"+" (
				either zero? parent-depth [
					append retval 'add
					append retval parse-equation str
					str: copy ""
				] [append str "+"]
			) |
			"-" (
				either zero? parent-depth [
					append retval 'subtract
					append retval parse-equation str
					str: copy ""
				] [append str "-"]
			) |
			"(" (
				append str "("
			  	parent-depth: add parent-depth 1
			) | 
			")" (
				append str ")"
				parent-depth: subtract parent-depth 1
			) | 
			copy char skip (append str char)
		]
	]
	
	if not empty? retval [
		append retval parse-equation str
		return retval
	]
	
	; We did not find operator of first precedence (+ and -)
	; We look now for second precedence (* and /).
	parent-depth: 0
	str: copy ""

	parse/all eq [
		any [ 
			"**" (append str "**") | 
			"*" (
				either zero? parent-depth [
					append retval 'multiply
					append retval parse-equation str
					str: copy ""
				] [append str "*"]
			) |
			"//" (
				either zero? parent-depth [
					append retval 'remainder
					append retval parse-equation str
					str: copy ""
				] [append str "//"]
			) |
			"/" (
				either zero? parent-depth [
					append retval 'divide
					append retval parse-equation str 
					str: copy ""
				] [append str "/"]
			) |
			"(" (
				append str "("
			  	parent-depth: add parent-depth 1
			) | 
			")" (
				append str ")"
				parent-depth: subtract parent-depth 1
			) | 
			copy char skip (append str char)
		]
	]
	
	if not empty? retval [
		append retval parse-equation str
		return retval
	]
	
	; Toujours rien? Il s'agit alors:
	; * soit d'un opérateur unitaire
	; * soit d'une expression entièrement comprise entre parenthèse
	; * soit d'une inconnue

	parent-depth: 0
	str: copy ""
	
	; opérateur unitaire
	parse/all eq [
		"abs(" copy str to end (
			remove back tail str
			append retval 'abs
			append retval parse-equation str
			return retval
		) |
		"arccos(" copy str to end (
			remove back tail str
			append retval to-word "arccosine/radians"
			append retval parse-equation str
			return retval
		) |
		"acos(" copy str to end (
			remove back tail str
			append retval to-word "arccosine/radians"
			append retval parse-equation str
			return retval
		) |
		"arcsin(" copy str to end (
			remove back tail str
			append retval to-word "arcsine/radians"
			append retval parse-equation str
			return retval
		) |
		"asin(" copy str to end (
			remove back tail str
			append retval to-word "arcsine/radians"
			append retval parse-equation str
			return retval
		) |
		"arctan(" copy str to end (
			remove back tail str
			append retval to-word "arctangent/radians"
			append retval parse-equation str
			return retval
		) |
		"atan(" copy str to end (
			remove back tail str
			append retval to-word "arctangent/radians"
			append retval parse-equation str
			return retval
		) |
		"cos(" copy str to end (
			remove back tail str
			append retval to-word "cosine/radians" 
			append retval parse-equation str
			return retval
		) |
		"exp(" copy str to end (
			remove back tail str
			append retval 'exp 
			append retval parse-equation str
			return retval
		) |
		"log(" copy str to end (
			remove back tail str
			append retval 'log-10 
			append retval parse-equation str
			return retval
		) |
		"ln(" copy str to end (
			remove back tail str
			append retval 'log-e 
			append retval parse-equation str
			return retval
		) |
		"sin(" copy str to end (
			remove back tail str
			append retval to-word "sine/radians"
			append retval parse-equation str
			return retval
		) |
		"sqrt(" copy str to end (
			remove back tail str
			append retval 'square-root
			append retval parse-equation str
			return retval
		) | 
		"tan(" copy str to end (
			remove back tail str
			append retval 'tangent
			append retval parse-equation str
			return retval
		)
	]
	
	parent-depth: 0
	str: copy ""
	
	parse/all eq [
		any [
			"**" (
				either zero? parent-depth [
					append retval 'power 
					append retval parse-equation str
					str: copy ""
				] [append str "**"]
			) | 
			"(" (
				append str "("
			  	parent-depth: add parent-depth 1
			) | 
			")" (
				append str ")"
				parent-depth: subtract parent-depth 1
			) | copy char skip (append str char)
		]
	]
	
	if not empty? retval [
		append retval parse-equation str
		return retval
	]
	
	if equal? #"(" first eq [
		remove head eq ; on supprimer la parenthèse ouvrante
		remove back tail eq ; on supprimer la parenthèse fermante
		append retval parse-equation eq
		return retval
	]
	
	; il ne reste plus que l'hypothèse d'une inconnue
	append retval to-word eq
	return retval
]