Mercurial > hg > Applications > Tokio

comparison cp.pl.c @ 0:cfb7c6b24319

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author kono
date Thu, 30 Aug 2007 14:57:44 +0900
parents
children 61743469ee56
comparison
equal deleted inserted replaced
-1:000000000000 0:cfb7c6b24319
1 /*
2 Copyright (C) 1988, Shinji Kono
3 Everyone is permitted to copy and distribute verbatim copies
4 of this license, but changing it is not allowed. You can also
5 use this wording to make the terms for other programs.
6
7 send your comments to kono@mtl.utokyo.ac.jp
8 */
9 /*
10 support routine for compatibilities
11 */
12
13 #ifdef CPROLOG
14
15 help :- tokio_help.
16
17 compile0(X) :- [X].
18
19 numbervars(X, V, V).
20
21 /*
22 % numbervars('$VAR'(V0), V0, V) :- !, V is V0+1.
23 numbervars(Vname, Vname, V0, V) :-
24 var(Vname),!,
25 V is V0+1,name(V0,Lv),name(Vname,[95|Lv]). %%% _001
26 numbervars(X, V0, V) :-
27 functor(X, F, A),
28 numbervars_args(0, A, X, V0, V),!.
29
30 % :- mode numbervars_args(+,+,+,-,+,-).
31 numbervars_args(N, N, _, V, V) :- !.
32 numbervars_args(K, N, X, V0, V) :-
33 K1 is K+1,
34 arg(K1, X, XK),
35 numbervars(XK, V0, V1),
36 numbervars_args(K1, N, X, V1, V).
37 */
38
39
40 #ifdef CPROLOG15
41 term_expansion(X,X).
42 :-unknown(X,trace).
43 #endif
44
45 :- (ttyflush;assert((ttyflush:-nl))).
46
47 :-asserta((c_post(Vname, Vname, V0, V) :-
48 var(Vname),!,
49 V is V0+1,name(V0,Lv),name(Vname,[95|Lv]))). %%% _001
50 % c_post continue to to.pl
51
52 :-abolish(c_post_atomic,2).
53 c_post_atomic([],[]) :- !.
54 c_post_atomic(Number,Number) :- number(Number),!.
55 c_post_atomic(=,' = ') :- !. % for 1.2, Do not ask me why.
56 c_post_atomic(Atomic,Qatomic):-
57 name(Atomic,La),La=[H|_],[H]\="'",[H]\="_",!,
58 concatenate(["'",La,"'"],Nla),name(Qatomic,Nla).
59 c_post_atomic(Atomic,Atomic).
60
61 :-abolish(write_clause0,1).
62 write_clause0((X:-true)) :-
63 c_post(X, XX, 0, _), write(XX), put("."), nl,!,fail. %%% writeq --> write
64 write_clause0(X) :-
65 c_post(X, XX, 0, _), write(XX), put("."), nl,!,fail. %%% writeq --> write
66
67 :-abolish(r_cputime,1).
68 r_cputime(X) :- X is cputime.
69
70 :-abolish(tokiocomp1,1).
71 tokiocomp1(X) :- tokiocomp2(X).
72 tokiocomp1(_) :-
73 telling(I),tell(user),
74 read(Next),tell(I), !, tokiocomp1(Next).
75 tokiocomp1(_) :- c_error((nl,write('read error'),nl)).
76
77 :-abolish(read_filter,2).
78 read_filter(X,Name) :- telling(I),tell(user),
79 repeat,read(X),
80 filter(X,Name),tell(I).
81
82 #endif
83
84 #ifdef SWIPROLOG
85 nofileerrors.
86 ttynl :- nl,flush.
87 #endif
88
89 #if defined(SICSTUS) || defined(SWIPROLOG)
90 compile0(F) :-
91 prolog_flag(single_var_warnings,_),!,
92 prolog_flag(single_var_warnings,X,off),
93 prolog_flag(discontiguous_warnings,Y,off),
94 compile(F),
95 prolog_flag(single_var_warnings,_,X),
96 prolog_flag(discontiguous_warnings,_,Y).
97 compile0(F) :-
98 style_check(-singleton),!,
99 style_check(-discontiguous),!,
100 compile(F),
101 style_check(+discontiguous),
102 style_check(+singleton).
103 compile0(F) :-
104 compile(F).
105 #endif
106
107 #if !defined(SICSTUS)||!defined(SWIPROLOG)
108
109 % copy(X,Y) :- copy_term(X,Y). % for sicstus prolog
110
111 copy(X, Y) :- copy(X, Y, var, _).
112 copy(X, Y, Vlist0, Vlist1) :- nonvar(X),
113 functor(X, F, A), functor(Y, F, A), !,
114 copy(A, X, Y, Vlist0, Vlist1).
115 copy(X, Y, Vlist0, Vlist0) :- map(Vlist0, X, Y), !.
116 copy(X, Y, Vlist0, var(X, Y, Vlist0)).
117 copy(0, _, _, Vlist0, Vlist0) :- !.
118 copy(N, X, Y, Vlist0, Vlist2) :-
119 arg(N, X, Xn), copy(Xn, Yn, Vlist0, Vlist1), arg(N, Y, Yn),
120 M is N-1, !, copy(M, X, Y, Vlist1, Vlist2).
121 map(var(X, Y, _), Var, Y) :- X==Var, !.
122 map(var(_,_,Rest), Var, Y) :- map(Rest, Var, Y).
123
124 #else
125
126 copy(X,Y) :- copy_term(X,Y).
127
128 #endif
129
130 /* end */