lvar and

LvarAnd.hs

data AndBool = ATrue | AFalse deriving Eq

joinAndBool :: AndBool -> AndBool -> AndBool
joinAndBool ATrue ATrue = ATrue
joinAndBool _ _ = AFalse

instance JoinSemiLattice AndBool where
    join = joinAndBool

data AndNum = Bot | One | Two | OneTwo deriving Eq

joinAndNum :: AndNum -> AndNum -> AndNum
joinAndNum OneTwo _ = OneTwo
joinAndNum _ OneTwo = OneTwo
joinAndNum One Two = OneTwo
joinAndNum One One = One
joinAndNum Two Two = Two
joinAndNum Two One = OneTwo
joinAndNum Bot y   = y
joinAndNum x Bot   = x

instance JoinSemiLattice AndNum where
    join = joinAndNum

data AndResult = RBot | RTrue | RFalse | RTop deriving Eq

joinAndResult :: AndResult -> AndResult -> AndResult
joinAndResult RTop _ = RTop
joinAndResult _ RTop = RTop
joinAndResult RTrue RFalse = RTop
joinAndResult RTrue _  = RTrue  -- True or bottom
joinAndResult RFalse RFalse = RFalse
joinAndResult RBot y        = y
joinAndResult x y          = joinAndResult y x

instance JoinSemiLattice AndResult where
    join = joinAndResult

asyncAnd :: Par Bool -> Par Bool -> Par Bool
asyncAnd l r = do
    tval <- newPureLVar ATrue
    tresp <- newPureLVar Bot
    tresult <- newPureLVar RBot
    let withBool comp n = do
          b <- comp
          putPureLVar tval (if b then ATrue else AFalse)
          putPureLVar tresp n
    fork $ withBool l One
    fork $ withBool r Two
    fork $ do _r <- getPureLVar tval [AFalse]; putPureLVar tresult RFalse
    fork $ do _ <- getPureLVar tresp [OneTwo]; r <- getPureLVar tval [ATrue]; putPureLVar tresult (if r == ATrue then RTrue else RFalse)
    x <- getPureLVar tresult [RTrue, RFalse]
    return (x == RTrue)