{-|
Module     : Jaskell.Prelude
Copyright  : (c) Owen Bechtel, 2023
License    : MIT
Maintainer : ombspring@gmail.com
Stability  : experimental

A standard library for Jaskell. The names of most functions in this module come from the Joy programming 
language (see [here](https://www.kevinalbrecht.com/code/joy-mirror/j03atm.html) for a list of Joy commands).
-}

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE Arrows #-}
module Jaskell.Prelude 
  ( -- * Stack manipulation
    stack, unstack, newstack
  , pop, dup, swap, popd, pop2, dupd, dup2, swapd, rollup, rolldown    
    -- * Ternary operator
  , choice, select
    -- * Tuples and lists
  , pair, unpair
  , cons, swons, uncons, unswons
    -- * Basic combinators
  , conjoin, disjoin
  , i, comp
  , consQ, swonsQ
  , nullary, dip, dipd, dipdd
  , app1, app2, app3, cleave
  , ifte, branch, cond
  , infra
    -- * Recursive combinators
  , whiledo
  , tailrec, linrec, linrec', binrec, binrec', natrec, listrec
  , CLROption(..), condlinrec
  , times
    -- * List combinators
  , step, step2, map, mapS, filter, filterS, split, splitS
  , any, all, zipwith, zipwithS
  ) where

import qualified Prelude
import Prelude hiding (map, filter, any, all, zipWith)
import Data.List (partition)
import Control.Applicative (liftA2)
import Control.Arrow (Arrow, ArrowApply, ArrowChoice, arr, (>>>), (>>^), (^>>), (&&&), returnA, app)

stack :: Arrow arr => arr s (s, s)
stack :: forall (arr :: * -> * -> *) s. Arrow arr => arr s (s, s)
stack = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \s
s -> (s
s, s
s)

unstack :: Arrow arr => arr (s, t) t
unstack :: forall (arr :: * -> * -> *) s t. Arrow arr => arr (s, t) t
unstack = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> b
snd

newstack :: Arrow arr => arr a ()
newstack :: forall (arr :: * -> * -> *) a. Arrow arr => arr a ()
newstack = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const ())

pop :: Arrow arr => arr (s, a) s
pop :: forall (arr :: * -> * -> *) s a. Arrow arr => arr (s, a) s
pop = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a, b) -> a
fst

dup :: Arrow arr => arr (s, a) ((s, a), a)
dup :: forall (arr :: * -> * -> *) s a.
Arrow arr =>
arr (s, a) ((s, a), a)
dup = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(s
s, a
x) -> ((s
s, a
x), a
x)

swap :: Arrow arr => arr ((s, a), b) ((s, b), a)
swap :: forall (arr :: * -> * -> *) s a b.
Arrow arr =>
arr ((s, a), b) ((s, b), a)
swap = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), b
y) -> ((s
s, b
y), a
x)

popd :: Arrow arr => arr ((s, a), b) (s, b)
popd :: forall (arr :: * -> * -> *) s a b.
Arrow arr =>
arr ((s, a), b) (s, b)
popd = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
_), b
y) -> (s
s, b
y)

pop2 :: Arrow arr => arr ((s, a), b) s
pop2 :: forall (arr :: * -> * -> *) s a b. Arrow arr => arr ((s, a), b) s
pop2 = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

dupd :: Arrow arr => arr ((s, a), b) (((s, a), a), b)
dupd :: forall (arr :: * -> * -> *) s a b.
Arrow arr =>
arr ((s, a), b) (((s, a), a), b)
dupd = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), b
y) -> (((s
s, a
x), a
x), b
y)

dup2 :: Arrow arr => arr ((s, a), b) ((((s, a), b), a), b)
dup2 :: forall (arr :: * -> * -> *) s a b.
Arrow arr =>
arr ((s, a), b) ((((s, a), b), a), b)
dup2 = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), b
y) -> ((((s
s, a
x), b
y), a
x), b
y)

swapd :: Arrow arr => arr (((s, a), b), c) (((s, b), a), c)
swapd :: forall (arr :: * -> * -> *) s a b c.
Arrow arr =>
arr (((s, a), b), c) (((s, b), a), c)
swapd = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(((s
s, a
x), b
y), c
z) -> (((s
s, b
y), a
x), c
z)

rollup :: Arrow arr => arr (((s, a), b), c) (((s, c), a), b)
rollup :: forall (arr :: * -> * -> *) s a b c.
Arrow arr =>
arr (((s, a), b), c) (((s, c), a), b)
rollup = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(((s
s, a
x), b
y), c
z) -> (((s
s, c
z), a
x), b
y)

rolldown :: Arrow arr => arr (((s, a), b), c) (((s, b), c), a)
rolldown :: forall (arr :: * -> * -> *) s a b c.
Arrow arr =>
arr (((s, a), b), c) (((s, b), c), a)
rolldown = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(((s
s, a
x), b
y), c
z) -> (((s
s, b
y), c
z), a
x)

choice :: Arrow arr => arr (((s, Bool), a), a) (s, a)
choice :: forall (arr :: * -> * -> *) s a.
Arrow arr =>
arr (((s, Bool), a), a) (s, a)
choice = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(((s
s, Bool
b), a
x), a
y) -> (s
s, if Bool
b then a
x else a
y)

select :: (Arrow arr, Eq a) => arr (((s, a), [(a, b)]), b) (s, b)
select :: forall (arr :: * -> * -> *) a s b.
(Arrow arr, Eq a) =>
arr (((s, a), [(a, b)]), b) (s, b)
select = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(((s
s, a
x), [(a, b)]
ps), b
dft) -> 
  let test :: (a, b) -> b -> b
test (a
x', b
y) b
z = if a
x forall a. Eq a => a -> a -> Bool
== a
x' then b
y else b
z
  in (s
s, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. (a, b) -> b -> b
test b
dft [(a, b)]
ps)

pair :: Arrow arr => arr ((s, a), b) (s, (a, b))
pair :: forall (arr :: * -> * -> *) s a b.
Arrow arr =>
arr ((s, a), b) (s, (a, b))
pair = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), b
y) -> (s
s, (a
x, b
y))

unpair :: Arrow arr => arr (s, (a, b)) ((s, a), b)
unpair :: forall (arr :: * -> * -> *) s a b.
Arrow arr =>
arr (s, (a, b)) ((s, a), b)
unpair = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(s
s, (a
x, b
y)) -> ((s
s, a
x), b
y)

cons :: Arrow arr => arr ((s, a), [a]) (s, [a])
cons :: forall (arr :: * -> * -> *) s a.
Arrow arr =>
arr ((s, a), [a]) (s, [a])
cons = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), [a]
xs) -> (s
s, a
x forall a. a -> [a] -> [a]
: [a]
xs)

swons :: Arrow arr => arr ((s, [a]), a) (s, [a])
swons :: forall (arr :: * -> * -> *) s a.
Arrow arr =>
arr ((s, [a]), a) (s, [a])
swons = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, [a]
xs), a
x) -> (s
s, a
x forall a. a -> [a] -> [a]
: [a]
xs)

uncons :: Arrow arr => arr (s, [a]) ((s, a), [a])
uncons :: forall (arr :: * -> * -> *) s a.
Arrow arr =>
arr (s, [a]) ((s, a), [a])
uncons = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(s
s, [a]
xs) -> 
  case [a]
xs of
    [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"Jaskell.Prelude.uncons: empty list"
    a
x:[a]
xt -> ((s
s, a
x), [a]
xt)

unswons :: Arrow arr => arr (s, [a]) ((s, [a]), a)
unswons :: forall (arr :: * -> * -> *) s a.
Arrow arr =>
arr (s, [a]) ((s, [a]), a)
unswons = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(s
s, [a]
xs) ->
  case [a]
xs of
    [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"Jaskell.Prelude.unswons: empty list"
    a
x:[a]
xt -> ((s
s, [a]
xt), a
x)

conjoin :: (Arrow arr, Arrow arr') => arr ((s, arr' t (u1, Bool)), arr' t (u2, Bool)) (s, arr' t (t, Bool))
conjoin :: forall (arr :: * -> * -> *) (arr' :: * -> * -> *) s t u1 u2.
(Arrow arr, Arrow arr') =>
arr
  ((s, arr' t (u1, Bool)), arr' t (u2, Bool)) (s, arr' t (t, Bool))
conjoin = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, arr' t (u1, Bool)
p1), arr' t (u2, Bool)
p2) -> 
  let p3 :: arr' t (t, Bool)
p3 = forall (a :: * -> * -> *) b. Arrow a => a b b
returnA forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((arr' t (u1, Bool)
p1 forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b. (a, b) -> b
snd) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (arr' t (u2, Bool)
p2 forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b. (a, b) -> b
snd) forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&))
  in (s
s, arr' t (t, Bool)
p3)

disjoin :: (Arrow arr, Arrow arr') => arr ((s, arr' t (u1, Bool)), arr' t (u2, Bool)) (s, arr' t (t, Bool))
disjoin :: forall (arr :: * -> * -> *) (arr' :: * -> * -> *) s t u1 u2.
(Arrow arr, Arrow arr') =>
arr
  ((s, arr' t (u1, Bool)), arr' t (u2, Bool)) (s, arr' t (t, Bool))
disjoin = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, arr' t (u1, Bool)
p1), arr' t (u2, Bool)
p2) -> 
  let p3 :: arr' t (t, Bool)
p3 = forall (a :: * -> * -> *) b. Arrow a => a b b
returnA forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((arr' t (u1, Bool)
p1 forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b. (a, b) -> b
snd) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (arr' t (u2, Bool)
p2 forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b. (a, b) -> b
snd) forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||))
  in (s
s, arr' t (t, Bool)
p3)

i :: ArrowApply arr => arr (s, arr s t) t
i :: forall (arr :: * -> * -> *) s t.
ArrowApply arr =>
arr (s, arr s t) t
i = (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(s
s, arr s t
f) -> (arr s t
f, s
s)) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app

comp :: (Arrow arr, Arrow arr') => arr ((s, arr' a b), arr' b c) (s, arr' a c)
comp :: forall (arr :: * -> * -> *) (arr' :: * -> * -> *) s a b c.
(Arrow arr, Arrow arr') =>
arr ((s, arr' a b), arr' b c) (s, arr' a c)
comp = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, arr' a b
f), arr' b c
g) -> (s
s, arr' a b
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> arr' b c
g)

consQ :: (Arrow arr, Arrow arr') => arr ((s, a), arr' (t, a) c) (s, arr' t c)
consQ :: forall (arr :: * -> * -> *) (arr' :: * -> * -> *) s a t c.
(Arrow arr, Arrow arr') =>
arr ((s, a), arr' (t, a) c) (s, arr' t c)
consQ = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, a
x), arr' (t, a) c
f) -> (s
s, (, a
x) forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> arr' (t, a) c
f)

swonsQ :: (Arrow arr, Arrow arr') => arr ((s, arr' (t, a) c), a) (s, arr' t c)
swonsQ :: forall (arr :: * -> * -> *) (arr' :: * -> * -> *) s t a c.
(Arrow arr, Arrow arr') =>
arr ((s, arr' (t, a) c), a) (s, arr' t c)
swonsQ = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, arr' (t, a) c
f), a
x) -> (s
s, (, a
x) forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> arr' (t, a) c
f)

nullary :: ArrowApply arr => arr (s, arr s (t, a)) (s, a)
nullary :: forall (arr :: * -> * -> *) s t a.
ArrowApply arr =>
arr (s, arr s (t, a)) (s, a)
nullary = proc (s
s, arr s (t, a)
f) -> do
  (t
_, a
x) <- arr s (t, a)
f -<< s
s
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, a
x)

dip :: ArrowApply arr => arr ((s, a), arr s t) (t, a)
dip :: forall (arr :: * -> * -> *) s a t.
ArrowApply arr =>
arr ((s, a), arr s t) (t, a)
dip = proc ((s
s, a
x), arr s t
f) -> do
  t
s' <- arr s t
f -<< s
s
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (t
s', a
x)

dipd :: ArrowApply arr => arr (((s, a), b), arr s t) ((t, a), b)
dipd :: forall (arr :: * -> * -> *) s a b t.
ArrowApply arr =>
arr (((s, a), b), arr s t) ((t, a), b)
dipd = proc (((s
s, a
x), b
y), arr s t
f) -> do
  t
s' <- arr s t
f -<< s
s
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((t
s', a
x), b
y)

dipdd :: ArrowApply arr => arr ((((s, a), b), c), arr s t) (((t, a), b), c)
dipdd :: forall (arr :: * -> * -> *) s a b c t.
ArrowApply arr =>
arr ((((s, a), b), c), arr s t) (((t, a), b), c)
dipdd = proc ((((s
s, a
x), b
y), c
z), arr s t
f) -> do
  t
s' <- arr s t
f -<< s
s
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (((t
s', a
x), b
y), c
z)

app1 :: ArrowApply arr => arr ((s, a), arr (s, a) (t, b)) (s, b)
app1 :: forall (arr :: * -> * -> *) s a t b.
ArrowApply arr =>
arr ((s, a), arr (s, a) (t, b)) (s, b)
app1 = proc ((s
s, a
x), arr (s, a) (t, b)
f) -> do
  (t
_, b
x') <- arr (s, a) (t, b)
f -<< (s
s, a
x)
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, b
x')

app2 :: ArrowApply arr => arr (((s, a), a), arr (s, a) (t, b)) ((s, b), b)
app2 :: forall (arr :: * -> * -> *) s a t b.
ArrowApply arr =>
arr (((s, a), a), arr (s, a) (t, b)) ((s, b), b)
app2 = proc (((s
s, a
x), a
y), arr (s, a) (t, b)
f) -> do
  (t
_, b
x') <- arr (s, a) (t, b)
f -<< (s
s, a
x)
  (t
_, b
y') <- arr (s, a) (t, b)
f -<< (s
s, a
y)
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((s
s, b
x'), b
y')

app3 :: ArrowApply arr => arr ((((s, a), a), a), arr (s, a) (t, b)) (((s, b), b), b)
app3 :: forall (arr :: * -> * -> *) s a t b.
ArrowApply arr =>
arr ((((s, a), a), a), arr (s, a) (t, b)) (((s, b), b), b)
app3 = proc ((((s
s, a
x), a
y), a
z), arr (s, a) (t, b)
f) -> do
  (t
_, b
x') <- arr (s, a) (t, b)
f -<< (s
s, a
x) 
  (t
_, b
y') <- arr (s, a) (t, b)
f -<< (s
s, a
y)
  (t
_, b
z') <- arr (s, a) (t, b)
f -<< (s
s, a
z)
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (((s
s, b
x'), b
y'), b
z')

cleave :: ArrowApply arr => arr (((s, a), arr (s, a) (t1, b1)), arr (s, a) (t2, b2)) ((s, b1), b2)
cleave :: forall (arr :: * -> * -> *) s a t1 b1 t2 b2.
ArrowApply arr =>
arr
  (((s, a), arr (s, a) (t1, b1)), arr (s, a) (t2, b2)) ((s, b1), b2)
cleave = proc (((s
s, a
x), arr (s, a) (t1, b1)
f), arr (s, a) (t2, b2)
g) -> do
  (t1
_, b1
x1) <- arr (s, a) (t1, b1)
f -<< (s
s, a
x)
  (t2
_, b2
x2) <- arr (s, a) (t2, b2)
g -<< (s
s, a
x)
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((s
s, b1
x1), b2
x2) 

ifte :: ArrowApply arr => arr (((s, arr s (t, Bool)), arr s u), arr s u) u
ifte :: forall (arr :: * -> * -> *) s t u.
ArrowApply arr =>
arr (((s, arr s (t, Bool)), arr s u), arr s u) u
ifte = proc (((s
s, arr s (t, Bool)
p), arr s u
f), arr s u
g) -> do
  (t
_, Bool
b) <- arr s (t, Bool)
p -<< s
s
  (if Bool
b then arr s u
f else arr s u
g) -<< s
s

branch :: ArrowApply arr => arr (((s, Bool), arr s t), arr s t) t
branch :: forall (arr :: * -> * -> *) s t.
ArrowApply arr =>
arr (((s, Bool), arr s t), arr s t) t
branch = proc (((s
s, Bool
b), arr s t
f), arr s t
g) -> (if Bool
b then arr s t
f else arr s t
g) -<< s
s

-- PRIVATE
chooseA :: (ArrowApply arr, ArrowChoice arr) => arr (s, [(arr s (t, Bool), a)], a) a
chooseA :: forall (arr :: * -> * -> *) s t a.
(ArrowApply arr, ArrowChoice arr) =>
arr (s, [(arr s (t, Bool), a)], a) a
chooseA = proc (s
s, [(arr s (t, Bool), a)]
ps, a
dft) -> 
  case [(arr s (t, Bool), a)]
ps of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
dft
    (arr s (t, Bool)
p, a
x):[(arr s (t, Bool), a)]
pt -> do
      (t
_, Bool
b) <- arr s (t, Bool)
p -<< s
s
      if Bool
b 
        then forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
x 
        else forall (arr :: * -> * -> *) s t a.
(ArrowApply arr, ArrowChoice arr) =>
arr (s, [(arr s (t, Bool), a)], a) a
chooseA -< (s
s, [(arr s (t, Bool), a)]
pt, a
dft) 

cond :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [(arr s (t, Bool), arr s u)]), arr s u) u
cond :: forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [(arr s (t, Bool), arr s u)]), arr s u) u
cond = proc ((s
s, [(arr s (t, Bool), arr s u)]
ps), arr s u
dft) -> do
  arr s u
f <- forall (arr :: * -> * -> *) s t a.
(ArrowApply arr, ArrowChoice arr) =>
arr (s, [(arr s (t, Bool), a)], a) a
chooseA -< (s
s, [(arr s (t, Bool), arr s u)]
ps, arr s u
dft)
  arr s u
f -<< s
s

infra :: ArrowApply arr => arr ((s, t), arr t u) (s, u)
infra :: forall (arr :: * -> * -> *) s t u.
ArrowApply arr =>
arr ((s, t), arr t u) (s, u)
infra = proc ((s
s, t
x), arr t u
f) -> do
  u
x' <- arr t u
f -<< t
x
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, u
x')

whiledo :: (ArrowApply arr, ArrowChoice arr) => arr ((s, arr s (t, Bool)), arr s s) s
whiledo :: forall (arr :: * -> * -> *) s t.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, arr s (t, Bool)), arr s s) s
whiledo = proc ((s
s, arr s (t, Bool)
p), arr s s
f) -> do
  (t
_, Bool
b) <- arr s (t, Bool)
p -<< s
s
  if Bool
b 
    then do
      s
s' <- arr s s
f -<< s
s
      forall (arr :: * -> * -> *) s t.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, arr s (t, Bool)), arr s s) s
whiledo -< ((s
s', arr s (t, Bool)
p), arr s s
f)
    else forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< s
s

tailrec :: (ArrowApply arr, ArrowChoice arr) => arr (((s, arr s (t, Bool)), arr s u), arr s s) u
tailrec :: forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, arr s (t, Bool)), arr s u), arr s s) u
tailrec = proc (((s
s, arr s (t, Bool)
p), arr s u
f), arr s s
g) -> do
  (t
_, Bool
stop) <- arr s (t, Bool)
p -<< s
s
  if Bool
stop
    then arr s u
f -<< s
s 
    else do
      s
s' <- arr s s
g -<< s
s
      forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, arr s (t, Bool)), arr s u), arr s s) u
tailrec -< (((s
s', arr s (t, Bool)
p), arr s u
f), arr s s
g)

linrec :: (ArrowApply arr, ArrowChoice arr) => arr ((((s, arr s (t, Bool)), arr s u), arr s s), arr u u) u
linrec :: forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr ((((s, arr s (t, Bool)), arr s u), arr s s), arr u u) u
linrec = proc ((((s
s, arr s (t, Bool)
p), arr s u
f), arr s s
g), arr u u
h) -> do
  (t
_, Bool
stop) <- arr s (t, Bool)
p -<< s
s
  if Bool
stop
    then arr s u
f -<< s
s
    else do
      s
s' <- arr s s
g -<< s
s
      u
u <- forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr ((((s, arr s (t, Bool)), arr s u), arr s s), arr u u) u
linrec -< ((((s
s', arr s (t, Bool)
p), arr s u
f), arr s s
g), arr u u
h)
      arr u u
h -<< u
u

linrec' :: (ArrowApply arr, ArrowChoice arr) => arr ((((s, arr s (t, Bool)), arr s u), arr s (s, c)), arr (u, c) u) u
linrec' :: forall (arr :: * -> * -> *) s t u c.
(ArrowApply arr, ArrowChoice arr) =>
arr
  ((((s, arr s (t, Bool)), arr s u), arr s (s, c)), arr (u, c) u) u
linrec' = proc ((((s
s, arr s (t, Bool)
p), arr s u
f), arr s (s, c)
g), arr (u, c) u
h) -> do
  (t
_, Bool
stop) <- arr s (t, Bool)
p -<< s
s
  if Bool
stop
    then arr s u
f -<< s
s
    else do
      (s
s', c
x) <- arr s (s, c)
g -<< s
s
      u
u <- forall (arr :: * -> * -> *) s t u c.
(ArrowApply arr, ArrowChoice arr) =>
arr
  ((((s, arr s (t, Bool)), arr s u), arr s (s, c)), arr (u, c) u) u
linrec' -< ((((s
s', arr s (t, Bool)
p), arr s u
f), arr s (s, c)
g), arr (u, c) u
h)
      arr (u, c) u
h -<< (u
u, c
x)

binrec :: (ArrowApply arr, ArrowChoice arr) => arr (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)), arr (s, a) ((s, a), a)), arr ((s, b), b) (u, b)) (u, b)
binrec :: forall (arr :: * -> * -> *) s a t u b.
(ArrowApply arr, ArrowChoice arr) =>
arr
  (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)),
    arr (s, a) ((s, a), a)),
   arr ((s, b), b) (u, b))
  (u, b)
binrec = proc (((((s, a)
s, arr (s, a) (t, Bool)
p), arr (s, a) (u, b)
f), arr (s, a) ((s, a), a)
g), arr ((s, b), b) (u, b)
h) -> do
  (t
_, Bool
stop) <- arr (s, a) (t, Bool)
p -<< (s, a)
s
  if Bool
stop
    then arr (s, a) (u, b)
f -<< (s, a)
s
    else do
      ((s
s', a
x), a
y) <- arr (s, a) ((s, a), a)
g -<< (s, a)
s
      (u
_, b
x') <- forall (arr :: * -> * -> *) s a t u b.
(ArrowApply arr, ArrowChoice arr) =>
arr
  (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)),
    arr (s, a) ((s, a), a)),
   arr ((s, b), b) (u, b))
  (u, b)
binrec -< (((((s
s', a
x), arr (s, a) (t, Bool)
p), arr (s, a) (u, b)
f), arr (s, a) ((s, a), a)
g), arr ((s, b), b) (u, b)
h)
      (u
_, b
y') <- forall (arr :: * -> * -> *) s a t u b.
(ArrowApply arr, ArrowChoice arr) =>
arr
  (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)),
    arr (s, a) ((s, a), a)),
   arr ((s, b), b) (u, b))
  (u, b)
binrec -< (((((s
s', a
y), arr (s, a) (t, Bool)
p), arr (s, a) (u, b)
f), arr (s, a) ((s, a), a)
g), arr ((s, b), b) (u, b)
h)
      arr ((s, b), b) (u, b)
h -<< ((s
s', b
x'), b
y')

binrec' :: (ArrowApply arr, ArrowChoice arr) => arr (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)), arr (s, a) (((s, a), a), c)), arr (((s, b), b), c) (u, b)) (u, b)
binrec' :: forall (arr :: * -> * -> *) s a t u b c.
(ArrowApply arr, ArrowChoice arr) =>
arr
  (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)),
    arr (s, a) (((s, a), a), c)),
   arr (((s, b), b), c) (u, b))
  (u, b)
binrec' = proc (((((s, a)
s, arr (s, a) (t, Bool)
p), arr (s, a) (u, b)
f), arr (s, a) (((s, a), a), c)
g), arr (((s, b), b), c) (u, b)
h) -> do
  (t
_, Bool
stop) <- arr (s, a) (t, Bool)
p -<< (s, a)
s
  if Bool
stop
    then arr (s, a) (u, b)
f -<< (s, a)
s
    else do
      (((s
s', a
x), a
y), c
z) <- arr (s, a) (((s, a), a), c)
g -<< (s, a)
s
      (u
_, b
x') <- forall (arr :: * -> * -> *) s a t u b c.
(ArrowApply arr, ArrowChoice arr) =>
arr
  (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)),
    arr (s, a) (((s, a), a), c)),
   arr (((s, b), b), c) (u, b))
  (u, b)
binrec' -< (((((s
s', a
x), arr (s, a) (t, Bool)
p), arr (s, a) (u, b)
f), arr (s, a) (((s, a), a), c)
g), arr (((s, b), b), c) (u, b)
h)
      (u
_, b
y') <- forall (arr :: * -> * -> *) s a t u b c.
(ArrowApply arr, ArrowChoice arr) =>
arr
  (((((s, a), arr (s, a) (t, Bool)), arr (s, a) (u, b)),
    arr (s, a) (((s, a), a), c)),
   arr (((s, b), b), c) (u, b))
  (u, b)
binrec' -< (((((s
s', a
y), arr (s, a) (t, Bool)
p), arr (s, a) (u, b)
f), arr (s, a) (((s, a), a), c)
g), arr (((s, b), b), c) (u, b)
h)
      arr (((s, b), b), c) (u, b)
h -<< (((s
s', b
x'), b
y'), c
z)

natrec :: (ArrowApply arr, ArrowChoice arr) => arr (((s, Int), arr s (t, b)), arr ((s, Int), b) (t, b)) (t, b)
natrec :: forall (arr :: * -> * -> *) s t b.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, Int), arr s (t, b)), arr ((s, Int), b) (t, b)) (t, b)
natrec = proc (((s
s, Int
n), arr s (t, b)
f), arr ((s, Int), b) (t, b)
g) -> 
  if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 
    then arr s (t, b)
f -<< s
s
    else do
      (t
_, b
res) <- forall (arr :: * -> * -> *) s t b.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, Int), arr s (t, b)), arr ((s, Int), b) (t, b)) (t, b)
natrec -< (((s
s, Int
n forall a. Num a => a -> a -> a
- Int
1), arr s (t, b)
f), arr ((s, Int), b) (t, b)
g)
      arr ((s, Int), b) (t, b)
g -<< ((s
s, Int
n), b
res)

listrec :: (ArrowApply arr, ArrowChoice arr) => arr (((s, [a]), arr s (t, b)), arr ((s, a), b) (t, b)) (t, b)
listrec :: forall (arr :: * -> * -> *) s a t b.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, [a]), arr s (t, b)), arr ((s, a), b) (t, b)) (t, b)
listrec = proc (((s
s, [a]
xs), arr s (t, b)
f), arr ((s, a), b) (t, b)
g) ->
  case [a]
xs of
    [] -> arr s (t, b)
f -<< s
s
    a
x:[a]
xt -> do
      (t
_, b
res) <- forall (arr :: * -> * -> *) s a t b.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, [a]), arr s (t, b)), arr ((s, a), b) (t, b)) (t, b)
listrec -< (((s
s, [a]
xt), arr s (t, b)
f), arr ((s, a), b) (t, b)
g)
      arr ((s, a), b) (t, b)
g -<< ((s
s, a
x), b
res)

data CLROption arr s u 
  = Stop (arr s u)
  | Recurse (arr s s) (arr u u)

condlinrec :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [(arr s (t, Bool), CLROption arr s u)]), CLROption arr s u) u 
condlinrec :: forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr
  ((s, [(arr s (t, Bool), CLROption arr s u)]), CLROption arr s u) u
condlinrec = proc ((s
s, [(arr s (t, Bool), CLROption arr s u)]
ps), CLROption arr s u
dft) -> do
  CLROption arr s u
opt <- forall (arr :: * -> * -> *) s t a.
(ArrowApply arr, ArrowChoice arr) =>
arr (s, [(arr s (t, Bool), a)], a) a
chooseA -< (s
s, [(arr s (t, Bool), CLROption arr s u)]
ps, CLROption arr s u
dft)
  case CLROption arr s u
opt of
    Stop arr s u
f -> arr s u
f -<< s
s
    Recurse arr s s
f arr u u
g -> do
      s
s' <- arr s s
f -<< s
s
      u
res <- forall (arr :: * -> * -> *) s t u.
(ArrowApply arr, ArrowChoice arr) =>
arr
  ((s, [(arr s (t, Bool), CLROption arr s u)]), CLROption arr s u) u
condlinrec -< ((s
s', [(arr s (t, Bool), CLROption arr s u)]
ps), CLROption arr s u
dft)
      arr u u
g -<< u
res

times :: (ArrowApply arr, ArrowChoice arr) => arr ((s, Int), arr s s) s
times :: forall (arr :: * -> * -> *) s.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, Int), arr s s) s
times = proc ((s
s, Int
n), arr s s
f) -> 
  if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0
    then forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< s
s
    else do
      s
s' <- arr s s
f -<< s
s
      forall (arr :: * -> * -> *) s.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, Int), arr s s) s
times -< ((s
s', Int
n forall a. Num a => a -> a -> a
- Int
1), arr s s
f)

step :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [a]), arr (s, a) s) s
step :: forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) s) s
step = proc ((s
s, [a]
xs), arr (s, a) s
f) ->
  case [a]
xs of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< s
s
    a
x:[a]
xt -> do
      s
s' <- arr (s, a) s
f -<< (s
s, a
x)
      forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) s) s
step -< ((s
s', [a]
xt), arr (s, a) s
f)

step2 :: (ArrowApply arr, ArrowChoice arr) => arr (((s, [a]), [b]), arr ((s, a), b) s) s
step2 :: forall (arr :: * -> * -> *) s a b.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, [a]), [b]), arr ((s, a), b) s) s
step2 = ( \(((s
s, [a]
xs), [b]
ys), arr ((s, a), b) s
f) -> ((s
s, forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) [a]
xs [b]
ys), ( \(s
t, (a
x, b
y)) -> ((s
t, a
x), b
y) ) forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> arr ((s, a), b) s
f) ) forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) s) s
step

map :: Arrow arr => arr ((s, [a]), (s, a) -> (t, b)) (s, [b])
map :: forall (arr :: * -> * -> *) s a t b.
Arrow arr =>
arr ((s, [a]), (s, a) -> (t, b)) (s, [b])
map = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, [a]
xs), (s, a) -> (t, b)
f) -> (s
s, forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\a
x -> forall a b. (a, b) -> b
snd ((s, a) -> (t, b)
f (s
s, a
x))) [a]
xs)

mapS :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [a]), arr (s, a) (s, b)) (s, [b])
mapS :: forall (arr :: * -> * -> *) s a b.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (s, b)) (s, [b])
mapS = proc ((s
s, [a]
xs), arr (s, a) (s, b)
f) ->
  case [a]
xs of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, [])
    a
x:[a]
xt -> do
      (s
s', b
y) <- arr (s, a) (s, b)
f -<< (s
s, a
x)
      (s
s'', [b]
yt) <- forall (arr :: * -> * -> *) s a b.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (s, b)) (s, [b])
mapS -< ((s
s', [a]
xt), arr (s, a) (s, b)
f)
      forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s'', b
yforall a. a -> [a] -> [a]
:[b]
yt)

filter :: Arrow arr => arr ((s, [a]), (s, a) -> (t, Bool)) (s, [a])
filter :: forall (arr :: * -> * -> *) s a t.
Arrow arr =>
arr ((s, [a]), (s, a) -> (t, Bool)) (s, [a])
filter = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, [a]
xs), (s, a) -> (t, Bool)
f) -> (s
s, forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (\a
x -> forall a b. (a, b) -> b
snd ((s, a) -> (t, Bool)
f (s
s, a
x))) [a]
xs)

filterS :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [a]), arr (s, a) (s, Bool)) (s, [a])
filterS :: forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (s, Bool)) (s, [a])
filterS = proc ((s
s, [a]
xs), arr (s, a) (s, Bool)
f) -> 
  case [a]
xs of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, [])
    a
x:[a]
xt -> do
      (s
s', Bool
b) <- arr (s, a) (s, Bool)
f -<< (s
s, a
x)
      (s
s'', [a]
yt) <- forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (s, Bool)) (s, [a])
filterS -< ((s
s', [a]
xt), arr (s, a) (s, Bool)
f)
      forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s'', if Bool
b then a
xforall a. a -> [a] -> [a]
:[a]
yt else [a]
yt)

split :: Arrow arr => arr ((s, [a]), (s, a) -> (t, Bool)) ((s, [a]), [a])
split :: forall (arr :: * -> * -> *) s a t.
Arrow arr =>
arr ((s, [a]), (s, a) -> (t, Bool)) ((s, [a]), [a])
split = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \((s
s, [a]
xs), (s, a) -> (t, Bool)
f) ->
  let ([a]
trues, [a]
falses) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\a
x -> forall a b. (a, b) -> b
snd ((s, a) -> (t, Bool)
f (s
s, a
x))) [a]
xs
  in ((s
s, [a]
falses), [a]
trues)

splitS :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [a]), arr (s, a) (s, Bool)) ((s, [a]), [a])
splitS :: forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (s, Bool)) ((s, [a]), [a])
splitS = proc ((s
s, [a]
xs), arr (s, a) (s, Bool)
f) ->
  case [a]
xs of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((s
s, []), [])
    a
x:[a]
xt -> do
      (s
s', Bool
b) <- arr (s, a) (s, Bool)
f -<< (s
s, a
x)
      ((s
s'', [a]
falses), [a]
trues) <- forall (arr :: * -> * -> *) s a.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (s, Bool)) ((s, [a]), [a])
splitS -< ((s
s', [a]
xt), arr (s, a) (s, Bool)
f)
      forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< if Bool
b then ((s
s'', [a]
falses), a
xforall a. a -> [a] -> [a]
:[a]
trues) else ((s
s'', a
xforall a. a -> [a] -> [a]
:[a]
falses), [a]
trues) 

any :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [a]), arr (s, a) (t, Bool)) (s, Bool)
any :: forall (arr :: * -> * -> *) s a t.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (t, Bool)) (s, Bool)
any = proc ((s
s, [a]
xs), arr (s, a) (t, Bool)
f) -> 
  case [a]
xs of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, Bool
False)
    a
x:[a]
xt -> do
      (t
_, Bool
b) <- arr (s, a) (t, Bool)
f -<< (s
s, a
x)
      if Bool
b 
        then forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, Bool
True) 
        else forall (arr :: * -> * -> *) s a t.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (t, Bool)) (s, Bool)
any -< ((s
s, [a]
xt), arr (s, a) (t, Bool)
f)

all :: (ArrowApply arr, ArrowChoice arr) => arr ((s, [a]), arr (s, a) (t, Bool)) (s, Bool)
all :: forall (arr :: * -> * -> *) s a t.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (t, Bool)) (s, Bool)
all = proc ((s
s, [a]
xs), arr (s, a) (t, Bool)
f) ->
  case [a]
xs of
    [] -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, Bool
True)
    a
x:[a]
xt -> do
      (t
_, Bool
b) <- arr (s, a) (t, Bool)
f -<< (s
s, a
x)
      if Bool
b
        then forall (arr :: * -> * -> *) s a t.
(ArrowApply arr, ArrowChoice arr) =>
arr ((s, [a]), arr (s, a) (t, Bool)) (s, Bool)
all -< ((s
s, [a]
xt), arr (s, a) (t, Bool)
f)
        else forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, Bool
False)

zipwith :: Arrow arr => arr (((s, [a]), [b]), ((s, a), b) -> (t, c)) (s, [c])
zipwith :: forall (arr :: * -> * -> *) s a b t c.
Arrow arr =>
arr (((s, [a]), [b]), ((s, a), b) -> (t, c)) (s, [c])
zipwith = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr \(((s
s, [a]
xs), [b]
ys), ((s, a), b) -> (t, c)
f) -> (s
s, forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith (\a
x b
y -> forall a b. (a, b) -> b
snd (((s, a), b) -> (t, c)
f ((s
s, a
x), b
y))) [a]
xs [b]
ys)

zipwithS :: (ArrowApply arr, ArrowChoice arr) => arr (((s, [a]), [b]), arr ((s, a), b) (s, c)) (s, [c])
zipwithS :: forall (arr :: * -> * -> *) s a b c.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, [a]), [b]), arr ((s, a), b) (s, c)) (s, [c])
zipwithS = proc (((s
s, [a]
xs), [b]
ys), arr ((s, a), b) (s, c)
f) -> 
  case ([a]
xs, [b]
ys) of
    ([], [b]
_) -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, [])
    ([a]
_, []) -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (s
s, [])
    (a
x:[a]
xt, b
y:[b]
yt) -> do
      (s
s', c
z) <- arr ((s, a), b) (s, c)
f -<< ((s
s, a
x), b
y)
      (s
s'', [c]
zt) <- forall (arr :: * -> * -> *) s a b c.
(ArrowApply arr, ArrowChoice arr) =>
arr (((s, [a]), [b]), arr ((s, a), b) (s, c)) (s, [c])
zipwithS -< (((s
s', [a]
xt), [b]
yt), arr ((s, a), b) (s, c)
f)
      forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -<< (s
s'', c
zforall a. a -> [a] -> [a]
:[c]
zt)