view cp.pl.c @ 4:f864bb4ba9a4 default tip

update tags
author convert-repo
date Fri, 07 Nov 2008 20:36:52 +0000
parents 92791d7fbf21
children
line wrap: on
line source

/*
 Copyright (C) 1988, 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@mtl.utokyo.ac.jp
*/
/* 
   support routine for compatibilities
   */

#ifdef CPROLOG

help :- tokio_help.

compile0(X) :- [X].

numbervars(X, V, V).

/*
% numbervars('$VAR'(V0), V0, V) :- !, V is V0+1.
numbervars(Vname, Vname, V0, V) :- 
  	var(Vname),!, 
	V is V0+1,name(V0,Lv),name(Vname,[95|Lv]).  %%% _001
numbervars(X, V0, V) :-
	functor(X, F, A), 
	numbervars_args(0, A, X, V0, V),!.

% :- mode numbervars_args(+,+,+,-,+,-).
numbervars_args(N, N, _, V, V) :- !.
numbervars_args(K, N, X, V0, V) :-
	K1 is K+1, 
	arg(K1, X, XK),   
	numbervars(XK, V0, V1), 
	numbervars_args(K1, N, X, V1, V).
*/


#ifdef CPROLOG15
term_expansion(X,X).
:-unknown(X,trace).
#endif

:- (ttyflush;assert((ttyflush:-nl))).

:-asserta((c_post(Vname, Vname, V0, V) :- 
  	var(Vname),!, 
	V is V0+1,name(V0,Lv),name(Vname,[95|Lv]))).  %%% _001
% c_post continue to to.pl

:-abolish(c_post_atomic,2).
c_post_atomic([],[]) :- !.
c_post_atomic(Number,Number) :- number(Number),!.
c_post_atomic(=,' = ') :- !.     % for 1.2, Do not ask me why.
c_post_atomic(Atomic,Qatomic):-
     name(Atomic,La),La=[H|_],[H]\="'",[H]\="_",!,
     concatenate(["'",La,"'"],Nla),name(Qatomic,Nla).
c_post_atomic(Atomic,Atomic).

:-abolish(write_clause0,1).
write_clause0((X:-true)) :- 
    c_post(X, XX, 0, _), write(XX), put("."), nl,!,fail. %%% writeq --> write
write_clause0(X) :- 
    c_post(X, XX, 0, _), write(XX), put("."), nl,!,fail. %%% writeq --> write

:-abolish(r_cputime,1).
r_cputime(X) :- X is cputime.

:-abolish(tokiocomp1,1). 
tokiocomp1(X) :- tokiocomp2(X).
tokiocomp1(_) :-
    telling(I),tell(user),
    read(Next),tell(I), !, tokiocomp1(Next). 
tokiocomp1(_) :- c_error((nl,write('read error'),nl)).

:-abolish(read_filter,2).
read_filter(X,Name) :- telling(I),tell(user),
        repeat,read(X),
	filter(X,Name),tell(I).

#endif

#ifdef SWIPROLOG
nofileerrors.
ttynl :- nl,flush.
#endif

#if defined(SICSTUS) || defined(SICSTUSV4) || defined(SWIPROLOG)
compile0(F) :- 
    prolog_flag(single_var_warnings,_),!,
    prolog_flag(single_var_warnings,X,off),
    prolog_flag(discontiguous_warnings,Y,off),
    compile(F),
    prolog_flag(single_var_warnings,_,X),
    prolog_flag(discontiguous_warnings,_,Y).
compile0(F) :- 
    style_check(-singleton),!,
    style_check(-discontiguous),!,
    compile(F),
    style_check(+discontiguous),
    style_check(+singleton).
compile0(F) :- 
    compile(F).
#endif

#if !defined(SICSTUS)||!defined(SWIPROLOG)

% 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). 
 
#else

copy(X,Y) :- copy_term(X,Y).

#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 :- prolog_flag(fileerrors,off,_).
fileerrors :- prolog_flag(fileerrors,on,_).

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