update Parser module

Author: linerlock

hs-src/Language/Egison.hs

@@ -7,6 +7,8 @@ module Language.Egison
        , counter --danger
        , loadLibraries
        , loadPrimitives
+       , loadEgisonFile
+       , loadEgisonLibrary
        , evalEgisonExpr
        , evalEgisonTopExpr
        , evalEgisonTopExprs
@@ -68,6 +70,12 @@ loadLibraries env = do
 loadPrimitives :: Env -> IO Env
 loadPrimitives env = (++) <$> return env <*> primitiveEnv
 
+loadEgisonFile :: Env -> FilePath -> IO (Either EgisonError Env)
+loadEgisonFile env path = modifyCounter $ runEgisonM $ loadFile path >>= evalTopExprs env
+
+loadEgisonLibrary :: Env -> FilePath -> IO (Either EgisonError Env)
+loadEgisonLibrary env path = modifyCounter $ runEgisonM $ loadLibraryFile path >>= evalTopExprs env
+
 evalEgisonExpr :: Env -> EgisonExpr -> IO (Either EgisonError EgisonValue)
 evalEgisonExpr env expr = modifyCounter $ runEgisonM $ evalExpr' env expr
 
@@ -78,10 +86,7 @@ evalEgisonTopExprs :: Env -> [EgisonTopExpr] -> IO (Either EgisonError Env)
 evalEgisonTopExprs env exprs = modifyCounter $ runEgisonM $ evalTopExprs env exprs
 
 runEgisonTopExpr :: Env -> String -> IO (Either EgisonError Env)
-runEgisonTopExpr env input = modifyCounter $ runEgisonM $ liftEgisonM (readTopExpr input) >>= evalTopExpr env
+runEgisonTopExpr env input = modifyCounter $ runEgisonM $ readTopExpr input >>= evalTopExpr env
 
 runEgisonTopExprs :: Env -> String -> IO (Either EgisonError Env)
-runEgisonTopExprs env input = modifyCounter $ runEgisonM $ liftEgisonM (readTopExprs input) >>= evalTopExprs env
-
-
-
+runEgisonTopExprs env input = modifyCounter $ runEgisonM $ readTopExprs input >>= evalTopExprs env

hs-src/Language/Egison/Core.hs

@@ -67,21 +67,6 @@ evalTopExpr env (Execute argv) = do
 evalTopExpr env (Load file) = loadLibraryFile file >>= evalTopExprs env
 evalTopExpr env (LoadFile file) = loadFile file >>= evalTopExprs env
 
-loadFile :: FilePath -> EgisonM [EgisonTopExpr]
-loadFile file = do
-  doesExist <- liftIO $ doesFileExist file
-  unless doesExist $ throwError $ strMsg ("file does not exist: " ++ file)
-  input <- liftIO $ readFile file
-  exprs <-  liftEgisonM $ readTopExprs input
-  concat <$> mapM recursiveLoad exprs
- where
-  recursiveLoad (Load file) = loadLibraryFile file
-  recursiveLoad (LoadFile file) = loadFile file
-  recursiveLoad expr = return [expr]
-
-loadLibraryFile :: FilePath -> EgisonM [EgisonTopExpr]
-loadLibraryFile file = liftIO (getDataFileName file) >>= loadFile
-
 evalExpr :: Env -> EgisonExpr -> EgisonM WHNFData
 evalExpr _ (CharExpr c) = return . Value $ Char c
 evalExpr _ (StringExpr s) = return . Value $ String s 

hs-src/Language/Egison/Parser.hs

@@ -2,22 +2,28 @@ module Language.Egison.Parser
        ( readTopExprs
        , readTopExpr
        , readExprs
-       , readExpr 
+       , readExpr
+       , loadFile
+       , loadLibraryFile
        , parseTopExprs
        , parseTopExpr
        , parseExprs
        , parseExpr ) where
 
-import Control.Monad.Identity
-import Control.Monad.Error
-import Control.Monad.State
+import Prelude hiding (mapM)
+import Control.Monad.Identity hiding (mapM)
+import Control.Monad.Error hiding (mapM)
+import Control.Monad.State hiding (mapM)
 import Control.Applicative ((<$>), (<*>), (*>), (<*), pure)
 
+import System.Directory (doesFileExist)
+
 import qualified Data.Sequence as Sq
 import Data.Either
 import Data.Set (Set)
 import Data.Char (isLower, isUpper)
 import qualified Data.Set as Set
+import Data.Traversable (mapM)
 
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy.Char8 ()
@@ -29,24 +35,40 @@ import qualified Text.Parsec.Token as P
 
 import Language.Egison.Types
 import Language.Egison.Desugar
+import Paths_egison (getDataFileName)
 
 doParse :: Parser a -> String -> Either EgisonError a
 doParse p input = either (throwError . fromParsecError) return $ parse p "egison" $ B.pack input
   where
     fromParsecError :: ParseError -> EgisonError
     fromParsecError = Parser . show
 
-readTopExprs :: String -> Fresh (Either EgisonError [EgisonTopExpr])
-readTopExprs = runDesugarM . either throwError (mapM desugarTopExpr) . parseTopExprs
+readTopExprs :: String -> EgisonM [EgisonTopExpr]
+readTopExprs = liftEgisonM . runDesugarM . either throwError (mapM desugarTopExpr) . parseTopExprs
+
+readTopExpr :: String -> EgisonM EgisonTopExpr
+readTopExpr = liftEgisonM . runDesugarM . either throwError desugarTopExpr . parseTopExpr
 
-readTopExpr :: String -> Fresh (Either EgisonError EgisonTopExpr)
-readTopExpr = runDesugarM . either throwError desugarTopExpr . parseTopExpr
+readExprs :: String -> EgisonM [EgisonExpr]
+readExprs = liftEgisonM . runDesugarM . either throwError (mapM desugar) . parseExprs
 
-readExprs :: String -> Fresh (Either EgisonError [EgisonExpr])
-readExprs = runDesugarM . either throwError (mapM desugar) . parseExprs
+readExpr :: String -> EgisonM EgisonExpr
+readExpr = liftEgisonM . runDesugarM . either throwError desugar . parseExpr
+
+loadFile :: FilePath -> EgisonM [EgisonTopExpr]
+loadFile file = do
+  doesExist <- liftIO $ doesFileExist file
+  unless doesExist $ throwError $ strMsg ("file does not exist: " ++ file)
+  input <- liftIO $ readFile file
+  exprs <- readTopExprs input
+  concat <$> mapM  recursiveLoad exprs
+ where
+  recursiveLoad (Load file) = loadLibraryFile file
+  recursiveLoad (LoadFile file) = loadFile file
+  recursiveLoad expr = return [expr]
 
-readExpr :: String -> Fresh (Either EgisonError EgisonExpr)
-readExpr = runDesugarM . either throwError desugar . parseExpr
+loadLibraryFile :: FilePath -> EgisonM [EgisonTopExpr]
+loadLibraryFile file = liftIO (getDataFileName file) >>= loadFile
 
 parseTopExprs :: String -> Either EgisonError [EgisonTopExpr]
 parseTopExprs = doParse $ whiteSpace >> endBy topExpr whiteSpace