Continuation transformer defined in Frege

[zhou...@163.com]

ContT is more pragmatic than Cont，with this powerful abstraction, I could effectively abstract away callbacks and listener in Android. My next exploration is to port coroutineT to Frege

module examples.MyCont where

class MonadIO m where

  --- Lift a computation from the 'IO' monad.

  liftIO :: IO a -> m a

class MonadTrans t where

  --- Lift a computation from the argument monad to the constructed monad.

  lift :: Monad m => m a -> t m a

instance MonadIO IO where

  liftIO io = io

instance MonadTrans (ContT r) where

    lift m = ContT (m >>=)

instance (Monad m, MonadIO m) => MonadIO (ContT r m) where

    liftIO = lift . liftIO

data ContT r m a = ContT { runContT :: (a -> m r) -> m r }

instance Monad (ContT r m) where

  pure x = contT ($ x)

  m >>= k = contT $ \c -> runContT m (\x -> runContT (k x) c)

contT :: ((a -> m r) -> m r) -> ContT r m a

contT f = ContT { runContT = f }

runContT :: ContT r m a -> ((a -> m r) -> m r)

runContT c = ContT.runContT c

callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a

callCC f = ContT $ \c -> ContT.runContT (f (\a -> ContT $ \_ -> c a)) c

data Data = native java.util.Date where

  native new :: () -> IO (MutableIO Data)

  native toString :: Mutable s Data -> ST s String

current :: IO String

current = do

  d <- Data.new ()

  d.toString

fun :: Int -> IO String

fun = (`runContT` id) $ do

  callCC $ \exit1 -> do

    exit1 $ liftIO current 

[Dierk König]

Would be cool to add it to the stdlib. 

Care about a PR? Best add a sample as well. 

Cheers

Dierk

sent from:mobile 

--
You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.
To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-l...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[zhou...@163.com]

I am just a junior of Haskell, I just copy Michael Chavinda‏'s android project and rewrite existing software. Due to non disclosure agreement, I can't have my own git account. I think google group is the right place I could contribute some code back to Frege. Because my supervisor can not trace my activity on google because of Chinese GFW

在 2017年11月24日星期五 UTC+8下午3:01:21，Dierk Koenig写道：

To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

[Dierk König]

Ok, that is perfectly fine. 

Then I do the PR on your behalf. 

I’d like to give you due credit, though. Is there a special name or nickname that you would like to see in a respective commit?

Dierk

sent from:mobile 

To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-l...@googlegroups.com.

[zhou...@163.com]

I still prefer my Chinese name Yu Zhou, I come from a none English speaking country. I still have great barrier understanding the culture of Frege group, what's the implied by PR on me as well as giving me due credit?
在 2017年11月24日星期五 UTC+8下午5:08:12，Dierk Koenig写道：

[Dierk König]

There are no official rules beyond what is common practice in the open-source community.
When a Pull Request is raised, one of the committers validates the quality and then merges into master.
When merging, the committer and the "author" can differ. You would be the author and visible as such in the repository.
This is to show that you are the cool dude that provided the content :-)

>>> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-l...@googlegroups.com.

>>> For more options, visit https://groups.google.com/d/optout.
>>
>> --
>> You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.

>> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-l...@googlegroups.com.

>> For more options, visit https://groups.google.com/d/optout.
>
> --
> You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.

> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-l...@googlegroups.com.

[zhou...@163.com]

Understand, I like your idea

在 2017年11月24日星期五 UTC+8下午5:59:22，Dierk Koenig写道：

>>> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

>>> For more options, visit https://groups.google.com/d/optout.
>>
>> --
>> You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.

>> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

>> For more options, visit https://groups.google.com/d/optout.
>
> --
> You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.

> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

[zhou...@163.com]

ContT monad transformer sucks , Maybe Frege's type class is not complete compatible with Haskell. The problem is the continuation variable can't be passed out of callCC block. So I decide to implement my continuation mechanism in JNI using scheme's call/cc 

在 2017年11月24日星期五 UTC+8下午5:59:22，Dierk Koenig写道：

There are no official rules beyond what is common practice in the open-source community.

>>> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

>>> For more options, visit https://groups.google.com/d/optout.
>>
>> --
>> You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.

>> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

>> For more options, visit https://groups.google.com/d/optout.
>
> --
> You received this message because you are subscribed to the Google Groups "Frege Programming Language" group.

> To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-language+unsub...@googlegroups.com.

[Dierk König]

Hi,

could you post the code that did not compile but should?

Cheers

Dierk

sent from:mobile 

To unsubscribe from this group and stop receiving emails from it, send an email to frege-programming-l...@googlegroups.com.

[zhou...@163.com]

Yes, the following two pictures reveal everything

在 2017年11月27日星期一 UTC+8下午4:27:48，Dierk Koenig写道：

[zhou...@163.com]

for fun6, I evaluate as

frege> fun6 3

(Monad a, MonadIO a) => a String

I hear ContT is belong to Haskell 98 standard, I wish Frege will support mtl library at next release. I love to program android with Frege, but without continuation mechanism, I can not handle the USB serial port communication naturely. I don't like the idea implementing it using JNI, so I implement my own co-routine library using Eta and called by Frege

在 2017年11月27日星期一 UTC+8下午4:27:48，Dierk Koenig写道：

Hi,

[zhou...@163.com]

It works like charm, it's my silly mistake. By replacing (`runContT` id) to (`runContT` return), Frege works just like Eta. I don't have to implement co-routine in Eta now. So I upload my whole source file, hope it helps

module examples.MyCont where

import Data.Char

import Control.Concurrent as C

class MonadIO m where

  --- Lift a computation from the 'IO' monad.

  liftIO :: IO a -> m a

class MonadTrans t where

  --- Lift a computation from the argument monad to the constructed monad.

  lift :: Monad m => m a -> t m a

instance MonadIO IO where

  liftIO io = io

instance MonadTrans (ContT r) where

    lift m = ContT (m >>=)

instance (Monad m, MonadIO m) => MonadIO (ContT r m) where

    liftIO = lift . liftIO

data ContT r m a = ContT { runContT :: (a -> m r) -> m r }

instance Functor (ContT r m) where

  fmap f m = ContT $ \c -> ContT.runContT m (c . f)

instance Applicative (ContT r m) where

  pure x = ContT ($ x)

  f <*> v = ContT $ \c -> ContT.runContT f $ \g -> ContT.runContT v (c . g)

  m *> k = m >>= \_ -> k

instance Monad (ContT r m) where

  pure x = ContT ($ x)

  m >>= k = ContT $ \c -> ContT.runContT m (\x -> ContT.runContT (k x) c)

callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a

callCC f = ContT $ \c -> ContT.runContT (f (\a -> ContT $ \_ -> c a)) c

data Date = native java.util.Date where

  native new :: () -> IO (MutableIO Date)

  native toString :: Mutable s Date -> ST s String

current :: IO String

current = do

  d <- Date.new ()

  d.toString

runContT = ContT.runContT

fun4 n = (`runContT` return) $ do

  str <- callCC $ \exit1 -> do

    d <- liftIO current

    when (n < 10) (exit1 $ d)

    let ns = map digitToInt (unpacked (show (n `div` 2)))

    n' <- callCC $ \exit2 -> do

      when ((length ns) < 3) (exit2 (length ns))

      when ((length ns) < 5) (exit2 n)

      when ((length ns) < 7) $ do

        let ns' = map intToDigit (reverse ns)

        exit1 $ packed $ (dropWhile (== '0') ns')

      return $ sum ns

    return $ "(ns = " ++ (show ns) ++ ") " ++ (show n')

  return $ "Answer: " ++ str

main = do

  fun4 9 >>= putStrLn

  fun4 199 >>= putStrLn

  fun4 19999 >>= putStrLn

  fun4 1999999 >>= putStrLn

  fun4 2000000 >>= putStrLn

  fun4 3000000 >>= putStrLn

  return ()

fun5 = (`runContT` return) $ do

  lift $ putStrLn "alpha"

  (k, num) <- callCC $ \k -> let f x = k (f, x)

                                 in return (f, 0)

  lift $ putStrLn "beta"

  lift $ putStrLn "gamma"

  if num < 5

    then k (num + 1) >> return ()

    else lift $ print num

fun6 n = (`runContT` return) $ do

  liftIO $ current

  callCC $ \exit1 -> do

    when (n < 10) (exit1 "< 10")

    return "> 10"

test6_1 = do

  fun6 10 >>= putStrLn

test6_2 = do

  fun6 4 >>= putStrLn

fun7 n = (`runContT` return) $ do

  callCC $ \exit1 -> do

    liftIO $ putStrLn "I am here!"

    when (n < 10) (exit1 3)

    return 4

test7_1 = do

  fun7 10 >>= putStrLn . show

test7_2 = do

  fun7 4 >>= putStrLn . show

here's the prove

在 2017年11月27日星期一 UTC+8下午4:27:48，Dierk Koenig写道：

Hi,