Mercurial > hg > Applications > Tokio
diff te.pl @ 0:cfb7c6b24319
Initial revision
author | kono |
---|---|
date | Thu, 30 Aug 2007 14:57:44 +0900 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/te.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,91 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + tokio compier function evaluator + Sat Jan 11 12:11:22 JST 1986 +*/ + +/* + Now we move hole computation routines to tp + preprocessor part. So we only try to make temporal varible + structures here. +*/ + +% c_eval(Expression, Generate_Expression, Qhead, Qtail, Control). + +c_eval(Var, Now, Q, Q, _C) :- + variable(Var),!, + c_seperate_now(Var, Now). +%c_eval(Exp, Value, Q, Q1, C) :- n_function(Exp,A,B,Exp1,AA,BB),!, +% c_eval_exp(A, AA, Q, Q2, C), +% c_eval_exp(B, BB, Q2, (Value is Exp1,Q1), C). +c_eval(Atomic, Atomic, Q, Q, _C) :- atomic(Atomic),!. +c_eval(@E, Next, Q, Q1, C) :- !, + c_seperate_next(E, EE), + c_eval(EE, Next, Q, Q1, C). +% c_eval(*S, Value, Q, Q1, C) :- !, % move into tp (macro expanstion) +% c_eval(S, Name, Q, ('r_read_value'(Name,Value),Q1), C). +c_eval(Func, Value, Q, Q1, C) :- + functor(Func, H, A), functor(Value, H, A), + c_eval_arg(0, A, Func, Value, Q, Q1, C). + +c_eval_arg(N, N, _, _, Q, Q, _) :- !. +c_eval_arg(N, M, A, B, Q, Q2, C) :- + N1 is N+1, + arg(N1, A, A1), arg(N1, B, B1), + c_eval(A1, B1, Q, Q1, C), + c_eval_arg(N1, M, A, B, Q1, Q2, C). + +%c_eval_exp(Exp, Exp1, Q, Q1, C) :- nonvar(Exp), +% n_function(Exp,A,B,Exp1,AA,BB),!, +% c_eval_exp(A, AA, Q, Q2, C), +% c_eval_exp(B, BB, Q2, Q1, C). +%c_eval_exp(Exp, Exp1, Q, Q1, C) :- +% c_eval(Exp, Exp1, Q, Q1, C). + +c_hex(H,V) :- c_hex(H,0,V). +c_hex([],V,V):-!. +c_hex([H|T],V,V1) :- c_hex1([H],VH), V2 is V*16+VH, + c_hex(T,V2,V1). + +c_binary(H,V) :- c_binary(H,0,V). +c_binary([],V,V):-!. +c_binary([H|T],V,V1) :- c_binary1([H],VH), V2 is V*2+VH, + c_binary(T,V2,V1). + +c_binary1("0",0). c_binary1("1",1). + +c_hex1("0",0). c_hex1("1",1). c_hex1("2",2). c_hex1("3",3). +c_hex1("4",4). c_hex1("5",5). c_hex1("6",6). c_hex1("7",7). +c_hex1("8",8). c_hex1("9",9). c_hex1("A",10). c_hex1("B",11). +c_hex1("C",12). c_hex1("D",13). c_hex1("E",14). c_hex1("F",15). +c_hex1("a",10). c_hex1("b",11). c_hex1("c",12). c_hex1("d",13). +c_hex1("e",14). c_hex1("f",15). + +n_predicate(A<B,A,B,AA<BB,AA,BB). +n_predicate(A>B,A,B,AA>BB,AA,BB). +n_predicate(A=<B,A,B,AA=<BB,AA,BB). +n_predicate(A>=B,A,B,AA>=BB,AA,BB). +n_predicate(A\=B,A,B,AA\==BB,AA,BB). + +% n_function(cputime,0,0,cputime,_,_). +n_function(A+B,A,B,AA+BB,AA,BB). +n_function(A-B,A,B,AA-BB,AA,BB). +n_function(A*B,A,B,AA*BB,AA,BB). +n_function(A/B,A,B,AA/BB,AA,BB). +n_function(A//B,A,B,AA//BB,AA,BB). +n_function(A^B,A,B,AA^BB,AA,BB). +n_function(A mod B,A,B,AA mod BB,AA,BB). +n_function(A/\B,A,B,AA/\BB,AA,BB). +n_function(A\/B,A,B,AA\/BB,AA,BB). +n_function(A<<B,A,B,AA<<BB,AA,BB). +n_function(A>>B,A,B,AA>>BB,AA,BB). + +/* evalator end */