Mercurial > hg > Applications > Tokio
changeset 2:61743469ee56 sicstus4
*** empty log message ***
| author | kono |
|---|---|
| date | Fri, 31 Aug 2007 23:33:02 +0900 |
| parents | cfb7c6b24319 |
| children | 92791d7fbf21 |
| files | cp.pl cp.pl.c td.pl tr.pl xf.pl |
| diffstat | 5 files changed, 71 insertions(+), 27 deletions(-) [+] |
line wrap: on
line diff
--- a/cp.pl Thu Aug 30 14:57:44 2007 +0900 +++ b/cp.pl Fri Aug 31 23:33:02 2007 +0900 @@ -1,11 +1,3 @@ - - - - - - - - compile0(F) :- prolog_flag(single_var_warnings,_),!, prolog_flag(single_var_warnings,X,off), @@ -21,7 +13,24 @@ style_check(+singleton). compile0(F) :- compile(F). - + + + + +% copy(X,Y) :- copy_term(X,Y). % for sicstus prolog + +copy(X, Y) :- copy(X, Y, var, _). +copy(X, Y, Vlist0, Vlist1) :- nonvar(X), + functor(X, F, A), functor(Y, F, A), !, + copy(A, X, Y, Vlist0, Vlist1). +copy(X, Y, Vlist0, Vlist0) :- map(Vlist0, X, Y), !. +copy(X, Y, Vlist0, var(X, Y, Vlist0)). +copy(0, _, _, Vlist0, Vlist0) :- !. +copy(N, X, Y, Vlist0, Vlist2) :- + arg(N, X, Xn), copy(Xn, Yn, Vlist0, Vlist1), arg(N, Y, Yn), + M is N-1, !, copy(M, X, Y, Vlist1, Vlist2). +map(var(X, Y, _), Var, Y) :- X==Var, !. +map(var(_,_,Rest), Var, Y) :- map(Rest, Var, Y). @@ -29,9 +38,17 @@ -copy(X,Y) :- copy_term(X,Y). +r_abolish(A,B) :- functor(C,A,B),retractall(C). + + - -nofileerrors. -ttynl :- nl,flush. +put([C]) :- !, char_code(Char,C),put_char(Char). +put(C) :- char_code(Char,C),put_char(Char). + +ttyflush :- flush_output. + +nofileerrors. + +tab(0) :-!. +tab(N) :- N>0, N1 is N-1,write(' '),tab(N1).
--- a/cp.pl.c Thu Aug 30 14:57:44 2007 +0900 +++ b/cp.pl.c Fri Aug 31 23:33:02 2007 +0900 @@ -86,7 +86,7 @@ ttynl :- nl,flush. #endif -#if defined(SICSTUS) || defined(SWIPROLOG) +#if defined(SICSTUS) || defined(SICSTUSV4) || defined(SWIPROLOG) compile0(F) :- prolog_flag(single_var_warnings,_),!, prolog_flag(single_var_warnings,X,off), @@ -127,4 +127,30 @@ #endif +r_abolish(A,B) :- functor(C,A,B),retractall(C). + +#if defined(SICSTUSV4) + + +put([C]) :- !, char_code(Char,C),put_char(Char). +put(C) :- char_code(Char,C),put_char(Char). + +ttyflush :- flush_output. + +nofileerrors. + +tab(0) :-!. +tab(N) :- N>0, N1 is N-1,write(' '),tab(N1). + +#else + +append([],X,X). +append([H|X],Y,[H|Z]) :- append(X,Y,Z). + +member(H,[H|_]) :-!. +member(H,[_|T]) :- member(H,T). + + +#endif + /* end */
--- a/td.pl Thu Aug 30 14:57:44 2007 +0900 +++ b/td.pl Fri Aug 31 23:33:02 2007 +0900 @@ -33,7 +33,7 @@ r_tokioDebug(S,_Q,Now) :- S > Now,!. r_tokioDebug(S,_Q,Now) :- 0<S,S < Now,!,fail. r_tokioDebug(_,Q,Now) :- - abolish(r_skip,1), + r_abolish(r_skip,1), assert(r_skip(-1)),!, r_select(Q,Now),!,r_skip(S),(S>Now;S= -1). @@ -96,7 +96,7 @@ r_save_queue(Q), told,!,fail. r_tokioDebug_menu(skip(N),_,Time) :- !, - M is N+Time,abolish(r_skip,1), + M is N+Time,r_abolish(r_skip,1), assert(r_skip(M)). r_tokioDebug_menu(_,_,_Time) :- !,fail. @@ -112,7 +112,7 @@ r_save_static. r_save_queue(t(Empty,X,Fin,Now,F,K,Next,Futures,True)) :- - nl,write((:- abolish(restart,1),recorda(time,Now,_))),write('.'), + nl,write((:- r_abolish(restart,1),recorda(time,Now,_))),write('.'), nl, OO = ( restart :- r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
--- a/tr.pl Thu Aug 30 14:57:44 2007 +0900 +++ b/tr.pl Fri Aug 31 23:33:02 2007 +0900 @@ -27,9 +27,9 @@ :-dynamic(r_skip/1). r_header :- - write(' - Tokio to prolog compiler $Revision$ $Date$ - try ?- tokio_help. + write('\ + Tokio to prolog compiler $Revision$ $Date$\ + try ?- tokio_help.\ '). user_help :- tokio_help. @@ -276,7 +276,7 @@ init_static :- recorded(r_static,Name,_),recorded(Name,_,Ref), erase(Ref),fail. -init_static :- abolish(r_skip,1), +init_static :- r_abolish(r_skip,1), assert(r_skip(-1)). reset_static :- recorded(r_static,Name,Iref),recorded(Name,_,Ref), @@ -312,11 +312,11 @@ % A \= A :-!,fail. % _ \= _. -append([],X,X). -append([H|X],Y,[H|Z]) :- append(X,Y,Z). +% append([],X,X). +% append([H|X],Y,[H|Z]) :- append(X,Y,Z). -member(H,[H|_]) :-!. -member(H,[_|T]) :- member(H,T). +% member(H,[H|_]) :-!. +% member(H,[_|T]) :- member(H,T). /* for ttyflush */
--- a/xf.pl Thu Aug 30 14:57:44 2007 +0900 +++ b/xf.pl Fri Aug 31 23:33:02 2007 +0900 @@ -51,6 +51,7 @@ systemp( waitevent(_)). systemp(abolish(_,_)). +systemp(r_abolish(_,_)). systemp(abort). systemp(arg(_,_,_)). systemp(assert(_)). @@ -140,7 +141,7 @@ systemp('LC'). systemp('NOLC'). systemp('!'). -systemp('\+'). +systemp('\\+'). systemp(_'<'_). systemp(_'=<'_). systemp('>'(_,_)). @@ -148,7 +149,7 @@ systemp('='(_,_)). systemp('=..'(_,_)). systemp('=='(_,_)). -systemp('\=='(_,_)). +systemp('\\=='(_,_)). systemp('@<'(_,_)). systemp('@=<'(_,_)). systemp('@>'(_,_)).