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

support for option comments(X) in read_term/1.

Browse Source
This commit is contained in:
Vitor Santos Costa 2011-06-12 17:23:10 +01:00
parent 787ca8fd05
commit 261e02b43e
12 changed files with 201 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/c_interface.c
View File

@ -2527,20 +2527,20 @@ YAP_Read(IOSTREAM *inp)
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, &tpos); tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, FALSE, &tpos);
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
{ {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return 0; return 0;
} }
if (inp->flags & (SIO_FEOF|SIO_FEOF2)) { if (inp->flags & (SIO_FEOF|SIO_FEOF2)) {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return MkAtomTerm (AtomEof); return MkAtomTerm (AtomEof);
} }
t = Yap_Parse(); t = Yap_Parse();
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return t; return t;

55
C/iopreds.c
View File

@ -402,19 +402,19 @@ Yap_StringToTerm(char *s,Term *tp)
if (sno == NULL) if (sno == NULL)
return FALSE; return FALSE;
TR_before_parse = TR; TR_before_parse = TR;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(sno, &tpos); tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(sno, FALSE, &tpos);
if (tokstart == NIL || tokstart->Tok == Ord (eot_tok)) { if (tokstart == NIL || tokstart->Tok == Ord (eot_tok)) {
if (tp) { if (tp) {
*tp = MkAtomTerm(AtomEOFBeforeEOT); *tp = MkAtomTerm(AtomEOFBeforeEOT);
} }
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
Sclose(sno); Sclose(sno);
return FALSE; return FALSE;
} else if (LOCAL_ErrorMessage) { } else if (LOCAL_ErrorMessage) {
if (tp) { if (tp) {
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); *tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
} }
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
Sclose(sno); Sclose(sno);
return FALSE; return FALSE;
} }
@ -422,11 +422,11 @@ Yap_StringToTerm(char *s,Term *tp)
TR = TR_before_parse; TR = TR_before_parse;
if (!t || LOCAL_ErrorMessage) { if (!t || LOCAL_ErrorMessage) {
GenerateSyntaxError(tp, tokstart, sno PASS_REGS); GenerateSyntaxError(tp, tokstart, sno PASS_REGS);
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
Sclose(sno); Sclose(sno);
return FALSE; return FALSE;
} }
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
Sclose(sno); Sclose(sno);
return t; return t;
} }
@ -512,25 +512,25 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos)
if (st == NULL) { if (st == NULL) {
return FALSE; return FALSE;
} }
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(st, tpos); tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(st, FALSE, tpos);
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
{ {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
if (terror) if (terror)
*terror = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); *terror = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE; return FALSE;
} }
pt = Yap_Parse(); pt = Yap_Parse();
if (LOCAL_ErrorMessage || pt == (CELL)0) { if (LOCAL_ErrorMessage || pt == (CELL)0) {
GenerateSyntaxError(terror, tokstart, st PASS_REGS); GenerateSyntaxError(terror, tokstart, st PASS_REGS);
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE; return FALSE;
} }
if (varnames) { if (varnames) {
*varnames = Yap_VarNames(LOCAL_VarTable, TermNil); *varnames = Yap_VarNames(LOCAL_VarTable, TermNil);
if (!*varnames) { if (!*varnames) {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE; return FALSE;
} }
} }
@ -548,6 +548,7 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos)
Vars: ARG4 Vars: ARG4
Pos: ARG5 Pos: ARG5
Err: ARG6 Err: ARG6
Comments: ARG7
*/ */
static Int static Int
do_read(IOSTREAM *inp_stream, int nargs USES_REGS) do_read(IOSTREAM *inp_stream, int nargs USES_REGS)
@ -556,6 +557,8 @@ static Int
TokEntry *tokstart; TokEntry *tokstart;
Term tmod = Deref(ARG3), OCurrentModule = CurrentModule, tpos; Term tmod = Deref(ARG3), OCurrentModule = CurrentModule, tpos;
extern void Yap_setCurrentSourceLocation(IOSTREAM **s); extern void Yap_setCurrentSourceLocation(IOSTREAM **s);
Term tcomms = Deref(ARG7);
int store_comments = IsVarTerm(tcomms);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation(&inp_stream);
if (IsVarTerm(tmod)) { if (IsVarTerm(tmod)) {
@ -583,10 +586,12 @@ static Int
while (TRUE) { while (TRUE) {
old_H = H; old_H = H;
tpos = Yap_StreamPosition(inp_stream); tpos = Yap_StreamPosition(inp_stream);
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, &tpos); LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos);
if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) { if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H; H = old_H;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
if (seekable) { if (seekable) {
Sseek64(inp_stream, cpos, SIO_SEEK_SET); Sseek64(inp_stream, cpos, SIO_SEEK_SET);
} }
@ -624,10 +629,10 @@ static Int
/* did we get the end of file from an abort? */ /* did we get the end of file from an abort? */
if (LOCAL_ErrorMessage && if (LOCAL_ErrorMessage &&
!strcmp(LOCAL_ErrorMessage,"Abort")) { !strcmp(LOCAL_ErrorMessage,"Abort")) {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE; return FALSE;
} else { } else {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)) return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof))
&& Yap_unify_constant(ARG4, TermNil); && Yap_unify_constant(ARG4, TermNil);
@ -670,7 +675,7 @@ static Int
} }
if (ParserErrorStyle == QUIET_ON_PARSER_ERROR) { if (ParserErrorStyle == QUIET_ON_PARSER_ERROR) {
/* just fail */ /* just fail */
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return FALSE; return FALSE;
} else if (ParserErrorStyle == CONTINUE_ON_PARSER_ERROR) { } else if (ParserErrorStyle == CONTINUE_ON_PARSER_ERROR) {
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
@ -682,14 +687,14 @@ static Int
LOCAL_ErrorMessage = "SYNTAX ERROR"; LOCAL_ErrorMessage = "SYNTAX ERROR";
if (ParserErrorStyle == EXCEPTION_ON_PARSER_ERROR) { if (ParserErrorStyle == EXCEPTION_ON_PARSER_ERROR) {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage); Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage);
return FALSE; return FALSE;
} else /* FAIL ON PARSER ERROR */ { } else /* FAIL ON PARSER ERROR */ {
Term t[2]; Term t[2];
t[0] = terr; t[0] = terr;
t[1] = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); t[1] = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(AtomError,2),2,t)); return Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(AtomError,2),2,t));
} }
} }
@ -701,6 +706,8 @@ static Int
} }
if (!Yap_unify(t, ARG2)) if (!Yap_unify(t, ARG2))
return FALSE; return FALSE;
if (store_comments && !Yap_unify(LOCAL_Comments, ARG7))
return FALSE;
if (AtomOfTerm (Deref (ARG1)) == AtomTrue) { if (AtomOfTerm (Deref (ARG1)) == AtomTrue) {
while (TRUE) { while (TRUE) {
CELL *old_H = H; CELL *old_H = H;
@ -721,10 +728,10 @@ static Int
TR = old_TR; TR = old_TR;
} }
} }
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return Yap_unify (v, ARG4); return Yap_unify (v, ARG4);
} else { } else {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
return TRUE; return TRUE;
} }
} }
@ -732,7 +739,7 @@ static Int
static Int static Int
p_read ( USES_REGS1 ) p_read ( USES_REGS1 )
{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
return do_read(NULL, 6 PASS_REGS); return do_read(NULL, 7 PASS_REGS);
} }
extern int Yap_getInputStream(Int, IOSTREAM **); extern int Yap_getInputStream(Int, IOSTREAM **);
@ -743,10 +750,10 @@ p_read2 ( USES_REGS1 )
IOSTREAM *inp_stream; IOSTREAM *inp_stream;
Int out; Int out;
if (!Yap_getInputStream(Yap_InitSlot(Deref(ARG7) PASS_REGS), &inp_stream)) { if (!Yap_getInputStream(Yap_InitSlot(Deref(ARG8) PASS_REGS), &inp_stream)) {
return(FALSE); return(FALSE);
} }
out = do_read(inp_stream, 7 PASS_REGS); out = do_read(inp_stream, 8 PASS_REGS);
return out; return out;
} }
@ -1108,8 +1115,8 @@ Yap_InitIOPreds(void)
/* here the Input/Output predicates */ /* here the Input/Output predicates */
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag); Yap_InitCPred ("$read", 7, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag); Yap_InitCPred ("$read", 8, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);

140
C/scanner.c
View File

@ -8,7 +8,7 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: %W% %G% * * File: %W% %G% *
* Last rev: 22-1-03 * * Last rev: 22-1-03 *
* mods: * * mods: *
* comments: Prolog's scanner * * comments: Prolog's scanner *
@ -746,7 +746,7 @@ Yap_scan_num(IOSTREAM *inp)
ch = getchr(inp); ch = getchr(inp);
} }
if (chtype(ch) != NU) { if (chtype(ch) != NU) {
Yap_clean_tokenizer(NULL, NULL, NULL); Yap_clean_tokenizer(NULL, NULL, NULL, 0L);
return TermNil; return TermNil;
} }
cherr = '\0'; cherr = '\0';
@ -754,13 +754,66 @@ Yap_scan_num(IOSTREAM *inp)
return TermNil; return TermNil;
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */ out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
PopScannerMemory(ptr, 4096); PopScannerMemory(ptr, 4096);
Yap_clean_tokenizer(NULL, NULL, NULL); Yap_clean_tokenizer(NULL, NULL, NULL, 0L);
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr)
return TermNil; return TermNil;
return out; return out;
} }
#define CHECK_SPACE() \
if (ASP-H < 1024) { \
LOCAL_ErrorMessage = "Stack Overflow"; \
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR; \
LOCAL_Error_Size = 0L; \
if (p) \
p->Tok = Ord(kind = eot_tok); \
/* serious error now */ \
return l; \
}
static void
open_comment(int ch, IOSTREAM *inp_stream) {
CELL *h0 = H;
H += 5;
h0[0] = AbsAppl(h0+2);
h0[1] = TermNil;
if (!LOCAL_CommentsTail) {
/* first comment */
LOCAL_Comments = AbsPair(h0);
} else {
/* extra comment */
*LOCAL_CommentsTail = AbsPair(h0);
}
LOCAL_CommentsTail = h0+1;
h0 += 2;
h0[0] = (CELL)FunctorMinus;
h0[1] = Yap_StreamPosition(inp_stream);
h0[2] = TermNil;
LOCAL_CommentsNextChar = h0+2;
LOCAL_CommentsBuff = (wchar_t *)malloc(1024*sizeof(wchar_t));
LOCAL_CommentsBuffLim = 1024;
LOCAL_CommentsBuff[0] = ch;
LOCAL_CommentsBuffPos = 1;
}
static void
extend_comment(int ch) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = ch;
LOCAL_CommentsBuffPos++;
if (LOCAL_CommentsBuffPos == LOCAL_CommentsBuffLim-1) {
LOCAL_CommentsBuff = (wchar_t *)realloc(LOCAL_CommentsBuff,sizeof(wchar_t)*(LOCAL_CommentsBuffLim+4096));
}
}
static void
close_comment(void) {
LOCAL_CommentsBuff[LOCAL_CommentsBuffPos] = '\0';
*LOCAL_CommentsNextChar = Yap_MkBlobWideStringTerm(LOCAL_CommentsBuff, LOCAL_CommentsBuffPos);
free(LOCAL_CommentsBuff);
}
static wchar_t * static wchar_t *
ch_to_wide(char *base, char *charp) ch_to_wide(char *base, char *charp)
{ {
@ -791,7 +844,7 @@ ch_to_wide(char *base, char *charp)
} }
TokEntry * TokEntry *
Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp) Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
{ {
CACHE_REGS CACHE_REGS
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
@ -846,7 +899,27 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp)
switch (chtype(ch)) { switch (chtype(ch)) {
case CC: case CC:
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF); if (store_comments) {
CHECK_SPACE();
open_comment(ch, inp_stream);
continue_comment:
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF) {
CHECK_SPACE();
extend_comment(ch);
}
CHECK_SPACE();
extend_comment(ch);
if (chtype(ch) != EF) {
ch = getchr(inp_stream);
if (chtype(ch) == CC) {
extend_comment(ch);
goto continue_comment;
}
}
close_comment();
} else {
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF);
}
if (chtype(ch) != EF) { if (chtype(ch) != EF) {
/* blank space */ /* blank space */
if (t == l) { if (t == l) {
@ -854,15 +927,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp)
while (chtype(ch) == BS) { while (chtype(ch) == BS) {
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
if (ASP-H < 1024) { CHECK_SPACE();
LOCAL_ErrorMessage = "Stack Overflow";
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Size = 0L;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
} }
goto restart; goto restart;
@ -947,15 +1012,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp)
/* serious error now */ /* serious error now */
return l; return l;
} }
if (ASP-H < 1024) { CHECK_SPACE();
LOCAL_ErrorMessage = "Stack Overflow";
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Size = 0L;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
if ((t->TokInfo = get_num(&cha,&cherr,inp_stream,ptr,4096,1)) == 0L) { if ((t->TokInfo = get_num(&cha,&cherr,inp_stream,ptr,4096,1)) == 0L) {
if (p) if (p)
p->Tok = Ord(kind = eot_tok); p->Tok = Ord(kind = eot_tok);
@ -1157,28 +1214,37 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp)
och = ch; och = ch;
ch = getchr(inp_stream); ch = getchr(inp_stream);
if (och == '/' && ch == '*') { if (och == '/' && ch == '*') {
while ((och != '*' || ch != '/') && chtype(ch) != EF) { if (store_comments) {
och = ch; CHECK_SPACE();
ch = getchr(inp_stream); open_comment('/', inp_stream);
while ((och != '*' || ch != '/') && chtype(ch) != EF) {
och = ch;
CHECK_SPACE();
extend_comment(ch);
ch = getchr(inp_stream);
}
if (chtype(ch) != EF) {
CHECK_SPACE();
extend_comment(ch);
}
close_comment();
} else {
while ((och != '*' || ch != '/') && chtype(ch) != EF) {
och = ch;
ch = getchr(inp_stream);
}
} }
if (chtype(ch) == EF) { if (chtype(ch) == EF) {
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
} }
/* leave comments */
ch = getchr(inp_stream); ch = getchr(inp_stream);
if (t == l) { if (t == l) {
/* we found a comment before reading characters */ /* we found a comment before reading characters */
while (chtype(ch) == BS) { while (chtype(ch) == BS) {
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
if (ASP-H < 1024) { CHECK_SPACE();
LOCAL_ErrorMessage = "Stack Overflow";
LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
LOCAL_Error_Size = 0L;
if (p)
p->Tok = Ord(kind = eot_tok);
/* serious error now */
return l;
}
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
} }
goto restart; goto restart;
@ -1293,7 +1359,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, Term *tposp)
} }
void void
Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable) Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable, Term commentable)
{ {
CACHE_REGS CACHE_REGS
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks; struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
@ -1302,5 +1368,7 @@ Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartab
free(ptr); free(ptr);
ptr = next; ptr = next;
} }
LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
} }

1
H/ScannerTypes.h
View File

@ -26,3 +26,4 @@ typedef struct VARSTRUCT {
struct VARSTRUCT *VarLeft, *VarRight; struct VARSTRUCT *VarLeft, *VarRight;
char VarRep[1]; char VarRep[1];
} VarEntry; } VarEntry;

12
H/dlocals.h
View File

@ -260,6 +260,18 @@
#define REMOTE_VarTable(wid) REMOTE(wid)->VarTable_ #define REMOTE_VarTable(wid) REMOTE(wid)->VarTable_
#define LOCAL_AnonVarTable LOCAL->AnonVarTable_ #define LOCAL_AnonVarTable LOCAL->AnonVarTable_
#define REMOTE_AnonVarTable(wid) REMOTE(wid)->AnonVarTable_ #define REMOTE_AnonVarTable(wid) REMOTE(wid)->AnonVarTable_
#define LOCAL_Comments LOCAL->Comments_
#define REMOTE_Comments(wid) REMOTE(wid)->Comments_
#define LOCAL_CommentsTail LOCAL->CommentsTail_
#define REMOTE_CommentsTail(wid) REMOTE(wid)->CommentsTail_
#define LOCAL_CommentsNextChar LOCAL->CommentsNextChar_
#define REMOTE_CommentsNextChar(wid) REMOTE(wid)->CommentsNextChar_
#define LOCAL_CommentsBuff LOCAL->CommentsBuff_
#define REMOTE_CommentsBuff(wid) REMOTE(wid)->CommentsBuff_
#define LOCAL_CommentsBuffPos LOCAL->CommentsBuffPos_
#define REMOTE_CommentsBuffPos(wid) REMOTE(wid)->CommentsBuffPos_
#define LOCAL_CommentsBuffLim LOCAL->CommentsBuffLim_
#define REMOTE_CommentsBuffLim(wid) REMOTE(wid)->CommentsBuffLim_
#define LOCAL_RestartEnv LOCAL->RestartEnv_ #define LOCAL_RestartEnv LOCAL->RestartEnv_
#define REMOTE_RestartEnv(wid) REMOTE(wid)->RestartEnv_ #define REMOTE_RestartEnv(wid) REMOTE(wid)->RestartEnv_
#define LOCAL_FileNameBuf LOCAL->FileNameBuf_ #define LOCAL_FileNameBuf LOCAL->FileNameBuf_

6
H/hlocals.h
View File

@ -147,6 +147,12 @@ typedef struct worker_local {
TokEntry* toktide_; TokEntry* toktide_;
VarEntry* VarTable_; VarEntry* VarTable_;
VarEntry* AnonVarTable_; VarEntry* AnonVarTable_;
Term Comments_;
CELL* CommentsTail_;
CELL* CommentsNextChar_;
wchar_t* CommentsBuff_;
size_t CommentsBuffPos_;
size_t CommentsBuffLim_;
sigjmp_buf RestartEnv_; sigjmp_buf RestartEnv_;
char FileNameBuf_[YAP_FILENAME_MAX]; char FileNameBuf_[YAP_FILENAME_MAX];
char FileNameBuf2_[YAP_FILENAME_MAX]; char FileNameBuf2_[YAP_FILENAME_MAX];

6
H/ilocals.h
View File

@ -151,6 +151,12 @@ static void InitWorker(int wid) {
REMOTE_PrologMode(wid) = BootMode; REMOTE_PrologMode(wid) = BootMode;
REMOTE_CritLocks(wid) = 0; REMOTE_CritLocks(wid) = 0;

6
H/rlocals.h
View File

@ -154,6 +154,12 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef ANALYST #ifdef ANALYST

4
H/yapio.h
View File

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

6
misc/LOCALS
View File

@ -164,6 +164,12 @@ TokEntry* tokptr void
TokEntry* toktide void TokEntry* toktide void
VarEntry* VarTable void VarEntry* VarTable void
VarEntry* AnonVarTable void VarEntry* AnonVarTable void
Term Comments void
CELL* CommentsTail void
CELL* CommentsNextChar void
wchar_t* CommentsBuff void
size_t CommentsBuffPos void
size_t CommentsBuffLim void
sigjmp_buf RestartEnv void sigjmp_buf RestartEnv void
char FileNameBuf[YAP_FILENAME_MAX] void char FileNameBuf[YAP_FILENAME_MAX] void
char FileNameBuf2[YAP_FILENAME_MAX] void char FileNameBuf2[YAP_FILENAME_MAX] void

14
pl/boot.yap
View File

@ -15,10 +15,6 @@
* * * *
*************************************************************************/ *************************************************************************/
% This one should come first so that disjunctions and long distance
% cuts are compiled right with co-routining.
%
true :- true. true :- true.
'$live' :- '$live' :-
@ -144,7 +140,7 @@ true :- true.
*/ */
/* main execution loop */ /* main execution loop */
'$read_vars'(user_input, Goal, Mod, Pos, Bindings, Prompt) :- '$read_vars'(user_input, Goal, Mod, Pos, Bindings, Prompt, ReadComments) :-
'$swi_current_prolog_flag'(readline, true), '$swi_current_prolog_flag'(readline, true),
read_history(h, '!h', read_history(h, '!h',
[trace, end_of_file], [trace, end_of_file],
@ -154,8 +150,8 @@ true :- true.
; ;
true true
). ).
'$read_vars'(Stream, T, Mod, Pos, V, _Prompt) :- '$read_vars'(Stream, T, Mod, Pos, V, _Prompt, ReadComments) :-
'$read'(true, T, Mod, V, Pos, Err, Stream), '$read'(true, T, Mod, V, Pos, Err, ReadComments, Stream),
(nonvar(Err) -> (nonvar(Err) ->
print_message(error,Err), fail print_message(error,Err), fail
; ;
@ -195,7 +191,7 @@ true :- true.
prompt(_,'| '), prompt(_,'| '),
'$run_toplevel_hooks', '$run_toplevel_hooks',
prompt1('|: '), prompt1('|: '),
'$read_vars'(user_input,Command,_,Pos,Varnames, ' ?- '), '$read_vars'(user_input,Command,_,Pos,Varnames, ' ?- ', no),
nb_setval('$spy_gn',1), nb_setval('$spy_gn',1),
% stop at spy-points if debugging is on. % stop at spy-points if debugging is on.
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
@ -1138,7 +1134,7 @@ bootstrap(F) :-
!. !.
'$enter_command'(Stream,Status) :- '$enter_command'(Stream,Status) :-
'$read_vars'(Stream,Command,_,Pos,Vars, '|: '), '$read_vars'(Stream,Command,_,Pos,Vars, '|: ', no),
'$command'(Command,Vars,Pos,Status). '$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :- '$abort_loop'(Stream) :-

32
pl/yio.yap
View File

@ -42,7 +42,8 @@
'$check_opt_read'(syntax_errors(T), G) :- !, '$check_opt_read'(syntax_errors(T), G) :- !,
'$check_read_syntax_errors_arg'(T, G). '$check_read_syntax_errors_arg'(T, G).
'$check_opt_read'(term_position(_), _) :- !. '$check_opt_read'(term_position(_), _) :- !.
'$check_opt_read'(module(_), _) :- !. '$check_opt_read'(term_position(_), _) :- !.
'$check_opt_read'(comments(_), _) :- !.
'$check_opt_read'(A, G) :- '$check_opt_read'(A, G) :-
'$do_error'(domain_error(read_option,A),G). '$do_error'(domain_error(read_option,A),G).
@ -97,7 +98,7 @@ exists(F) :- access_file(F,exist).
/* Term IO */ /* Term IO */
read(T) :- read(T) :-
'$read'(false,T,_,_,_,Err), '$read'(false,T,_,_,_,Err,_),
(nonvar(Err) -> (nonvar(Err) ->
print_message(error,Err), fail print_message(error,Err), fail
; ;
@ -105,7 +106,7 @@ read(T) :-
). ).
read(Stream,T) :- read(Stream,T) :-
'$read'(false,T,_,_,_,Err,Stream), '$read'(false,T,_,_,_,Err,_,Stream),
(nonvar(Err) -> (nonvar(Err) ->
print_message(error,Err), fail print_message(error,Err), fail
; ;
@ -115,29 +116,31 @@ read(Stream,T) :-
read_term(T, Options) :- read_term(T, Options) :-
'$check_io_opts'(Options,read_term(T, Options)), '$check_io_opts'(Options,read_term(T, Options)),
current_input(S), current_input(S),
'$preprocess_read_terms_options'(Options,Module), '$preprocess_read_terms_options'(Options,Module,DoComments),
'$read_vars'(S,T,Module,Pos,VL,'|: '), '$read_vars'(S,T,Module,Pos,VL,'|: ',DoComments),
'$postprocess_read_terms_options'(Options, T, VL, Pos). '$postprocess_read_terms_options'(Options, T, VL, Pos).
read_term(Stream, T, Options) :- read_term(Stream, T, Options) :-
'$check_io_opts'(Options,read_term(T, Options)), '$check_io_opts'(Options,read_term(T, Options)),
'$preprocess_read_terms_options'(Options,Module), '$preprocess_read_terms_options'(Options,Module,DoComments),
'$read_vars'(Stream,T,Module,Pos,VL,'|: '), '$read_vars'(Stream,T,Module,Pos,VL,'|: ',DoComments),
'$postprocess_read_terms_options'(Options, T, VL, Pos). '$postprocess_read_terms_options'(Options, T, VL, Pos).
% %
% support flags to read % support flags to read
% %
'$preprocess_read_terms_options'([],_). '$preprocess_read_terms_options'([], _, no).
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L],Mod) :- !, '$preprocess_read_terms_options'([syntax_errors(NewVal)|L], Mod, DoComments) :- !,
'$get_read_error_handler'(OldVal), '$get_read_error_handler'(OldVal),
set_value('$read_term_error_handler', OldVal), set_value('$read_term_error_handler', OldVal),
'$set_read_error_handler'(NewVal), '$set_read_error_handler'(NewVal),
'$preprocess_read_terms_options'(L,Mod). '$preprocess_read_terms_options'(L,Mod, DoComments).
'$preprocess_read_terms_options'([module(Mod)|L],Mod) :- !, '$preprocess_read_terms_options'([module(Mod)|L], Mod, DoComments) :- !,
'$preprocess_read_terms_options'(L,Mod). '$preprocess_read_terms_options'(L, Mod, DoComments).
'$preprocess_read_terms_options'([_|L],Mod) :- '$preprocess_read_terms_options'([comments(Val)|L], Mod, Val) :- !,
'$preprocess_read_terms_options'(L,Mod). '$preprocess_read_terms_options'(L, Mod, _).
'$preprocess_read_terms_options'([_|L],Mod, DoComments) :-
'$preprocess_read_terms_options'(L,Mod, DoComments).
'$postprocess_read_terms_options'([], _, _, _). '$postprocess_read_terms_options'([], _, _, _).
'$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !, '$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !,
@ -159,6 +162,7 @@ read_term(Stream, T, Options) :-
'$fetch_singleton_names'(Val1,VL,Val). '$fetch_singleton_names'(Val1,VL,Val).
'$postprocess_read_terms_option'(variables(Val), T, _, _) :- '$postprocess_read_terms_option'(variables(Val), T, _, _) :-
'$variables_in_term'(T, [], Val). '$variables_in_term'(T, [], Val).
'$postprocess_read_terms_option'(comments(_), _, _, _).
'$postprocess_read_terms_option'(term_position(Pos), _, _, Pos). '$postprocess_read_terms_option'(term_position(Pos), _, _, Pos).
'$postprocess_read_terms_option'(module(_), _, _, _). '$postprocess_read_terms_option'(module(_), _, _, _).
%'$postprocess_read_terms_option'(cycles(Val), _, _). %'$postprocess_read_terms_option'(cycles(Val), _, _).