Mercurial > hg > Applications > Tokio
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 */