From f5bba7b8f7f68863fe98d1fd1ab98e147bb4969a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Feb 2010 15:51:31 +0000 Subject: [PATCH] fix indexing of dbrefs (obs from Nicola di Mauro). --- H/findclause.h | 147 ++++++++++++++++++++++++++++++++++++++++++------- H/headclause.h | 147 ++++++++++++++++++++++++++++++++++++++++++------- H/iatoms.h | 1 + misc/ATOMS | 2 +- misc/buildops | 35 +++++++++--- packages/jpl | 2 +- 6 files changed, 281 insertions(+), 53 deletions(-) diff --git a/H/findclause.h b/H/findclause.h index 4e0edc486..34b33e6b7 100644 --- a/H/findclause.h +++ b/H/findclause.h @@ -17,95 +17,195 @@ break; case _get_2atoms: if (is_regcopy(myregs, nofregs, Yap_regnotoreg(1))) { - clause->Tag = cl->u.cc.c1; + if (IsApplTerm(cl->u.cc.c1)) { + CELL *pt = RepAppl(cl->u.cc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cc.c1; + } else + clause->Tag = cl->u.cc.c1; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(2))) { - clause->Tag = cl->u.cc.c2; + if (IsApplTerm(cl->u.cc.c2)) { + CELL *pt = RepAppl(cl->u.cc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cc.c2; + } else + clause->Tag = cl->u.cc.c2; return; } cl = NEXTOP(cl,cc); break; case _get_3atoms: if (is_regcopy(myregs, nofregs, Yap_regnotoreg(1))) { - clause->Tag = cl->u.ccc.c1; + if (IsApplTerm(cl->u.ccc.c1)) { + CELL *pt = RepAppl(cl->u.ccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccc.c1; + } else + clause->Tag = cl->u.ccc.c1; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(2))) { - clause->Tag = cl->u.ccc.c2; + if (IsApplTerm(cl->u.ccc.c2)) { + CELL *pt = RepAppl(cl->u.ccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccc.c2; + } else + clause->Tag = cl->u.ccc.c2; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(3))) { - clause->Tag = cl->u.ccc.c3; + if (IsApplTerm(cl->u.ccc.c3)) { + CELL *pt = RepAppl(cl->u.ccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccc.c3; + } else + clause->Tag = cl->u.ccc.c3; return; } cl = NEXTOP(cl,ccc); break; case _get_4atoms: if (is_regcopy(myregs, nofregs, Yap_regnotoreg(1))) { - clause->Tag = cl->u.cccc.c1; + if (IsApplTerm(cl->u.cccc.c1)) { + CELL *pt = RepAppl(cl->u.cccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c1; + } else + clause->Tag = cl->u.cccc.c1; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(2))) { - clause->Tag = cl->u.cccc.c2; + if (IsApplTerm(cl->u.cccc.c2)) { + CELL *pt = RepAppl(cl->u.cccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c2; + } else + clause->Tag = cl->u.cccc.c2; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(3))) { - clause->Tag = cl->u.cccc.c3; + if (IsApplTerm(cl->u.cccc.c3)) { + CELL *pt = RepAppl(cl->u.cccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c3; + } else + clause->Tag = cl->u.cccc.c3; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(4))) { - clause->Tag = cl->u.cccc.c4; + if (IsApplTerm(cl->u.cccc.c4)) { + CELL *pt = RepAppl(cl->u.cccc.c4); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c4; + } else + clause->Tag = cl->u.cccc.c4; return; } cl = NEXTOP(cl,cccc); break; case _get_5atoms: if (is_regcopy(myregs, nofregs, Yap_regnotoreg(1))) { - clause->Tag = cl->u.ccccc.c1; + if (IsApplTerm(cl->u.ccccc.c1)) { + CELL *pt = RepAppl(cl->u.ccccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c1; + } else + clause->Tag = cl->u.ccccc.c1; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(2))) { - clause->Tag = cl->u.ccccc.c2; + if (IsApplTerm(cl->u.ccccc.c2)) { + CELL *pt = RepAppl(cl->u.ccccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c2; + } else + clause->Tag = cl->u.ccccc.c2; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(3))) { - clause->Tag = cl->u.ccccc.c3; + if (IsApplTerm(cl->u.ccccc.c3)) { + CELL *pt = RepAppl(cl->u.ccccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c3; + } else + clause->Tag = cl->u.ccccc.c3; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(4))) { - clause->Tag = cl->u.ccccc.c4; + if (IsApplTerm(cl->u.ccccc.c4)) { + CELL *pt = RepAppl(cl->u.ccccc.c4); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c4; + } else + clause->Tag = cl->u.ccccc.c4; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(5))) { - clause->Tag = cl->u.ccccc.c5; + if (IsApplTerm(cl->u.ccccc.c5)) { + CELL *pt = RepAppl(cl->u.ccccc.c5); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c5; + } else + clause->Tag = cl->u.ccccc.c5; return; } cl = NEXTOP(cl,ccccc); break; case _get_6atoms: if (is_regcopy(myregs, nofregs, Yap_regnotoreg(1))) { - clause->Tag = cl->u.cccccc.c1; + if (IsApplTerm(cl->u.cccccc.c1)) { + CELL *pt = RepAppl(cl->u.cccccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c1; + } else + clause->Tag = cl->u.cccccc.c1; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(2))) { - clause->Tag = cl->u.cccccc.c2; + if (IsApplTerm(cl->u.cccccc.c2)) { + CELL *pt = RepAppl(cl->u.cccccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c2; + } else + clause->Tag = cl->u.cccccc.c2; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(3))) { - clause->Tag = cl->u.cccccc.c3; + if (IsApplTerm(cl->u.cccccc.c3)) { + CELL *pt = RepAppl(cl->u.cccccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c3; + } else + clause->Tag = cl->u.cccccc.c3; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(4))) { - clause->Tag = cl->u.cccccc.c4; + if (IsApplTerm(cl->u.cccccc.c4)) { + CELL *pt = RepAppl(cl->u.cccccc.c4); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c4; + } else + clause->Tag = cl->u.cccccc.c4; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(5))) { - clause->Tag = cl->u.cccccc.c5; + if (IsApplTerm(cl->u.cccccc.c5)) { + CELL *pt = RepAppl(cl->u.cccccc.c5); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c5; + } else + clause->Tag = cl->u.cccccc.c5; return; } if (is_regcopy(myregs, nofregs, Yap_regnotoreg(6))) { - clause->Tag = cl->u.cccccc.c6; + if (IsApplTerm(cl->u.cccccc.c6)) { + CELL *pt = RepAppl(cl->u.cccccc.c6); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c6; + } else + clause->Tag = cl->u.cccccc.c6; return; } cl = NEXTOP(cl,cccccc); @@ -558,7 +658,12 @@ break; case _get_atom: if (is_regcopy(myregs, nofregs, cl->u.xc.x)) { - clause->Tag = cl->u.xc.c; + if (IsApplTerm(cl->u.xc.c)) { + CELL *pt = RepAppl(cl->u.xc.c); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.xc.c; + } else + clause->Tag = cl->u.xc.c; return; } cl = NEXTOP(cl,xc); diff --git a/H/headclause.h b/H/headclause.h index f60ca3946..44242c83b 100644 --- a/H/headclause.h +++ b/H/headclause.h @@ -11,95 +11,195 @@ break; case _get_2atoms: if (iarg == Yap_regnotoreg(1)) { - clause->Tag = cl->u.cc.c1; + if (IsApplTerm(cl->u.cc.c1)) { + CELL *pt = RepAppl(cl->u.cc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cc.c1; + } else + clause->Tag = cl->u.cc.c1; return; } if (iarg == Yap_regnotoreg(2)) { - clause->Tag = cl->u.cc.c2; + if (IsApplTerm(cl->u.cc.c2)) { + CELL *pt = RepAppl(cl->u.cc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cc.c2; + } else + clause->Tag = cl->u.cc.c2; return; } cl = NEXTOP(cl,cc); break; case _get_3atoms: if (iarg == Yap_regnotoreg(1)) { - clause->Tag = cl->u.ccc.c1; + if (IsApplTerm(cl->u.ccc.c1)) { + CELL *pt = RepAppl(cl->u.ccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccc.c1; + } else + clause->Tag = cl->u.ccc.c1; return; } if (iarg == Yap_regnotoreg(2)) { - clause->Tag = cl->u.ccc.c2; + if (IsApplTerm(cl->u.ccc.c2)) { + CELL *pt = RepAppl(cl->u.ccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccc.c2; + } else + clause->Tag = cl->u.ccc.c2; return; } if (iarg == Yap_regnotoreg(3)) { - clause->Tag = cl->u.ccc.c3; + if (IsApplTerm(cl->u.ccc.c3)) { + CELL *pt = RepAppl(cl->u.ccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccc.c3; + } else + clause->Tag = cl->u.ccc.c3; return; } cl = NEXTOP(cl,ccc); break; case _get_4atoms: if (iarg == Yap_regnotoreg(1)) { - clause->Tag = cl->u.cccc.c1; + if (IsApplTerm(cl->u.cccc.c1)) { + CELL *pt = RepAppl(cl->u.cccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c1; + } else + clause->Tag = cl->u.cccc.c1; return; } if (iarg == Yap_regnotoreg(2)) { - clause->Tag = cl->u.cccc.c2; + if (IsApplTerm(cl->u.cccc.c2)) { + CELL *pt = RepAppl(cl->u.cccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c2; + } else + clause->Tag = cl->u.cccc.c2; return; } if (iarg == Yap_regnotoreg(3)) { - clause->Tag = cl->u.cccc.c3; + if (IsApplTerm(cl->u.cccc.c3)) { + CELL *pt = RepAppl(cl->u.cccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c3; + } else + clause->Tag = cl->u.cccc.c3; return; } if (iarg == Yap_regnotoreg(4)) { - clause->Tag = cl->u.cccc.c4; + if (IsApplTerm(cl->u.cccc.c4)) { + CELL *pt = RepAppl(cl->u.cccc.c4); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccc.c4; + } else + clause->Tag = cl->u.cccc.c4; return; } cl = NEXTOP(cl,cccc); break; case _get_5atoms: if (iarg == Yap_regnotoreg(1)) { - clause->Tag = cl->u.ccccc.c1; + if (IsApplTerm(cl->u.ccccc.c1)) { + CELL *pt = RepAppl(cl->u.ccccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c1; + } else + clause->Tag = cl->u.ccccc.c1; return; } if (iarg == Yap_regnotoreg(2)) { - clause->Tag = cl->u.ccccc.c2; + if (IsApplTerm(cl->u.ccccc.c2)) { + CELL *pt = RepAppl(cl->u.ccccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c2; + } else + clause->Tag = cl->u.ccccc.c2; return; } if (iarg == Yap_regnotoreg(3)) { - clause->Tag = cl->u.ccccc.c3; + if (IsApplTerm(cl->u.ccccc.c3)) { + CELL *pt = RepAppl(cl->u.ccccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c3; + } else + clause->Tag = cl->u.ccccc.c3; return; } if (iarg == Yap_regnotoreg(4)) { - clause->Tag = cl->u.ccccc.c4; + if (IsApplTerm(cl->u.ccccc.c4)) { + CELL *pt = RepAppl(cl->u.ccccc.c4); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c4; + } else + clause->Tag = cl->u.ccccc.c4; return; } if (iarg == Yap_regnotoreg(5)) { - clause->Tag = cl->u.ccccc.c5; + if (IsApplTerm(cl->u.ccccc.c5)) { + CELL *pt = RepAppl(cl->u.ccccc.c5); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.ccccc.c5; + } else + clause->Tag = cl->u.ccccc.c5; return; } cl = NEXTOP(cl,ccccc); break; case _get_6atoms: if (iarg == Yap_regnotoreg(1)) { - clause->Tag = cl->u.cccccc.c1; + if (IsApplTerm(cl->u.cccccc.c1)) { + CELL *pt = RepAppl(cl->u.cccccc.c1); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c1; + } else + clause->Tag = cl->u.cccccc.c1; return; } if (iarg == Yap_regnotoreg(2)) { - clause->Tag = cl->u.cccccc.c2; + if (IsApplTerm(cl->u.cccccc.c2)) { + CELL *pt = RepAppl(cl->u.cccccc.c2); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c2; + } else + clause->Tag = cl->u.cccccc.c2; return; } if (iarg == Yap_regnotoreg(3)) { - clause->Tag = cl->u.cccccc.c3; + if (IsApplTerm(cl->u.cccccc.c3)) { + CELL *pt = RepAppl(cl->u.cccccc.c3); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c3; + } else + clause->Tag = cl->u.cccccc.c3; return; } if (iarg == Yap_regnotoreg(4)) { - clause->Tag = cl->u.cccccc.c4; + if (IsApplTerm(cl->u.cccccc.c4)) { + CELL *pt = RepAppl(cl->u.cccccc.c4); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c4; + } else + clause->Tag = cl->u.cccccc.c4; return; } if (iarg == Yap_regnotoreg(5)) { - clause->Tag = cl->u.cccccc.c5; + if (IsApplTerm(cl->u.cccccc.c5)) { + CELL *pt = RepAppl(cl->u.cccccc.c5); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c5; + } else + clause->Tag = cl->u.cccccc.c5; return; } if (iarg == Yap_regnotoreg(6)) { - clause->Tag = cl->u.cccccc.c6; + if (IsApplTerm(cl->u.cccccc.c6)) { + CELL *pt = RepAppl(cl->u.cccccc.c6); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.cccccc.c6; + } else + clause->Tag = cl->u.cccccc.c6; return; } cl = NEXTOP(cl,cccccc); @@ -455,7 +555,12 @@ break; case _get_atom: if (iarg == cl->u.xc.x) { - clause->Tag = cl->u.xc.c; + if (IsApplTerm(cl->u.xc.c)) { + CELL *pt = RepAppl(cl->u.xc.c); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.xc.c; + } else + clause->Tag = cl->u.xc.c; return; } cl = NEXTOP(cl,xc); diff --git a/H/iatoms.h b/H/iatoms.h index 6eff7a802..14bce0cfd 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -58,6 +58,7 @@ AtomCut = Yap_LookupAtom("!"); AtomCutBy = Yap_FullLookupAtom("$cut_by"); AtomDAbort = Yap_FullLookupAtom("$abort"); + AtomDBREF = Yap_LookupAtom("DBRef"); AtomDBReference = Yap_LookupAtom("db_reference"); AtomDBTerm = Yap_LookupAtom("db_term"); AtomDBref = Yap_FullLookupAtom("$dbref"); diff --git a/misc/ATOMS b/misc/ATOMS index 5c6009cbd..59f0b8e34 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -67,7 +67,7 @@ A CurrentModule F "$current_module" A Cut N "!" A CutBy F "$cut_by" A DAbort F "$abort" -A DBREF A "DBRef" +A DBREF N "DBRef" A DBReference N "db_reference" A DBTerm N "db_term" A DBref F "$dbref" diff --git a/misc/buildops b/misc/buildops index 1891ebb61..58fdc2819 100644 --- a/misc/buildops +++ b/misc/buildops @@ -483,17 +483,19 @@ dump_action(bind(Who,What,Extra), _, T, L) :- integer(Who), !, handle_bind_extra(Extra, T, Command), handle_constant(What, T, Constant), + check_atom_dbref(What, Constant, ExtraAction), format(L,' if (is_regcopy(myregs, nofregs, Yap_regnotoreg(~d))) { - clause->Tag = ~s;~s + ~sclause->Tag = ~s;~s return; - }~n', [Who,Constant,Command]). + }~n', [Who, ExtraAction, Constant, Command]). dump_action(bind(Who,What,Extra), _, T, L) :- handle_bind_extra(Extra, T, Command), handle_constant(What, T, Constant), + check_atom_dbref(What, Constant, ExtraAction), format(L,' if (is_regcopy(myregs, nofregs, cl->u.~s.~s)) { - clause->Tag = ~s;~s + ~sclause->Tag = ~s;~s return; - }~n', [T,Who,Constant,Command]). + }~n', [T, Who, ExtraAction, Constant, Command]). dump_action(new(Who), _, T, L) :- format(L,' if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.~s.~s))) { clause->Tag = (CELL)NULL; @@ -532,7 +534,20 @@ dump_action(logical, _, _, L) :- clause->Tag = (CELL)NULL; } return;~n', []). - + + +% +% atoms may actually be dbrefs :( +check_atom_dbref(Constant, What, ExtraAction) :- + Constant = [0'c|_], !, %0'c + format_to_chars("if (IsApplTerm(~s)) { + CELL *pt = RepAppl(~s); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = ~s; + } else + ",[What,What,What], ExtraAction). +check_atom_dbref(_, _, ""). + handle_bind_extra([], _, ""). handle_bind_extra(t_ptr=[], _,S) :- !, format_to_chars("~n clause->u.t_ptr = (CELL)NULL;",[],S). @@ -589,17 +604,19 @@ dump_head_action(bind(Who,What,Extra), _, T, L) :- integer(Who), !, handle_bind_extra(Extra, T, Command), handle_constant(What, T, Constant), + check_atom_dbref(What, Constant, ExtraAction), format(L,' if (iarg == Yap_regnotoreg(~d)) { - clause->Tag = ~s;~s + ~sclause->Tag = ~s;~s return; - }~n', [Who,Constant,Command]). + }~n', [Who,ExtraAction,Constant,Command]). dump_head_action(bind(Who,What,Extra), _, T, L) :- handle_constant(What, T, Constant), handle_bind_extra(Extra, T, Command), + check_atom_dbref(What, Constant, ExtraAction), format(L,' if (iarg == cl->u.~s.~s) { - clause->Tag = ~s;~s + ~sclause->Tag = ~s;~s return; - }~n', [T,Who,Constant,Command]). + }~n', [T,Who,ExtraAction,Constant,Command]). dump_head_action(new(Who), _, _, _) :- Who = [0'y|_], !. % 0'y done dump_head_action(new(Who), _, T, L) :- format(L,' if (iarg == cl->u.~s.~s) { diff --git a/packages/jpl b/packages/jpl index d9614e99d..9f80255cc 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit d9614e99dc98f8546fdc213c9e45003cf6efd520 +Subproject commit 9f80255cce18ee268792631aa1180e19a496346f