calculadora polinómica en haskell

evalexpr.hs

--Nelson Duranhona
--Trabajo Practico de Estructura de los Lenguajes - Tema:Calculadora de expresiones enteras
--fecha Modificacion Final : 20081128
--Se asume que se apila  y desapila hacia la izquierda
---------------------------------------------------------------------------------------------
--FUNCIONES DEL INTERFAZ DEL PROGRAMA
import Data.Char (isSpace)
import System.Environment (getArgs)
import List(delete)
main = do
  cmd <- prompt "ee> "
  let comando = trim cmd
  case comando of
 	"q" -> return()
	"quit" -> return()
	"s"    -> return()
	"salir"-> return()   	
	otherwise -> do
		ee comando
		main 		

prompt p = do
	putStr p
	getLine



---UTILIDADES DE CADENAS
-- trim: Elimina espacios en blanco en una cadena
trim      :: String -> String
trim      = f . f
   where f = reverse . dropWhile isSpace 

--copiar: agrega espacios entre los operadores y las expresiones..
	--copiar("1+2+3")="1 + 2 + 3 ".. 
	--porq los espacios son significativos en la notacion posfija
copiar (a)= copiar' (a ,[] ,0)
copiar' (a ,b,i) 
	| i==length a		=	b
	| esope(a!!i)==True	=	copiar'(a,b++[' ']++[a!!i]++[' '],i+1)
	| otherwise 		=	copiar'(a,b++[a!!i],i+1)

--clsposfijo:funcion que quita parentesis de una cadena 	   
clsposfijo(expr)=clsposfijo'(expr,[])
clsposfijo'(expr,nuevalista)
	|length expr==0 = nuevalista
	|letra /=')' && letra /='(' = clsposfijo'(tail expr ,nuevalista++[letra])
	|otherwise	            = clsposfijo'(tail expr ,nuevalista)
 	where 
		letra= head expr
		
--UTILIDADES DE OPERADORES
--retorna true si el caracter es operador 
esope (x) 
	| x=='+'  ||  x=='-'   ||   x=='/'  ||x=='*'  || x=='^'  || x=='('  ||x==')'  =	True 
	| otherwise											       =	False  

--devuelve true si a tiene menor  precedencia que b ,
esmenor (a,b)= getorden (a)< getorden(b)    
	where getorden (x) --le asingna numero de procedencia al operador 
		| x=='+' || x=='-' 	=	1 
		| x=='/' || x=='*'  =	2		
		| x=='^'			=	3
		| x=='(' || x==')'	=	4
		| otherwise	=	error "El caracter no es un operador"  

		
--FUNCIONES DE CONVERSION A EXPRESION POSFIJA--
--funcion  que convierte a notacion posfija 
posfija(expr)=copiar( clsposfijo(posfija'(copiar(expr),[],[])))
posfija'(expr,posfi,pilaope)
	| length expr==0			= posfi++pilaope
	| esope(frentlist)==False	= posfija'(restlist,posfi++[frentlist],pilaope)
	| esope(frentlist)==True 	= posfija'(restlist,posfi++ retlistaope(pilaope,frentlist),newlistaope(pilaope,frentlist))  
	| otherwise 				= error "Ocurrio un error inesperado en la conversion a la notacion posfija"
	where frentlist =  head expr 
	      restlist  =  tail expr 	

--funciones que tratan el caso de los parentesis
-- inparentesis devuelve la expresion a apilar en la expresion posfija
inparentesis(listope)
	|  operadores==[] 	= error "No se esperaba )"
	|  otherwise 		= operadores
	where operadores = inparentesis'(listope,[],0)
inparentesis'(listope, newlistaoper,i)
	| length listope ==i || operador=='('	= delete '(' newlistaoper
	| otherwise 			  				= inparentesis'(listope,newlistaoper++[operador],i+1) 
	where  operador= listope !! i 		

--quitparent devuelve la nueva lista de operadores al encontrar el cierre del parentesis
quitparent(listope)
	| length listope ==0 || operador=='('	= delete '(' listope
	| otherwise 			  	= quitparent(tail listope) 
	where operador= head listope

--retorna la lista operadores a apilar en la expresion posfija, 
	--tomando la lista actual  y el operador como parametros
retlistaope (lista,ope) 				
	|length lista ==0 							   =[]
	|esmenor (ope,head lista)== True &&  ope/=')'  =[head lista] 	
	|ope ==')'	 								   = inparentesis(lista)	
	|otherwise 				 					   =[]					

--retorna la nueva lista de operadores segun el operador pasado como parametro
newlistaope(lista,ope) 
	|length lista ==0 								= [ope]
	|esmenor (ope,head lista)== True &&  ope/=')' 	= [ope]++(tail lista)  	
	|ope ==')'	   									= quitparent(lista)	
	|otherwise 				 						= [ope]++(lista)				

--FUNCIONES QUE EJECUTAN LAS OPERACIONES QUE ESTAN EN LA PILA posfija		  

---ejecutar recibe como parametro un String en notacion posfija y retorna una cadena con tas las operaciones 
--echas eje:  ejecutar("5 4+")= ["5","+","4", "=", "9"] 
---ejecutar recibe como parametro un String en notacion posfija y retorna una cadena con tas las operaciones 
--echas :  ejecutar("5 4+")= ["5","+","4", "=", "9"] 
ejecutar(expr)= resultfinal
	where
		--nos posicionamos en la ultimo elemento que es el resultado
		resultfinal= ejecutar'(listatok,[],[],1) 
		listatok= words expr 
ejecutar'(expr, pilavar,result,i)
	| length expr ==0   = result
	| esoperador==False = ejecutar'(tail expr, [head expr]++pilavar,result,i)
	| esoperador==True  = ejecutar'(tail expr, [resulstring] ++tail (tail pilavar),result++resultado,i+1)
	| otherwise			= error "Error inesperado"
	where
	   esoperador=esope((head expr)!!0)
	   resultado=operacion(pilavar,(head expr)!!0,i)	
	   resulstring=resultado!! ((length resultado)-1) -- -1 porq se cuenta de 0 ,las posiciones


--funciones que ejecutan las operaciones con la pila posfija
--devuelve algo como ["10","+","30","=","40"]
operacion(pilavar,tok,i) 
	| tok=='+' && valido==True	=expre++[suma a b]
	| tok=='-' && valido==True	=expre++[resta a b]
	| tok=='*' && valido==True	=expre++[mult a b]
	| tok=='/' && valido==True	=expre++[divi a b] 
	| tok=='^' && valido==True	=expre++[poten a b] 
	| otherwise	= error "<- ultima expr reconocida , verifique el resto de la expresion"
	where 
		a= head pilavar
		b= head (tail pilavar)	
		expre=["\n"]++[show(i)]++[")"]++[b]++([[tok]])++[a]++["="]	
		valido=length pilavar >=2 --controlamos la cantidad de parametros


--ojo que se debe operar la cabecera de la pila  como segundo argumento en las 
--funciones de resta , mult , divi, poten
suma a b = show((read a::Float) + (read b::Float))
resta a b =show((read b::Float)-(read a::Float))
mult a b = show((read a::Float) * (read b::Float)) 
divi a b = show((read b::Float)/(read a::Float)) 
poten a b =show((read b::Float)**(read a::Float))


---FUNCIONES DE IMPRESION
imprimir x = putStr (unwords x++"\n")

---FUNCCION  ee 
ee expr =  do  imprimir x
	where 
	exprposf=posfija(expr)
	x=ejecutar(exprposf)