{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module AsyncRattus.Strict
( List(..),
singleton,
fromList,
toList,
init',
reverse',
(+++),
listToMaybe',
map',
zip',
zipWith',
mapMaybe',
(:*)(..),
Maybe'(..),
maybe',
fromMaybe',
fst',
snd',
curry',
uncurry'
)where
import Prelude hiding (map)
import Data.VectorSpace
infixr 2 :*
infixr 8 :!
data List a = Nil | !a :! !(List a)
singleton :: a -> List a
singleton :: forall a. a -> List a
singleton a
x = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! List a
forall a. List a
Nil
fromList :: [a] -> List a
fromList :: forall a. [a] -> List a
fromList [] = List a
forall a. List a
Nil
fromList (a
x : [a]
xs) = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! [a] -> List a
forall a. [a] -> List a
fromList [a]
xs
toList :: List a -> [a]
toList :: forall a. List a -> [a]
toList List a
Nil = []
toList (a
x :! List a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: List a -> [a]
forall a. List a -> [a]
toList List a
xs
init' :: List a -> List a
init' :: forall a. List a -> List a
init' List a
Nil = List a
forall a. List a
Nil
init' (a
_ :! List a
Nil) = List a
forall a. List a
Nil
init' (a
x :! List a
xs) = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! List a -> List a
forall a. List a -> List a
init' List a
xs
reverse' :: List a -> List a
reverse' :: forall a. List a -> List a
reverse' List a
l = List a -> List a -> List a
forall {a}. List a -> List a -> List a
rev List a
l List a
forall a. List a
Nil
where
rev :: List a -> List a -> List a
rev List a
Nil List a
a = List a
a
rev (a
x:!List a
xs) List a
a = List a -> List a -> List a
rev List a
xs (a
xa -> List a -> List a
forall a. a -> List a -> List a
:!List a
a)
listToMaybe' :: List a -> Maybe' a
listToMaybe' :: forall a. List a -> Maybe' a
listToMaybe' List a
Nil = Maybe' a
forall a. Maybe' a
Nothing'
listToMaybe' (a
x :! List a
_) = a -> Maybe' a
forall a. a -> Maybe' a
Just' a
x
(+++) :: List a -> List a -> List a
+++ :: forall {a}. List a -> List a -> List a
(+++) List a
Nil List a
ys = List a
ys
(+++) (a
x:!List a
xs) List a
ys = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! List a
xs List a -> List a -> List a
forall {a}. List a -> List a -> List a
+++ List a
ys
map' :: (a -> b) -> List a -> List b
map' :: forall a b. (a -> b) -> List a -> List b
map' a -> b
_ List a
Nil = List b
forall a. List a
Nil
map' a -> b
f (a
x :! List a
xs) = a -> b
f a
x b -> List b -> List b
forall a. a -> List a -> List a
:! (a -> b) -> List a -> List b
forall a b. (a -> b) -> List a -> List b
map' a -> b
f List a
xs
zip' :: List a -> List b -> List (a :* b)
zip' :: forall a b. List a -> List b -> List (a :* b)
zip' List a
Nil List b
_ = List (a :* b)
forall a. List a
Nil
zip' List a
_ List b
Nil = List (a :* b)
forall a. List a
Nil
zip' (a
x :! List a
xs) (b
y :! List b
ys) = (a
x a -> b -> a :* b
forall a b. a -> b -> a :* b
:* b
y) (a :* b) -> List (a :* b) -> List (a :* b)
forall a. a -> List a -> List a
:! List a -> List b -> List (a :* b)
forall a b. List a -> List b -> List (a :* b)
zip' List a
xs List b
ys
zipWith' :: (a -> b -> c) -> List a -> List b -> List c
zipWith' :: forall a b c. (a -> b -> c) -> List a -> List b -> List c
zipWith' a -> b -> c
_ List a
Nil List b
_ = List c
forall a. List a
Nil
zipWith' a -> b -> c
_ List a
_ List b
Nil = List c
forall a. List a
Nil
zipWith' a -> b -> c
f (a
x :! List a
xs) (b
y :! List b
ys) = a -> b -> c
f a
x b
y c -> List c -> List c
forall a. a -> List a -> List a
:! (a -> b -> c) -> List a -> List b -> List c
forall a b c. (a -> b -> c) -> List a -> List b -> List c
zipWith' a -> b -> c
f List a
xs List b
ys
mapMaybe' :: (a -> Maybe' b) -> List a -> List b
mapMaybe' :: forall a b. (a -> Maybe' b) -> List a -> List b
mapMaybe' a -> Maybe' b
_ List a
Nil = List b
forall a. List a
Nil
mapMaybe' a -> Maybe' b
f (a
x:!List a
xs) =
let rs :: List b
rs = (a -> Maybe' b) -> List a -> List b
forall a b. (a -> Maybe' b) -> List a -> List b
mapMaybe' a -> Maybe' b
f List a
xs in
case a -> Maybe' b
f a
x of
Maybe' b
Nothing' -> List b
rs
Just' b
r -> b
rb -> List b -> List b
forall a. a -> List a -> List a
:!List b
rs
instance Foldable List where
foldMap :: forall m a. Monoid m => (a -> m) -> List a -> m
foldMap a -> m
f = List a -> m
run where
run :: List a -> m
run List a
Nil = m
forall a. Monoid a => a
mempty
run (a
x :! List a
xs) = a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> List a -> m
run List a
xs
foldr :: forall a b. (a -> b -> b) -> b -> List a -> b
foldr a -> b -> b
f = b -> List a -> b
run where
run :: b -> List a -> b
run b
b List a
Nil = b
b
run b
b (a
a :! List a
as) = (b -> List a -> b
run (b -> List a -> b) -> b -> List a -> b
forall a b. (a -> b) -> a -> b
$! (a -> b -> b
f a
a b
b)) List a
as
foldl :: forall b a. (b -> a -> b) -> b -> List a -> b
foldl b -> a -> b
f = b -> List a -> b
run where
run :: b -> List a -> b
run b
a List a
Nil = b
a
run b
a (a
b :! List a
bs) = (b -> List a -> b
run (b -> List a -> b) -> b -> List a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f b
a a
b)) List a
bs
elem :: forall a. Eq a => a -> List a -> Bool
elem a
a = List a -> Bool
run where
run :: List a -> Bool
run List a
Nil = Bool
False
run (a
x :! List a
xs)
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = Bool
True
| Bool
otherwise = List a -> Bool
run List a
xs
instance Functor List where
fmap :: forall a b. (a -> b) -> List a -> List b
fmap = (a -> b) -> List a -> List b
forall a b. (a -> b) -> List a -> List b
map'
instance Eq a => Eq (List a) where
List a
Nil == :: List a -> List a -> Bool
== List a
Nil = Bool
True
List a
Nil == List a
_ = Bool
False
List a
_ == List a
Nil = Bool
False
(a
x :! List a
xs) == (a
y :! List a
ys) = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then List a
xs List a -> List a -> Bool
forall a. Eq a => a -> a -> Bool
== List a
ys else Bool
False
instance Show a => Show (List a) where
show :: List a -> String
show List a
Nil = String
"Nil"
show (a
x :! List a
xs) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ List a -> String
forall a. Show a => a -> String
show List a
xs
data Maybe' a = Just' !a | Nothing'
instance Eq a => Eq (Maybe' a) where
Maybe' a
Nothing' == :: Maybe' a -> Maybe' a -> Bool
== Maybe' a
Nothing' = Bool
True
Just' a
x == Just' a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
Maybe' a
_ == Maybe' a
_ = Bool
False
instance Show a => Show (Maybe' a) where
show :: Maybe' a -> String
show Maybe' a
Nothing' = String
"Nothing'"
show (Just' a
x) = String
"Just' " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
maybe' :: b -> (a -> b) -> Maybe' a -> b
maybe' :: forall b a. b -> (a -> b) -> Maybe' a -> b
maybe' b
n a -> b
_ Maybe' a
Nothing' = b
n
maybe' b
_ a -> b
f (Just' a
x) = a -> b
f a
x
fromMaybe' :: a -> Maybe' a -> a
fromMaybe' :: forall a. a -> Maybe' a -> a
fromMaybe' a
_ (Just' a
x) = a
x
fromMaybe' a
d Maybe' a
Nothing' = a
d
data a :* b = !a :* !b
fst' :: (a :* b) -> a
fst' :: forall a b. (a :* b) -> a
fst' (a
a:*b
_) = a
a
snd' :: (a :* b) -> b
snd' :: forall a b. (a :* b) -> b
snd' (a
_:*b
b) = b
b
curry' :: ((a :* b) -> c) -> a -> b -> c
curry' :: forall a b c. ((a :* b) -> c) -> a -> b -> c
curry' (a :* b) -> c
f a
x b
y = (a :* b) -> c
f (a
x a -> b -> a :* b
forall a b. a -> b -> a :* b
:* b
y)
uncurry' :: (a -> b -> c) -> (a :* b) -> c
uncurry' :: forall a b c. (a -> b -> c) -> (a :* b) -> c
uncurry' a -> b -> c
f (a
x :* b
y) = a -> b -> c
f a
x b
y
instance Functor ((:*) a) where
fmap :: forall a b. (a -> b) -> (a :* a) -> a :* b
fmap a -> b
f (a
x:*a
y) = (a
x a -> b -> a :* b
forall a b. a -> b -> a :* b
:* a -> b
f a
y)
instance (Show a, Show b) => Show (a:*b) where
show :: (a :* b) -> String
show (a
a :* b
b) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
instance (Eq a, Eq b) => Eq (a :* b) where
(a
x1 :* b
y1) == :: (a :* b) -> (a :* b) -> Bool
== (a
x2 :* b
y2) = a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
y2
instance (VectorSpace v a, VectorSpace w a, Floating a, Eq a) => VectorSpace (v :* w) a where
zeroVector :: v :* w
zeroVector = v
forall v a. VectorSpace v a => v
zeroVector v -> w -> v :* w
forall a b. a -> b -> a :* b
:* w
forall v a. VectorSpace v a => v
zeroVector
a
a *^ :: a -> (v :* w) -> v :* w
*^ (v
x :* w
y) = (a
a a -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ v
x) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (a
a a -> w -> w
forall v a. VectorSpace v a => a -> v -> v
*^ w
y)
(v
x :* w
y) ^/ :: (v :* w) -> a -> v :* w
^/ a
a = (v
x v -> a -> v
forall v a. VectorSpace v a => v -> a -> v
^/ a
a) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w
y w -> a -> w
forall v a. VectorSpace v a => v -> a -> v
^/ a
a)
negateVector :: (v :* w) -> v :* w
negateVector (v
x :* w
y) = (v -> v
forall v a. VectorSpace v a => v -> v
negateVector v
x) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w -> w
forall v a. VectorSpace v a => v -> v
negateVector w
y)
(v
x1 :* w
y1) ^+^ :: (v :* w) -> (v :* w) -> v :* w
^+^ (v
x2 :* w
y2) = (v
x1 v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^+^ v
x2) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w
y1 w -> w -> w
forall v a. VectorSpace v a => v -> v -> v
^+^ w
y2)
(v
x1 :* w
y1) ^-^ :: (v :* w) -> (v :* w) -> v :* w
^-^ (v
x2 :* w
y2) = (v
x1 v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^-^ v
x2) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w
y1 w -> w -> w
forall v a. VectorSpace v a => v -> v -> v
^-^ w
y2)
(v
x1 :* w
y1) dot :: (v :* w) -> (v :* w) -> a
`dot` (v
x2 :* w
y2) = (v
x1 v -> v -> a
forall v a. VectorSpace v a => v -> v -> a
`dot` v
x2) a -> a -> a
forall a. Num a => a -> a -> a
+ (w
y1 w -> w -> a
forall v a. VectorSpace v a => v -> v -> a
`dot` w
y2)