>From 3cfd865d2645de79d4aa81fcd2c6ed659a792f5c Mon Sep 17 00:00:00 2001 From: Matt Lilley Date: Fri, 16 Dec 2011 11:45:45 +1300 Subject: [PATCH 2/2] Tidy up code, add tests, setup_call_catcher_cleanup/4 --- src/gnu/prolog/vm/BacktrackInfoWithCleanup.java | 27 +---- src/gnu/prolog/vm/Interpreter.java | 10 +- src/gnu/prolog/vm/buildins/buildins.pro | 3 +- src/gnu/prolog/vm/buildins/ext.meta.pro | 24 ++++ .../meta/Predicate_setup_call_catcher_cleanup.java | 116 ++++++++++++++++++++ src/gnu/prolog/vm/interpreter/Predicate_call.java | 9 ++- test/inriasuite/inriasuite.pl | 5 +- test/inriasuite/setup_call_catcher_cleanup | 23 ++++ 8 files changed, 186 insertions(+), 31 deletions(-) create mode 100644 src/gnu/prolog/vm/buildins/ext.meta.pro create mode 100644 src/gnu/prolog/vm/buildins/meta/Predicate_setup_call_catcher_cleanup.java create mode 100644 test/inriasuite/setup_call_catcher_cleanup diff --git a/src/gnu/prolog/vm/BacktrackInfoWithCleanup.java b/src/gnu/prolog/vm/BacktrackInfoWithCleanup.java index 57e78b6..265a848 100644 --- a/src/gnu/prolog/vm/BacktrackInfoWithCleanup.java +++ b/src/gnu/prolog/vm/BacktrackInfoWithCleanup.java @@ -1,5 +1,5 @@ /* GNU Prolog for Java - * Copyright (C) 1997-1999 Constantine Plotnikov + * Copyright (C) 2011 Matt Lilley * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either @@ -25,39 +25,22 @@ public class BacktrackInfoWithCleanup extends BacktrackInfo /** * a constructor * - * @param undoPosition - * address@hidden #undoPosition} - * @param codePosition - * address@hidden #codePosition} * @param cleanup * address@hidden #codePosition} * */ - public BacktrackInfoWithCleanup(int undoPosition, int codePosition, Term cleanup) + public BacktrackInfoWithCleanup(Term cleanup) { - super(undoPosition, codePosition); + super(-1, -1); this.cleanup = cleanup; } - public BacktrackInfoWithCleanup(BacktrackInfo backtrackInfo, Term cleanup) - { - super(backtrackInfo.undoPosition, backtrackInfo.codePosition); - this.cleanup = cleanup; - } - private Term cleanup; - public void cleanup(Interpreter interpreter) + public void cleanup(Interpreter interpreter) throws PrologException { if (cleanup != null) { - try - { - gnu.prolog.vm.interpreter.Predicate_call.staticExecute(interpreter, false, cleanup); - } - catch(PrologException e) - { - /* Ignore exceptions and return status for cleanup */ - } + gnu.prolog.vm.interpreter.Predicate_call.staticExecute(interpreter, false, cleanup); } } } diff --git a/src/gnu/prolog/vm/Interpreter.java b/src/gnu/prolog/vm/Interpreter.java index 7d148d2..fadc306 100644 --- a/src/gnu/prolog/vm/Interpreter.java +++ b/src/gnu/prolog/vm/Interpreter.java @@ -139,7 +139,7 @@ public final class Interpreter implements HasEnvironment * * @return the popped top backtrack information */ - public BacktrackInfo popBacktrackInfo() + public BacktrackInfo popBacktrackInfo() throws PrologException { BacktrackInfo rc = backtrackInfoStack[--backtrackInfoAmount]; if (rc instanceof BacktrackInfoWithCleanup) @@ -150,13 +150,13 @@ public final class Interpreter implements HasEnvironment return rc; } - public void popBacktrackInfoUntil(BacktrackInfo cutPoint) + public void popBacktrackInfoUntil(BacktrackInfo cutPoint) throws PrologException { int pos = backtrackInfoAmount - 1; while (pos >= 0 && cutPoint != backtrackInfoStack[pos]) { pos--; - } + } if (pos < 0) { throw new IllegalArgumentException("cutPoint not found"); @@ -592,8 +592,8 @@ public final class Interpreter implements HasEnvironment * * @param goal * the goal to stop. - */ - public void stop(Goal goal) + */ + public void stop(Goal goal) throws PrologException { if (currentGoal != goal) { diff --git a/src/gnu/prolog/vm/buildins/buildins.pro b/src/gnu/prolog/vm/buildins/buildins.pro index 0667c9c..eab6165 100644 --- a/src/gnu/prolog/vm/buildins/buildins.pro +++ b/src/gnu/prolog/vm/buildins/buildins.pro @@ -215,8 +215,9 @@ halt:-halt(0). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.debug.pro')). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.list.pro')). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.datetime.pro')). +:-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.meta.pro')). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.misc.pro')). -:-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.java.pro')). +:-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.java.pro')). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.uuid.pro')). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.dialogs.pro')). :-ensure_loaded(resource('/gnu/prolog/vm/buildins/ext.database.pro')). diff --git a/src/gnu/prolog/vm/buildins/ext.meta.pro b/src/gnu/prolog/vm/buildins/ext.meta.pro new file mode 100644 index 0000000..5ad8bc0 --- /dev/null +++ b/src/gnu/prolog/vm/buildins/ext.meta.pro @@ -0,0 +1,24 @@ +/* GNU Prolog for Java + * Copyright (C) 2011 Matt Lilley + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 3 of the License, or (at your option) any later version. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. The text of license can be also found + * at http://www.gnu.org/copyleft/lgpl.html + */ + +% +% Meta-call extensions +% + +% setup_call_catcher_cleanup(+Setup, +Call, -Catcher, +Cleanup) +:-build_in(setup_call_catcher_cleanup/4,'gnu.prolog.vm.buildins.meta.Predicate_setup_call_catcher_cleanup'). diff --git a/src/gnu/prolog/vm/buildins/meta/Predicate_setup_call_catcher_cleanup.java b/src/gnu/prolog/vm/buildins/meta/Predicate_setup_call_catcher_cleanup.java new file mode 100644 index 0000000..6f27e39 --- /dev/null +++ b/src/gnu/prolog/vm/buildins/meta/Predicate_setup_call_catcher_cleanup.java @@ -0,0 +1,116 @@ +/* GNU Prolog for Java + * Copyright (C) 2011 Matt Lilley + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 3 of the License, or (at your option) any later version. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. The text of license can be also found + * at http://www.gnu.org/copyleft/lgpl.html + */ + +package gnu.prolog.vm.buildins.meta; + +import gnu.prolog.term.AtomTerm; +import gnu.prolog.term.Term; +import gnu.prolog.term.CompoundTerm; +import gnu.prolog.term.CompoundTermTag; +import gnu.prolog.vm.PrologCode.RC; +import gnu.prolog.vm.PrologException; +import gnu.prolog.vm.interpreter.Predicate_call; +import gnu.prolog.vm.BacktrackInfo; +import gnu.prolog.vm.BacktrackInfoWithCleanup; +import gnu.prolog.vm.Interpreter; +import gnu.prolog.vm.Environment; +import gnu.prolog.vm.ExecuteOnlyCode; + +/** + * @author Matt Lilley + * + */ + +public class Predicate_setup_call_catcher_cleanup extends ExecuteOnlyCode +{ + public RC execute(Interpreter interpreter, boolean backtrackMode, gnu.prolog.term.Term args[]) throws PrologException + { + Environment environment = interpreter.getEnvironment(); + RC rc = RC.SUCCESS; + Term setup = args[0]; + Term call = args[1]; + Term catcher = args[2]; + Term cleanup = args[3]; + + // Only call setup the first time + if (!backtrackMode) + rc = Predicate_call.staticExecute(interpreter, false, setup); + if (rc == RC.SUCCESS || rc == RC.SUCCESS_LAST) + { + try + { + rc = Predicate_call.staticExecute(interpreter, backtrackMode, call); + } + catch(PrologException q) + { + rc = interpreter.unify(catcher, new CompoundTerm(CompoundTermTag.get(AtomTerm.get("exception"), 1), + q.getTerm())); + if (rc == RC.SUCCESS || rc == RC.SUCCESS_LAST) + return Predicate_call.staticExecute(interpreter, false, cleanup); + // re-throw exception if unification fails + else + { + throw(q); + } + } + if (rc != RC.SUCCESS) + { + // Call cleanup if the 2nd arg fails, has an exception or is finished + // But first, unify the port with catcher + if (rc == RC.FAIL) + rc = interpreter.unify(catcher, AtomTerm.get("fail")); + else if (rc == RC.SUCCESS_LAST) + { + rc = interpreter.unify(catcher, AtomTerm.get("exit")); + } + if (rc == RC.SUCCESS || rc == RC.SUCCESS_LAST) + return Predicate_call.staticExecute(interpreter, false, cleanup); + else + return rc; + } + else + { + // Choicepoint has been left. Inject a cleanup here + interpreter.pushBacktrackInfo(new BacktrackInfoWithCatcherCleanup(catcher, cleanup)); + return rc; + } + } + else + return rc; + } + + + public class BacktrackInfoWithCatcherCleanup extends BacktrackInfoWithCleanup + { + Term catcher; + public BacktrackInfoWithCatcherCleanup(Term catcher, Term cleanup) + { + super(cleanup); + this.catcher = catcher; + } + + public void cleanup(Interpreter interpreter) throws PrologException + { + if (interpreter.unify(catcher, AtomTerm.get("!")) == RC.SUCCESS_LAST) + super.cleanup(interpreter); + } + + } + +} \ No newline at end of file diff --git a/src/gnu/prolog/vm/interpreter/Predicate_call.java b/src/gnu/prolog/vm/interpreter/Predicate_call.java index 57fd681..2c5273a 100644 --- a/src/gnu/prolog/vm/interpreter/Predicate_call.java +++ b/src/gnu/prolog/vm/interpreter/Predicate_call.java @@ -23,6 +23,7 @@ import gnu.prolog.term.CompoundTerm; import gnu.prolog.term.Term; import gnu.prolog.term.VariableTerm; import gnu.prolog.vm.BacktrackInfo; +import gnu.prolog.vm.BacktrackInfoWithCleanup; import gnu.prolog.vm.Environment; import gnu.prolog.vm.ExecuteOnlyCode; import gnu.prolog.vm.Interpreter; @@ -96,7 +97,13 @@ public class Predicate_call extends ExecuteOnlyCode */ public static RC staticExecute(Interpreter interpreter, boolean backtrackMode, Term arg) throws PrologException { - CallTermBacktrackInfo cbi = backtrackMode ? (CallTermBacktrackInfo) interpreter.popBacktrackInfo() : null; + BacktrackInfo bi = backtrackMode ? interpreter.popBacktrackInfo() : null; + while (bi != null && (bi instanceof BacktrackInfoWithCleanup)) + { + ((BacktrackInfoWithCleanup)bi).cleanup(interpreter); + bi = backtrackMode ? interpreter.popBacktrackInfo() : null; + } + CallTermBacktrackInfo cbi = (CallTermBacktrackInfo)bi; PrologCode code; // code to call Term args[]; // arguments of code Term callTerm; // term being called diff --git a/test/inriasuite/inriasuite.pl b/test/inriasuite/inriasuite.pl index 7ab18e1..7498556 100644 --- a/test/inriasuite/inriasuite.pl +++ b/test/inriasuite/inriasuite.pl @@ -756,6 +756,7 @@ file(repeat). file(retract). file(set_prolog_flag). file(setof). +file(setup_call_catcher_cleanup). file(sub_atom). file(true). file(unify). @@ -781,8 +782,8 @@ file(TF,IF) :- arith(arith_diff). arith(arith_eq). arith(arith_gt). -arith('arith_gt='). -arith(arith_lt). +arith('arith_gt='). +arith(arith_lt). arith('arith_lt='). arith(arith_plus_minus). arith(arith_multiply_divide). diff --git a/test/inriasuite/setup_call_catcher_cleanup b/test/inriasuite/setup_call_catcher_cleanup new file mode 100644 index 0000000..668eccb --- /dev/null +++ b/test/inriasuite/setup_call_catcher_cleanup @@ -0,0 +1,23 @@ +/* file setup_call_catcher_cleanup */ + +[setup_call_catcher_cleanup(true, true, A, true), [[A <-- exit]]]. + +[(setup_call_catcher_cleanup(true, member(A, [a,b]), Catcher, true), var(Catcher)), [[A <-- a], [A <-- b]]]. + +[(setup_call_catcher_cleanup(true, member(A, [a,b]), Catcher, true), !), [[A <-- a, Catcher <-- !]]]. + +[setup_call_catcher_cleanup(true, fail, Catcher, true), [[Catcher <-- fail]]]. + +[setup_call_catcher_cleanup(true, throw(egg), Catcher, true), [[Catcher <-- exception(egg)]]]. + +[(setup_call_catcher_cleanup(true, Call=done, Catcher, Cleanup=done), !), [[Call <-- done, Cleanup <-- done, Catcher <-- exit]]]. + +[(setup_call_catcher_cleanup(Setup=done, member(A, [a,b]), Catcher, Cleanup=done), var(Cleanup), var(Catcher), !), [[Setup <-- done, A <--a, Catcher <-- !, Cleanup <-- done]]]. + +[setup_call_catcher_cleanup(fail, member(A, [a,b]), Catcher, Cleanup=done), failure]. + +[(setup_call_catcher_cleanup(throw(egg), member(_, [a,b,c]), _, Cleanup=done), !, var(Cleanup)), unexpected_ball(egg)]. + +[setup_call_catcher_cleanup(true, true, Catcher, throw(egg)), unexpected_ball(egg)]. + +/* end of file setup_call_catcher_cleanup */ -- 1.7.7.msysgit.1