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)
import Debug.Trace (traceShow)

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)

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