mcBV/WatchManager.fs

437 строки
14 KiB
Forth

module WatchManager
open GlobalOptions
open Literal
open Clause
open BooleanValuation
open NumeralDB
open TheoryDB
open ClauseDB
type WOList = int []
type WatchList = int []
type OccurenceList = int []
// Watch list/Occurence list structure:
//|Size|Count| p_0 | ... |p_{count-1}| trash |
//| OFFSET | p_0 | ... |p_{count-1}| trash |
//Returns a pair of (newWatch, clauseStatus)/numNonFalseWatches)/
let findWatch (pl:Literal) (c:Clause) (v:Ref<BooleanValuation>) =
let size = getSize(c)
let npl = -pl;
assert (size >= 2)
if (c.[1] = npl) then
let tmp = c.[1]
c.[1] <- c.[2]
c.[2] <- tmp
// at this point we know that c.[2] = npl, which just became false.
match (!v).getValueB(c.[1]) with
| True -> (c.[1], Sat) // Satisfied clause.
// This is wrong:
// | False -> (c.[1], 0) // Conflict, c.[1] is the "conflicting literal"
| _ ->
let mutable i = 3
let mutable found = false
// [ U, F ] or [ F F ]
while (not found && i <= size) do
if (!v).getValueB(c.[i]) <> False then
found <- true
else
i <- i + 1
if (found) then // [ U, U ] or [ F, U ]
let tmp = c.[i]
c.[i] <- c.[2]
c.[2] <- tmp
(c.[2], Unknown) // All fine, c.[1] and c.[2] are valid watches
else
if (!v).getValueB(c.[1]) = False then
(c.[1], Unsat) // Conflict, c.[1] is the "conflicting literal"
else
(c.[1], Implication) // Implication; invariant: implied literals is at c.[1]
let findTwoWatches (c:Clause) (v:Ref<BooleanValuation>) =
let size = getSize(c)
assert (size >= 2)
let mutable i = 0
let v(l) = (!v).getValueB(l)
if v(c.[1]) = False then
i <- 2
while i <= size do
if v(c.[i]) <> False then
let tmp = c.[1]
c.[1] <- c.[i]
c.[i] <- tmp
i <- size + 1
else
i <- i + 1
if v(c.[2]) = False then
i <- 3
while i <= size do
if v(c.[i]) <> False then
let tmp = c.[1]
c.[1] <- c.[i]
c.[i] <- tmp
i <- size + 1
else
i <- i + 1
if v(c.[1]) = True then
(c.[1], Sat)
else if v(c.[1]) = False then
(c.[1], Unsat)
elif v(c.[2]) = False then
(c.[1], Implication)
else
(c.[2], Unknown)
let sizeInd = 0
let countInd = 1
let snapCount = 2
let wolOffset = 3
type WatchManager private (numOfVariables:int, initWLSize:int) =
let reallocCoefficient = 2.0
new (numOfVariables:int, initWLSize:int, tDB:Ref<TheoryDB>) as this =
WatchManager(numOfVariables, initWLSize)
then
this.initializeWatchLists tDB ()
member val private allocated = 2*numOfVariables with get, set
member val private inUse = numOfVariables with get, set
member val offset = 3 with get //Offset for the Size and Count and snapshot*)
member val lists = [|([|0; 0|]:WatchList)|] with get, set
member val private inTempMode = false with get, set
member val private snapshot = -1 with get, set
member r.emptyWatchList = [|0; 0|]
member r.initializeWatchLists (fThDB:Ref<TheoryDB>) () =
r.lists <- [| for i in 0 .. r.allocated - 1 do yield Array.create initWLSize -1 |]
for i in 0 .. r.allocated - 1 do
r.setSz i (initWLSize - r.offset) |> ignore
r.setCnt i 0 |> ignore
for i in 0 .. (!fThDB).count - 1 do
let t = ((!fThDB).getThRelationByIndex i)
for varg in t.variableArguments do
r.watchBV varg i
member r.getIndex(l:Literal) :int =
let ind = if l > 0 then
2*l - 1
elif l < 0 then
2 * (-l - 1)
else
-1
assert (r.validIndex ind)
ind
member r.reallocate() =
let newSize = int (reallocCoefficient * float r.allocated)
r.reallocate (newSize, initWLSize)
member r.reallocate (newSize:int, wlSize:int)=
assert(newSize > r.allocated)
r.lists <- Array.append r.lists [|for i in 0 .. newSize - r.allocated - 1 do yield Array.create wlSize -1 |]
let oldSize = r.allocated
r.allocated <- newSize
for i in oldSize .. r.allocated - 1 do
r.setSz i (wlSize - r.offset) |> ignore
r.setCnt i 0 |> ignore
member r.newVarToWatch (var:Var) =
assert (not r.inTempMode ||var = r.inUse + 1)
if r.inUse * 2 >= r.allocated then
r.reallocate()
r.inUse <- r.inUse + 1
member r.validIndex ind = ind > -1 && ind < 2*r.inUse && r.inUse < r.allocated
//To be stand alone functions over WatchList/OccurenceList
member private r.getSz(ind:int) :int =
r.lists.[ind].[sizeInd]
member r.getSize(l:int) :int =
let ind = r.getIndex(l)
r.getSz(ind)
member r.setSz(ind:int) (s:int) :int =
assert ( ind > -1 && ind < r.allocated)
r.lists.[ind].[sizeInd] <- s
r.lists.[ind].[sizeInd]
member private r.getCnt(ind:int)=
assert (r.validIndex ind)
r.lists.[ind].[countInd]
member r.getCount(l:Literal) : int =
let ind = r.getIndex(l)
r.getCnt(ind)
member private r.setCnt (ind:int) (c:int) : int =
assert ( ind > -1 && ind < r.allocated)
r.lists.[ind].[countInd] <- c
r.lists.[ind].[countInd]
member r.setCount (l:Literal) (c:int) =
let ind = r.getIndex(l)
r.setCnt ind c
member private r.incrCnt (ind:int) : int =
assert (r.validIndex ind)
r.lists.[ind].[countInd] <- r.lists.[ind].[countInd] + 1
r.lists.[ind].[countInd]
member r.removeReference (bvVar:Var) (ptr:int) =
assert (r.inTempMode)
let idx = r.getIndex bvVar
let mutable found = false
let cnt = r.getCnt idx
for i in 0 .. cnt - 1 do
if not found && r.getPtr idx i = ptr then
found <- true
if i < cnt - 1 then
r.setPtr idx i (r.getPtr idx (cnt - 1))
r.setPtr idx (cnt - 1) -1
r.setCnt idx (cnt - 1) |> ignore
assert(found)
member r.getPtr (ind:int) (i:int) :int =
assert ( r.validIndex ind && 0 <= i && i < r.getCnt ind)
r.lists.[ind].[r.offset + i]
member r.setPtr (ind:int) (i:int) (ptr:int) : Unit =
assert ( r.validIndex ind && 0 <= i && i <= r.getCnt ind)
r.lists.[ind].[r.offset + i] <- ptr
member r.getPointer (l:Literal) (i:int) :int =
let ind = r.getIndex l
r.getPtr ind i
member r.setPointer (l:Literal) (ptr:int) =
let ind = r.getIndex(l)
assert (ind > -1 && ind < r.allocated)//if ind > -1 then
let cnt = r.getCnt ind
if cnt >= r.getSz ind then
r.reallocateList ind |> ignore
r.setPtr ind cnt ptr
r.incrCnt(ind) |> ignore
//Initializing/Migrating the watches
member r.watchBool (l:Literal) (c:int) : Unit =
assert (l<>0)
r.setPointer -l c
//Initializing the occurences
member r.watchBV (v:Var) (t:int) : Unit =
assert (v <> 0)
r.setPointer v t
member r.watchBVInTmpMode (v:Var) (t:int) : Unit =
assert (v <> 0)
assert (r.inTempMode)
let idx = r.getIndex v
let mutable found = false
let cnt = r.getCnt idx
for i in 0 .. cnt - 1 do
if not found && r.getPtr idx i = t then
found <- true
if not found then
r.setPointer v t
member r.getWatchList (l:Literal) :WatchList =
assert (l <> 0)
let ind = r.getIndex(l)
assert (ind > -1)//if ind > -1 then
r.lists.[ind]
member r.reallocateList (ind:int) :int =
assert (r.validIndex ind)
let size = r.getSz(ind)
assert(size > 0)
let nSize = 2*size
r.lists.[ind] <- Array.append r.lists.[ind] (Array.create size -1)
r.setSz ind nSize
member r.printThWatch (nDB:Ref<NumeralDB>) (thDB:Ref<TheoryDB>) (l:Literal) =
let ind = r.getIndex(l)
let cnt = r.getCnt(ind)
if cnt = 0 then
printfn "%d:bv: None." l
else
printfn "%d:bv: " l
for k in 0 .. cnt - 1 do
let cPtr = r.getPtr ind k
let tRel = !((!thDB).getThRelRef cPtr)
printfn " %d : %s " cPtr (tRel.ToString nDB) //(clauseToString (!(cDB.getClauseRef cPtr)))
member r.printBoolWatch (cDB:Ref<ClauseDB>) (l:Literal) =
let ind = r.getIndex(l)
let cnt = r.getCnt(ind)
// printfn "Currently watching clauses for literal %d: " l
if cnt = 0 then
printfn "%d: None." l
else
printfn "%d: " l
for k in 0 .. cnt - 1 do
let cPtr = r.getPtr ind k
printfn " %d : %s " cPtr (clauseToString (!((!cDB).getClauseRef cPtr)))
member r.trcPrintWatch (nDB:Ref<NumeralDB>) (cDB:Ref<ClauseDB>) (tDB:Ref<TheoryDB>) (l:Literal) (isBool:bool) =
if TRC then
if isBool then
r.printBoolWatch cDB l
else
r.printThWatch nDB tDB l
member r.setSnapCnt (ind:int) =
assert (r.inTempMode)
assert ( ind > -1 && ind < r.allocated)
r.lists.[ind].[snapCount] <- r.getCnt ind
member r.resetSnapCnt (ind:int) =
assert (r.inTempMode)
assert ( r.validIndex ind)
r.lists.[ind].[snapCount] <- - 1
member r.getSnapCnt (ind:int) =
assert ( ind > -1 && ind < r.allocated)
r.lists.[ind].[snapCount]
member r.resetListToSnapCnt (ind:int) =
assert (r.inTempMode)
assert ( ind > -1 && ind < r.allocated)
let snap = r.getSnapCnt ind
let cnt = r.getCnt ind
if snap > -1 then
for i in snap + 1 .. cnt - 1 do
r.setPtr ind i -1
r.setCnt ind snap |> ignore
r.resetSnapCnt ind
member r.getInUse = r.inUse
member r.enterTempModeOld () =
assert(not r.inTempMode)
assert(r.snapshot = -1)
r.inTempMode <- true
for i in 1 .. r.inUse do
r.setSnapCnt (r.getIndex i)
r.setSnapCnt (r.getIndex -i)
r.snapshot <- r.inUse
member r.enterTempMode (newMaxVar:Var) =
assert(not r.inTempMode)
assert(r.snapshot = -1)
r.inTempMode <- true
while newMaxVar > r.inUse do
r.newVarToWatch (r.inUse + 1)
let initSz = (initWLSize/2)
assert (initSz > r.offset)
r.lists <- [|for i in 0 .. r.allocated - 1 do yield Array.create initSz -1 |]
for i in 0 .. r.allocated - 1 do
r.setSz i (initSz - r.offset) |> ignore
r.setCnt i 0 |> ignore
member r.leaveTempMode (highestVarInUse:Var) =
assert(r.inTempMode)
//assert(r.snapshot >= 0)
r.inUse <- highestVarInUse
r.inTempMode <- false
member r.leaveTempModeOld =
assert(r.inTempMode)
assert(r.snapshot >= 0)
for i in r.snapshot .. r.inUse - 1 do
let indA = r.getIndex i
r.lists.[indA] <- Array.create initWLSize -1
r.setSz indA (initWLSize - r.offset) |> ignore
r.setCnt indA 0 |> ignore
let indB = r.getIndex i
r.lists.[indB] <- Array.create initWLSize -1
r.setSz indB (initWLSize - r.offset) |> ignore
r.setCnt indB 0 |> ignore
for i in 1 .. r.snapshot - 1 do
r.resetListToSnapCnt (r.getIndex i)
r.resetListToSnapCnt (r.getIndex -i)
r.inUse <- r.snapshot
r.snapshot <- -1
r.inTempMode <- false
member r.fastForward (orig:Ref<WatchManager>) =
let oInUse = (!orig).getInUse
if r.inUse < oInUse then r.inUse <- oInUse
if r.inUse >= r.allocated then r.reallocate (r.inUse, 3)
assert (r.inUse = oInUse)
// member r.watchNewClause (pCls:Ref<Clause>) (pVal:Ref<Valuation>) (pT:Ref<Trail>) =
// let mutable inConflict = false
// let mutable newState = null
// if getSize(!pCls) = 1 then
// match (!pVal).getVal((!pCls).[1]) with
// | False -> inConflict <- true
// newState <- Conflict (pT, pCDB, pCls)
// | Undefined -> trail.push (cDB.getClauseRef i) (!pCls).[1] |> ignore
// | True -> () //Already True, and therefore on the trail
// else
// match findWatch -(!pCls).[1] !pCls pVal with
// | (_, Clause.Unknown) -> w.watchBool (!pCls).[1] i |>ignore
// w.watchBool (!pCls).[2] i |>ignore
// | _ -> match findWatch -(!pCls).[1] !pCls pVal with
// | (_, Clause.Unsat) -> w.watchBool (!pCls).[1] i |>ignore
// w.watchBool (!pCls).[2] i |>ignore
// inConflict <- true
// newState <- Conflict (pT, pCDB, pCls)
// | (_, Implication) ->
// w.watchBool (!pCls).[1] i |>ignore
// w.watchBool (!pCls).[2] i |>ignore
// if (!pVal).getVal((!pCls).[1]) = Undefined then //this should be the invariant
// trail.push (cDB.getClauseRef i) (!pCls).[1]|> ignore
// | _ -> w.watchBool (!pCls).[1] i |>ignore
// w.watchBool (!pCls).[2] i |>ignore
//Watch literal l in clause c