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
parent
592fe9e366
commit
0dcf34b7bc
@ -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
2
C/init.c
@ -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
14
C/iopreds.c
@ -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"));
|
||||
|
||||
@ -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
20
C/scanner.c
@ -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
98
C/write.c
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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).
|
||||
*/
|
||||
|
||||
@ -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).
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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));
|
||||
|
||||
@ -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);
|
||||
|
||||
//
|
||||
|
||||
@ -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
82
pl/boot.yap
@ -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).
|
||||
|
||||
@ -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
20
pl/hacks.yap
@ -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) -->
|
||||
|
||||
@ -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'].
|
||||
|
||||
Reference in New Issue
Block a user