ProblemBuilder.hs

{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}

-- |
-- Module      :  Datafix.ProblemBuilder
-- Copyright   :  (c) Sebastian Graf 2018
-- License     :  ISC
-- Maintainer  :  sgraf1337@gmail.com
-- Portability :  portable
--
-- Builds a 'DataFlowProblem' for a 'Denotation'al formulation in terms of
-- 'MonadDatafix'. Effectively reduces descriptions from "Datafix.Denotational"
-- to ones from "Datafix.Explicit", so that solvers such as "Datafix.Worklist"
-- only have to provide an interpreter for 'MonadDependency'.

module Datafix.ProblemBuilder
  ( ProblemBuilder
  , buildProblem
  ) where

import           Data.Primitive.Array
import           Datafix.Common
import           Datafix.Denotational
import           Datafix.Entailments
import           Datafix.Explicit
import           Datafix.NodeAllocator
import           Datafix.Utils.Constraints

-- | Constructs a build plan for a 'DataFlowProblem' by tracking allocation of
-- 'Node's mapping to 'ChangeDetector's and transfer functions.
newtype ProblemBuilder m a
  = ProblemBuilder { unwrapProblemBuilder :: NodeAllocator (ChangeDetector (Domain m), LiftedFunc (Domain m) m) a }
  deriving (Functor, Applicative, Monad)

instance MonadDependency m => MonadDatafix (ProblemBuilder m) where
  type DepM (ProblemBuilder m) = m
  datafix cd func = ProblemBuilder $ allocateNode $ \node -> do
    let deref = dependOn @m node
    (ret, transfer) <- unwrapProblemBuilder (func deref)
    return (ret, (cd, transfer))

-- | @(root, max, dfp) = buildProblem builder@ executes the build plan specified
-- by @builder@ and returns the resulting 'DataFlowProblem' @dfp@, as well as
-- the @root@ 'Node' denoting the transfer function returned by the
-- 'ProblemBuilder' action and the @max@imum node of the problem as a proof for
-- its denseness.
buildProblem
  :: forall m
   . MonadDependency m
  => Denotation (Domain m)
  -> (Node, Node, DataFlowProblem m)
buildProblem buildDenotation = (root, Node (sizeofArray arr - 1), prob)
  where
    prob = DFP (snd . indexArray arr . unwrapNode) (fst . indexArray arr . unwrapNode)
    (root, arr) = runAllocator $ allocateNode $ \root_ -> do
      denotation <- unwrapProblemBuilder (buildDenotation @(ProblemBuilder m))
      return (root_, (alwaysChangeDetector @(Domain m) \\ cdInst @(Domain m), denotation))