[clean-list] Combine two library versions in one executable?

[Tomasz Zielonka]

On Tue, Feb 22, 2005 at 11:00:50AM +0100, Erik Zuurbier wrote:
> Dear Cleaners,
> 
> I have a libray version that I consider semantically correct (actually it
> is a parser combinator library), but it is not optimally efficient.
> 
> And then I have a second version that exports exactly the same functions
> and types. This version is faster but considerably more complicated. But
> is it semantically correct?
> 
> I would like to test that by running a number of actual parsers, each compiled
> twice - with both library versions. Then I would like to compare the results
> and list the differences. Call it model checking if you like.
> 
> In Clean I see the following options:
> [...]

4) Introduce a third parser type with combinators that build both types
   of parsers. I managed to do something like this in Haskell for two
   libraries of monadic parser combinators - see the attached example.

   Usage example:

    tomek at green:~/lang/haskell/bimonad$ ghci-6.4.20050220
       ___         ___ _
      / _ \ /\  /\/ __(_)
     / /_\// /_/ / /  | |      GHC Interactive, version 6.4.20050220, for Haskell 98.
    / /_\\/ __  / /___| |      http://www.haskell.org/ghc/
    \____/\/ /_/\____/|_|      Type :? for help.

    Loading package base-1.0 ... linking ... done.
    Prelude> :l Bi
    Compiling Bi               ( Bi.hs, interpreted )
    Ok, modules loaded: Bi.

    *Bi> ReadPrec.readPrec_to_S (fst $ runBi $ test) 0 "123,456,7890"
    [(["123","456","7890"],"")]

    *Bi> Parsec.parse (snd $ runBi $ test) "?" "123,456,7890"
    Right ["123","456","7890"]

Best regards
Tomasz
-------------- next part --------------

module Bi where

import Control.Monad.Writer
import qualified Text.ParserCombinators.Parsec as Parsec
import qualified Text.Read as ReadPrec
import Text.ParserCombinators.Parsec (GenParser)
import Text.Read (ReadPrec)
import Char (isDigit)

newtype Bi m1 m2 a = Bi { runBi :: (m1 a, m2 a) }

instance (Monad m1, Monad m2) => Monad (Bi m1 m2) where
    return x = Bi (return x, return x)
    Bi (m1, m2) >>= f =
        Bi ( m1 >>= (fst . runBi . f), m2 >>= (snd . runBi . f) )

get :: Bi ReadPrec (GenParser Char ()) Char
get = Bi (ReadPrec.get, Parsec.anyChar)

choice :: [Bi ReadPrec (GenParser Char ()) a] -> Bi ReadPrec (GenParser Char ()) a
choice chs = Bi (ReadPrec.choice (map (fst . runBi) chs), Parsec.choice (map (snd . runBi) chs))

pfail :: Bi ReadPrec (GenParser Char ()) a
pfail = Bi (ReadPrec.pfail, Parsec.pzero)

try :: Bi ReadPrec (GenParser Char ()) a -> Bi ReadPrec (GenParser Char ()) a
try (Bi (f, s)) = Bi (f, Parsec.try s)

eof :: Bi ReadPrec (GenParser Char ()) ()
eof = Bi ((ReadPrec.look >>= \cs -> when (not (null cs)) ReadPrec.pfail), Parsec.eof)

test = do
    l <- number `sepBy1` char ','
    eof
    return l
  where
    digit = try $ do
        c <- get
        when (not (isDigit c)) pfail
        return c

    number = many1 digit

    char c = try $ do
        c' <- get
        when (c /= c') pfail
        return c

    sepBy1 p sep = do
        x <- p
        choice
            [ do
                sep
                xs <- sepBy p sep
                return (x : xs)
            , return [x]
            ]

    sepBy p sep = do
        choice
            [ do
                x <- p
                choice
                    [ do
                        sep
                        xs <- sepBy p sep
                        return (x : xs)
                    , do
                        return [x]
                    ]
            , return []
            ]

    many1 p = do
        x <- p
        xs <- many p
        return (x : xs)

    many p = do
        choice
            [ do
                x <- p
                xs <- many p
                return (x : xs)
            , do
                return []
            ]