You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
70 lines
2.2 KiB
70 lines
2.2 KiB
module Elab.Eval.Formula where
|
|
|
|
import qualified Data.Map.Strict as Map
|
|
import qualified Data.Sequence as Seq
|
|
import Data.Map.Strict (Map)
|
|
|
|
import Syntax
|
|
|
|
import {-# SOURCE #-} Elab.WiredIn (inot, ior, iand)
|
|
|
|
toDnf :: Value -> Maybe Value
|
|
toDnf (VNe _ _) = Nothing
|
|
toDnf x = toDnf x where
|
|
toDnf (VIAnd x y) = idist <$> toDnf (inot x) <*> toDnf (inot y)
|
|
toDnf (VIOr x y) = ior <$> toDnf x <*> toDnf y
|
|
toDnf (VINot x) = inot <$> toDnf x
|
|
toDnf VI0 = pure VI0
|
|
toDnf VI1 = pure VI1
|
|
toDnf v@(VNe _ Seq.Empty) = pure v
|
|
toDnf _ = Nothing
|
|
|
|
compareDNFs :: Value -> Value -> Bool
|
|
compareDNFs (VIOr x y) (VIOr x' y') =
|
|
let (a, a') = swap x y
|
|
(b, b') = swap x' y'
|
|
in compareDNFs a b && compareDNFs a' b'
|
|
compareDNFs (VIAnd x y) (VIAnd x' y') =
|
|
let (a, a') = swap x x'
|
|
(b, b') = swap y y'
|
|
in compareDNFs a a' && compareDNFs b b'
|
|
compareDNFs x y = x == y
|
|
|
|
swap :: Ord b => b -> b -> (b, b)
|
|
swap x y =
|
|
if x <= y then (x, y) else (y, x)
|
|
|
|
possible :: Map Head Bool -> Value -> (Bool, Map Head Bool)
|
|
possible sc (VINot (VNe n Seq.Empty)) =
|
|
case Map.lookup n sc of
|
|
Just True -> (False, sc)
|
|
_ -> (True, Map.insert n False sc)
|
|
possible sc (VNe n Seq.Empty) =
|
|
case Map.lookup n sc of
|
|
Just False -> (False, sc)
|
|
_ -> (True, Map.insert n True sc)
|
|
possible sc (VIAnd x y) =
|
|
let (a, sc') = possible sc x
|
|
(b, sc'') = possible sc' y
|
|
in (a && b, sc'')
|
|
possible sc (VIOr x y) =
|
|
case possible sc x of
|
|
(True, sc') -> (True, sc')
|
|
(False, _) -> possible sc y
|
|
possible sc VI0 = (False, sc)
|
|
possible sc VI1 = (True, sc)
|
|
possible sc _ = (False, sc)
|
|
|
|
truthAssignments :: NFEndp -> Map Name (NFType, NFEndp) -> [Map Name (NFType, NFEndp)]
|
|
truthAssignments VI0 m = []
|
|
truthAssignments VI1 m = pure m
|
|
truthAssignments (VIOr x y) m = truthAssignments x m ++ truthAssignments y m
|
|
truthAssignments (VIAnd x y) m = truthAssignments x =<< truthAssignments y m
|
|
truthAssignments (VNe (HVar x) Seq.Empty) m = pure (Map.insert x (VI, VI1) m)
|
|
truthAssignments (VINot (VNe (HVar x) Seq.Empty)) m = pure (Map.insert x (VI, VI0) m)
|
|
truthAssignments x _ = error $ "impossible formula: " ++ show x
|
|
|
|
idist :: Value -> Value -> Value
|
|
idist (VIOr x y) z = (x `idist` z) `ior` (y `idist` z)
|
|
idist z (VIOr x y) = (z `idist` x) `ior` (z `idist` y)
|
|
idist z x = iand z x
|