view te.pl @ 1:09586da5afa8 kono r1

Tokio compiler on Prolog.
author kono
date Thu, 30 Aug 2007 14:57:44 +0900
parents cfb7c6b24319
children
line wrap: on
line source

/*
 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 */