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

ciao style arrays, (...)

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-07-07 16:15:25 -05:00
parent c5554a343d
commit 493161f6d8
7 changed files with 97 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
C/parser.c
View File

@ -70,7 +70,7 @@ typedef struct jmp_buff_struct {
static void GNextToken( CACHE_TYPE1 );
static void checkfor(Term, JMPBUFF * CACHE_TYPE);
static Term ParseArgs(Atom, JMPBUFF * CACHE_TYPE);
static Term ParseArgs(Atom, Term, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(JMPBUFF * CACHE_TYPE);
static Term ParseTerm(int, JMPBUFF * CACHE_TYPE);
@ -324,7 +324,7 @@ checkfor(Term c, JMPBUFF *FailBuff USES_REGS)
}
static Term
ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1 USES_REGS)
{
int nargs = 0;
Term *p, t;
@ -335,6 +335,27 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
NextToken;
p = (Term *) ParserAuxSp;
if (arg1) {
*p = arg1;
nargs++;
ParserAuxSp = (char *)(p+1);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
&& LOCAL_tokptr->TokInfo == close) {
func = Yap_MkFunctor(a, 1);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = Yap_MkApplTerm(func, nargs, p);
if (H > ASP-4096) {
LOCAL_ErrorMessage = "Stack Overflow";
return TermNil;
}
NextToken;
return t;
}
}
while (1) {
Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp+1 > LOCAL_TrailTop) {
@ -380,7 +401,7 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
return TermNil;
}
/* check for possible overflow against local stack */
checkfor((Term) ')', FailBuff PASS_REGS);
checkfor(close, FailBuff PASS_REGS);
return t;
}
@ -519,7 +540,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
&& Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom) t, FailBuff PASS_REGS);
t = ParseArgs((Atom) t, (Term)')', FailBuff, 0L PASS_REGS);
else
t = MkAtomTerm((Atom)t);
break;
@ -710,6 +731,24 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
}
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyBrackets, (Term)')', FailBuff, t PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptySquareBrackets, (Term)']', FailBuff, t PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyCurlyBrackets, (Term)'}', FailBuff, t PASS_REGS);
curprio = opprio;
continue;
}
}
if (LOCAL_tokptr->Tok <= Ord(WString_tok))

41
C/write.c
View File

@ -320,7 +320,7 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
ob = protect_open_number(wglb, last_minus, sgn);
#if THREADS
/* old style writing */
int found_dot = FALSE, found_exp = FALSE;
int found_dot = FALSE;
char *pt = s;
int ch;
@ -348,7 +348,6 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
found_dot = TRUE;
wrputs(".0", stream);
}
found_exp = TRUE;
default:
wrputc(ch, stream);
}
@ -751,7 +750,6 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
static void
write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt)
{
CACHE_REGS
Term ti;
struct rewind_term nrwt;
nrwt.parent = rwt;
@ -975,7 +973,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops &&
Arity == 1 &&
( Arity == 1 || atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || atom == AtomEmptySquareBrackets) &&
Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
@ -995,7 +993,40 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
putAtom(atom, wglb->Quote_illegal, wglb);
if (Arity > 1) {
if (atom == AtomEmptyBrackets) {
wrputc('(', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) {
wrputc('[', wglb->stream);
} else if (atom == AtomEmptyCurlyBrackets) {
wrputc('{', wglb->stream);
}
lastw = separator;
for (op = 2; op <= Arity; ++op) {
if (op == wglb->MaxArgs) {
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
break;
}
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
if (op != Arity) {
wrputc(',', wglb->stream);
lastw = separator;
}
}
if (atom == AtomEmptyBrackets) {
wrputc(')', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) {
wrputc(']', wglb->stream);
} else if (atom == AtomEmptyCurlyBrackets) {
wrputc('}', wglb->stream);
}
lastw = separator;
} else {
putAtom(atom, wglb->Quote_illegal, wglb);
}
if (op > p) {
wrclose_bracket(wglb, TRUE);
}

3
H/iatoms.h
View File

@ -20,6 +20,9 @@
AtomArrayType = Yap_LookupAtom("array_type");
AtomArrow = Yap_LookupAtom("->");
AtomAssert = Yap_LookupAtom(":-");
AtomEmptyBrackets = Yap_LookupAtom("()");
AtomEmptySquareBrackets = Yap_LookupAtom("[]");
AtomEmptyCurlyBrackets = Yap_LookupAtom("{}");
AtomAt = Yap_LookupAtom("at");
AtomAtom = Yap_LookupAtom("atom");
AtomAtomic = Yap_LookupAtom("atomic");

3
H/ratoms.h
View File

@ -20,6 +20,9 @@
AtomArrayType = AtomAdjust(AtomArrayType);
AtomArrow = AtomAdjust(AtomArrow);
AtomAssert = AtomAdjust(AtomAssert);
AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets);
AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets);
AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets);
AtomAt = AtomAdjust(AtomAt);
AtomAtom = AtomAdjust(AtomAtom);
AtomAtomic = AtomAdjust(AtomAtomic);

6
H/tatoms.h
View File

@ -38,6 +38,12 @@
#define AtomArrow Yap_heap_regs->AtomArrow_
Atom AtomAssert_;
#define AtomAssert Yap_heap_regs->AtomAssert_
Atom AtomEmptyBrackets_;
#define AtomEmptyBrackets Yap_heap_regs->AtomEmptyBrackets_
Atom AtomEmptySquareBrackets_;
#define AtomEmptySquareBrackets Yap_heap_regs->AtomEmptySquareBrackets_
Atom AtomEmptyCurlyBrackets_;
#define AtomEmptyCurlyBrackets Yap_heap_regs->AtomEmptyCurlyBrackets_
Atom AtomAt_;
#define AtomAt Yap_heap_regs->AtomAt_
Atom AtomAtom_;

3
misc/ATOMS
View File

@ -25,6 +25,9 @@ A ArrayOverflow N "array_overflow"
A ArrayType N "array_type"
A Arrow N "->"
A Assert N ":-"
A EmptyBrackets N "()"
A EmptySquareBrackets N "[]"
A EmptyCurlyBrackets N "{}"
A At N "at"
A Atom N "atom"
A Atomic N "atomic"

6
pl/utils.yap
View File

@ -92,11 +92,11 @@
'$do_error'(instantiation_error,G).
'$check_op_name'(_,_,',',G) :- !,
'$do_error'(permission_error(modify,operator,','),G).
'$check_op_name'(_,_,'[]',G) :- !,
'$check_op_name'(_,_,'[]',G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'[]'),G).
'$check_op_name'(_,_,'{}',G) :- !,
'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
'$do_error'(permission_error(create,operator,'{}'),G).
'$check_op_name'(P,T,'|',G) :-
'$check_op_name'(P,T,'|',G) :-
(
integer(P),
P < 1001, P > 0