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

prettying

This commit is contained in:
Vítor Santos Costa 2015-07-22 19:27:29 -05:00
parent 0e1335d7ff
commit 019ca45bdb
7 changed files with 83 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
C/load_foreign.c
View File

@ -50,9 +50,9 @@ p_load_foreign( USES_REGS1 )
yhandle_t CurSlot = Yap_StartSlots();
strcpy(LOCAL_ErrorSay,"Invalid arguments");
Yap_DebugPlWrite(ARG1); printf("%s\n", " \n");
Yap_DebugPlWrite(ARG2); printf("%s\n", " \n");
Yap_DebugPlWrite(ARG3); printf("%s\n", " \n");
// Yap_DebugPlWrite(ARG1); printf("%s\n", " \n");
//Yap_DebugPlWrite(ARG2); printf("%s\n", " \n");
//ap_DebugPlWrite(ARG3); printf("%s\n", " \n");
/* collect the list of object files */
t = Deref(ARG1);

7
C/other.c
View File

@ -61,7 +61,7 @@ Yap_MkNewPairTerm(void)
}
Term
Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)
Yap_MkApplTerm(Functor f, arity_t n, const Term *a)
/* build compound term with functor f and n
* args a */
{
@ -74,12 +74,13 @@ Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)
return MkPairTerm(a[0], a[1]);
*HR++ = (CELL) f;
while (n--)
*HR++ = (CELL) * a++;
*HR++ = * a++;
return (AbsAppl(t));
}
Term
Yap_MkNewApplTerm(Functor f, unsigned int n)
Yap_MkNewApplTerm(Functor f, arity_t n)
/* build compound term with functor f and n
* args a */
{

5
C/parser.c
View File

@ -205,7 +205,7 @@ static Term ParseTerm( int, JMPBUFF *CACHE_TYPE);
#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
VarEntry *Yap_LookupVar(char *var) /* lookup variable in variables table */
VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table */
{
CACHE_REGS
VarEntry *p;
@ -216,11 +216,10 @@ VarEntry *Yap_LookupVar(char *var) /* lookup variable in variables table */
#endif
if (var[0] != '_' || var[1] != '\0') {
VarEntry **op = &LOCAL_VarTable;
unsigned char *vp = (unsigned char *)var;
UInt hv;
p = LOCAL_VarTable;
hv = HashFunction(vp) % AtomHashTableSize;
hv = HashFunction(var) % AtomHashTableSize;
while (p != NULL) {
CELL hpv = p->hv;
if (hv == hpv) {

8
C/qlyw.c
View File

@ -48,12 +48,12 @@ GrowAtomTable(void) {
Atom a = p->val;
export_atom_hash_entry_t *newp;
CELL hash;
char *apt;
const char *apt;
if (!a) continue;
apt = RepAtom(a)->StrOfAE;
hash = HashFunction((unsigned char *)apt)/(2*sizeof(CELL)) % new_size;
hash = HashFunction(apt)/(2*sizeof(CELL)) % new_size;
newp = newt+hash;
while (newp->val) {
newp++;
@ -71,8 +71,8 @@ static void
LookupAtom(Atom at)
{
CACHE_REGS
char *p = RepAtom(at)->StrOfAE;
CELL hash = HashFunction((unsigned char *)p) % LOCAL_ExportAtomHashTableSize;
const char *p = RepAtom(at)->StrOfAE;
CELL hash = HashFunction(p) % LOCAL_ExportAtomHashTableSize;
export_atom_hash_entry_t *a;
a = LOCAL_ExportAtomHashChain+hash;

115
C/stdpreds.c
View File

@ -875,43 +875,46 @@ static Int
}
static bool
valid_prop(Prop p)
valid_prop(Prop p, Term task)
{
if ( (RepPredProp(p)->PredFlags & HiddenPredFlag) )
return false;
if (RepPredProp(p)->OpcodeOfPred == UNDEF_OPCODE)
return false;
return true;
if ( (RepPredProp(p)->PredFlags & (HiddenPredFlag|StandardPredFlag) ) )
{
return (task == SYSTEM_MODULE || task == TermTrue );
} else {
return (task == USER_MODULE || task == TermTrue );
}
}
static PropEntry *
followLinkedListOfProps (PropEntry *p)
followLinkedListOfProps (PropEntry *p, Term task)
{
while (p) {
if (p->KindOfPE == PEProp &&
valid_prop(p) ) {
valid_prop(p, task) ) {
// found our baby..
return p;
}
}
p = p->NextOfPE;
}
return NIL;
}
static PropEntry *
getPredProp (PropEntry *p)
getPredProp (PropEntry *p, Term task)
{
PredEntry *pe;
if (p == NIL)
return NIL;
pe = RepPredProp(p);
while (p != NIL) {
if (p->KindOfPE == PEProp && valid_prop(p)) {
if (p->KindOfPE == PEProp && valid_prop(p, task)) {
return p;
} else if (p->KindOfPE == FunctorProperty) {
// first search remainder of functor list
Prop pf;
if ((pf = followLinkedListOfProps(RepFunctorProp(p)->PropsOfFE))) {
if ((pf = followLinkedListOfProps(RepFunctorProp(p)->PropsOfFE, task))) {
return pf;
}
}
@ -921,7 +924,7 @@ getPredProp (PropEntry *p)
}
static PropEntry *
nextPredForAtom (PropEntry *p)
nextPredForAtom (PropEntry *p, Term task)
{
PredEntry *pe;
if (p == NIL)
@ -929,36 +932,38 @@ nextPredForAtom (PropEntry *p)
pe = RepPredProp(p);
if (pe->ArityOfPE == 0) {
// if atom prop, search atom list
return followLinkedListOfProps(p->NextOfPE);
return followLinkedListOfProps(p->NextOfPE, task);
} else {
FunctorEntry *f = pe->FunctorOfPred;
// first search remainder of functor list
PropEntry *pf;
if ((pf = followLinkedListOfProps(p->NextOfPE))) {
if ((pf = followLinkedListOfProps(p->NextOfPE, task)), task) {
return pf;
}
// if that fails, follow the functor
return getPredProp( f->NextOfPE );
return getPredProp( f->NextOfPE , task);
}
}
static Prop
initFunctorSearch(Term t3, Term t2)
initFunctorSearch(Term t3, Term t2, Term task)
{
if (IsAtomTerm(t3)) {
Atom at = AtomOfTerm(t3);
// access the entry at key address.
return ( followLinkedListOfProps( RepAtom( at )->PropsOfAE ) );
return followLinkedListOfProps( RepAtom( at )->PropsOfAE , task );
} else if (IsIntTerm(t3)) {
if (IsNonVarTerm(t2) && t2 != IDB_MODULE) {
Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
return NULL;
} else {
Prop p;
// access the entry at key address.
// a single property (this will be deterministic
return AbsPredProp( Yap_FindLUIntKey( IntOfTerm( t3 ) ) );
p = AbsPredProp( Yap_FindLUIntKey( IntOfTerm( t3 ) ) );
if (valid_prop(p, task)) return p;
}
Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
return NULL;
@ -973,41 +978,41 @@ initFunctorSearch(Term t3, Term t2)
return NULL;
}
}
return ( followLinkedListOfProps( f->PropsOfFE ) );
return followLinkedListOfProps( f->PropsOfFE, task );
}
}
static PredEntry *
firstModulePred( PredEntry * npp)
firstModulePred( PredEntry * npp, Term task)
{
if (!npp)
return NULL;
do {
npp = npp->NextPredOfModule;
} while (npp &&
!valid_prop(AbsPredProp(npp)) );
npp = npp->NextPredOfModule;
} while (npp &&
!valid_prop(AbsPredProp(npp), task));
return npp;
}
static PredEntry *
firstModulesPred( PredEntry *npp )
firstModulesPred( PredEntry *npp, Term task )
{
ModEntry *m;
if (npp) {
m = Yap_GetModuleEntry( npp-> ModuleOfPred );
m = Yap_GetModuleEntry( npp-> ModuleOfPred );
npp = npp->NextPredOfModule;
} else {
m = CurrentModules;
npp = m->PredForME;
}
do {
while (npp && !valid_prop(AbsPredProp(npp) ) )
while (npp && !valid_prop(AbsPredProp(npp), task ) )
npp = npp->NextPredOfModule;
if (npp)
return npp;
m = m->NextME;
if (m) {
npp = m->PredForME;
npp = m->PredForME;
}
} while (npp || m);
return npp;
@ -1016,28 +1021,31 @@ firstModulesPred( PredEntry *npp )
static Int cont_current_predicate(USES_REGS1) {
UInt Arity;
Term name;
Term name, task;
Term t1 = ARG1, t2 = ARG2, t3 = ARG3;
bool rc, will_cut = false;
Functor f;
PredEntry *pp;
t1 = Yap_YapStripModule(t1, &t2);
t3 = Yap_YapStripModule(t3, &t2);
task = Deref(ARG4);
pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
if (IsNonVarTerm(t3)) {
PropEntry *np, *p;
// t3 is a functor, or compound term,
// just follow the functor chain
p = AbsPredProp( pp );
p = AbsPredProp( pp );
if (!p) {
// initial search, tracks down what is the first call with
// that name, functor..
p = initFunctorSearch( t3, t2 );
p = initFunctorSearch( t3, t2, task );
// now, we can do lookahead.
pp = RepPredProp(p);
if (!IsVarTerm(t2)) {
if (p == NIL)
cut_fail();
pp = RepPredProp(p);
if (!IsVarTerm(t2)) {
do {
if (t2 == TermProlog)
t2 = PROLOG_MODULE;
@ -1045,7 +1053,7 @@ static Int cont_current_predicate(USES_REGS1) {
will_cut = true;
break;
} else {
pp = RepPredProp(p = followLinkedListOfProps( p->NextOfPE ));
pp = RepPredProp(p = followLinkedListOfProps( p->NextOfPE, task ));
}
} while (!will_cut && p);
}
@ -1053,9 +1061,9 @@ static Int cont_current_predicate(USES_REGS1) {
cut_fail();
}
do {
np = followLinkedListOfProps( p->NextOfPE );
np = followLinkedListOfProps( p->NextOfPE, task );
if (!np) {
will_cut = true;
will_cut = true;
} else {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(RepPredProp(np));
B->cp_h = HR;
@ -1065,16 +1073,16 @@ static Int cont_current_predicate(USES_REGS1) {
PropEntry *np, *p;
// run over the same atomany predicate defined for that atom
// may be fair bait, depends on whether we know the module.
p = AbsPredProp( pp );
p = AbsPredProp( pp );
if (!p) {
// initialization time
if (IsIntTerm( t1 )) {
// or this or nothing....
p = AbsPredProp( Yap_FindLUIntKey( IntOfTerm( t3 ) ) );
p = AbsPredProp( Yap_FindLUIntKey( IntOfTerm( t3 ) ) );
} else if (IsAtomTerm( t1 )) {
// should be the usual situation.
Atom at = AtomOfTerm(t1);
p = getPredProp( RepAtom(at)->PropsOfAE );
p = getPredProp( RepAtom(at)->PropsOfAE , task);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "current_predicate/2");
}
@ -1083,7 +1091,7 @@ static Int cont_current_predicate(USES_REGS1) {
pp = RepPredProp(p);
}
// now, we can do lookahead.
np = nextPredForAtom(p);
np = nextPredForAtom(p, task);
if (!np)
will_cut = true;
else {
@ -1093,17 +1101,17 @@ static Int cont_current_predicate(USES_REGS1) {
} else if (IsNonVarTerm(t2)) {
// operating within the same module.
PredEntry *npp;
if (!pp) {
if (!IsAtomTerm( t2 )) {
Yap_Error(TYPE_ERROR_ATOM, t2, "current_predicate/2");
}
}
ModEntry *m = Yap_GetModuleEntry(t2);
pp = firstModulePred( m->PredForME );
pp = firstModulePred( m->PredForME , task );
if (!pp)
cut_fail();
}
npp = firstModulePred( pp );
npp = firstModulePred( pp , task);
if (!npp)
will_cut = true;
@ -1115,13 +1123,13 @@ static Int cont_current_predicate(USES_REGS1) {
} else {
// operating across all modules.
PredEntry *npp;
if (!pp) {
pp = firstModulesPred( CurrentModules->PredForME );
pp = firstModulesPred( CurrentModules->PredForME, task );
if (!pp)
cut_fail();
}
npp = firstModulesPred( pp );
npp = firstModulesPred( pp , task);
if (!npp)
will_cut = true;
@ -1158,10 +1166,9 @@ static Int cont_current_predicate(USES_REGS1) {
} else {
rc = Yap_unify(t3,name);
}
rc = (rc &&
rc = rc &&
Yap_unify(t2, ModToTerm(pp->ModuleOfPred)) &&
Yap_unify(t1, name) &&
Yap_unify(ARG4, MkIntegerTerm(pp->PredFlags)) );
Yap_unify(t1, name);
if (will_cut) {
if (rc) cut_succeed();
cut_fail();
@ -1169,11 +1176,7 @@ static Int cont_current_predicate(USES_REGS1) {
return rc;
}
static Int init_current_predicate(USES_REGS1) {
Term t1 = Deref(ARG1), t2 = Deref(ARG2), t3 = Deref(ARG3);
t1 = Yap_YapStripModule(t1, &t2);
t3 = Yap_YapStripModule(t3, &t2);
static Int current_predicate(USES_REGS1) {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(NULL);
// ensure deref access to choice-point fields.
return cont_current_predicate(PASS_REGS1);
@ -1655,7 +1658,7 @@ static Int p_break(USES_REGS1) {
}
void Yap_InitBackCPreds(void) {
Yap_InitCPredBack("$current_predicate", 4, 1, init_current_predicate,
Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate,
cont_current_predicate, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$current_op", 5, 1, init_current_op, cont_current_op,
SafePredFlag | SyncPredFlag);

3
C/tracer.c
View File

@ -152,7 +152,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
Int arity;
/* extern int gc_calls; */
vsc_count++;
if (vsc_count == 12534) jmp_deb( 2 );
//if (HR < ASP ) return;
//fif (vsc_count == 12534) jmp_deb( 2 );
#if __ANDROID__ && 0
PredEntry *ap = pred;
if (pred && port == enter_pred) {

9
C/yap-args.c
View File

@ -388,6 +388,15 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
#ifdef DEBUG
case 'P':
YAP_SetOutputMessage();
if (p[1] != '\0') {
while (p[1] != '\0') {
int ch = p[1];
if (ch >= 'A' && ch <= 'Z')
ch += ('a'-'A');
if (ch >= 'a' && ch <= 'z')
GLOBAL_Option[ch - 96] = 1;
}
}
break;
#endif
case 'L':