Rule.hs

module UniqueLogic.ST.Rule (
   -- * Custom rules
   generic2,
   generic3,
   -- * Common rules
   equ, pair, max, add, mul, square, pow,
   ) where

import qualified UniqueLogic.ST.System as Sys
import qualified UniqueLogic.ST.MonadTrans as UMT

import qualified Prelude as P
import Prelude hiding (max)


generic2 ::
   (UMT.C w) =>
   (b -> a) -> (a -> b) ->
   Sys.Variable w s a -> Sys.Variable w s b -> Sys.T w s ()
generic2 f g x y =
   sequence_ $
   Sys.assignment2 f y x :
   Sys.assignment2 g x y :
   []

generic3 ::
   (UMT.C w) =>
   (b -> c -> a) -> (c -> a -> b) -> (a -> b -> c) ->
   Sys.Variable w s a -> Sys.Variable w s b -> Sys.Variable w s c -> Sys.T w s ()
generic3 f g h x y z =
   sequence_ $
   Sys.assignment3 f y z x :
   Sys.assignment3 g z x y :
   Sys.assignment3 h x y z :
   []


equ ::
   (UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s a -> Sys.T w s ()
equ = generic2 id id

max ::
   (Ord a, UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s a -> Sys.Variable w s a -> Sys.T w s ()
max =
   Sys.assignment3 P.max

{- |
You might be tempted to use the 'pair' rule to collect parameters
for rules with more than three arguments.
This is generally not a good idea since this way you lose granularity.
For building rules with more than three arguments,
please build according assignments with 'Sys.arg' and 'Sys.runApply'
and bundle these assignments to rules.
This is the way, 'generic2' and 'generic3' work.
-}
pair ::
   (UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s b -> Sys.Variable w s (a,b) -> Sys.T w s ()
pair x y xy =
   Sys.assignment3 (,) x y xy >>
   Sys.assignment2 fst xy x >>
   Sys.assignment2 snd xy y

add :: (Num a, UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s a -> Sys.Variable w s a -> Sys.T w s ()
add = generic3 subtract (-) (+)

mul :: (Fractional a, UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s a -> Sys.Variable w s a -> Sys.T w s ()
mul = generic3 (flip (/)) (/) (*)

square :: (Floating a, UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s a -> Sys.T w s ()
square = generic2 sqrt (^(2::Int))

pow :: (Floating a, UMT.C w) =>
   Sys.Variable w s a -> Sys.Variable w s a -> Sys.Variable w s a -> Sys.T w s ()
pow = generic3 (\x y -> y ** recip x) (flip logBase) (**)