1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: systools.pl,v 1.1 2008/06/30 17:43:50 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29%
30% This file contains various Prolog system tools
31%
32
33:- module(systools).
34
35:- pragma(deprecated_warnings(off)).
36
37:- export
38	compare_dump/1,
39	make_quick/1,
40	html_index/0,
41	html_index/2,
42	print_exported/0,
43	print_quick/0,
44	read_dump_file/1,
45	undef_biprefs/0,
46	undef_biprefs/1,
47	undoc_bips/0,
48	undoc_bips/1.
49
50:- import
51	bytes_to_term/2,
52	compiled_stream/1,
53	current_built_in_body/2,
54	current_predicate_body/2,
55	get_flag_body/4
56    from sepia_kernel.
57
58
59col_width(48).
60
61% Last was 67
62make_quick(NL) :-
63	printf("reading index file...%n%b", []),
64	read_index_file,
65	setof(X, (A,B,C,D)^(bip(A, C, D, X, B), not ignored_type(X, _)), BT),
66	setof(X, (A,B,C,D)^(bip(A, C, D, X, B), not ignored_type(X, _)), BT),
67	findall(X, type(X, _), Types),
68	sort(Types, ST),
69	(ST = BT ->			% check if up-to-date
70		true
71	;
72		printf(error, "Types differ:\ndoc: %Dw\nfile: %Dw\n%b",
73			[BT, ST]),
74		fail
75	),
76	get_flag(version, Ver),
77	printf("writing file quick1...%n%b", []),
78	open(quick1, write, qs),
79	% These are only Sepia bips, not Megalog
80	printf(qs, "ECLIPSE %s BUILT-IN PREDICATES\n", [Ver]),
81	output_types(Types),
82	close(qs),
83	printf("writing file quick.ps...%n%b", []),
84	exec("wc -l quick1",[null,WC]), read_token(WC,Lines,_),close(WC),
85	Cols is (Lines-1)//(2*NL)+1,
86	concat_string(['enscript -o quick.ps -r -B -fTimes-Roman7 -c --columns=',Cols,' -L', NL, ' quick1'], Cmd),
87	exec(Cmd, []),
88	system("/bin/rm -f quick1 quick??").
89/*
90	merge_columns(NL),
91	printf(error, "Print and remove temporary files? %b", []),
92	(tyi(0'y) ->
93	    nl(error),
94	    print_quick(NL),
95	    system("/bin/rm quick1 quick??")
96	;
97	    true
98	).
99*/
100
101output_types([]).
102output_types([T|Types]) :-
103	type(T, TS),
104	printf(qs, "\n%% %s\n\n", [TS]),
105	output_type(T),
106	output_types(Types).
107
108output_type(Type) :-
109	(System = sepia ; System = extensions),
110	P=N/A,
111	bip(N, A, System, Type, File),
112	not(ignored(P)),
113	get_flag(installation_directory, Inst),
114	concat_string([Inst,'/doc/bips/',System,/,Type,/,File,'.txt'], HelpFile),
115	(exists(HelpFile) ->
116	    (short_descr(P, Line) ->
117		printf(qs, "%s\n", [Line])
118	    ;
119		open(HelpFile, read, HelpStream),
120		print_paragraph(HelpStream),
121		close(HelpStream)
122	    )
123	;
124	    printf(error, "The help file %s is missing\n%b", [HelpFile])
125	),
126	fail;true.
127
128print_paragraph(HelpStream) :-
129    pred_descr(HelpStream, Line),
130    printf(qs, "%s\n", [Line]).
131
132pred_descr(S, Line) :-
133	repeat,					% skip empty lines
134	read_string(S, end_of_line, Len, Line),
135	Len > 0,
136	!.
137
138read_index_file :-
139    (is_predicate(bip/5) ->
140	true
141    ;
142	get_flag(installation_directory, Inst),
143	concat_atom([Inst, '/doc/bips/index.pl'], Index),
144	compile(Index)
145    ).
146
147type(allsols, "All solutions").
148type(arithmetic, "Arithmetic").
149type(arrays, "Arrays and global variables").
150type(control, "Control").
151type(coroutine, "Coroutining").
152type(debug, "Debugger").
153type(directives, "Compiler directives").
154type(env, "Prolog Environment").
155type(event, "Event handling").
156type(externals, "External predicate interface").
157type(iochar, "I/O - character based").
158type(iostream, "I/O - stream handling").
159type(ioterm, "I/O - term based").
160type(liblist, "Lists library").
161type(modules, "Modules").
162type(database, "Predicate Database").
163type(libsort, "Sorts library").
164type(libstring, "Strings library predicates").
165type(opsys, "Operating system").
166type(record, "Recorded Database").
167type(stratom, "Strings and Atoms").
168type(termcomp, "Term Comparison").
169type(termmanip, "Term Manipulation").
170type(typetest, "Type testing").
171type(fd, "Finite Domains").
172type(propia, "Propia").
173type(conjunto, "Conjunto").
174
175ignored_type(user, "User defined system predicates").
176ignored_type(megalog, "Megalog").
177ignored_type(obsolete, "Obsolete").
178ignored_type(r, "").
179ignored_type(glossary, "").
180ignored_type(dbkernel, "").
181ignored_type(db, "").
182ignored_type(kb, "").
183ignored_type(mps, "").
184ignored_type(chr, "").
185
186ignored(toplevel_prompt/1).
187ignored(user_end/0).
188ignored(user_error_exit/0).
189ignored(user_loop/1).
190ignored(user_start/0).
191%ignored((+)/2).
192%ignored((-)/2).
193%ignored((\)/2).
194%ignored((+)/3).
195%ignored((-)/3).
196%ignored((*)/3).
197%ignored((/)/3).
198%ignored((//)/3).
199%ignored((/\)/3).
200%ignored((\/)/3).
201%ignored((^)/3).
202%ignored((<<)/3).
203%ignored((>>)/3).
204
205short_descr(current_macro/4, "current_macro(?Term, ?Pred, ?Opts, ?Mod)").
206short_descr(compare_instances/4, "compare_instances(?Rel, ?T1, ?T2, ?MetaTerms)").
207short_descr(read_directory/4, "read_directory(+Dir, +Pattern, ?Dirs, ?Files)").
208short_descr(read_string/4, "read_string(+Stream, +DelString, ?Len, ?String)").
209short_descr(substring/4, "substring(+String1, ?Position, ?Len, ?String2)").
210short_descr(substring/5, "substring(+String1, ?Before, ?Length, ?After, ?String2)").
211
212nostr(_, read_string(_, _, 0, '')) :- !.
213nostr(N, Goal) :-
214	error(default(N), Goal).
215
216:- set_error_handler(190, nostr/2).
217:- set_error_handler(198, nostr/2).
218
219merge_columns(NL) :-
220	(exists(quickai) -> delete(quickai); true),
221	concat_string(['split -', NL, ' quick1 quick'], Cmd),
222	exec(Cmd, []),
223	(exists(quickai) ->
224		printf("Too many columns\n%b", []),
225		abort
226	;
227		true
228	),
229	open('QUICK', write, qs),
230	open(quickaa, read, C1),
231	open(quickab, read, C2),
232	open(quickac, read, C3),
233	open(quickad, read, C4),
234	merge(C1, C2, C3, C4),
235	close(C1),
236	close(C2),
237	close(C3),
238	close(C4),
239	open(quickae, read, C5),
240	open(quickaf, read, C6),
241	open(quickag, read, C7),
242	open(quickah, read, C8),
243	merge(C5, C6, C7, C8),
244	close(C5),
245	close(C6),
246	close(C7),
247	close(C8),
248	close(qs).
249
250merge(C1, C2, C3, C4) :-
251	read_string(C1, end_of_line, L1, S1),
252	string(S1),
253	!,
254	put_string(L1, S1),
255	read_string(C2, end_of_line, L2, S2),
256	put_string(L2, S2),
257	read_string(C3, end_of_line, L3, S3),
258	put_string(L3, S3),
259	read_string(C4, end_of_line, L4, S4),
260	put_string(L4, S4),
261	nl(qs),
262	merge(C1, C2, C3, C4).
263merge(_, _, _, _).
264
265put_string(Len, S) :-
266	Tabs is max((col_width +7 - Len)//8, 0),
267	printf(qs, "%s%*c", [S, Tabs, 0'	]).
268
269
270print_quick(NL) :-
271    concat_string(['enscript -r -B -fTimes-Roman7 -L', NL, ' -p/dev/null QUICK'], Cmd1),
272    exec(Cmd1, [null, null, M], Pid),
273    wait(Pid, _),
274    read_string(M, end_of_line, _, S),
275    (substring(S, "wrapped", _) ->
276	printf(error, "There are wrapped lines in the output\n%b", []),
277	read_string(M, end_of_line, _, T),
278	Goal=fail
279    ;
280	S = T,
281	Goal=true
282    ),
283    close(M),
284    (substring(T, "2 pages", _) ->
285	Goal,
286	concat_string(['enscript -r -B -fTimes-Roman7 -L', NL, ' QUICK'], Cmd2),
287	exec(Cmd2, []),
288	concat_string(['enscript -r -B -fTimes-Roman7 -L', NL, ' -pQUICK.ps QUICK'], Cmd3),
289	exec(Cmd3, [])
290    ;
291	printf(error, "There are not 2 pages in the output\n%b", []),
292	fail
293    ).
294
295%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
296% Print all predicates exported from sepia_kernel together with their class
297%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
298
299:- compiled_stream(X), get_stream_info(X, name, Name), pathname(Name, Path, _),
300	setval(lib_path, Path).
301:- external(ul/1).
302
303print_exported :-
304    (is_locked(sepia_kernel) ->
305	getval(lib_path, Path),
306	concat_strings(Path, "unlock.o", UF),
307	load(UF),
308	external(ul/1, ul),
309	ul(sepia_kernel)
310    ;
311	true
312    ),
313    current_functor(X),
314    arg(2, X) < 256,
315    get_flag_body(X, visibility, exported, sepia_kernel),
316    get_flag_body(X, defined, on, sepia_kernel),
317    (	current_built_in(Y),
318	get_flag_body(Y, tool, on, sepia_kernel),
319	tool_body(Y, X, sepia_kernel) ->
320		Type = 'tool_body        '
321    ;
322	current_error(N),
323	get_error_handler(N, X, sepia_kernel) ->
324		Type = 'error_handler    '
325    ;
326	current_interrupt(N, _),
327	get_interrupt_handler(N, X, sepia_kernel) ->
328		Type = 'interrupt_handler'
329    ;
330	call(proc_flags(X, 1, F, sepia_kernel), sepia_kernel),
331	F /\ 16'20000000 =:= 0 ->
332		Type = 'used internally  '
333    ;
334		Type = 'not referenced   '
335    ),
336    printf("%s : %w\n%b", [Type, X]),
337    fail.
338
339%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
340% Read a dump file
341%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
342
343read_dump_file(File) :-
344	open(File, read, In),
345	read_string(In, "", 12, _Header),
346%	writeq(header = _Header), nl,
347	read_dump_stream(In).
348
349read_dump_stream(In) :-
350	( at_eof(In) ->
351	    true
352	;
353	    read_dumped_term(In, Term),
354%	    writeln(Term),
355	    writeclause(Term),
356	    read_dump_stream(In)
357	).
358
359read_dumped_term(In, Term) :-
360	read_integer(In, Length),
361	read_string(In, "", Length, String),
362	bytes_to_term(String, Term).
363
364read_integer(In, N) :-
365	get(In, Byte3),
366	get(In, Byte2),
367	get(In, Byte1),
368	get(In, Byte0),
369	N is Byte3 << 24 \/ Byte2 << 16 \/ Byte1 << 8 \/ Byte0.
370
371%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
372% Compare .pl with .eco file
373%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
374
375compare_dump(File) :-
376	concat_string([File, ".eco"], FileSd),
377	concat_string([File, ".pl"], FilePl),
378	open(FileSd, read, Sd),
379	open(FilePl, read, Pl),
380	read_string(Sd, "", 12, _Header),
381	compare_streams(Pl, Sd).
382
383compare_streams(Pl, Sd) :-
384	read(Pl, TermPl),
385	( at_eof(Sd) ->
386	    TermSd = end_of_file
387	;
388	    read_dumped_term(Sd, TermSd)
389	),
390	( variant(TermPl, TermSd) ->
391	    ( TermPl = end_of_file ->
392		writeln("Ok")
393	    ;
394		compare_streams(Pl, Sd)
395	    )
396	;
397	    writeln("********* Terms differ **********"),
398	    writeclause(TermPl),
399	    writeclause(TermSd)
400	).
401
402
403%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
404% Make html index files for bip book pages
405%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
406
407html_index :-
408	Dest = "/usr/local/eclipse/prerelease/doc/bips",
409	BipRoot = "/usr/local/eclipse/prerelease/doc/bips",
410	html_index(BipRoot, Dest).
411
412html_index(BipRoot, Dest) :-
413	nonvar(Dest),		% where to put the .html files
414	nonvar(BipRoot),	% where the bip pages reside
415
416	concat_strings(BipRoot, "/index.pl", Index),
417	compile(Index),
418
419	make_full_index(BipRoot, Dest),
420	make_grouped_index(BipRoot, Dest).
421
422make_full_index(Root, Dest) :-
423	concat_strings(Dest, "/fullindex.html", File),
424	open(File, write, Out),
425	concat_strings("chmod 644 ", File, Chmod),
426	exec(Chmod, []),
427	writeln(File),
428	writeln(Out, "<HEAD><TITLE>All ECLiPSe Built-In Predicates</TITLE></HEAD><BODY>"),
429	writeln(Out, "<H1> All ECLiPSe Built-In Predicates in Alphabetic Order </H1>"),
430	writeln(Out, "<OL>"),
431	make_links(Root, Out, _, _),
432	writeln(Out, "</OL>"),
433	close(Out).
434
435
436make_grouped_index(Root, Dest) :-
437	concat_strings(Dest, "/groupindex.html", GroupFile),
438	open(GroupFile, write, Out),
439	concat_strings("chmod 644 ", GroupFile, Chmod),
440	exec(Chmod, []),
441	writeln(GroupFile),
442	writeln(Out, "<HEAD><TITLE>ECLiPSe Built-In Predicate Groups </TITLE></HEAD><BODY>"),
443	writeln(Out, "<H1> ECLiPSe Built-In Predicate Groups </H1>"),
444	writeln(Out, "<UL>"),
445	(
446	    group(Group),
447	    printf(Out, "<LI>%s\n<UL>", [Group]),
448	    (
449		subgroup(Group, SubGroup),
450		concat_string(['index_',Group,'_',SubGroup,'.html'],
451		    File),
452		printf(Out, "<LI><A HREF=\"%s\"> %s </A>\n",
453		    [File,SubGroup]),
454		concat_string([Dest,/,File], AbsFile),
455
456		open(AbsFile, write, SubOut),
457		concat_strings("chmod 644 ", AbsFile, ChmodFile),
458		exec(ChmodFile, []),
459		writeln(AbsFile),
460		printf(SubOut,
461		    "<HEAD><TITLE>ECLiPSe Built-In Predicates (%s/%s)\
462			</TITLE></HEAD><BODY>\n",
463		    [Group, SubGroup]),
464		printf(SubOut,
465		    "<H1>ECLiPSe Built-In Predicates (%s/%s)</H1><UL>\n",
466		    [Group, SubGroup]),
467		make_links(Root, SubOut, Group, SubGroup),
468		writeln(SubOut, "</UL>"),
469		close(SubOut),
470
471		fail
472	    ;
473		true
474	    ),
475	    writeln(Out, "</UL>"),
476	    fail
477	;
478	    true
479	),
480	writeln(Out, "</UL>"),
481	close(Out).
482
483make_links(_Root, Out, Group, SubGroup) :-
484	bip(Name, Group, SubGroup, File),
485	printf(Out, "<LI><A HREF=\"%s/%s/%s\"> %w </A>\n",
486		[Group,SubGroup,File,Name]),
487	fail.
488make_links(_, _, _, _).
489
490group(Group) :-
491	setof(G, N^F^SG^bip(N, G, SG, F), GroupList),
492	member(Group, GroupList).
493
494subgroup(Group, SubGroup) :-
495	setof(SG, N^F^bip(N, Group, SG, F), SubGroupList),
496	member(SubGroup, SubGroupList).
497
498%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
499% Look for dangling references in and to the bip pages
500%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
501
502:- coroutine.
503
504undef_biprefs :-
505    undef_biprefs(sepia),
506    undef_biprefs(megalog),
507    undef_biprefs(extensions).
508
509undef_biprefs(Type) :-
510    printf("Checking %s for dangling references%n%b", Type),
511    set_error_handler(133, true/0),
512    set_error_handler(139, true/0),
513    concat_string(["collect_bip_files /home/lp/sepia/workdir/sepia/doc_tex/bips/", Type], Comm),
514    exec(Comm, [null, N], Pid),
515    (Type = extensions ->
516	load_extensions
517    ;
518    Type = megalog ->
519	load_db
520    ;
521	true
522    ),
523    set_error_handler(190, fail/0),
524    set_chtab(0'$, solo),
525    set_chtab(0'\, solo),
526    read_bip_file(N),
527    wait(Pid, _),
528    set_chtab(0'/, first_comment),
529    set_chtab(0'$, symbol),
530    set_chtab(0'\, escape),
531    reset_error_handler(133),
532    reset_error_handler(139),
533    reset_error_handler(190).
534
535load_extensions :-
536    lib(fd),
537    lib(chr),
538    lib(propia),
539    lib(conjunto),
540    lib(r).
541
542load_db :-
543    (get_flag(extension, megalog) ->
544	use_module(library(database_kernel)),
545	lib(db),
546	lib(kb)
547    ;
548	true
549    ).
550
551read_bip_file(N) :-
552    read_string(N, end_of_line, _, BipFile),
553    !,
554    open(BipFile, read, F),
555    read_string(F, "", _, File),
556    check_bip_defined(BipFile, File),
557    find_seealso(File, SeeAlso),
558    check_preds(BipFile, SeeAlso, "nonexisting referenced"),
559    close(F),
560    read_bip_file(N).
561read_bip_file(_).
562
563% Find the pred name and check if it is defined
564check_bip_defined(BipFile, File) :-
565    substring(File, Pos, _, "manpage"),
566    Pos1 > Pos + 9,
567    substring(File, Pos1, 1, "}"),
568    Pos2 > Pos1,
569    substring(File, Pos2, 1, "{"),
570    Pos3 > Pos2,
571    substring(File, Pos3, 1, "}"),
572    Start is Pos2 + 1,
573    Length is Pos3 - Start,
574    substring(File, Start, Length, BipS),
575    !,
576    check_preds(BipFile, BipS, "nonexisting documented").
577
578find_seealso(File, SeeAlso) :-
579    (substring(File, Pos, _, "\\bipseealso") ->
580	Pos1 > Pos,
581	substring(File, Pos1, 1, "}"),
582	Length is Pos1 - Pos - 12,
583	Start is Pos + 12,
584	substring(File, Start, Length, SeeAlso),
585	!
586    ;
587	SeeAlso = ""
588    ).
589
590%
591% A finite automaton to find all atom/integer sequences.
592%
593check_preds(From, Preds, What) :-
594    open(Preds, string, S),
595    check_pred1(From, S, What),
596    close(S).
597
598check_pred1(From, S, What) :-
599    read_token(S, Name, T1),
600    !,
601    (Name = "\\" ->
602	check_pred1(From, S, What)
603    ;
604    Name = backslash ->
605	check_pred2(From, S, \, What)
606    ;
607    Name = sim ->
608	check_pred2(From, S, ~, What)
609    ;
610    Name = verb ->
611	get_char(S, Char),
612	read_string(S, Char, _, SNew),
613	atom_string(New, SNew),
614	check_pred2(From, S, New, What)
615    ;
616    T1 = atom ->
617	check_pred2(From, S, Name, What)
618    ;
619	check_pred1(From, S, What)
620    ).
621check_pred1(_, _, _).
622
623check_pred2(From, S, Name, What) :-			% we have the atom
624    read_token(S, A, B),
625    !,
626    (A = (/) ->
627	check_pred3(From, S, Name, What)
628    ;
629    A = ("\\") ->
630	check_pred2(From, S, Name, What)
631    ;
632    A = backslash ->
633	check_pred2(From, S, Name, What)
634    ;
635    A = space ->
636	check_pred2(From, S, Name, What)
637    ;
638    A = sim ->
639	check_pred2(From, S, '~', What)
640    ;
641    A = "$" ->
642	check_pred2(From, S, Name, What)
643    ;
644    B = atom ->
645	(Name = (/); Name = (\); Name = # ->
646	    concat_atoms(Name, A, New)
647	;
648	    New = A
649	),
650	check_pred2(From, S, New, What)
651    ;
652	check_pred1(From, S, What)
653    ).
654check_pred2(_, _, _, _).
655
656check_pred3(From, S, Name, What) :-			% atom and /
657    read_token(S, A, B),
658    !,
659    (B = integer ->
660	write_pred(Name, A, From, What),
661	check_pred1(From, S, What)
662    ;
663    B = atom ->
664	check_pred2(From, S, Name, What)
665    ;
666	check_pred1(From, S, What)
667    ).
668check_pred3(_, _, _, _).
669
670write_pred(Name, A, From, What) :-
671    (valid_pred(Name/A) ->
672	true
673    ;
674	pathname(From, Par, File),
675	pathname(Par, _, Type),
676	concat_strings(Type, File, FT),
677	printf("%-30.30s: %w   \t%s\n%b", [FT, Name/A, What])
678    ).
679
680xform_name(Name, RealName) :-
681    string_list(Name, L),
682    xform_name_list(L, RL),
683    string_list(RealName, RL).
684
685xform_name_list([], []).
686xform_name_list([0'\|L], P) :-
687    !,
688    (name("backslash", BL),
689    append(BL, R, L) ->
690	P = [0'\|S],
691	xform_name_list(R, S)
692    ;
693	xform_name_list(L, P)
694    ).
695xform_name_list([0'$|L], P) :-
696    !,
697    xform_name_list(L, P).
698xform_name_list([C|L], [C|P]) :-
699    xform_name_list(L, P).
700
701valid_pred(begin_module/1).
702valid_pred(module_interface/1).
703valid_pred(import_from/2).
704valid_pred((->)/2).
705valid_pred((->)/3).
706valid_pred((-?->)/1).
707valid_pred(pragma/1).
708valid_pred(\^\ /3).				% ^/3
709valid_pred(\^\ /2).				% ^/2
710valid_pred(Pred) :-
711    get_flag(Pred, definition_module, M),
712    M \= sepia.
713
714%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
715% Check for builtins which are not documented
716%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
717
718undoc_bips :-
719    % Load all libraries that have help pages
720    set_error_handler(133, true/0),
721    set_error_handler(139, true/0),
722    lib(lists),
723    lib(sorts),
724    lib(strings),
725    lib(profile),
726%    lib(statistics),
727    load_db,
728    load_extensions,
729    printf("Undocumented and visible predicates:%n%b", []),
730    undoc_bips(sepia_kernel).
731undoc_bips :-
732    reset_error_handler(133),
733    reset_error_handler(139).
734
735
736undoc_bips(Lib) :-
737    (current_module(Lib) -> true; lib(Lib)),
738    read_index_file,
739    unlock(sepia_kernel, "Sepia"),
740    current_module(M),
741    (current_built_in_body(Pred, M), T = 'S'
742    ;current_predicate_body(Pred, M), T = 'U'),
743    get_flag_body(Pred, definition_module, M, M),
744    (get_flag(Pred, visibility, global) -> V = 'G'
745    ;get_flag(Pred, visibility, imported) -> V = 'E'),
746    get_flag(Pred, definition_module, DM),
747    not(ignored_module(DM)),
748    Pred=N/A,
749    not(bip(N,A, _, _, _)),
750    not(allowed_export(Pred)),
751    printf("(%a%a)%-15.15s: %w%n%b", [T, V, M, Pred]),
752    fail.
753
754allowed_export(bytes_to_term/2).
755allowed_export(compiled_stream/1).
756allowed_export(current_built_in_body/2).
757allowed_export(current_predicate_body/2).
758allowed_export(get_flag_body/4).
759% suspend
760allowed_export(unify_suspend/2).
761allowed_export(compare_instances_suspend/3).
762allowed_export(delayed_goals_suspend/3).
763allowed_export(delayed_goals_number_suspend/2).
764allowed_export(tr_if_suspend/3).
765% FD PREDICATES
766% auxiliaries
767allowed_export(delayed_goals_number_domain/2).
768allowed_export(delayed_goals_domain/3).
769allowed_export(copy_term_domain/2).
770allowed_export(compare_instances_domain/3).
771allowed_export(unify_domain/2).
772allowed_export(test_unify_domain/2).
773allowed_export(linear_term_range/3).
774allowed_export(term_to_linear/2).
775allowed_export(dvar_update_nocheck/3).
776%    macro transformations
777allowed_export(tr_fd_out/2).
778allowed_export(tr_fd_arith_out/2).
779allowed_export(tr_fd_arith_in/2).
780allowed_export(tr_fd_arith_bool/2).
781allowed_export(tr_fd_domain_in/2).
782allowed_export(tr_fd_domain_out/2).
783%    debug macros
784allowed_export(debug_handler_d/2).
785allowed_export(debug_handler_w/2).
786%    expanded macros
787allowed_export(fd_ineq/1).
788allowed_export(fd_ge/1).
789allowed_export(fd_eq/1).
790allowed_export(fd_qeq/3).
791allowed_export(fd_re/2).
792allowed_export(fd_gec/5).
793allowed_export(fd_gec_ent/6).
794allowed_export(fd_ge/2).
795allowed_export(fd_eq/2).
796allowed_export(fd_dom_simple/2).
797allowed_export(fd_dom_simple/3).
798% CHR predicates
799allowed_export(tr_chr/2).
800allowed_export(chr_start_handler/3).
801allowed_export(chr_delayed_goals_handler/3).
802allowed_export(coca/1).
803allowed_export('CHR='/2).
804allowed_export('CHRdelay'/2).
805allowed_export('CHRnonvar'/1).
806allowed_export('CHRfail'/0).
807allowed_export('CHRhead_not_kept'/1).
808allowed_export('CHRvar'/1).
809allowed_export('CHRgen_num'/1).
810allowed_export('CHRcheck_and_mark_applied'/2).
811allowed_export('CHRcheck_and_mark_applied'/5).
812allowed_export('CHRkeep_heads_checking'/4).
813allowed_export('CHRkeep_heads_checking'/6).
814allowed_export('CHRalready_in'/1).
815allowed_export('CHRkill'/1).
816allowed_export('CHRget_delayed_goals'/2).
817allowed_export(chr_macro/2).
818
819
820ignored_module(systools).
821ignored_module(define).
822ignored_module(sepia).
823ignored_module(database_kernel).	% Too many missing - why??
824ignored_module(fd_util).		% source is distributed
825ignored_module(structures).		% in manual appendix
826