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 <https://lh3.googleusercontent.com/-I0LlQgLwcG0/Wh5p2MJD3hI/AAAAAAAAAA8/ed-vU64ra4sUCLjhtSKFtGnnu5uDft0HQCLcBGAs/s1600/works.png> 在 2017年11月27日星期一 UTC+8下午4:27:48,Dierk Koenig写道: > > Hi, > > could you post the code that did not compile but should? > > Cheers > Dierk > > sent from:mobile > > Am 27.11.2017 um 03:02 schrieb zhou...@163.com <javascript:>: > > 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. >> 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 :-) >> >> >> > Am 24.11.2017 um 10:23 schrieb 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写道: >> > 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 >> > >> > Am 24.11.2017 um 09:44 schrieb 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写道: >> >> Would be cool to add it to the stdlib. >> >> Care about a PR? Best add a sample as well. >> >> >> >> Cheers >> >> Dierk >> >> >> >> sent from:mobile >> >> >> >> Am 24.11.2017 um 02:33 schrieb 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 >> >>> >> >>> >> >>> >> >>> >> >>> >> >>> >> >>> -- >> >>> 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+unsubscr...@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+unsubscr...@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+unsubscr...@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+unsubscr...@googlegroups.com > <javascript:>. > 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+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.