hfusion-0.0.5: HFusion/HFusion.hs

-- Please, see the file LICENSE for copyright and license information.

-- | Functions exported by this module can be used to fuse programs as shown below.
-- The following program reads some Haskell definitions from the standard input
-- and prints the transformed definitions to the standard output.
--
-- > import HFusion.HFusion
-- > import Control.Monad.Trans(lift)
-- > import Language.Haskell.Parser(parseModule)
--
-- > fuseProgram :: String -> Either FusionError String
-- > fuseProgram sourceCode = runFusionState newVarGen$
-- >    -- Parse input with a Haskell parser.
-- >    parseResult2FusionState (Language.Haskell.Parser.parseModule sourceCode) 
-- >    -- Convert the haskell AST to the AST used by HFusion.
-- >    >>= hsModule2HsSyn 
-- >    -- Fuse compositions in the program.
-- >    >>= \dfs -> lift (fuseDefinitions dfs dfs) 
-- >    -- Pretty print the result.
-- >    >>= return . hsSyn2HsSourceCode . uncurry (++)
-- >
-- >    main = do cs <- getContents
-- >              putStr$ either (("There was an error: "++) . show) id$ fuseProgram cs
--
-- For more information on HFusion please visit <http://www.fing.edu.uy/inco/proyectos/fusion>.
module HFusion.HFusion (
        hsModule2HsSyn --  :: HsModule -> FusionState [Def]
       ,deriveHylos --  :: [Def] -> IntState (([Def],FusionError),[HyloT])
       ,fuseDefinitions -- :: [Def] -> [Def] -> VarGenState [Def]
       ,fuse --  :: [HyloT] -> String -> Int -> String -> String -> FusionState [Def]
       ,fuse' --  :: String -> Int -> String -> [String] -> [HyloT] -> FusionState ([Def],String)
       ,hsSyn2HsSourceCode --  :: [Def] -> String
       -- * Auxiliary definitions 
       ,runFusionState --  :: VarGen -> FusionState a -> Either FusionError a
       ,FusionError(..)
       ,FusionState
       ,VarGen,newVarGen
       ,parseResult2FusionState --  :: ParseResult HsModule -> FusionState HsModule
       -- * Abstract syntax tree
       ,Def(..),Term(..),Pattern(..),Variable(..),Constructor,Literal(..),Boundvar(..)
    ) where

import HFusion.Internal.HsSyn hiding (Vars,VarsB,AlphaConvertible)
import HFusion.Internal.Parsing.Translator
import HFusion.Internal.Parsing.HyloParser
import HFusion.Internal.FuseEnvironment
import HFusion.Internal.FuseFace
import HFusion.Internal.HyloFace
import HFusion.Internal.Utils
import HFusion.Internal.Compositions
import Control.Monad.Trans(lift)
import Control.Monad(liftM2)
import Control.Arrow(first,(&&&))

-- | Fuses the composition of two recursive functions producing an equivalent 
-- new recursive function.
--
-- @fuse "f" 1 "g" [h_1 .. h_n] dfns@ yields a set of mutually recursive functions named @h_1 .. h_n@ which are equivalent to @f . g@. 
-- Functions @f@ and @g@ must be hylomorphisms defined in @dfns@.
--
-- @fuse "f" 2 "g" [h_1 .. h_n] dfns@ yields a recursive function equivalent to @\\x y -> f x (g y)@,
-- @fuse "f" 3 "g" [h_1 .. h_n] dfns@ yields a recursive function equivalent to @\\x y z -> f x y (g z)@,
-- and so on ...
fuse :: String -> Int -> String -> [String] -> [HyloT] -> FusionState [Def]
fuse nombre1 inArg nombre2 resultNames hylos = env2FusionState fuseHylos  >>= lift . inline >>= return . map polishDef
 where fuseHylos :: Env HyloT
       fuseHylos = do mapM_ insertFuseEnv hylos
                      fuseFuseEnv (map str2var resultNames) (str2var nombre1) inArg (str2var nombre2)

-- | Works like 'fuse' but returns also a string resembling the hylomorphism which represents
-- the result of fusion.
fuse' :: String -> Int -> String -> [String] -> [HyloT] -> FusionState ([Def],String)
fuse' nombre1 inArg nombre2 resultNames hylos = 
           env2FusionState fuseHylos  >>= lift . uncurry (liftM2 (,)) . (inline  &&& showHT)
           >>= return . first (map polishDef)
 where fuseHylos :: Env HyloT
       fuseHylos = do mapM_ insertFuseEnv hylos
                      fuseFuseEnv (map str2var resultNames) (str2var nombre1) inArg (str2var nombre2)

-- | Pretty prints a set of definitions into Haskell source code. 
hsSyn2HsSourceCode :: [Def] -> String
hsSyn2HsSourceCode = unlines . map ((++"\n").show . polishDef)