-
Notifications
You must be signed in to change notification settings - Fork 1
/
sicstus4compatibility.pl
117 lines (81 loc) · 2.28 KB
/
sicstus4compatibility.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
%% FILE sicstus4compatibility.pl
%% SYSTEM TUC
%% CREATED TA-071026
%% REVISED TA-080506
:-module( sicstus4compatibility, [ get0/1, get/1, out/1, output/1, prettypr/2, prompt/1, put/1, remove_duplicates1/2,
tab/1, traceprog/2, ttyflush/0,
%writeanswer/1,
writepred/1 ] ). %% RS-150119 progtrace/2,
%% Sicstus 4 compatibility
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:-use_module( declare, [ language/1, value/2 ] ).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% append/3 %% built-in Sicstus 4 (library.pl)
get(G) :- get_code(F),
F = 10 -> get(G) %% CR
;
G=10.
get0(G) :- get_code(G). %% TA-070809
%% member/2 %% built-in Sicstus 4 (library.pl)
out(P) :- write(P), tab(1). %% Moved to sicstus4compatibility!
output(P) :- write(P), nl. %% Moved to sicstus4compatibility!
prompt( ' ' ) :-
value(norsource,true). %% TA-110207
prompt(P):-
language(L),
prompt2(L,P),
!.
prompt('?: '). % Undefined Prompt.
prompt2( english, 'E: ' ).
prompt2( norsk, 'N: ' ).
%%built in Sicstus 4 (library.pl), but doesn't really work in sicstusProlog!!
%% remove_duplicates Standard -> library
remove_duplicates1(X,Y):- % preserves order of first occurrence
rem_dups(X,[],Y).
rem_dups([],_,[]):-!.
rem_dups([X|Y],Keep,[X|Z]):-
\+ member(X,Keep),
!,
rem_dups(Y,[X|Keep],Z).
rem_dups([_|Y],Keep,Z):-
rem_dups(Y,Keep,Z).
%%
put(G) :- put_code(G).
%% drop ... %% TA-110204
prettypr(H,P) :-
write('*** '), %% drop ... %% TA-110204
write(H),
write(' ***'),
nl,nl,
prettypr2(P).
prettypr2((X,R)) :-
!,
write(X),nl,
prettypr2(R).
prettypr2(X) :-
write(X),nl.
%%%
ttyflush :- flush_output(user).
%% ad hoc
tab(N):- write_blanks(N).
%% same as traceprog
%progtrace( N, P ) :-
% value(traceprog,M), number(M), M >= N,
% !,
% write(P),nl
%;
% true.
traceprog( N, P ) :-
value( traceprog, M ), number(M), M >= N,
!,
write(P),nl
;
true.
write_blanks(N):-
N > 0,
!,
write(' '),
N1 is N-1,
write_blanks(N1).
write_blanks(_).
writepred(P) :- writeq(P),write('.'),nl.