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