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

bootstrapping

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-01-22 13:53:17 +00:00
parent fdf7bb516f
commit 9fce1e9ba2
23 changed files with 1479 additions and 3330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/c_interface.c
View File

@ -2191,10 +2191,10 @@ X_API Term YAP_ReadFromStream(int sno) {
return o; return o;
} }
X_API Term YAP_ReadClauseFromStream(int sno, Term vs) { X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
Term t = Yap_read_term(sno, t = MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), TermNil), true); Term t = Yap_read_term(sno,MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition,1),1,&pos), TermNil)), true);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return t; return t;
} }

12
C/cdmgr.c
View File

@ -47,7 +47,7 @@ static void assertz_dynam_clause(PredEntry *, yamop *);
static void expand_consult(void); static void expand_consult(void);
static int not_was_reconsulted(PredEntry *, Term, int); static int not_was_reconsulted(PredEntry *, Term, int);
static int RemoveIndexation(PredEntry *); static int RemoveIndexation(PredEntry *);
static Int p_number_of_clauses(USES_REGS1); static Int number_of_clauses(USES_REGS1);
static Int p_compile(USES_REGS1); static Int p_compile(USES_REGS1);
static Int p_purge_clauses(USES_REGS1); static Int p_purge_clauses(USES_REGS1);
static Int p_setspy(USES_REGS1); static Int p_setspy(USES_REGS1);
@ -1490,7 +1490,9 @@ PredEntry *Yap_PredFromClause(Term t USES_REGS) {
t = ArgOfTerm(2, t); t = ArgOfTerm(2, t);
} else if (f == FunctorAssert) { } else if (f == FunctorAssert) {
t = ArgOfTerm(1, t); t = ArgOfTerm(1, t);
} else if (f == FunctorComma && extra_arity == 2) { } else if (f == FunctorComma
&& extra_arity == 2) {
t = ArgOfTerm(1, t); t = ArgOfTerm(1, t);
} else if (f == FunctorDoubleArrow) { } else if (f == FunctorDoubleArrow) {
extra_arity = 2; extra_arity = 2;
@ -2379,7 +2381,7 @@ static Int p_rmspy(USES_REGS1) { /* '$rm_spy'(+T,+Mod) */
******************************************************************/ ******************************************************************/
static Int static Int
p_number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */ number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
Term mod = Deref(ARG2); Term mod = Deref(ARG2);
int ncl = 0; int ncl = 0;
@ -2405,7 +2407,7 @@ static Int
return (Yap_unify_constant(ARG3, MkIntegerTerm(ncl))); return (Yap_unify_constant(ARG3, MkIntegerTerm(ncl)));
} }
/* @pred '$new_multifile'(+N,+Ar,+Mod) /* @pred '$new_multifile'(+G,+Mod)
* sets the multi-file flag * sets the multi-file flag
* */ * */
static Int new_multifile(USES_REGS1) { static Int new_multifile(USES_REGS1) {
@ -4709,7 +4711,7 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$mk_dynamic", 2, mk_dynamic, SafePredFlag); Yap_InitCPred("$mk_dynamic", 2, mk_dynamic, SafePredFlag);
Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag); Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag); Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
Yap_InitCPred("$numb er_of_clauses", 3, p_number_of_clauses, Yap_InitCPred("$number_of_clauses", 3, number_of_clauses,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag | TestPredFlag); Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag | TestPredFlag);
Yap_InitCPred("$undefp_handler", 2, undefp_handler, Yap_InitCPred("$undefp_handler", 2, undefp_handler,

10
C/compiler.c
View File

@ -3513,14 +3513,20 @@ yamop *Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod,
LOCAL_ErrorMessage = "clause head should be atom or compound term"; LOCAL_ErrorMessage = "clause head should be atom or compound term";
return (0); return (0);
} else { } else {
loop:
/* find out which predicate we are compiling for */ /* find out which predicate we are compiling for */
if (IsAtomTerm(head)) { if (IsAtomTerm(head)) {
Atom ap = AtomOfTerm(head); Atom ap = AtomOfTerm(head);
cglobs.cint.CurrentPred = RepPredProp(PredPropByAtom(ap, mod)); cglobs.cint.CurrentPred = RepPredProp(PredPropByAtom(ap, mod));
} else { } else {
Functor f = FunctorOfTerm(head);
if (f == FunctorModule) {
mod = ArgOfTerm(1,head);
head = ArgOfTerm(2,head);
goto loop;
}
cglobs.cint.CurrentPred = cglobs.cint.CurrentPred =
RepPredProp(PredPropByFunc(FunctorOfTerm(head), mod)); RepPredProp(PredPropByFunc(f, mod));
} }
/* insert extra instructions to count calls */ /* insert extra instructions to count calls */
PELOCK(52, cglobs.cint.CurrentPred); PELOCK(52, cglobs.cint.CurrentPred);

86
C/scanner.c
View File

@ -534,19 +534,18 @@ static struct stream_desc *inp0;
// standard get char, uses conversion table // standard get char, uses conversion table
// and converts to wide // and converts to wide
static inline int getchr(struct stream_desc *inp) static inline int getchr(struct stream_desc *inp) {
{ /* if (inp != inp0) { fprintf(stderr,"\n %s
if (inp != inp0) { fprintf(stderr,"\n %s **********************************\n", AtomName(inp->name)); * **********************************\n", AtomName(inp->name)); */
inp0 = inp; /* inp0 = inp; */
} /* } */
int ch = inp->stream_wgetc_for_read(inp - GLOBAL_Stream); int ch = inp->stream_wgetc_for_read(inp - GLOBAL_Stream);
// fprintf(stderr,"%c", ch); // fprintf(stderr,"%c", ch);
return ch; return ch;
} }
// get char for quoted data, eg, quoted atoms and so on // get char for quoted data, eg, quoted atoms and so on
// converts to wide // converts to wide
static inline int getchrq(struct stream_desc *inp) static inline int getchrq(struct stream_desc *inp) {
{
int ch = inp->stream_wgetc(inp - GLOBAL_Stream); int ch = inp->stream_wgetc(inp - GLOBAL_Stream);
return ch; return ch;
} }
@ -614,7 +613,7 @@ static char *AllocScannerMemory(unsigned int size) {
if (LOCAL_ScannerExtraBlocks) { if (LOCAL_ScannerExtraBlocks) {
struct scanner_extra_alloc *ptr; struct scanner_extra_alloc *ptr;
if (!(ptr = (struct scanner_extra_alloc *)malloc( if (!(ptr = (struct scanner_extra_alloc *)Malloc(
size + sizeof(ScannerExtraBlock)))) { size + sizeof(ScannerExtraBlock)))) {
return NULL; return NULL;
} }
@ -629,7 +628,7 @@ static char *AllocScannerMemory(unsigned int size) {
if (!Yap_growtrail(alloc_size, TRUE)) { if (!Yap_growtrail(alloc_size, TRUE)) {
struct scanner_extra_alloc *ptr; struct scanner_extra_alloc *ptr;
if (!(ptr = (struct scanner_extra_alloc *)malloc( if (!(ptr = (struct scanner_extra_alloc *)Malloc(
size + sizeof(ScannerExtraBlock)))) { size + sizeof(ScannerExtraBlock)))) {
return NULL; return NULL;
} }
@ -885,7 +884,7 @@ static int num_send_error_message(char s[]) {
char *nbuf; \ char *nbuf; \
\ \
if (buf == buf0) { \ if (buf == buf0) { \
nbuf = malloc(nsz); \ nbuf = Malloc(nsz); \
} else { \ } else { \
nbuf = realloc(buf, nsz); \ nbuf = realloc(buf, nsz); \
} \ } \
@ -1133,8 +1132,8 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) {
; ;
#endif #endif
TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
tokptr->TokLine = GetCurInpLine(inp); tokptr->TokLine = GetCurInpLine(inp);
tokptr->TokPos = GetCurInpPos(inp); tokptr->TokPos = GetCurInpPos(inp);
if (ch == '-') { if (ch == '-') {
sign = -1; sign = -1;
ch = getchr(inp); ch = getchr(inp);
@ -1247,16 +1246,16 @@ const char *Yap_tokText(void *tokptre) {
return "<QQ>"; return "<QQ>";
case Number_tok: case Number_tok:
if (IsIntegerTerm(info)) { if (IsIntegerTerm(info)) {
char *s = malloc(36); char *s = Malloc(36);
snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info)); snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info));
return s; return s;
} else if (IsFloatTerm(info)) { } else if (IsFloatTerm(info)) {
char *s = malloc(64); char *s = Malloc(64);
snprintf(s, 63, "%6g", FloatOfTerm(info)); snprintf(s, 63, "%6g", FloatOfTerm(info));
return s; return s;
} else { } else {
size_t len = Yap_gmp_to_size(info, 10); size_t len = Yap_gmp_to_size(info, 10);
char *s = malloc(len + 2); char *s = Malloc(len + 2);
return Yap_gmp_to_string(info, s, len + 1, 10); return Yap_gmp_to_string(info, s, len + 1, 10);
} }
break; break;
@ -1286,7 +1285,7 @@ static void open_comment(int ch, StreamDesc *st USES_REGS) {
h0[1] = Yap_StreamPosition(st - GLOBAL_Stream); h0[1] = Yap_StreamPosition(st - GLOBAL_Stream);
h0[2] = TermNil; h0[2] = TermNil;
LOCAL_CommentsNextChar = h0 + 2; LOCAL_CommentsNextChar = h0 + 2;
LOCAL_CommentsBuff = (wchar_t *)malloc(1024 * sizeof(wchar_t)); LOCAL_CommentsBuff = (wchar_t *)Malloc(1024 * sizeof(wchar_t));
LOCAL_CommentsBuffLim = 1024; LOCAL_CommentsBuffLim = 1024;
LOCAL_CommentsBuff[0] = ch; LOCAL_CommentsBuff[0] = ch;
LOCAL_CommentsBuffPos = 1; LOCAL_CommentsBuffPos = 1;
@ -1305,7 +1304,7 @@ static void extend_comment(int ch USES_REGS) {
static void close_comment(USES_REGS1) { static void close_comment(USES_REGS1) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0'; LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS); *LOCAL_CommentsNextChar = Yap_WCharsToString(LOCAL_CommentsBuff PASS_REGS);
free(LOCAL_CommentsBuff); Free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL; LOCAL_CommentsBuff = NULL;
LOCAL_CommentsBuffLim = 0; LOCAL_CommentsBuffLim = 0;
} }
@ -1364,8 +1363,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
while (chtype(ch) == BS) { while (chtype(ch) == BS) {
ch = getchr(st); ch = getchr(st);
} }
t->TokPos = GetCurInpPos(st); t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st); t->TokLine = GetCurInpLine(st);
switch (chtype(ch)) { switch (chtype(ch)) {
@ -1413,7 +1412,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
int32_t och = ch; int32_t och = ch;
ch = getchr(st); ch = getchr(st);
size_t sz = 512; size_t sz = 512;
TokImage = malloc(sz PASS_REGS); TokImage = Malloc(sz PASS_REGS);
scan_name: scan_name:
charp = (unsigned char *)TokImage; charp = (unsigned char *)TokImage;
isvar = (chtype(och) != LC); isvar = (chtype(och) != LC);
@ -1426,7 +1425,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (TokImage == NULL) { if (TokImage == NULL) {
return CodeSpaceError(t, p, l); return CodeSpaceError(t, p, l);
} }
charp = TokImage - (charp - p0); charp = TokImage + (charp - p0);
} }
add_ch_to_buff(ch); add_ch_to_buff(ch);
} }
@ -1443,7 +1442,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
Atom ae; Atom ae;
/* don't do this in iso */ /* don't do this in iso */
ae = Yap_ULookupAtom(TokImage); ae = Yap_ULookupAtom(TokImage);
free(TokImage); Free(TokImage);
if (ae == NIL) { if (ae == NIL) {
return CodeSpaceError(t, p, l); return CodeSpaceError(t, p, l);
} }
@ -1453,7 +1452,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
} else { } else {
VarEntry *ve = Yap_LookupVar((const char *)TokImage); VarEntry *ve = Yap_LookupVar((const char *)TokImage);
free(TokImage); Free(TokImage);
t->TokInfo = Unsigned(ve); t->TokInfo = Unsigned(ve);
if (cur_qq) { if (cur_qq) {
ve->refs++; ve->refs++;
@ -1484,8 +1483,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (cherr) { if (cherr) {
TokEntry *e; TokEntry *e;
t->Tok = Number_tok; t->Tok = Number_tok;
t->TokPos = GetCurInpPos(st); t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st); t->TokLine = GetCurInpLine(st);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) { if (e == NULL) {
return TrailSpaceError(p, l); return TrailSpaceError(p, l);
@ -1500,7 +1499,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case 'e': case 'e':
case 'E': case 'E':
och = cherr; och = cherr;
TokImage = malloc(1024 PASS_REGS); TokImage = Malloc(1024 PASS_REGS);
goto scan_name; goto scan_name;
break; break;
case '=': case '=':
@ -1511,8 +1510,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(Var_tok); t->Tok = Ord(Var_tok);
t->TokInfo = (Term)Yap_LookupVar("E"); t->TokInfo = (Term)Yap_LookupVar("E");
t->TokPos = GetCurInpPos(st); t->TokPos = GetCurInpPos(st);
t->TokLine = GetCurInpLine(st); t->TokLine = GetCurInpLine(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) { if (e2 == NULL) {
return TrailSpaceError(p, l); return TrailSpaceError(p, l);
@ -1545,8 +1544,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
t->TokInfo = MkAtomTerm(AtomE); t->TokInfo = MkAtomTerm(AtomE);
t->TokLine = GetCurInpLine(st); t->TokLine = GetCurInpLine(st);
t->TokPos = GetCurInpPos(st); t->TokPos = GetCurInpPos(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) { if (e2 == NULL) {
return TrailSpaceError(p, l); return TrailSpaceError(p, l);
@ -1569,7 +1568,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case QT: case QT:
case DC: case DC:
quoted_string: quoted_string:
TokImage = malloc(1048); TokImage = Malloc(1048);
charp = TokImage; charp = TokImage;
quote = ch; quote = ch;
len = 0; len = 0;
@ -1633,7 +1632,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (!(t->TokInfo)) { if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l); return CodeSpaceError(t, p, l);
} }
free(TokImage); Free(TokImage);
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
if (ch == '(') if (ch == '(')
solo_flag = false; solo_flag = false;
@ -1746,7 +1745,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else { } else {
Atom ae; Atom ae;
sz = 1024; sz = 1024;
TokImage = malloc(sz); TokImage = Malloc(sz);
charp = TokImage; charp = TokImage;
add_ch_to_buff(och); add_ch_to_buff(och);
for (; chtype(ch) == SY; ch = getchr(st)) { for (; chtype(ch) == SY; ch = getchr(st)) {
@ -1767,7 +1766,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (t->TokInfo == (CELL)NIL) { if (t->TokInfo == (CELL)NIL) {
return CodeSpaceError(t, p, l); return CodeSpaceError(t, p, l);
} }
free(TokImage); Free(TokImage);
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
if (ch == '(') if (ch == '(')
solo_flag = false; solo_flag = false;
@ -1827,7 +1826,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
qq_t *qq = (qq_t *)calloc(sizeof(qq_t), 1); qq_t *qq = (qq_t *)calloc(sizeof(qq_t), 1);
if (!qq) { if (!qq) {
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote"; LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError; t->TokInfo = TermOutOfHeapError;
return l; return l;
@ -1837,7 +1835,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError; t->TokInfo = TermOutOfHeapError;
free(qq); Free(qq);
return l; return l;
} else { } else {
cur_qq = qq; cur_qq = qq;
@ -1871,7 +1869,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (!qq) { if (!qq) {
LOCAL_ErrorMessage = "quasi quoted's || without {|"; LOCAL_ErrorMessage = "quasi quoted's || without {|";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
free(cur_qq); Free(cur_qq);
cur_qq = NULL; cur_qq = NULL;
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError; t->TokInfo = TermError;
@ -1890,7 +1888,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = QuasiQuotes_tok); t->Tok = Ord(kind = QuasiQuotes_tok);
ch = getchr(st); ch = getchr(st);
sz = 1024; sz = 1024;
TokImage = malloc(sz); TokImage = Malloc(sz);
if (!TokImage) { if (!TokImage) {
LOCAL_ErrorMessage = LOCAL_ErrorMessage =
"not enough heap space to read in a quasi quoted atom"; "not enough heap space to read in a quasi quoted atom";
@ -1914,7 +1912,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
break; break;
} }
} else if (chtype(ch) == EF) { } else if (chtype(ch) == EF) {
free(TokImage); Free(TokImage);
mark_eof(st); mark_eof(st);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError; t->TokInfo = TermOutOfHeapError;
@ -1930,7 +1928,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} }
} }
len = charp - (unsigned char *)TokImage; len = charp - (unsigned char *)TokImage;
mp = malloc(len + 1); mp = Malloc(len + 1);
if (mp == NULL) { if (mp == NULL) {
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote"; LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
@ -1982,8 +1980,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
p->TokNext = e; p->TokNext = e;
e->Tok = Error_tok; e->Tok = Error_tok;
e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
e->TokPos = GetCurInpPos(st); e->TokPos = GetCurInpPos(st);
e->TokLine = GetCurInpLine(st); e->TokLine = GetCurInpLine(st);
e->TokNext = NULL; e->TokNext = NULL;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
p = e; p = e;
@ -1999,14 +1997,14 @@ void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks; struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
while (ptr) { while (ptr) {
struct scanner_extra_alloc *next = ptr->next; struct scanner_extra_alloc *next = ptr->next;
free(ptr); Free(ptr);
ptr = next; ptr = next;
} }
TR = (tr_fr_ptr)tokstart; TR = (tr_fr_ptr)tokstart;
LOCAL_Comments = TermNil; LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL; LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
if (LOCAL_CommentsBuff) { if (LOCAL_CommentsBuff) {
free(LOCAL_CommentsBuff); Free(LOCAL_CommentsBuff);
LOCAL_CommentsBuff = NULL; LOCAL_CommentsBuff = NULL;
} }
LOCAL_ScannerStack = NULL; LOCAL_ScannerStack = NULL;

210
C/yap-args.c
View File

@ -154,7 +154,6 @@ static void start_modules(void) {
CurrentModule = cm; CurrentModule = cm;
} }
const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR, *Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR,
*Yap_STARTUP, *Yap_BOOTFILE; *Yap_STARTUP, *Yap_BOOTFILE;
@ -166,7 +165,7 @@ static void consult(const char *b_file USES_REGS) {
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1); Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1); Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
Functor functor_bc = Yap_MkFunctor(Yap_LookupAtom("$bc"), 2); Functor functor_bc = Yap_MkFunctor(Yap_LookupAtom("$bc"), 3);
/* consult boot.pl */ /* consult boot.pl */
char *full = malloc(YAP_FILENAME_MAX + 1); char *full = malloc(YAP_FILENAME_MAX + 1);
@ -178,43 +177,29 @@ static void consult(const char *b_file USES_REGS) {
exit(1); exit(1);
} }
do { do {
CACHE_REGS CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false); YAP_Reset(YAP_FULL_RESET, false);
Yap_StartSlots(); Yap_StartSlots();
Term vs = YAP_MkVarTerm(); Term vs = YAP_MkVarTerm(), pos = MkVarTerm();
t = YAP_ReadClauseFromStream(boot_stream, vs); t = YAP_ReadClauseFromStream(boot_stream, vs, pos);
//Yap_GetNèwSlot(t); // Yap_GetNèwSlot(t);
if (t == 0) { if (t == 0) {
fprintf(stderr, fprintf(stderr, "[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n",
"[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n",
b_file, GLOBAL_Stream[boot_stream].linecount); b_file, GLOBAL_Stream[boot_stream].linecount);
} else if (IsVarTerm(t) || t == TermNil) { } else if (IsVarTerm(t) || t == TermNil) {
fprintf(stderr, "[ line %d: term cannot be compiled ]", GLOBAL_Stream[boot_stream].linecount); fprintf(stderr, "[ line %d: term cannot be compiled ]",
GLOBAL_Stream[boot_stream].linecount);
} else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query || } else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query ||
FunctorOfTerm(t) == functor_command1)) { FunctorOfTerm(t) == functor_command1)) {
t = ArgOfTerm(1, t); t = ArgOfTerm(1, t);
if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) { if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) {
consult( RepAtom(AtomOfTerm(ArgOfTerm(1,t)))->StrOfAE); consult(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE);
} else { } else {
YAP_Term ts[2];
ts[0] = t;
ts[1] = vs;
t = YAP_MkApplTerm(functor_bc, 2, ts);
YAP_RunGoalOnce(t); YAP_RunGoalOnce(t);
} }
} else { } else {
Term ts[2];
char *ErrorMessage; char *ErrorMessage;
Functor fun = Yap_MkFunctor(Yap_LookupAtom("$prepare_clause"), 2);
PredEntry *pe = RepPredProp(PredPropByFunc(fun, PROLOG_MODULE));
if (pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE) {
ts[0] = t;
RESET_VARIABLE(ts + 1);
if (YAP_RunGoal(Yap_MkApplTerm(fun, 2, ts)))
t = ts[1];
}
ErrorMessage = YAP_CompileClause(t); ErrorMessage = YAP_CompileClause(t);
if (ErrorMessage) { if (ErrorMessage) {
fprintf(stderr, "%s", ErrorMessage); fprintf(stderr, "%s", ErrorMessage);
@ -243,30 +228,29 @@ do {
* *
*/ */
typedef struct config { typedef struct config {
char *name; char *name;
const char * *root; const char **root;
const char * *lib; const char **lib;
const char * *share; const char **share;
const char * *include; const char **include;
const char * *pl; const char **pl;
const char * *commons; const char **commons;
const char * *dll; const char **dll;
const char * *ss; const char **ss;
const char * *bootpl; const char **bootpl;
} config_t; } config_t;
const char *gd_root[] = {"@RootDir","[root]", "(execdir).."}; const char *gd_root[] = {"@RootDir", "[root]", "(execdir).."};
const char *gd_lib[] = {"@LibDir","[lib]", "(root)lib"}; const char *gd_lib[] = {"@LibDir", "[lib]", "(root)lib"};
const char *gd_share[] = {"@ShareDir","[share]", "(root)share"}; const char *gd_share[] = {"@ShareDir", "[share]", "(root)share"};
const char *gd_include[] = {"@IncludeDir","[include]", "(root)include"}; const char *gd_include[] = {"@IncludeDir", "[include]", "(root)include"};
const char *gd_dll[] = {"@DLLDir","(lib)Yap"}; const char *gd_dll[] = {"@DLLDir", "(lib)Yap"};
const char *gd_pl[] = {"@PlDir","(share)Yap"}; const char *gd_pl[] = {"@PlDir", "(share)Yap"};
const char *gd_commons[] = {"@CommonsDir","(share)PrologCommons"}; const char *gd_commons[] = {"@CommonsDir", "(share)PrologCommons"};
const char *gd_ss[] = {"@SavedState","(dll)startup.yss"}; const char *gd_ss[] = {"@SavedState", "(dll)startup.yss"};
const char *gd_bootpl[] = {"@PrologBootFile","(pl)pl/boot.yap"}; const char *gd_bootpl[] = {"@PrologBootFile", "(pl)pl/boot.yap"};
static config_t *gnu(config_t *i) static config_t *gnu(config_t *i) {
{
i->root = gd_root; i->root = gd_root;
i->lib = gd_lib; i->lib = gd_lib;
i->share = gd_share; i->share = gd_share;
@ -280,33 +264,30 @@ static config_t *gnu(config_t *i)
return i; return i;
} }
const char *build_root[] = {"."}; const char *build_root[] = {"."};
const char *build_lib[] = {"."}; const char *build_lib[] = {"."};
const char *build_share[] = {"(src)"}; const char *build_share[] = {"(src)"};
const char *build_include[] = {"(src/include]"}; const char *build_include[] = {"(src/include]"};
const char *build_dll[] = {"."}; const char *build_dll[] = {"."};
const char *build_pl[] = {"pl"}; const char *build_pl[] = {"pl"};
const char *build_commons[] = {"PrologCommons"}; const char *build_commons[] = {"PrologCommons"};
const char *build_ss[] = {NULL}; const char *build_ss[] = {NULL};
const char *build_bootpl[] = {"(pl)boot.yap"}; const char *build_bootpl[] = {"(pl)boot.yap"};
static config_t *build(config_t *i) {
static config_t *build(config_t *i) i->root = build_root;
{ i->lib = build_lib;
i->root = build_root; i->share = build_share;
i->lib = build_lib; i->include = build_include;
i->share = build_share; i->dll = build_dll;
i->include = build_include; i->pl = build_pl;
i->dll = build_dll; i->commons = build_commons;
i->pl = build_pl; i->ss = build_ss;
i->commons = build_commons; i->bootpl = build_bootpl;
i->ss = build_ss; return i;
i->bootpl = build_bootpl;
return i;
} }
/**
/**
* Search * Search
*/ */
char *location(YAP_init_args *iap, const char *inp, char *out) { char *location(YAP_init_args *iap, const char *inp, char *out) {
@ -342,7 +323,7 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
strcat(out, inp + strlen("(pl)")); strcat(out, inp + strlen("(pl)"));
} else if (strstr(inp + 1, "execdir") == inp + 1) { } else if (strstr(inp + 1, "execdir") == inp + 1) {
char *buf = Malloc(YAP_FILENAME_MAX + 1); char *buf = Malloc(YAP_FILENAME_MAX + 1);
const char *ex = Yap_AbsoluteFile(Yap_FindExecutable(), buf, false); const char *ex = Yap_AbsoluteFile(Yap_FindExecutable(), buf, false);
if (ex != NULL) { if (ex != NULL) {
strcpy(out, dirname((char *)ex)); strcpy(out, dirname((char *)ex));
strcat(out, "/"); strcat(out, "/");
@ -356,23 +337,23 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
if (tmp && tmp[0]) if (tmp && tmp[0])
strcpy(out, tmp); strcpy(out, tmp);
} else if (strstr(inp + 1, "LibDir") == inp + 1) { } else if (strstr(inp + 1, "LibDir") == inp + 1) {
const char *tmp = iap->LibDir; const char *tmp = iap->LibDir;
if (tmp && tmp[0]) if (tmp && tmp[0])
strcpy(out, tmp); strcpy(out, tmp);
} else if (strstr(inp + 1, "IncludeDir") == inp + 1) { } else if (strstr(inp + 1, "IncludeDir") == inp + 1) {
const char *tmp = iap->IncludeDir; const char *tmp = iap->IncludeDir;
if (tmp && tmp[0]) if (tmp && tmp[0])
strcpy(out, tmp); strcpy(out, tmp);
} else if (strstr(inp + 1, "SharedDir") == inp + 1) { } else if (strstr(inp + 1, "SharedDir") == inp + 1) {
const char *tmp = iap->SharedDir; const char *tmp = iap->SharedDir;
if (tmp && tmp[0]) if (tmp && tmp[0])
strcpy(out, tmp); strcpy(out, tmp);
} else if (strstr(inp + 1, "DLLDir") == inp + 1) { } else if (strstr(inp + 1, "DLLDir") == inp + 1) {
const char *tmp = iap->DLLDir; const char *tmp = iap->DLLDir;
if (tmp && tmp[0]) if (tmp && tmp[0])
strcpy(out, tmp); strcpy(out, tmp);
} else if (strstr(inp + 1, "PlDir") == inp + 1) { } else if (strstr(inp + 1, "PlDir") == inp + 1) {
const char *tmp = iap->SavedState; const char *tmp = iap->SavedState;
if (tmp && tmp[0]) if (tmp && tmp[0])
strcpy(out, tmp); strcpy(out, tmp);
} else if (strstr(inp + 1, "PrologBootFile") == inp + 1) { } else if (strstr(inp + 1, "PrologBootFile") == inp + 1) {
@ -460,35 +441,27 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
* @return * @return
*/ */
static const char *find_directory(YAP_init_args *iap, const char *paths[], static const char *find_directory(YAP_init_args *iap, const char *paths[],
const char *names[]) { char *filename) {
int lvl = push_text_stack(); int lvl = push_text_stack();
char *out = Malloc(YAP_FILENAME_MAX + 1); char *out = Malloc(YAP_FILENAME_MAX + 1);
const char *inp; const char *inp;
char *full; char *full;
if (names) { if (filename) {
full = Malloc(YAP_FILENAME_MAX + 1); full = Malloc(YAP_FILENAME_MAX + 1);
} }
int i = 0; int i = 0;
while ((inp = paths[i++]) != NULL) { while ((inp = paths[i++]) != NULL) {
out[0] = '\0'; out[0] = '\0';
char *o = location(iap, inp, out), *no; char *o = location(iap, inp, out), *no;
if (o && o[0] && Yap_Exists(o)) { if (o && o[0] && Yap_isDirectory(o)) {
if (names) { if (filename) {
size_t s = strlen(o); o = realpath(o, full);
o[s++] = '/'; strcat(o, "/");
const char *p; strcat(o, filename);
int j = 0; return o;
while ((p = names[j++])) {
char *io = o + s;
if ((no = location(iap, p, io)) && io[0] != '\0' && Yap_Exists(o)) {
o = pop_output_text_stack(lvl, o);
o = realpath(o, full);
return o;
}
}
} else { } else {
return pop_output_text_stack(lvl, o); o = pop_output_text_stack(lvl, o);
return o;
} }
} }
} }
@ -499,17 +472,16 @@ static const char *find_directory(YAP_init_args *iap, const char *paths[],
static void Yap_set_locations(YAP_init_args *iap) { static void Yap_set_locations(YAP_init_args *iap) {
config_t t, *template; config_t t, *template;
template = gnu(&t);
template= gnu(&t); Yap_ROOTDIR = find_directory(iap, template->root, NULL);
Yap_ROOTDIR = find_directory(iap, template->root, NULL);
Yap_LIBDIR = find_directory(iap, template->lib, NULL); Yap_LIBDIR = find_directory(iap, template->lib, NULL);
//Yap_BINDIR = find_directory(iap, template->bin, NULL); // Yap_BINDIR = find_directory(iap, template->bin, NULL);
Yap_SHAREDIR = find_directory(iap, template->share, NULL); Yap_SHAREDIR = find_directory(iap, template->share, NULL);
Yap_DLLDIR = find_directory(iap, template->dll, NULL); Yap_DLLDIR = find_directory(iap, template->dll, NULL);
Yap_PLDIR = find_directory(iap, template->pl, NULL); Yap_PLDIR = find_directory(iap, template->pl, NULL);
Yap_COMMONSDIR = find_directory(iap, template->commons, NULL); Yap_COMMONSDIR = find_directory(iap, template->commons, NULL);
Yap_STARTUP = find_directory(iap, template->ss, NULL); Yap_STARTUP = find_directory(iap, template->ss, NULL);
Yap_BOOTFILE = find_directory(iap, template->bootpl, NULL); Yap_BOOTFILE = find_directory(iap, template->bootpl, NULL);
if (Yap_ROOTDIR) if (Yap_ROOTDIR)
setAtomicGlobalPrologFlag(HOME_FLAG, setAtomicGlobalPrologFlag(HOME_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
@ -942,17 +914,22 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
if (!strcmp("-nosignals", p)) { if (!strcmp("-nosignals", p)) {
iap->PrologCannotHandleInterrupts = true; iap->PrologCannotHandleInterrupts = true;
break; break;
} else if (!strncmp("-output-saved-state=", p, strlen("-output-saved-state="))) { } else if (!strncmp("-output-saved-state=", p,
strlen("-output-saved-state="))) {
iap->OutputSavedState = p + strlen("-output-saved-state="); iap->OutputSavedState = p + strlen("-output-saved-state=");
} else if (!strncmp("-home=", p, strlen("-home="))) { } else if (!strncmp("-home=", p, strlen("-home="))) {
iap->RootDir = p + strlen("-home="); iap->RootDir = p + strlen("-home=");
} else if (!strncmp("-system-library-directory=", p, strlen("-system-library-directory="))) { } else if (!strncmp("-system-library-directory=", p,
strlen("-system-library-directory="))) {
iap->LibDir = p + strlen("-system-library-directory="); iap->LibDir = p + strlen("-system-library-directory=");
} else if (!strncmp("-system-shared-directory=", p, strlen("-system-shared-directory="))) { } else if (!strncmp("-system-shared-directory=", p,
strlen("-system-shared-directory="))) {
iap->SharedDir = p + strlen("-system-shared-directory="); iap->SharedDir = p + strlen("-system-shared-directory=");
} else if (!strncmp("-prolog-library-directory=", p, strlen("-prolog-library-directory="))) { } else if (!strncmp("-prolog-library-directory=", p,
strlen("-prolog-library-directory="))) {
iap->PlDir = p + strlen("-prolog-library-directory="); iap->PlDir = p + strlen("-prolog-library-directory=");
} else if (!strncmp("-dll-library-directory=", p, strlen("-dll-library-directory="))) { } else if (!strncmp("-dll-library-directory=", p,
strlen("-dll-library-directory="))) {
iap->DLLDir = p + strlen("-dll-library-directory="); iap->DLLDir = p + strlen("-dll-library-directory=");
} else if (!strncmp("-home=", p, strlen("-home="))) { } else if (!strncmp("-home=", p, strlen("-home="))) {
iap->RootDir = p + strlen("-home="); iap->RootDir = p + strlen("-home=");
@ -977,7 +954,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
ssize = &(iap->HeapSize); ssize = &(iap->HeapSize);
p += strlen("-heap="); p += strlen("-heap=");
goto GetSize; goto GetSize;
} else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) { } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) {
ssize = &(iap->MaxStackSize); ssize = &(iap->MaxStackSize);
p += strlen("-max-stack="); p += strlen("-max-stack=");
goto GetSize; goto GetSize;
@ -1140,7 +1117,7 @@ static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) {
static YAP_file_type_t end_init(YAP_init_args *yap_init, YAP_file_type_t rc) { static YAP_file_type_t end_init(YAP_init_args *yap_init, YAP_file_type_t rc) {
YAP_initialized = true; YAP_initialized = true;
LOCAL_PrologMode &= ~BootMode; LOCAL_PrologMode &= ~BootMode;
return rc; return rc;
} }
@ -1188,18 +1165,24 @@ X_API YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
Yap_Restore(Yap_STARTUP)) { Yap_Restore(Yap_STARTUP)) {
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
CurrentModule = LOCAL_SourceModule = USER_MODULE; CurrentModule = LOCAL_SourceModule = USER_MODULE;
init_globals(yap_init); init_globals(yap_init);
start_modules(); start_modules();
return end_init(yap_init, YAP_QLY); return end_init(yap_init, YAP_QLY);
} else { } else {
init_globals(yap_init); init_globals(yap_init);
start_modules(); start_modules();
consult(Yap_BOOTFILE PASS_REGS); consult(Yap_BOOTFILE PASS_REGS);
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, if (yap_init->install) {
MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE))); Term t = MkAtomTerm(Yap_LookupAtom(YAP_STARTUP));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1),
1, &t);
YAP_RunGoalOnce(g);
}
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
return end_init(yap_init, YAP_BOOT_PL); return end_init(yap_init, YAP_BOOT_PL);
} }
} }
@ -1227,7 +1210,6 @@ X_API YAP_file_type_t YAP_FastInit(char *saved_state, int argc, char *argv[]) {
YAP_init_args init_args; YAP_init_args init_args;
YAP_file_type_t out; YAP_file_type_t out;
if ((out = Yap_InitDefaults(&init_args, saved_state, argc, argv)) != if ((out = Yap_InitDefaults(&init_args, saved_state, argc, argv)) !=
YAP_FOUND_BOOT_ERROR) YAP_FOUND_BOOT_ERROR)
out = YAP_Init(&init_args); out = YAP_Init(&init_args);

1
H/ATOMS
View File

@ -397,6 +397,7 @@ A SystemLibraryDir N "system_library_directory"
A T N "t" A T N "t"
A Term N "term" A Term N "term"
A TermExpansion N "term_expansion" A TermExpansion N "term_expansion"
A TermPosition N "term_position"
A Terms N "terms" A Terms N "terms"
A Text N "text" A Text N "text"
A TextStream N "text_stream" A TextStream N "text_stream"

1
H/generated/iatoms.h
View File

@ -392,6 +392,7 @@
AtomT = Yap_LookupAtom("t"); TermT = MkAtomTerm(AtomT); AtomT = Yap_LookupAtom("t"); TermT = MkAtomTerm(AtomT);
AtomTerm = Yap_LookupAtom("term"); TermTerm = MkAtomTerm(AtomTerm); AtomTerm = Yap_LookupAtom("term"); TermTerm = MkAtomTerm(AtomTerm);
AtomTermExpansion = Yap_LookupAtom("term_expansion"); TermTermExpansion = MkAtomTerm(AtomTermExpansion); AtomTermExpansion = Yap_LookupAtom("term_expansion"); TermTermExpansion = MkAtomTerm(AtomTermExpansion);
AtomTermPosition = Yap_LookupAtom("term_position"); TermTermPosition = MkAtomTerm(AtomTermPosition);
AtomTerms = Yap_LookupAtom("terms"); TermTerms = MkAtomTerm(AtomTerms); AtomTerms = Yap_LookupAtom("terms"); TermTerms = MkAtomTerm(AtomTerms);
AtomText = Yap_LookupAtom("text"); TermText = MkAtomTerm(AtomText); AtomText = Yap_LookupAtom("text"); TermText = MkAtomTerm(AtomText);
AtomTextStream = Yap_LookupAtom("text_stream"); TermTextStream = MkAtomTerm(AtomTextStream); AtomTextStream = Yap_LookupAtom("text_stream"); TermTextStream = MkAtomTerm(AtomTextStream);

1
H/generated/ratoms.h
View File

@ -392,6 +392,7 @@
AtomT = AtomAdjust(AtomT); TermT = MkAtomTerm(AtomT); AtomT = AtomAdjust(AtomT); TermT = MkAtomTerm(AtomT);
AtomTerm = AtomAdjust(AtomTerm); TermTerm = MkAtomTerm(AtomTerm); AtomTerm = AtomAdjust(AtomTerm); TermTerm = MkAtomTerm(AtomTerm);
AtomTermExpansion = AtomAdjust(AtomTermExpansion); TermTermExpansion = MkAtomTerm(AtomTermExpansion); AtomTermExpansion = AtomAdjust(AtomTermExpansion); TermTermExpansion = MkAtomTerm(AtomTermExpansion);
AtomTermPosition = AtomAdjust(AtomTermPosition); TermTermPosition = MkAtomTerm(AtomTermPosition);
AtomTerms = AtomAdjust(AtomTerms); TermTerms = MkAtomTerm(AtomTerms); AtomTerms = AtomAdjust(AtomTerms); TermTerms = MkAtomTerm(AtomTerms);
AtomText = AtomAdjust(AtomText); TermText = MkAtomTerm(AtomText); AtomText = AtomAdjust(AtomText); TermText = MkAtomTerm(AtomText);
AtomTextStream = AtomAdjust(AtomTextStream); TermTextStream = MkAtomTerm(AtomTextStream); AtomTextStream = AtomAdjust(AtomTextStream); TermTextStream = MkAtomTerm(AtomTextStream);

1
H/generated/tatoms.h
View File

@ -392,6 +392,7 @@ X_API EXTERNAL Atom AtomSystemLibraryDir; X_API EXTERNAL Term TermSystemLibraryD
X_API EXTERNAL Atom AtomT; X_API EXTERNAL Term TermT; X_API EXTERNAL Atom AtomT; X_API EXTERNAL Term TermT;
X_API EXTERNAL Atom AtomTerm; X_API EXTERNAL Term TermTerm; X_API EXTERNAL Atom AtomTerm; X_API EXTERNAL Term TermTerm;
X_API EXTERNAL Atom AtomTermExpansion; X_API EXTERNAL Term TermTermExpansion; X_API EXTERNAL Atom AtomTermExpansion; X_API EXTERNAL Term TermTermExpansion;
X_API EXTERNAL Atom AtomTermPosition; X_API EXTERNAL Term TermTermPosition;
X_API EXTERNAL Atom AtomTerms; X_API EXTERNAL Term TermTerms; X_API EXTERNAL Atom AtomTerms; X_API EXTERNAL Term TermTerms;
X_API EXTERNAL Atom AtomText; X_API EXTERNAL Term TermText; X_API EXTERNAL Atom AtomText; X_API EXTERNAL Term TermText;
X_API EXTERNAL Atom AtomTextStream; X_API EXTERNAL Term TermTextStream; X_API EXTERNAL Atom AtomTextStream; X_API EXTERNAL Term TermTextStream;

2
include/YapInterface.h
View File

@ -400,7 +400,7 @@ extern X_API YAP_Term YAP_ReadFromStream(int s);
/// read a Prolog clause from a Prolog opened stream $s$. Similar to /// read a Prolog clause from a Prolog opened stream $s$. Similar to
/// YAP_ReadFromStream() but takes /// default options from read_clause/3. /// YAP_ReadFromStream() but takes /// default options from read_clause/3.
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames); extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, YAP_Term);
extern X_API void YAP_Write(YAP_Term t, FILE *s, int); extern X_API void YAP_Write(YAP_Term t, FILE *s, int);

3
pl/CMakeLists.txt
View File

@ -52,6 +52,7 @@ set(PL_BOOT_SOURCES
swi.yap swi.yap
tabling.yap tabling.yap
threads.yap threads.yap
top.yap
udi.yap udi.yap
undefined.yap undefined.yap
utils.yap utils.yap
@ -90,5 +91,3 @@ else(CMAKE_CROSSCOMPILING)
endif() endif()

4
pl/absf.yap
View File

@ -260,13 +260,13 @@ absolute_file_name(File0,File) :-
'$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]), '$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]),
(First == first -> ! ; true ). (First == first -> ! ; true ).
% allow paths in File Name % allow paths in File Name
'$core_file_name'(Name, Opts) --> '$core_file_name'(Name, Opts) -->
'$file_name'(Name, Opts, E), '$file_name'(Name, Opts, E),
'$suffix'(E, Opts), '$suffix'(E, Opts),
'$glob'(Opts). '$glob'(Opts).
% %
% handle library(lists) or foreign(jpl) % handle library(lists) or foreign(jpl)
% %
'$file_name'(Name, Opts, E) --> '$file_name'(Name, Opts, E) -->

1239
pl/boot.yap
View File

File diff suppressed because it is too large Load Diff

21
pl/builtins.yap
View File

@ -337,10 +337,25 @@ call(G) :- '$execute'(G).
/** @pred incore( 0:P ) /** @pred incore( 0:P )
The same as call/1.
*/
incore(G) :- '$execute'(G).
/** @pred once( 0 G) is iso
Execute the goal _G_ only once. The predicate is defined by:
~~~~~{.prolog}
once(G) :- call(G), !.
~~~~~
Note that cuts inside once/1 can only cut the other goals inside
once/1.
*/
once(G) :-
strip_module(G, M, C),
'$meta_call'(C, M),
!.
(:- G) :- '$execute'(G), !. (:- G) :- '$execute'(G), !.

15
pl/consult.yap
View File

@ -472,7 +472,8 @@ load_files(Files,Opts) :-
'$reexport'( TOpts, ParentF, Reexport, Imports, File ). '$reexport'( TOpts, ParentF, Reexport, Imports, File ).
'$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :-
% check if there is a qly file % check if there is a qly file
% start_low_level_trace, % start_low_level_trace,
'$pred_exists'('$absolute_file_name'(File,[],F),prolog),
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F),
open( F, read, Stream , [type(binary)] ), open( F, read, Stream , [type(binary)] ),
( (
@ -1090,6 +1091,18 @@ make_library_index(_Directory).
exists_source(File) :- exists_source(File) :-
'$full_filename'(File, _AbsFile). '$full_filename'(File, _AbsFile).
'$full_filename'(F0, F) :-
'$undefined'('$absolute_file_name'(F0,[],F),prolog_complete),
!,
absolute_file_system_path(F0, F).
'$full_filename'(F0, F) :-
'$absolute_file_name'(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
expand(true)],F).
% reload_file(File) :- % reload_file(File) :-
% ' $source_base_name'(File, Compile), % ' $source_base_name'(File, Compile),
% findall(M-Opts, % findall(M-Opts,

20
pl/control.yap
View File

@ -87,26 +87,6 @@
*/ */
/** @pred once(: _G_) is iso
Execute the goal _G_ only once. The predicate is defined by:
~~~~~{.prolog}
once(G) :- call(G), !.
~~~~~
Note that cuts inside once/1 can only cut the other goals inside
once/1.
*/
once(G) :-
strip_module(G, M, C),
'$meta_call'(C, M),
!.
/** @pred forall(: _Cond_,: _Action_) /** @pred forall(: _Cond_,: _Action_)

4
pl/directives.yap
View File

@ -69,7 +69,9 @@
'$directive'(G). '$directive'(G).
%:- '$multifile'( '$directive'/1, prolog ). %:- '$multifile'( '$directive'/1, prolog ).
:- multifile prolog:'$exec_directive'/5, prolog:'$directive'/1. %:- multifile prolog:'$exec_directive'/5, prolog:'$directive'/1.
:- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog).
:- '$new_multifile'('$directive'(_), prolog).

2051
pl/errors.yap
View File

File diff suppressed because it is too large Load Diff

9
pl/grammar.yap
View File

@ -67,7 +67,7 @@ right hand side of a grammar rule
Grammar related built-in predicates: Grammar related built-in predicates:
*/ */
/*
:- system_module( '$_grammar', [!/2, :- system_module( '$_grammar', [!/2,
(',')/4, (',')/4,
(->)/4, (->)/4,
@ -81,6 +81,7 @@ Grammar related built-in predicates:
phrase/3, phrase/3,
{}/3, {}/3,
('|')/4], ['$do_error'/2]). ('|')/4], ['$do_error'/2]).
*/
% :- meta_predicate ^(?,0,?). % :- meta_predicate ^(?,0,?).
% ^(Xs, Goal, Xs) :- call(Goal). % ^(Xs, Goal, Xs) :- call(Goal).
@ -276,11 +277,11 @@ prolog:'\\+'(A, S0, S) :-
t_body(\+ A, _, last, S0, S, Goal), t_body(\+ A, _, last, S0, S, Goal),
'$execute'(Goal). '$execute'(Goal).
:- multifile system:goal_expansion/2. :- '$new_multifile'( goal_expansion(_,_), prolog).
:- '$mk_dynamic'( goal_expansion(_,_), prolog).
:- dynamic system:goal_expansion/2.
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :- '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
nonvar(NT),
catch(prolog:'$translate_rule'( catch(prolog:'$translate_rule'(
(pseudo_nt --> Mod:NT), Rule), (pseudo_nt --> Mod:NT), Rule),
error(Pat,ImplDep), error(Pat,ImplDep),

1
pl/messages.yap
View File

@ -105,6 +105,7 @@ In YAP, the info field describes:
prefix/5, prefix/5,
file_location/3]). file_location/3]).
:- abolish(prolog:print_message/2).
:- use_system_module( user, [message_hook/3]). :- use_system_module( user, [message_hook/3]).

2
pl/modules.yap
View File

@ -285,7 +285,7 @@ use_module(F,Is) :-
recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R), recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R),
'$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)), '$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)),
lists:append( AllReExports, AllExports, Everything0 ), lists:append( AllReExports, AllExports, Everything0 ),
sort( Everything0, Everything ), '$sort'( Everything0, Everything ),
( source_location(_, Line) -> true ; Line = 0 ), ( source_location(_, Line) -> true ; Line = 0 ),
recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_). recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_).

2
pl/newmod.yap
View File

@ -124,7 +124,7 @@ set_module_property(Mod, class(Class)) :-
( recorded('$module','$module'( HostF, HostM, _, _, _, _),_) -> true ; HostF = user_input ), ( recorded('$module','$module'( HostF, HostM, _, _, _, _),_) -> true ; HostF = user_input ),
% first build the initial export table % first build the initial export table
'$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files), '$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
sort( AllExports0, AllExports ), '$sort'( AllExports0, AllExports ),
'$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now '$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
% last, export everything to the host: if the loading crashed you didn't actually do % last, export everything to the host: if the loading crashed you didn't actually do
% no evil. % no evil.

1106
pl/top.yap Normal file
View File

File diff suppressed because it is too large Load Diff