% Testing Higher-Order Functional-Logic Operations
% Sebastian Fischer (sebf@informatik.uni-kiel.de)

This module defines tests that show how to define higher-order
functional-logic programs.

> module CFLP.Tests.HigherOrder where
>
> import CFLP
> import CFLP.Tests
>
> import Test.HUnit
>
> import Prelude hiding ( not, null, head, map, foldr, flip, id )
> import qualified Prelude as P
> import CFLP.Types.Bool
> import CFLP.Types.List
>
> tests :: Test
> tests = "higher order" ~: test
>   [ "apply not function" ~: applyNotFunction
>   , "apply binary constructor" ~: applyBinCons
>   , "apply non-deterministic choice" ~: applyChoice
>   , "call-time choice" ~: callTimeChoice
>   , "map shared unknowns" ~: mapSharedUnknowns
>   , "member with fold" ~: memberWithFold
>   , "overApplication" ~: overApplication
>   , "reverse with foldr" ~: reverseWithFoldr
>   , "pointfree reverse" ~: pointfreeReverse
>   , "function conversion" ~: functionConversion
>   ]

The following test simply applies the not function.

> applyNotFunction :: Assertion
> applyNotFunction = assertResults comp [True]
>  where
>   comp :: Computation Bool
>   comp = apply (fun not) false

The following test applies the binary list constructor.

> applyBinCons :: Assertion
> applyBinCons = assertResults comp [[True]]
>  where
>   comp :: Computation [Bool]
>   comp cs = withUnique $ \u1 u2 ->
>               apply (apply (fun (^:)) true cs u1) nil cs u2

The following tests applies the binary operator for non-deterministic
choice.

> applyChoice :: Assertion
> applyChoice = assertResults comp [False,True]
>  where
>   comp :: Computation Bool
>   comp cs = withUnique $ \u1 u2 ->
>               apply (apply (fun (?)) false cs u1) true cs u2

The following test checks whether call-time choice is still obtained
when applying the choice combinator using higher-order features.

> callTimeChoice :: Assertion
> callTimeChoice = assertResults comp [[False,False],[True,True]]
>  where
>   comp :: Computation [Bool]
>   comp cs = withUnique $ \u1 u2 u3 ->
>               apply (fun two)
>                     (apply (apply (fun (?)) false cs u1) true cs u2) cs u3
>
> two :: (Monad m, Generic a) => Nondet cs m a -> Nondet cs m [a]
> two x = x ^: x ^: nil

The following test maps the function `not` over a list with a
duplicated free variable.

> mapSharedUnknowns :: Assertion
> mapSharedUnknowns = assertResults comp [[True,True],[False,False]]
>  where
>   comp :: Computation [Bool]
>   comp cs = withUnique $ \u -> map (fun not) (two (unknown u)) cs

The following test checks the member operation defined using `foldr`.

> memberWithFold :: Assertion
> memberWithFold = assertResults comp [True,False]
>  where
>   comp :: Computation Bool
>   comp = foldr (fun (?)) failure (true ^: false ^: nil)

The following test applies the composition function which is has a
function on its right-hand side:

> after :: CFLP s => Data s (b -> c) -> Data s (a -> b) -> Data s (a -> c)
> after f g = fun (\x cs -> withUnique $ \u -> apply f (apply g x cs u) cs)
>
> overApplication :: Assertion
> overApplication = assertResults comp [True]
>  where
>   comp :: Computation Bool
>   comp = apply (after (fun not) (fun not)) true

The following test makes extensive use of higher-order features by
implementing the reverse function using `foldr`.

~~~
rev = flip (foldr (\x f l -> f (x:l)) id) []
~~~

> reverseWithFoldr :: Assertion
> reverseWithFoldr = assertResults comp [[True,False,False]]
>  where
>   comp :: Computation [Bool]
>   comp = rev (false ^: false ^: true ^: nil)
>
>   rev :: CFLP s => Data s [Bool] -> Context (Ctx s) -> ID -> Data s [Bool]
>   rev = flip (fun (foldr (fun (\x f l -> apply f (x ^: l))) (fun id))) nil
>
> flip :: CFLP s
>      => Data s (a -> b -> c) -> Data s b -> Data s a
>      -> Context (Ctx s) -> ID -> Data s c
> flip f x y cs = withUnique $ \u -> apply (apply f y cs u) x cs
> 
> id :: Data s a -> Data s a
> id x = x

The following uses even more higher-order functions by implementing a
pointfree version of the above reverse function.

~~~
rev = flip (foldr (flip (flip ((.).(.)) (:))) id) []
~~~

> pointfreeReverse :: Assertion
> pointfreeReverse = assertResults comp [[True,False,False]]
>  where
>   comp :: Computation [Bool]
>   comp = apply rev (false ^: false ^: true ^: nil)
>
>   rev :: CFLP s => Data s ([Bool] -> [Bool])
>   rev = fun (flip (fun (foldr (fun (flip (fun (flip 
>    (fun after `after` fun after) (fun (^:)))))) (fun id))) nil)

The following test converts primitive Haskell functions to
non-deterministic ones and applies them to non-deterministic values.

> functionConversion :: Assertion
> functionConversion = assertResults comp [False]
>  where
>   comp :: Computation Bool
>   comp cs = withUnique $ \u ->
>              apply (foldr (fun after) (fun id)
>                       (nondet [P.not,P.not,P.not]) cs u)
>                true cs