diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mainbranch fixes to: 

- fix quoted characters output
- fix line position in read_term and friends
- make messages look a bit better
- CLP(BN) EM improvements.
This commit is contained in:
Vitor Santos Costa 2008-10-23 22:17:45 +01:00
parent 592fe9e366
commit 0dcf34b7bc
18 changed files with 195 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
C/c_interface.c
View File

@ -1781,7 +1781,7 @@ YAP_EndConsult(void)
X_API Term
YAP_Read(int (*mygetc)(void))
{
Term t;
Term t, tpos = TermNil;
int sno;
TokEntry *tokstart;
@ -1794,7 +1794,8 @@ YAP_Read(int (*mygetc)(void))
return TermNil;
}
Stream[sno].stream_getc = do_yap_getc;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
Stream[sno].status |= Tty_Stream_f;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
Stream[sno].status = Free_Stream_f;
if (Yap_ErrorMessage)
{

2
C/init.c
View File

@ -946,7 +946,7 @@ InitFlags(void)
yap_flags[LANGUAGE_MODE_FLAG] = 0;
yap_flags[STRICT_ISO_FLAG] = FALSE;
yap_flags[SOURCE_MODE_FLAG] = FALSE;
yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES;
yap_flags[CHARACTER_ESCAPE_FLAG] = ISO_CHARACTER_ESCAPES;
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
#if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = FALSE;

14
C/iopreds.c
View File

@ -3827,8 +3827,7 @@ static Int
old_H = H;
Yap_eot_before_eof = FALSE;
tpos = StreamPosition(inp_stream);
StartLine = Stream[inp_stream].linecount;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp_stream);
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp_stream, &tpos);
if (Yap_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H;
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
@ -4181,13 +4180,19 @@ StreamPosition(int sno)
else
sargs[0] = MkIntTerm (YP_ftell (Stream[sno].u.file.file));
}
sargs[1] = MkIntegerTerm (Stream[sno].linecount);
sargs[1] = MkIntegerTerm (StartLine = Stream[sno].linecount);
sargs[2] = MkIntegerTerm (Stream[sno].linepos);
sargs[3] = sargs[4] = MkIntTerm (0);
return Yap_MkApplTerm (FunctorStreamPos, 5, sargs);
}
Term
Yap_StreamPosition(int sno)
{
return StreamPosition(sno);
}
static Int
p_show_stream_position (void)
{ /* '$show_stream_position'(+Stream,Pos) */
@ -5971,12 +5976,13 @@ Yap_StringToTerm(char *s,Term *tp)
Term t;
TokEntry *tokstart;
tr_fr_ptr TR_before_parse;
Term tpos = TermNil;
if (sno < 0)
return FALSE;
UNLOCK(Stream[sno].streamlock);
TR_before_parse = TR;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
if (tokstart == NIL && tokstart->Tok == Ord (eot_tok)) {
if (tp) {
*tp = MkAtomTerm(Yap_LookupAtom("end of file found before end of term"));

4
C/readutil.c
View File

@ -145,13 +145,13 @@ static Int
p_stream_to_terms(void)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t = Deref(ARG3);
Term t = Deref(ARG3), tpos = TermNil;
if (sno < 0)
return FALSE;
while (!(Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
TokEntry *tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
TokEntry *tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
if (!Yap_ErrorMessage)
{
Term th = Yap_Parse();

20
C/scanner.c
View File

@ -732,7 +732,7 @@ ch_to_wide(char *base, char *charp)
}
TokEntry *
Yap_tokenizer(int inp_stream)
Yap_tokenizer(int inp_stream, Term *tposp)
{
TokEntry *t, *l, *p;
enum TokenKinds kind;
@ -753,6 +753,10 @@ Yap_tokenizer(int inp_stream)
p = NULL; /* Just to make lint happy */
LOCK(Stream[inp_stream].streamlock);
ch = Nxtch(inp_stream);
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
do {
wchar_t och;
int quote, isvar;
@ -789,6 +793,13 @@ Yap_tokenizer(int inp_stream)
while ((ch = Nxtch(inp_stream)) != 10 && chtype(ch) != EF);
if (chtype(ch) != EF) {
/* blank space */
if (t == l) {
/* we found a comment before reading characters */
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
}
goto restart;
} else {
t->Tok = Ord(kind = eot_tok);
@ -1114,6 +1125,13 @@ Yap_tokenizer(int inp_stream)
t->Tok = Ord(kind = eot_tok);
}
ch = Nxtch(inp_stream);
if (t == l) {
/* we found a comment before reading characters */
while (chtype(ch) == BS) {
ch = Nxtch(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
}
goto restart;
}
enter_symbol:

98
C/write.c
View File

@ -178,17 +178,18 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */
else if (Yap_chtype[ch] == SL)
return (!*++s);
else if ((ch == ',' || ch == '.') && !s[1])
return (FALSE);
return FALSE;
else
while (ch) {
if (Yap_chtype[ch] != SY) return (FALSE);
if (Yap_chtype[ch] != SY || ch == '\\')
return FALSE;
ch = *++s;
}
return (TRUE);
return TRUE;
} else
while ((ch = *++s) != 0)
if (Yap_chtype[ch] > NU)
return (FALSE);
return FALSE;
return (TRUE);
}
@ -219,6 +220,73 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
return(symbol);
}
static void
write_quoted(int ch, int quote, wrf writewch)
{
if (yap_flags[CHARACTER_ESCAPE_FLAG] == CPROLOG_CHARACTER_ESCAPES) {
wrputc(ch, writewch);
if (ch == '\'')
wrputc('\'', writewch); /* be careful about quotes */
return;
}
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\') {
wrputc(ch, writewch);
} else {
switch (ch) {
case '\\':
case '\'':
wrputc('\\', writewch);
wrputc(ch, writewch);
break;
case 7:
wrputc('\\', writewch);
wrputc('a', writewch);
break;
case '\b':
wrputc('\\', writewch);
wrputc('b', writewch);
break;
case '\t':
wrputc('\\', writewch);
wrputc('t', writewch);
break;
case ' ':
case 160:
wrputc(' ', writewch);
break;
case '\n':
wrputc('\\', writewch);
wrputc('n', writewch);
break;
case 11:
wrputc('\\', writewch);
wrputc('v', writewch);
break;
case '\r':
wrputc('\\', writewch);
wrputc('r', writewch);
break;
case '\f':
wrputc('\\', writewch);
wrputc('f', writewch);
break;
default:
if ( ch <= 0xff ) {
char esc[8];
if (yap_flags[CHARACTER_ESCAPE_FLAG] == SICSTUS_CHARACTER_ESCAPES) {
sprintf(esc, "\\%03o", ch);
} else {
/* last backslash in ISO mode */
sprintf(esc, "\\%03o\\", ch);
}
wrputs(esc, writewch);
}
}
}
}
static void
putAtom(Atom atom, int Quote_illegal, wrf writewch) /* writes an atom */
@ -242,11 +310,7 @@ putAtom(Atom atom, int Quote_illegal, wrf writewch) /* writes an atom */
wrputc('\'', writewch);
while (*ws) {
wchar_t ch = *ws++;
wrputc(ch, writewch);
if (ch == '\\' && yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES)
wrputc('\\', writewch); /* be careful about backslashes */
else if (ch == '\'')
wrputc('\'', writewch); /* be careful about quotes */
write_quoted(ch, '\'', writewch);
}
wrputc('\'', writewch);
} else {
@ -261,11 +325,7 @@ putAtom(Atom atom, int Quote_illegal, wrf writewch) /* writes an atom */
wrputc('\'', writewch);
while (*s) {
wchar_t ch = *s++;
wrputc(ch, writewch);
if (ch == '\\' && yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES)
wrputc('\\', writewch); /* be careful about backslashes */
else if (ch == '\'')
wrputc('\'', writewch); /* be careful about quotes */
write_quoted(ch, '\'', writewch);
}
wrputc('\'', writewch);
} else {
@ -276,7 +336,8 @@ putAtom(Atom atom, int Quote_illegal, wrf writewch) /* writes an atom */
static int
IsStringTerm(Term string) /* checks whether this is a string */
{
if (IsVarTerm(string)) return(FALSE);
if (IsVarTerm(string))
return FALSE;
do {
Term hd;
int ch;
@ -301,12 +362,7 @@ putString(Term string, wrf writewch) /* writes a string */
wrputc('"', writewch);
while (string != TermNil) {
int ch = IntOfTerm(HeadOfTerm(string));
wrputc(ch, writewch);
if (ch == '\\' && yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES)
wrputc('\\', writewch); /* be careful about backslashes */
else if (ch == '"')
wrputc('"', writewch); /* be careful about quotes */
string = TailOfTerm(string);
write_quoted(ch, '"', writewch);
}
wrputc('"', writewch);
lastw = alphanum;

1
CLPBN/Makefile.in
View File

@ -52,6 +52,7 @@ CLPBN_PROGRAMS= \
CLPBN_LEARNING_PROGRAMS= \
$(CLPBN_LEARNING_SRCDIR)/bnt_parms.yap \
$(CLPBN_LEARNING_SRCDIR)/em.yap \
$(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \
$(CLPBN_LEARNING_SRCDIR)/mle.yap

14
CLPBN/learning/em.yap
View File

@ -16,6 +16,9 @@
empty_dist/2,
dist_new_table/2]).
:- use_module(library('clpbn/connected'),
[clpbn_subgraphs/2]).
:- use_module(library('clpbn/learning/learn_utils'),
[run_all/1,
clpbn_vars/2,
@ -29,8 +32,10 @@
[matrix_add/3,
matrix_to_list/2]).
:- use_module(library('clpbn/utils'), [
check_for_hidden_vars/3]).
:- use_module(library('clpbn/utils'),
[
check_for_hidden_vars/3,
sort_vars_by_key/3]).
:- meta_predicate em(:,+,+,-,-), init_em(:,-).
@ -50,8 +55,9 @@ em(Items, MaxError, MaxIts, Tables, Likelihood) :-
init_em(Items, state(AllVars, AllDists, AllDistInstances, MargVars)) :-
run_all(Items),
attributes:all_attvars(AllVars0),
sort_vars_by_key(AllVars0,AllVars1,[]),
% remove variables that do not have to do with this query.
check_for_hidden_vars(AllVars0, AllVars0, AllVars),
check_for_hidden_vars(AllVars1, AllVars1, AllVars),
different_dists(AllVars, AllDists, AllDistInstances, MargVars),
clpbn_init_solver(MargVars, AllVars, _).
@ -59,6 +65,8 @@ init_em(Items, state(AllVars, AllDists, AllDistInstances, MargVars)) :-
em_loop(Its, Likelihood0, State, MaxError, MaxIts, LikelihoodF, FTables) :-
estimate(State, LPs),
maximise(State, Tables, LPs, Likelihood),
(recorded(clpbn_dist_db, DB, _), writeln(DB), fail ; true),
writeln(Likelihood:Tables),
(
(
(Likelihood - Likelihood0)/Likelihood < MaxError

2
CLPBN/learning/example/school_params.yap
View File

@ -28,7 +28,5 @@ goal(student_intelligence(P,V)) :-
goal(course_difficulty(P,V)) :-
pos:course_difficulty(P,V1),
( random > 0.1 -> V = V1 ; true).
/*
goal(registration_satisfaction(P,V)) :-
pos:registration_satisfaction(P,V).
*/

2
CLPBN/learning/learn_utils.yap
View File

@ -54,8 +54,6 @@ normalise_counts(MAT,NMAT) :-
matrix_op_to_lines(MAT, Sum, /, NMAT).
compute_likelihood(Table0, NewTable, DeltaLik) :-
matrix:matrix_to_list(Table0,L0), writeln(L0),
matrix:matrix_to_list(NewTable,L1), writeln(L1),
matrix_to_logs(NewTable, Logs),
matrix_op(Table0, Logs, *, Logs),
matrix_sum(Logs, DeltaLik).

1
H/iopreds.h
View File

@ -135,6 +135,7 @@ StreamDesc;
#define ALIASES_BLOCK_SIZE 8
void STD_PROTO (Yap_InitStdStreams, (void));
Term STD_PROTO (Yap_StreamPosition, (int));
EXTERN inline int
GetCurInpPos (int inp_stream)

2
H/yapio.h
View File

@ -283,7 +283,7 @@ VarEntry STD_PROTO(*Yap_LookupVar,(char *));
Term STD_PROTO(Yap_VarNames,(VarEntry *,Term));
/* routines in scanner.c */
TokEntry STD_PROTO(*Yap_tokenizer,(int));
TokEntry STD_PROTO(*Yap_tokenizer,(int, Term *));
void STD_PROTO(Yap_clean_tokenizer,(TokEntry *, VarEntry *, VarEntry *));
Term STD_PROTO(Yap_scan_num,(int (*)(int)));
char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));

5
library/rltree/range_list.c
View File

@ -56,6 +56,11 @@ static void root_intervals(RL_Tree* tree);
NUM next_min(RL_Tree *tree,NUM node,NUM node_num,NUM interval,NUM max,NUM min);
NUM tree_minus(RL_Tree *r1,RL_Tree *r2,NUM node1,NUM node2,NUM node_num,NUM interval,NUM max);
RL_Tree* minus_rl(RL_Tree* range1,RL_Tree* range2);
void shift_right(RL_Tree *tree,const NUM idx,const long nnodes);
void shift_left(RL_Tree *tree,const NUM idx, const long nnodes);
void intersect_leafs(char *storage1,char *storage2);
static void print_nodes(RL_Tree* tree);
//

11
library/rltree/yap_rl.c
View File

@ -116,7 +116,7 @@ static
int
p_rl_size(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1),t2=YAP_Deref(YAP_ARG2),t_size;
YAP_Term t1=YAP_Deref(YAP_ARG1),t_size;
IDTYPE id;
RL_Tree* tree;
unsigned int size;
@ -129,7 +129,7 @@ p_rl_size(void) {
size=tree->size*sizeof(RL_Node)+sizeof(RL_Tree);
t_size=YAP_MkIntTerm(size);
if(!YAP_Unify(YAP_Deref(YAP_ARG2),t_size) )
if(!YAP_Unify(YAP_ARG2,t_size) )
return (FALSE);
return(TRUE);
@ -207,6 +207,8 @@ p_rl_set_in(void) {
#endif
return (TRUE);
}
#ifdef UNUSED
/*
*
*
@ -234,6 +236,8 @@ p_rl_in(void) {
return (TRUE);
return (FALSE);
}
#endif
/*
*
*
@ -372,7 +376,6 @@ int
p_rl_b_in2(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
YAP_Term t2=YAP_Deref(YAP_ARG2);
IDTYPE id;
NUM val;
RL_Tree *tree;
@ -422,7 +425,7 @@ p_rl_b_in1(void) {
}
}
/* ******************************************************* */
void init_rl(){
void init_rl(void){
YAP_UserCPredicate("rl_new", p_rl_new,2); // Maximum -> RangeID

82
pl/boot.yap
View File

@ -165,13 +165,13 @@ true :- true.
prompt(_,' ?- '),
prompt(' | '),
'$run_toplevel_hooks',
'$read_vars'(user_input,Command,_,_,Varnames),
'$read_vars'(user_input,Command,_,Pos,Varnames),
nb_setval('$spy_gn',1),
% stop at spy-points if debugging is on.
nb_setval('$debug_run',off),
nb_setval('$debug_zip',off),
prompt(_,' |: '),
'$command'((?-Command),Varnames,top),
'$command'((?-Command),Varnames,Pos,top),
'$sync_mmapped_arrays',
set_value('$live','$false').
@ -283,16 +283,16 @@ true :- true.
recordz('$corout','$corout'(main,main,'$corout'([],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[])),_Ref),
recorda('$result',going,_).
'$command'(C,VL,Con) :-
'$command'(C,VL,Pos,Con) :-
'$access_yap_flags'(9,1), !,
'$execute_command'(C,VL,Con,C).
'$command'(C,VL,Con) :-
'$execute_command'(C,VL,Pos,Con,C).
'$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) ->
'$execute_command'(C,VL,Con,C), ! ;
'$execute_command'(C,VL,Pos,Con,C), ! ;
% do term expansion
expand_term(C, EC),
% execute a list of commands
'$execute_commands'(EC,VL,Con,C),
'$execute_commands'(EC,VL,Pos,Con,C),
% succeed only if the *original* was at end of file.
C == end_of_file
).
@ -300,18 +300,18 @@ true :- true.
%
% Hack in case expand_term has created a list of commands.
%
'$execute_commands'(V,_,_,Source) :- var(V), !,
'$execute_commands'(V,_,_,_,Source) :- var(V), !,
'$do_error'(instantiation_error,meta_call(Source)).
'$execute_commands'([],_,_,_) :- !.
'$execute_commands'([C|Cs],VL,Con,Source) :- !,
'$execute_commands'([],_,_,_,_) :- !.
'$execute_commands'([C|Cs],VL,Pos,Con,Source) :- !,
(
'$execute_command'(C,VL,Con,Source),
'$execute_command'(C,VL,Pos,Con,Source),
fail
;
'$execute_commands'(Cs,VL,Con,Source)
'$execute_commands'(Cs,VL,Pos,Con,Source)
).
'$execute_commands'(C,VL,Con,Source) :-
'$execute_command'(C,VL,Con,Source).
'$execute_commands'(C,VL,Pos,Con,Source) :-
'$execute_command'(C,VL,Pos,Con,Source).
@ -319,27 +319,27 @@ true :- true.
%
%
'$execute_command'(C,_,top,Source) :- var(C), !,
'$execute_command'(C,_,_,top,Source) :- var(C), !,
'$do_error'(instantiation_error,meta_call(Source)).
'$execute_command'(C,_,top,Source) :- number(C), !,
'$execute_command'(C,_,_,top,Source) :- number(C), !,
'$do_error'(type_error(callable,C),meta_call(Source)).
'$execute_command'(R,_,top,Source) :- db_reference(R), !,
'$execute_command'(R,_,_,top,Source) :- db_reference(R), !,
'$do_error'(type_error(callable,R),meta_call(Source)).
'$execute_command'(end_of_file,_,_,_) :- !.
'$execute_command'(Command,_,_,_) :-
'$execute_command'(end_of_file,_,_,_,_) :- !.
'$execute_command'(Command,_,_,_,_) :-
nb_getval('$if_skip_mode',skip),
\+ '$if_directive'(Command),
!.
'$execute_command'((:-G),_,Option,_) :- !,
'$execute_command'((:-G),_,_,Option,_) :- !,
'$current_module'(M),
% allow user expansion
expand_term((:- G), O),
O = (:- G1),
'$process_directive'(G1, Option, M).
'$execute_command'((?-G),V,_,Source) :- !,
'$execute_command'(G,V,top,Source).
'$execute_command'(G,V,Option,Source) :-
'$continue_with_command'(Option,V,G,Source).
'$execute_command'((?-G),V,Pos,_,Source) :- !,
'$execute_command'(G,V,Pos,top,Source).
'$execute_command'(G,V,Pos,Option,Source) :-
'$continue_with_command'(Option,V,Pos,G,Source).
%
% This command is very different depending on the language mode we are in.
@ -377,34 +377,34 @@ true :- true.
'$process_directive'(G, _, M) :-
( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
'$continue_with_command'(reconsult,V,G,Source) :-
'$go_compile_clause'(G,V,5,Source),
'$continue_with_command'(reconsult,V,Pos,G,Source) :-
'$go_compile_clause'(G,V,Pos,5,Source),
fail.
'$continue_with_command'(consult,V,G,Source) :-
'$go_compile_clause'(G,V,13,Source),
'$continue_with_command'(consult,V,Pos,G,Source) :-
'$go_compile_clause'(G,V,Pos,13,Source),
fail.
'$continue_with_command'(top,V,G,_) :-
'$continue_with_command'(top,V,_,G,_) :-
'$query'(G,V).
%
% not 100% compatible with SICStus Prolog, as SICStus Prolog would put
% module prefixes all over the place, although unnecessarily so.
%
'$go_compile_clause'(G,V,N,Source) :-
'$go_compile_clause'(G,V,Pos,N,Source) :-
'$current_module'(Mod),
'$go_compile_clause'(G,V,N,Mod,Mod,Source).
'$go_compile_clause'(G,V,Pos,N,Mod,Mod,Source).
'$go_compile_clause'(M:G,V,N,_,_,Source) :- !,
'$go_compile_clause'(G,V,N,M,M,Source).
'$go_compile_clause'((M:H :- B),V,N,_,BodyMod,Source) :- !,
'$go_compile_clause'((H :- B),V,N,M,BodyMod,Source).
'$go_compile_clause'(G,V,N,HeadMod,BodyMod,Source) :- !,
'$prepare_term'(G, V, G0, G1, BodyMod, HeadMod, Source),
'$go_compile_clause'(M:G,V,Pos,N,_,_,Source) :- !,
'$go_compile_clause'(G,V,Pos,N,M,M,Source).
'$go_compile_clause'((M:H :- B),V,Pos,N,_,BodyMod,Source) :- !,
'$go_compile_clause'((H :- B),V,Pos,N,M,BodyMod,Source).
'$go_compile_clause'(G,V,Pos,N,HeadMod,BodyMod,Source) :- !,
'$prepare_term'(G, V, Pos, G0, G1, BodyMod, HeadMod, Source),
'$$compile'(G1, G0, N, HeadMod).
'$prepare_term'(G, V, G0, G1, BodyMod, SourceMod, Source) :-
'$prepare_term'(G, V, Pos, G0, G1, BodyMod, SourceMod, Source) :-
( get_value('$syntaxcheckflag',on) ->
'$check_term'(Source, V, BodyMod) ; true ),
'$check_term'(Source, V, Pos, BodyMod) ; true ),
'$precompile_term'(G, G0, G1, BodyMod, SourceMod).
% process an input clause
@ -1006,8 +1006,8 @@ bootstrap(F) :-
!.
'$enter_command'(Stream,Status) :-
'$read_vars'(Stream,Command,_,_,Vars),
'$command'(Command,Vars,Status).
'$read_vars'(Stream,Command,_,Pos,Vars),
'$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :-
'$do_error'(permission_error(input,closed_stream,Stream), loop).

8
pl/checker.yap
View File

@ -120,20 +120,20 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$values'('$syntaxcheckmultiple',O,N).
'$check_term'(T,_,M) :-
'$check_term'(T,_,P,M) :-
get_value('$syntaxcheckdiscontiguous',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_discontiguous'(F,A,NM), fail.
'$check_term'(T,_,M) :-
'$check_term'(T,_,P,M) :-
get_value('$syntaxcheckmultiple',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_multiple'(F,A,NM), fail.
'$check_term'(T,VL,_) :-
'$check_term'(T,VL,P,_) :-
get_value('$syntaxchecksinglevar',on),
( '$chk_binding_vars'(T),
'$sv_list'(VL,Sv) ->
'$sv_warning'(Sv,T) ), fail.
'$check_term'(_,_,_).
'$check_term'(_,_,_,_).
'$chk_binding_vars'(V) :- var(V), !, V = '$V'(_).
'$chk_binding_vars'('$V'(off)) :- !.

20
pl/hacks.yap
View File

@ -151,14 +151,14 @@ beautify_hidden_goal('$csult'(Files,Mod),prolog) -->
[reconsult(Mod:Files)].
beautify_hidden_goal('$use_module'(Files,Mod,Is),prolog) -->
[use_module(Mod,Files,Is)].
beautify_hidden_goal('$continue_with_command'(reconsult,V,G,Source),prolog) -->
['Assert'(G,V,Source)].
beautify_hidden_goal('$continue_with_command'(consult,V,G,Source),prolog) -->
['Assert'(G,V,Source)].
beautify_hidden_goal('$continue_with_command'(top,V,G,_),prolog) -->
['Query'(G,V)].
beautify_hidden_goal('$continue_with_command'(Command,V,G,Source),prolog) -->
['TopLevel'(Command,G,V,Source)].
beautify_hidden_goal('$continue_with_command'(reconsult,V,P,G,Source),prolog) -->
['Assert'(G,V,P,Source)].
beautify_hidden_goal('$continue_with_command'(consult,V,P,G,Source),prolog) -->
['Assert'(G,V,P,Source)].
beautify_hidden_goal('$continue_with_command'(top,V,P,G,_),prolog) -->
['Query'(G,V,P)].
beautify_hidden_goal('$continue_with_command'(Command,V,P,G,Source),prolog) -->
['TopLevel'(Command,G,V,P,Source)].
beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
['DebuggerCall'(M:G, InControl, Redo)].
beautify_hidden_goal('$do_spy'(Goal, Mod, CP, InControl),prolog) -->
@ -167,8 +167,8 @@ beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
[catch(Mod:G, Exc, Handler)].
beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->
[catch(G, Exc, Handler)].
beautify_hidden_goal('$execute_command'(Query,V,Option,Source),prolog) -->
[toplevel_query(Query, V, Option, Source)].
beautify_hidden_goal('$execute_command'(Query,V,P,Option,Source),prolog) -->
[toplevel_query(Query, V, P, Option, Source)].
beautify_hidden_goal('$process_directive'(Gs,_,Mod),prolog) -->
[(:- Mod:Gs)].
beautify_hidden_goal('$loop'(Stream,Option),prolog) -->

4
pl/messages.yap
View File

@ -31,9 +31,9 @@ file_location(Prefix) -->
[ nl ].
file_position(user_input,LN,MsgCodes) -->
[ '~a at user_input near line ~d.' - [MsgCodes,LN] ].
[ '~a (user_input:~d).' - [MsgCodes,LN] ].
file_position(FileName,LN,MsgCodes) -->
[ '~a at file ~a, near line ~d.' - [MsgCodes,FileName,LN] ].
[ '~a (~a:~d).' - [MsgCodes,FileName,LN] ].
generate_message(halt) --> !,
['YAP execution halted'].