[Martin Meyer]

I have tried above cutBackTrack test in 32 bit. That revealed a problem. It outputs:

Code: Select all

1 begin
2 begin
3 begin
3 fail

I suppose the problem which you have mentioned in the disclaimer is showing up here. Do you have an idea how to fix it?

I also tried the eight queens demo in 32 bit. That however worked well.

[Thomas Linder Puls]

Instead of delegating all the individual predicates you can just write:

Code: Select all

delegate
    interface array2M{@ItemType} to ar2M

An advantage (but perhaps also a danger) is that future extension of the array2M interface will automatically be handled by this.

Anyways, concerning your questions.

1) No, I don't know of any such example; but I have not given it a lot of considerations. Also, I cannot ensure that it will not break in future releases.

2) I have tried your example on the current version and it works. But the language will contain a new feature for "suspending" (~asynchronous) code and I am quite certain that your approach can break in that context. But I doubt that that will be a problem for you, because it is unlikely that you will use it in such a context.

3) The function also exist in teh vip9 kernel. I believe you can simply mimic the declaration from vip10 (but have not tried it). The link names are:

32bit:

Code: Select all

    getBackTrackTop = "?GetBackTrackTop@Kernel@VIP@@YAQAVTBackTrackBlock@12@XZ".

64 bit:

Code: Select all

    getBackTrackTop = "?GetBackTrackTop@Kernel@VIP@@YAQAVTBackTrackBlock@12@XZ".

[Thomas Linder Puls]

The link names seems to be the same .

[Martin Meyer]

Many thanks Thomas for the info!

A truly useable solution to the "undo destructive changes when backtracking" problem requires a construction which is supported by you. I know I've annoyed you already lots with this, but still: it would be great if you could somehow turn the demo construct (by vip internal changes) into a valid one that doesn't violate invariants.

[Thomas Linder Puls]

It is never annoying to hear from you.

What I write below may be stuff that you choose to "ignore" in a concreate usage of your approach. But for general support it must be handled.

You have only considered the "positive" cases. To make this fully/generally correct you will also need to deal with exceptions. You should also perform undo actions when exiting out of code. There is a similar chain for exceptions, and both of these chains contains the corresponding entry in the other chain because when one is "activated" the other one needs to be restored correspondingly.

Also what happens if an undo action registers an undo action (or raises an exception)?

Finally the use of a class facts for trail and execUndoAddress, means that it will not work in a multithreaded context. Each thread will need its own instances of these facts. (The btop and ttop are in thread local storage).

I will consider "first class" support of such a feature once more. But there is a general penalty on all backtracking and exception handling, not just in situations where undo actions are actually used.

[Martin Meyer]

Maybe it could be implemented in VIP with little expense like this:

Code: Select all

class btReversion
    open core
 
predicates
    addUndoAction : (predicate Undo).
 
predicates
    undoOnFailure_mt : () multi.
 
end class btReversion
 
%---
 
implement btReversion
    open core
 
domains
    trailEntry = trailEntry(programControl::stackMark StackMark, predicate Undo).
 
class facts
    trailTree : redBlackTree::tree{multiThread_native::threadID ThreadID, varM{trailEntry*} TrailM} := redBlackTree::emptyUnique().
 
class predicates
    getTrailM : () -> varM{trailEntry*} TrailM.
clauses
    getTrailM() = TrailM :-
        ThreadId = multiThread_native::getCurrentThreadId(),
        if TrailM = redBlackTree::tryLookUp(trailTree, ThreadId) then
        else
            TrailM = varM::new([]),
            trailTree := redBlackTree::insert(trailTree, ThreadId, TrailM)
        end if.
 
clauses
    undoOnFailure_mt().
 
    undoOnFailure_mt() :-
        TrailM = getTrailM(),
        undoOnFailure_fl(TrailM).
 
class predicates
    undoOnFailure_fl : (varM{trailEntry*} TrailM) failure.
clauses
    undoOnFailure_fl(TrailM) :-
        [trailEntry(StackMark, Undo) | RestTrail] = TrailM:value,
        StackMark <= programControl::getBackTrack(),
        TrailM:value := RestTrail,
        try
            Undo()
        finally
            undoOnFailure_fl(TrailM)
        end try.
 
clauses
    addUndoAction(Undo) :-
        TrailM = getTrailM(),
        StackMark = programControl::getBackTrack(),
        TrailM:value := [trailEntry(StackMark, Undo) | TrailM:value].
 
end implement btReversion
 
%===
 
interface array2B{@ItemType} supports array2M{@ItemType}
end interface array2B
 
%---
 
class array2B{@ItemType} : array2B{@ItemType}
    open core
 
constructors
    new : (positive SizeX, positive SizeY).
 
constructors
    newInitialize : (positive SizeX, positive SizeY, @ItemType InitValue).
 
constructors
    newPointer : (pointer Data, positive SizeX, positive SizeY).
 
end class array2B
 
%---
 
implement array2B{@ItemType}
    open core, btReversion
 
delegate
    interface array2M{@ItemType} to ar2M
 
facts
    ar2M : array2M{@ItemType}.
 
clauses
    new(SizeX, SizeY) :-
        ar2M := array2M::new(SizeX, SizeY).
 
clauses
    newInitialize(SizeX, SizeY, Init) :-
        ar2M := array2M::newInitialize(SizeX, SizeY, Init).
 
clauses
    newPointer(Buffer, SizeX, SizeY) :-
        ar2M := array2M::newPointer(Buffer, SizeX, SizeY).
 
clauses
    set(X, Y, Value) :-
        OldValue = ar2M:get(X, Y),
        ar2M:set(X, Y, Value),
        addUndoAction({  :- ar2M:set(X, Y, OldValue) }).
 
clauses
    set(tuple(X, Y), Value) :-
        set(X, Y, Value).
 
clauses
    set_optional(tuple(X, Y), some(Value)) :-
        set(X, Y, Value).
 
    set_optional(XY, none) :-
        ar2M:set_optional(XY, none). %raises exception
 
clauses
    insert(tuple(XY, Value)) :-
        set(XY, Value).
 
clauses
    insertList(TupleList) :-
        OldAr2M = ar2M:createCopy(),
        ar2M:insertList(TupleList),
        addUndoAction({  :- ar2M := OldAr2M }).
 
clauses
    insertCollection(TupleCollection) :-
        OldAr2M = ar2M:createCopy(),
        ar2M:insertCollection(TupleCollection),
        addUndoAction({  :- ar2M := OldAr2M }).
 
clauses
    insertEnumerator(TupleEnum_nd) :-
        OldAr2M = ar2M:createCopy(),
        ar2M:insertEnumerator(TupleEnum_nd),
        addUndoAction({  :- ar2M := OldAr2M }).
 
end implement array2B
 
%===
 
implement main
    open core
 
constants
    boardSize : positive = 8.
 
class facts
    boardB : array2B{unsigned8} := array2B::new(boardSize, boardSize).
    solutionCount : positive := 0.
 
clauses
    run() :-
        stdIO::nl(),
        solve_nd(0, 0),
        fail.
 
    run() :-
        stdIO::writeF("Total solutions for a %ux%u board: %u.\n", boardSize, boardSize, solutionCount).
 
class predicates
    show : ().
clauses
    show() :-
        stdIO::writeF("Solution %u:\n", solutionCount),
        foreach Y = std::downTo(boardSize - 1, 0) do
            stdIO::writeF("%2u", Y + 1),
            foreach X = std::fromTo(0, boardSize - 1) do
                Field = if boardB:get(X, Y) = 0 then '.' else 'Q' end if,
                stdIO::write(Field)
            end foreach,
            stdIO::nl()
        end foreach,
        stdIO::write('  '),
        foreach X = std::fromTo(0, boardSize - 1) do
            stdIO::write(string::getCharFromValue(string::getCharValue('a') + X))
        end foreach,
        stdIO::nl(),
        stdIO::nl().
 
class predicates
    solve_nd : (positive QueenX, positive QueenY) nondeterm.
clauses
    solve_nd(QueenX, QueenY) :-
        btReversion::undoOnFailure_mt(), %internally insert a call to undoOnFailure_mt at each backtrack point
        boardB:set(QueenX, QueenY, 1),
        not(canCaptureHorizontal(0, QueenX, QueenY)),
        not(canCaptureDiagonal1(0, QueenX, QueenY)),
        not(canCaptureDiagonal2(0, QueenX, QueenY)),
        if QueenX = boardSize - 1 then
            solutionCount := solutionCount + 1,
            show()
        else
            solve_nd(QueenX + 1, 0)
        end if.
 
    solve_nd(QueenX, QueenY) :-
        QueenY < boardSize - 1,
        solve_nd(QueenX, QueenY + 1).
 
class predicates
    canCaptureHorizontal : (positive N, positive QueenX, positive QueenY) determ.
clauses
    canCaptureHorizontal(N, QueenX, QueenY) :-
        N < QueenX,
        if boardB:get(N, QueenY) = 0 then
            canCaptureHorizontal(N + 1, QueenX, QueenY)
        end if.
 
class predicates
    canCaptureDiagonal1 : (positive N, positive QueenX, positive QueenY) determ.
clauses
    canCaptureDiagonal1(N, QueenX, QueenY) :-
        N < QueenX,
        N < QueenY,
        N1 = N + 1,
        if boardB:get(QueenX - N1, QueenY - N1) = 0 then
            canCaptureDiagonal1(N1, QueenX, QueenY)
        end if.
 
class predicates
    canCaptureDiagonal2 : (positive N, positive QueenX, positive QueenY) determ.
clauses
    canCaptureDiagonal2(N, QueenX, QueenY) :-
        N < QueenX,
        N1 = N + 1,
        N1 < boardSize - QueenY,
        if boardB:get(QueenX - N1, QueenY + N1) = 0 then
            canCaptureDiagonal2(N1, QueenX, QueenY)
        end if.
 
end implement main

The only essential change in VIP would be that you needed to insert internally a call to btReversion::undoOnFailure_mt at each backtrack point like I am doing it in above at the programmer's level.

I haven't tried it but I presume that the above construct neither poses problems with exceptions resp. handling them nor in a multithreaded context. Also I don't see a problem when an undo action registers an undo action. Or am I overlooking something?

There might even be a medicine to avoid a penalty on backtracking where undo actions are not used. A simple solution would be a compiler directive to turn the feature on. All existant programs don't use the compiler directive and the calls to undoOnFailure_mt would not be inserted.

[Thomas Linder Puls]

There are problems in Vip11 which you cannot know anything about. While this approach can be made working in ordinary code it will not work in suspending code (a new language feature).

While you may not need to worry about this because you don't intend to use it in suspending code (at least not at first ); we will have to make a supported feature working more generally. So we would have to use a strategy which also fits into suspending code.

And this displays a major problem about features in general. A feature not only have a code to implement it also put restrictions and burdens on future development. Assume that we in Vip10 had introduced the feature and implemented in more or less like this, then we would have to figure out how to deal with that feature in the context of suspending predicates. So this "simple-to-implement-at-some-point" feature may later require a different strategy in a new context.

Anyway there is some problem with the trail: There are also places where undo actions should be removed from the trail without being performed (the trail should be restored to some earlier state). But right now I am uncertain on where that is; but I believe you may end up undoing things that should not be undone.

[Thomas Linder Puls]

I take the last words back , the trail should not be reset at any point and using the stack depth as an indicator of which undo actions to performs will work (I think).

But not for suspending predicates. Suspending predicates are not tied to a run stack in any way. When a suspending predicate suspends (which is what they can) they are removed completely from the stack of that thread. When they are resumed (which is the other thing they can) it can be on the stack of a different thread, meaning that the run stack is now a different one (and subsequently you cannot use stack marks for anything).

A correct way to deal with this (in all contexts) is to store trail-marks in the backtrack records. When adding an undo action it will be chained into the trail from the current/top backtrack record. When backtracking (or exiting) you will perform all undo actions from the overall trail until you meet the undo action in the new current/top backtrack record.

When cutting you will transfer the current/top trail to the backtrack record that becomes the new current/top. Effectively this means that all undo actions from all cut backtrack records will now belong to the new current/top backtrack record.

[Martin Meyer]

Hello Thomas,

I followed your advice and would like to return to the matter. I was looking for a way to place trail-marks in the backtrack records. It appears that the four least significant bits (resp. two on 32bit platform) of LastTTop in backtrackEntry are always zero for memory alignment reasons.

In my experiments, setting the low bit of LastTTop to 1 caused no harm. I am using that bit as the trail-mark (do you think that is legal in all cases?):

Code: Select all

class reversal
    open core
 
predicates
    addUndoAction : (predicate UndoAction).
 
predicates
    undo : ().
 
end class reversal
 
%------
 
implement reversal
    open core
 
domains
    backtrackEntry = backtrackEntry(bTop Next, tTopP LastTTop, returnAddress ReturnAddress, handle EBP).
    bTop = pointer.
    tTopP = pointer.
    returnAddress = pointer.
 
domains
    undoElement = undoElement(bTop BtEntryP, predicate UndoAction).
 
%---
class predicates
    getBackTrackTop : () -> bTop BTop language c as linknames_vipKernel::getBackTrackTop.
 
resolve
    getBackTrackTop externally
 
%---
class facts
    undoStack : undoElement* := [].
 
%--
class predicates
    setMark : (tTopP LastTTop) -> tTopP MarkedLastTTop.
clauses
    setMark(LastTTop) = uncheckedConvert(tTopP, uncheckedConvert(unsignedNative, LastTTop) ++ 1).
 
%--
class predicates
    isMarkNotSet : (tTopP LastTTop) determ.
clauses
    isMarkNotSet(LastTTop) :-
        uncheckedConvert(unsignedNative, LastTTop) ** 1 = 0.
 
%---
clauses
    addUndoAction(UndoAction) :-
        TopBtEntryP = getBackTrackTop(),
        undo_walkDown(TopBtEntryP),
        undoStack := [undoElement(TopBtEntryP, UndoAction) | undoStack],
        if not(memory::isNull(TopBtEntryP)) then
            TopBtEntry = uncheckedConvert(backtrackEntry, TopBtEntryP),
            backtrackEntry(:LastTTop = LastTTop | _) == TopBtEntry,
            MarkedLastTTop = setMark(LastTTop),
            memory::copyTo(TopBtEntry, backtrackEntry(:LastTTop = MarkedLastTTop | TopBtEntry))
        end if.
 
%---
clauses
    undo() :-
        TopBtEntryP = getBackTrackTop(),
        undo_walkDown(TopBtEntryP).
 
class predicates
    undo_walkDown : (bTop WalkerBtEntryP).
clauses
    undo_walkDown(WalkerBtEntryP) :-
        if memory::isNull(WalkerBtEntryP) then
            undo_all()
        else
            backtrackEntry(:Next = NextBtEntryP, :LastTTop = LastTTop | _) == uncheckedConvert(backtrackEntry, WalkerBtEntryP),
            if isMarkNotSet(LastTTop) then
                undo_allAbove(WalkerBtEntryP),
                undo_walkDown(NextBtEntryP)
            end if
        end if.
 
class predicates
    undo_allAbove : (bTop WalkerBtEntryP).
clauses
    undo_allAbove(WalkerBtEntryP) :-
        if [undoElement(UndoEntryP, UndoAction) | RestUndoStack] = undoStack and UndoEntryP <= WalkerBtEntryP then
            try
                UndoAction()
            catch TraceID do
                continueUndoException(TraceID)
            end try,
            undoStack := RestUndoStack,
            undo_allAbove(WalkerBtEntryP)
        end if.
 
class predicates
    undo_all : ().
clauses
    undo_all() :-
        if [undoElement(_UndoEntryP, UndoAction) | RestUndoStack] = undoStack then
            try
                UndoAction()
            catch TraceID do
                continueUndoException(TraceID)
            end try,
            undoStack := RestUndoStack,
            undo_all()
        end if.
 
class predicates
    continueUndoException : (exception::traceId TraceID) erroneous.
clauses
    continueUndoException(TraceID) :-
        exception::continue_unknown(TraceID, "Undo action raised exception").
 
end implement reversal
 
%======
 
implement main
 
class facts
    myFact : string := "original".
 
class predicates
    show : (string Mark).
clauses
    show(Mark) :-
        reversal::undo(),
        stdio::writef("(%s) BackTrackPoints=%, myFact=%p\n", Mark, programControl::getBackTrackPoints(), myFact).
 
clauses
    run() :-
        show("1"),
        OldMyFact = myFact,
        myFact := "changed",
        reversal::addUndoAction({  :- myFact := OldMyFact }),
        show("2"),
        fail.
 
/*
    run() :-
        show("3"),
        fail.
*/
 
    run() :-
        show("4").
 
end implement main
 
goal
    console::runUtf8(main::run).

As expected, the above outputs:

(1) BackTrackPoints=1, myFact="original"
(2) BackTrackPoints=1, myFact="changed"
(4) BackTrackPoints=0, myFact="original"

However, if the show("3") clause is not commented out, the following unintended results occurs:

(1) BackTrackPoints=1, myFact="original"
(2) BackTrackPoints=1, myFact="changed"
(3) BackTrackPoints=1, myFact="changed"
(4) BackTrackPoints=0, myFact="original"

I suspect the problem is that no new backtrack point is generated for the show("3") clause; instead, the existing one is reused. However, this does not reset the marker to zero.

How can I fix the problem? Is there a better way to insert trail-markers?

Happy New Year 2026 to you and my fellow VIP users!

[Thomas Linder Puls]

I believe this approach is completely wrong.

It is correct that the least significant bits of a tTopP are always zero due to alignment. But they must be zero. If you set a bit there the tTopP will point to another address than it is supposed to point to.

The tTopP are used by the exception system, so problems arising from setting a bit in the LastTTop will appear when an exception occurs.

The reason that your mark is set in several records is that when backtracking occurs the tTop is restored from the backtrackEntry and when a new backtrack point is created the current (wrong) value of the tTop is inserted as LastTTop.

(Such a mark could be stored in such a bit, but it would require that our runtime system masked it away before using the value as a "LastTTop".)

[Martin Meyer]

Okay I understand, it is not working the way I tried.

Is there a way to correctly insert path markers into stack frames?

If there is no suitable place for markers yet, could you create one please?

[Thomas Linder Puls]

All the fields in a backtrack record is obviously used for something. Important entities are restored from these values. All of them will have zero bits due to alignment. But these bits will have to be zero when the corresponding entity is restored from the value.

I am afraid that we will not introduce features in the runtime which are not used by Visual Prolog itself. Because sooner or later such a feature will either break or stand in the way for something we want to do.

If we were to support this as a first class feature, there are a number of things that needs to be solved.

Your code reveals that there is a problem with exceptions in the undo actions. I believe the undo actions must all be performed, also if one or more of them terminates with an exception. So somehow undo-action exceptions must be collected and raised as a single exception.

Your code will not work in a multithreaded context, because you store information in a class fact, which will be shared between the threads. We do have possibility for using thread local storage. In fact the bTop and tTop are stored in thread local storage.

Furthermore, some of it will not work at all in suspending code, because you cannot use the address of the bTop for anything in that context. When you are in suspending code the backtrack chain is stored in the heap and addresses will be more "random". I.e. this test does not make sense:

Code: Select all

       ... and UndoEntryP <= WalkerBtEntryP then

It should of course not be necessary to invoke an "undo" predicate manually. Undo should be performed automatically where needed.

Finally, there are some considerations around exceptions and "cut". If backtrack points are "lost" due to exciting or because they are "cut" away should the corresponding undo actions then be forgotten or should they be performed?

[Martin Meyer]

The most difficult problem among the issues you have pointed out in my code seems to me to be the handling of cuts:

A primary use of undoing destructive changes triggered by backtracking is emulating "ordinary Prolog" variables. A cut must therefore have the same effect on the undoing as it had on reference domain values.

If backtrack points are cut off, the corresponding undo actions must not be forgotten; their execution merely needs to be postponed until the previous backtrack point before the cut-off points is reached by backtracking.

Conversely, if backtrack points have been removed in backtracking, the corresponding undo actions must be executed to restore the data to its current state.

The problem, however, is that it is impossible to determine whether backtrack points have been cut off or been removed in backtracking by only placing markers and inspecting the stack after (possibly multiple) cuts and/or backtracking have been performed.

Thus I now belief, it would not suffice if you only created a field in the backtrack entries, where users can set markers. A real solution requires more sophisticated system support.

To deal with the issue "exceptions in undo actions" appears less problematic to me:

It is advisable to avoid situations where an undo action raises an exception, as this can lead to inconsistent data. Should such fatal incident nevertheless occur, it may be best to continue the exception outwards until it terminates the program. Or, at least, continue it to some outer exception handler where any (possibly) inconsistent data is "forgotten".