Archive version of: parse-equation.r ... version: 1 ... fvzv 13-Mar-2011

Amendment note: new script || Publicly available? Yes

REBOL [
	File: %parse-equation.r
	Date: 13-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.0
	History: [
		0.9.0 13-Mar-2011 "Francois Vanzeveren" 
			"First public release. Future versions will provide additional functions."
	]
	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 [
					repend retval ['add str] 
					str: copy ""
				] [append str "+"]
			) |
			"-" (
				either zero? parent-depth [
					repend retval ['subtract 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)
		]
	]
	
	append retval str
	
	if equal? 1 length? retval [
		; We did not find operator of first precedence (+ and -)
		; We look now for second precedence (* and /).
		retval: copy []
		parent-depth: 0
		str: copy ""

		parse/all eq [
			any [ 
				"**" (
					either zero? parent-depth [
						repend retval ['power str] 
						str: copy ""
					] [append str "**"]
				) | 
				"*" (
					either zero? parent-depth [
						repend retval ['multiply str] 
						str: copy ""
					] [append str "*"]
				) |
				"//" (
					either zero? parent-depth [
						repend retval ['remainder str] 
						str: copy ""
					] [append str "//"]
				) |
				"/" (
					either zero? parent-depth [
						repend retval ['divide 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)
			]
		]
		append retval str
	]
	
	if equal? 1 length? retval [
		; Toujours rien? Il s'agit alors:
		; * soit d'une expression entièrement comprise entre parenthèse
		; * soit d'un opérateur unitaire
		; * soit d'une inconnue

		retval: copy []
		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
		]
		
		; opérateur unitaire
		parse/all eq [
			"sqrt(" copy str to end (
				remove back tail str
				append retval 'square-root
				append retval parse-equation str
			) | 
			"sin(" copy str to end (
				remove back tail str
				append retval to-word "sine/radians"
				append retval parse-equation str
			) |
			"cos(" copy str to end (
				remove back tail str
				append retval to-word "cosine/radians" 
				append retval parse-equation str
			) |
			; il ne reste plus que l'hypothèse d'une inconnue
			copy str to end (append retval to-word str)
		]
		
		return retval
	]

	forall retval [
		if string? first retval [
			change/part retval parse-equation first retval 1
		]
	]
	return head retval
]