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

Merge branch 'master' of yap.dcc.fc.up.pt:yap-6

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-11-29 16:52:25 +00:00
commit a1d9a1d095
12 changed files with 123 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
C/exec.c
View File

@ -1034,11 +1034,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b)
}
B = (choiceptr)ASP;
B--;
#ifdef TABLING
if (top && GLOBAL_root_dep_fr) {
DepFr_cons_cp(GLOBAL_root_dep_fr) = B;
}
#endif /* TABLING */
B->cp_h = H;
B->cp_tr = TR;
B->cp_cp = CP;

23
C/write.c
View File

@ -292,29 +292,30 @@ wrputref(CODEADDR ref, int Quote_illegal, wrf writewch) /* writes a data base
static int
legalAtom(unsigned char *s) /* Is this a legal atom ? */
{
wchar_t ch = *s;
if (ch == '\0')
return(FALSE);
return FALSE;
if (Yap_chtype[ch] != LC) {
if (ch == '[')
return (*++s == ']' && !(*++s));
else if (ch == '{')
return (*++s == '}' && !(*++s));
if (ch == '[') {
return (s[1] == ']' && !s[2]);
} else if (ch == '{') {
return (s[1] == '}' && !s[2]);
// else if (ch == '/')
// return (*++s != '*');
else if (Yap_chtype[ch] == SL)
return (!*++s);
else if ((ch == ',' || ch == '.') && !s[1])
} else if (Yap_chtype[ch] == SL) {
return (!s[1]);
} else if ((ch == ',' || ch == '.') && !s[1]) {
return FALSE;
else
} else {
while (ch) {
if (Yap_chtype[ch] != SY)
if (Yap_chtype[ch] != SY) {
return FALSE;
}
ch = *++s;
}
}
return TRUE;
} else
while ((ch = *++s) != 0)

3
OPTYap/opt.init.c
View File

@ -239,6 +239,9 @@ void make_root_frames(void) {
/* root dependency frame */
if (!GLOBAL_root_dep_fr) {
new_dependency_frame(GLOBAL_root_dep_fr, FALSE, NULL, NULL, NULL, NULL, NULL);
#ifdef TABLING
DepFr_cons_cp(GLOBAL_root_dep_fr) = B;
#endif /* TABLING */
}
#endif /* TABLING */
}

4
include/SWI-Prolog.h
View File

@ -513,8 +513,8 @@ extern X_API int PL_recorded_external(char *, term_t);
extern X_API int PL_erase_external(char *);
extern X_API int PL_action(int,...);
extern X_API void PL_on_halt(void (*)(int, void *), void *);
extern X_API void *PL_malloc(int);
extern X_API void *PL_realloc(void*,int);
extern X_API void *PL_malloc(size_t);
extern X_API void *PL_realloc(void*,size_t);
extern X_API void PL_free(void *);
extern X_API int PL_eval_expression_to_int64_ex(term_t t, int64_t *val);
extern X_API void PL_cleanup_fork(void);

4
library/dialect/swi.yap
View File

@ -6,7 +6,6 @@
:- module(system, [concat_atom/2,
concat_atom/3,
setenv/2,
prolog_to_os_filename/2,
is_absolute_file_name/1,
read_clause/1,
string/1,
@ -224,7 +223,6 @@ goal_expansion(rename_file(A,B),system:swi_rename_file(A,B)) :- swi_io.
goal_expansion(is_absolute_file_name(A), is_absolute_file_name(A)) :- swi_io.
goal_expansion(file_base_name(A,B),system:swi_file_base_name(A,B)) :- swi_io.
goal_expansion(file_directory_name(A,B),system:swi_file_directory_name(A,B)) :- swi_io.
goal_expansion(prolog_to_os_filename(A,B),system:swi_prolog_to_os_filename(A,B)) :- swi_io.
goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- swi_io.
goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io.
@ -281,8 +279,6 @@ concat_atom(List, New) :-
setenv(X,Y) :- unix(putenv(X,Y)).
prolog_to_os_filename(X,X).
is_absolute_file_name(X) :-
absolute_file_name(X,X).

13
library/tries/core_dbtries.c
View File

@ -612,8 +612,17 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} while (bucket != first_bucket);
} else {
do {
if (TrNode_entry(child) == PairEndTag)
return core_breadth_reduction(engine, child, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function);
if (TrNode_entry(child) == PairEndTag) {
/* do breadth reduction simplification */
node = TrNode_parent(child);
DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(node));
TrNode_child(node) = NULL;
node = trie_node_check_insert(node, PairEndTag);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
return node;
//return core_breadth_reduction(engine, node, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function);
}
while (IS_FUNCTOR_NODE(child)) {
child = TrNode_child(child);
if (IS_HASH_NODE(child)) { // gets first child in the hash

85
library/yap2swi/yap2swi.c
View File

@ -272,8 +272,8 @@ ensure_space(char **sp, size_t room, unsigned flags) {
min += 512;
if (flags & BUF_MALLOC) {
free(*sp);
*sp = malloc(room);
PL_free(*sp);
*sp = PL_malloc(room);
return *sp;
} else if (flags & BUF_RING) {
for (i=1; i<= SWI_BUF_RINGS; i++)
@ -512,7 +512,7 @@ static int do_yap_putc(int sno, wchar_t ch) {
UInt bufsize = putc_cur_lim-putc_cur_buf;
UInt bufpos = putc_curp-putc_cur_buf;
if (!(putc_cur_buf = realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) {
if (!(putc_cur_buf = PL_realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) {
/* we can+t go forever */
return FALSE;
}
@ -564,7 +564,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
if ((flags & BUF_RING)) {
tmp = alloc_ring_buf();
} else if ((flags & BUF_MALLOC)) {
tmp = malloc(SWI_BUF_SIZE);
tmp = PL_malloc(SWI_BUF_SIZE);
} else {
tmp = SWI_buffers[0];
}
@ -641,7 +641,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
}
if (flags & BUF_MALLOC) {
size_t sz = strlen(tmp);
char *nbf = malloc(sz+1);
char *nbf = PL_malloc(sz+1);
if (!nbf)
return 0;
strncpy(nbf,tmp,sz+1);
@ -685,7 +685,7 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
}
room = (sz+1)*sizeof(wchar_t);
if (flags & BUF_MALLOC) {
*wsp = buf = (wchar_t *)malloc(room);
*wsp = buf = (wchar_t *)PL_malloc(room);
} else if (flags & BUF_RING) {
*wsp = (wchar_t *)alloc_ring_buf();
buf = (wchar_t *)ensure_space((char **)wsp, room, flags);
@ -1129,7 +1129,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
{
va_list ap;
int arity, i;
Term *tmp = (Term *)SWI_buffers[0];
Term *tmp, t;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
@ -1137,46 +1137,55 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
return TRUE;
}
arity = ArityOfFunctor(ff);
if (arity > SWI_TMP_BUF_SIZE/sizeof(YAP_CELL)) {
fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity);
while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
return FALSE;
}
}
if (arity == 2 && ff == FunctorDot) {
t = Yap_MkNewPairTerm();
tmp = RepPair(t);
} else {
t = Yap_MkNewApplTerm(ff, arity);
tmp = RepAppl(t)+1;
}
va_start (ap, f);
for (i = 0; i < arity; i++) {
tmp[i] = Yap_GetFromSlot(va_arg(ap, term_t));
Yap_unify(tmp[i],Yap_GetFromSlot(va_arg(ap, term_t)));
}
va_end (ap);
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(d,MkPairTerm(tmp[0],tmp[1]));
else
Yap_PutInSlot(d,Yap_MkApplTerm(ff,arity,tmp));
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
return FALSE;
}
}
Yap_PutInSlot(d,t);
return TRUE;
}
X_API int PL_cons_functor_v(term_t d, functor_t f,term_t a0)
X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0)
{
int arity;
int arity, i;
Term *tmp, t;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d,(Term)ff);
Yap_PutInSlot(d, (YAP_Term)f);
return TRUE;
}
arity = ArityOfFunctor(ff);
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(a0),Yap_GetFromSlot(a0+1)));
else
Yap_PutInSlot(d,Yap_MkApplTerm(ff,arity,Yap_AddressFromSlot(a0)));
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
return FALSE;
}
}
if (arity == 2 && ff == FunctorDot) {
t = Yap_MkNewPairTerm();
tmp = RepPair(t);
} else {
t = Yap_MkNewApplTerm(ff, arity);
tmp = RepAppl(t)+1;
}
for (i = 0; i < arity; i++) {
Yap_unify(tmp[i],Yap_GetFromSlot(a0));
a0++;
}
Yap_PutInSlot(d,t);
return TRUE;
}
@ -3011,21 +3020,33 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
X_API void *
PL_malloc(int sz)
PL_malloc(size_t sz)
{
return (void *)Yap_AllocCodeSpace((long unsigned int)sz);
if ( sz == 0 )
return NULL;
return (void *)malloc((long unsigned int)sz);
}
X_API void *
PL_realloc(void *ptr, int sz)
PL_realloc(void *ptr, size_t sz)
{
return Yap_ReallocCodeSpace((char *)ptr,(long unsigned int)sz);
if (ptr) {
if (sz) {
return realloc((char *)ptr,(long unsigned int)sz);
} else {
free(ptr);
return NULL;
}
} else {
return PL_malloc(sz);
}
}
X_API void
PL_free(void *obj)
{
return Yap_FreeCodeSpace((char *)obj);
if (obj)
free(obj);
}
X_API int

2
packages/clib/process.pl
View File

@ -45,6 +45,8 @@
:- use_module(library(option)).
:- use_module(library(error)).
:- use_module(library(maplist)).
:- use_foreign_library(foreign(process)).
/** <module> Create processes and redirect I/O

28
packages/semweb/rdf_db.pl
View File

@ -127,6 +127,10 @@
(rdf_meta)/1, % +Heads
op(1150, fx, (rdf_meta))
]).
:- expects_dialect(swi).
:- assert(system:swi_io).
:- use_module(library(rdf)).
:- use_module(library(lists)).
:- use_module(library(shlib)).
@ -153,6 +157,16 @@
:- discontiguous
term_expansion/2.
:- meta_predicate
rdf_transaction(0),
rdf_transaction(0, +),
rdf_monitor(1, +),
rdf_save(+, :),
rdf_load(+, :).
:- thread_local
named_anon/2. % +Resource, -Id
/** <module> Core RDF database
@see Documentation for semweb package
@ -1369,16 +1383,6 @@ rdf_reset_db :-
% file-url (=|file://path|=) or a stream wrapped
% in a term stream(Out).
:- meta_predicate
rdf_transaction(0),
rdf_transaction(0, +),
rdf_monitor(1, +),
rdf_save(+, :),
rdf_load(+, :).
:- thread_local
named_anon/2. % +Resource, -Id
rdf_save(File) :-
rdf_save2(File, []).
@ -2183,3 +2187,7 @@ into(_, _) --> []. % TBD
in_time(Triples, ParseTime) -->
[ ' in ~2f sec; ~D triples'-[ParseTime, Triples]
].
:- retract(system:swi_io).

2
packages/tai/Makefile.in
View File

@ -56,4 +56,4 @@ install: all
clean:
rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK
-(cd libtai && $(MAKE) clean)

2
pl/consult.yap
View File

@ -1036,6 +1036,8 @@ file_name_extension(A1,A2,F) :-
atom_codes(A2, S2),
(
S2 = [0'.|_] %'
;
A2 = ''
->
atom_concat(A1, A2, F)
;

18
pl/yio.yap
View File

@ -1209,3 +1209,21 @@ with_output_to(Output, Command) :-
atom_codes(Char, [Code]),
'$codes_to_chars'(String0, String, Chars).
prolog_to_os_filename(Prolog, OS) :-
'$undefined'(swi_prolog_to_os_filename(Prolog, OS), system),
'$current_module'(Old, system),
load_foreign_files([libplstream], [], initIO),
'$current_module'(system, Old),
fail.
prolog_to_os_filename(Prolog, OS) :-
system:swi_prolog_to_os_filename(Prolog, OS).