From 0c3b291b95bf41cb1887d83fa4d43fa21b375332 Mon Sep 17 00:00:00 2001 From: Andreas Grois Date: Sun, 5 Mar 2023 21:25:17 +0100 Subject: Initial commit. The code is kinda working, but it's missing documentation and tests. --- src/lib.rs | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 164 insertions(+) create mode 100644 src/lib.rs (limited to 'src') diff --git a/src/lib.rs b/src/lib.rs new file mode 100644 index 0000000..26fb1e1 --- /dev/null +++ b/src/lib.rs @@ -0,0 +1,164 @@ +pub extern crate higher; +pub use paste::paste; + +#[macro_export] +macro_rules! free { + ($v:vis $name:ident<$generic:ident>, $f:ty) => { + $crate::paste! { + #[derive(Clone)] + $v enum $name<$generic> { + Pure($generic), + Free(Box<$f>) + } + impl<$generic> $name<$generic>{ + $v fn lift_f(command : <$f as $crate::higher::Functor>::Target<$generic>) -> Self{ + use $crate::higher::Functor; + Self::Free(Box::new(command.fmap(|a| Self::Pure(a)))) + } + + $v fn retract<'a>(self) -> <$f as $crate::higher::Bind<'a,Self>>::Target<$generic> where $f : $crate::higher::Monad<'a,Self>, <$f as $crate::higher::Bind<'a,Self>>::Target<$generic> : $crate::higher::Pure<$generic> { + use $crate::higher::{Bind, Pure}; + match self { + $name::Pure(a) => {<$f as $crate::higher::Bind<'a,Self>>::Target::<$generic>::pure(a)}, + $name::Free(m) => {m.bind(|a| a.retract())} + } + } + } + mod [<$name _module>] { + use $crate::higher::{Functor, Apply, Bind, Applicative, Monad, Pure, apply::ApplyFn, apply::ap}; + use super::$name; + impl<$generic> $name<$generic> { + fn __fmap_impl<'a, B, F>(self, f: &F) -> $name where F: Fn($generic) -> B + 'a{ + match self { + $name::Pure(a) => {$name::Pure(f(a))}, + $name::Free(fa) => {$name::Free(Box::new(fa.fmap(|x| x.__fmap_impl(f))))}, + } + } + fn __bind_impl<'a, B, F>(self, f: &F) -> $name where F: Fn($generic) -> $name + 'a{ + match self { + $name::Pure(a) => {f(a)}, + $name::Free(m) => {$name::Free(Box::new(m.fmap(|x| x.__bind_impl(f))))}, + } + } + } + + impl<'a,A> Functor<'a,A> for $name { + type Target = $name; + fn fmap(self, f: F) -> Self::Target where F: Fn(A) -> B + 'a{ + self.__fmap_impl(&f) + } + } + + impl Pure for $name { + fn pure(value : A) -> Self { + Self::Pure(value) + } + } + + impl<'a, A> Apply<'a, A> for $name where A: 'a + Clone,{ + type Target = $name where T:'a; + fn apply( + self, + f: >::Target>, + ) -> >::Target + where + B: 'a, + { + ap(f,self) + } + } + + impl<'a,A> Bind<'a,A> for $name{ + type Target = $name; + fn bind(self, f: F) -> Self::Target + where + F: Fn(A) -> Self::Target, + { + self.__bind_impl(&f) + } + } + } + } + }; + ($v:vis $name:ident<$a:lifetime, $($other_lifetimes:lifetime,)* $generic:ident>, $f:ty) =>{ + $crate::paste! { + #[derive(Clone)] + $v enum $name<$a, $($other_lifetimes,)* $generic> { + Pure($generic), + Free(Box<$f>) + } + impl<$a, $($other_lifetimes,)* $generic> $name<$a, $($other_lifetimes,)* $generic> where $generic : $a { + $v fn lift_f(command : <$f as $crate::higher::Functor<$a, Self>>::Target<$generic>) -> Self{ + use $crate::higher::Functor; + Self::Free(Box::new(command.fmap(|a| Self::Pure(a)))) + } + + $v fn retract(self) -> <$f as $crate::higher::Bind<$a,Self>>::Target<$generic> where $f : $crate::higher::Monad<$a,Self>, <$f as $crate::higher::Bind<$a,Self>>::Target<$generic> : $crate::higher::Pure<$generic> { + use $crate::higher::{Bind, Pure}; + match self { + $name::Pure(a) => {<$f as $crate::higher::Bind<$a,Self>>::Target::<$generic>::pure(a)}, + $name::Free(m) => {m.bind(|a| a.retract())} + } + } + } + mod [<$name _module>] { + use $crate::higher::{Functor, Apply, Bind, Applicative, Monad, Pure, apply::ApplyFn, apply::ap}; + use super::$name; + impl<$a, $($other_lifetimes,)* $generic> $name<$a, $($other_lifetimes,)* $generic> where $generic : $a { + fn __fmap_impl(self, f: std::rc::Rc) -> $name<$a, $($other_lifetimes,)* B> where F: Fn($generic) -> B + $a{ + match self { + $name::Pure(a) => {$name::Pure(f(a))}, + $name::Free(fa) => {$name::Free(Box::new(fa.fmap(move |x : Self| x.__fmap_impl(f.clone()))))}, + } + } + fn __bind_impl(self, f: std::rc::Rc) -> $name<$a, $($other_lifetimes,)* B> where F: Fn($generic) -> $name<$a, $($other_lifetimes,)* B> + $a{ + match self { + $name::Pure(a) => {f(a)}, + $name::Free(m) => {$name::Free(Box::new(m.fmap(move |x| x.__bind_impl(f.clone()))))}, + } + } + } + + impl<$a, $($other_lifetimes,)* A> Functor<$a,A> for $name<$a, $($other_lifetimes,)*A> where A : $a { + type Target = $name<$a, $($other_lifetimes,)* T>; + fn fmap(self, f: F) -> Self::Target + where F: Fn(A) -> B + $a + { + let r = std::rc::Rc::new(f); + self.__fmap_impl(r) + } + } + + impl<$a, $($other_lifetimes,)* A> Pure for $name<$a, $($other_lifetimes,)* A> { + fn pure(value : A) -> Self { + Self::Pure(value) + } + } + + impl<$a, $($other_lifetimes,)* A> Apply<$a, A> for $name<$a, $($other_lifetimes,)* A> where A: $a + Clone,{ + type Target = $name<$a, $($other_lifetimes,)* T> where T:$a; + fn apply( + self, + f: >::Target>, + ) -> >::Target + where + B: $a, + { + ap(f,self) + } + } + + impl<$a, $($other_lifetimes,)* A> Bind<$a,A> for $name<$a, $($other_lifetimes,)*A> where A : $a{ + type Target = $name<$a, $($other_lifetimes,)* T>; + fn bind(self, f: F) -> Self::Target + where + F: Fn(A) -> Self::Target + $a, + { + let r = std::rc::Rc::new(f); + self.__bind_impl(r) + } + } + } + } + }; +} \ No newline at end of file -- cgit v1.2.3