Example.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}

-- | An example using arithmetic expressions.
module Overeasy.Example
  ( Arith (..)
  , ArithF (..)
  , exampleGraph
  , examplePat
  , exampleMain
  ) where

import Control.DeepSeq (NFData)
import Control.Monad.State.Strict (execState)
import Data.Functor.Foldable.TH (makeBaseFunctor)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Overeasy.EGraph (EClassId (..), EGraph, egAddTerm, egMerge, egNew, noAnalysis)
import Overeasy.Matching (Pat, match)
import Unfree (pattern FreeEmbed, pattern FreePure)

-- | Arithmetic expressions.
-- 'ArithF' is the base functor for this type.
data Arith =
    ArithPlus Arith Arith
  | ArithTimes Arith Arith
  | ArithShiftL Arith !Int
  | ArithShiftR Arith !Int
  | ArithConst !Int
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable, NFData)

-- Generates 'ArithF' and other recursion-schemes boilerplate
makeBaseFunctor ''Arith

deriving stock instance Eq a => Eq (ArithF a)
deriving stock instance Show a => Show (ArithF a)
deriving stock instance Generic (ArithF a)
deriving anyclass instance Hashable a => Hashable (ArithF a)
deriving anyclass instance NFData a => NFData (ArithF a)

-- | Creates a simple e-graph with the equality `2 + 2 = 4`.
exampleGraph :: EGraph () ArithF
exampleGraph = flip execState egNew $ do
  -- We don't need to analyze here.
  let ana = noAnalysis
  -- Some simple terms:
  let termFour = ArithConst 4
      termTwo = ArithConst 2
      termPlus = ArithPlus termTwo termTwo
  -- Add the term `4`
  (_, cidFour) <- egAddTerm ana termFour
  -- Add the term `2`
  (_, _cidTwo) <- egAddTerm ana termTwo
  -- Add the term `2 + 2`
  (_, cidPlus) <- egAddTerm ana termPlus
  -- Merge `4` and `2 + 2`
  _ <- egMerge cidFour cidPlus
  pure ()

-- | Creates a simple pattern to match nodes like `x + x`.
examplePat :: Pat ArithF String
examplePat = FreeEmbed (ArithPlusF (FreePure "x") (FreePure "x"))

-- | Build an e-graph, e-match on it, and print the result.
exampleMain :: IO ()
exampleMain = do
  let eg = exampleGraph
  putStrLn "e-graph:"
  print eg
  let pat = examplePat
  putStrLn "pattern:"
  print pat
  let results = match pat eg
  putStrLn "e-matches:"
  print results