diff --git a/C/c_interface.c b/C/c_interface.c index 885197e30..a93f63a96 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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) { diff --git a/C/init.c b/C/init.c index c576607f9..679b4167a 100644 --- a/C/init.c +++ b/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; diff --git a/C/iopreds.c b/C/iopreds.c index 78b9e2c4c..b5be01515 100644 --- a/C/iopreds.c +++ b/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")); diff --git a/C/readutil.c b/C/readutil.c index 3f021d74a..52b910ea2 100644 --- a/C/readutil.c +++ b/C/readutil.c @@ -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(); diff --git a/C/scanner.c b/C/scanner.c index 13c6d08a9..a63f6d9ea 100644 --- a/C/scanner.c +++ b/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: diff --git a/C/write.c b/C/write.c index acd4c7f0e..f0f144df0 100644 --- a/C/write.c +++ b/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; diff --git a/CLPBN/Makefile.in b/CLPBN/Makefile.in index 60e820cef..64dfd8456 100644 --- a/CLPBN/Makefile.in +++ b/CLPBN/Makefile.in @@ -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 diff --git a/CLPBN/learning/em.yap b/CLPBN/learning/em.yap index 01a370506..5cf154af7 100644 --- a/CLPBN/learning/em.yap +++ b/CLPBN/learning/em.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 diff --git a/CLPBN/learning/example/school_params.yap b/CLPBN/learning/example/school_params.yap index a2ced93ee..abe26f891 100644 --- a/CLPBN/learning/example/school_params.yap +++ b/CLPBN/learning/example/school_params.yap @@ -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). -*/ diff --git a/CLPBN/learning/learn_utils.yap b/CLPBN/learning/learn_utils.yap index a6833684a..03d96a4a7 100644 --- a/CLPBN/learning/learn_utils.yap +++ b/CLPBN/learning/learn_utils.yap @@ -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). diff --git a/H/iopreds.h b/H/iopreds.h index f8033ac9a..2bf2ec26a 100644 --- a/H/iopreds.h +++ b/H/iopreds.h @@ -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) diff --git a/H/yapio.h b/H/yapio.h index e60bb039c..65a374487 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -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)); diff --git a/library/rltree/range_list.c b/library/rltree/range_list.c index f4bccb399..4a74aca95 100644 --- a/library/rltree/range_list.c +++ b/library/rltree/range_list.c @@ -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); // diff --git a/library/rltree/yap_rl.c b/library/rltree/yap_rl.c index 2894d2795..43d7c91d4 100644 --- a/library/rltree/yap_rl.c +++ b/library/rltree/yap_rl.c @@ -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 diff --git a/pl/boot.yap b/pl/boot.yap index 8671058d4..9d6d8e7a0 100644 --- a/pl/boot.yap +++ b/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). diff --git a/pl/checker.yap b/pl/checker.yap index 86bd926be..f37c6ced4 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -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)) :- !. diff --git a/pl/hacks.yap b/pl/hacks.yap index 5a277919c..dbc4dec49 100644 --- a/pl/hacks.yap +++ b/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) --> diff --git a/pl/messages.yap b/pl/messages.yap index 350e1d462..858a664ae 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -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'].