egison 3.0.5 → 3.0.6

raw patch · 10 files changed

+121/−130 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• benchmark/Benchmark-Collection.hs +0/−30
• benchmark/Benchmark.hs +9/−9
• egison.cabal +2/−8
• hs-src/Interpreter/egisoni.hs +11/−5
• hs-src/Language/Egison.hs +15/−11
• hs-src/Language/Egison/Core.hs +3/−21
• hs-src/Language/Egison/Desugar.hs +0/−3
• hs-src/Language/Egison/Parser.hs +44/−19
• hs-src/Language/Egison/Types.hs +20/−7
• test/UnitTest.hs +17/−17

@@ -1,30 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Main where-import Control.Applicative ((<$>), (<*>))-import Control.Monad.Error-import Control.Applicative-import Control.DeepSeq (NFData(rnf))-import Criterion.Main-import Criterion.Config-import Text.Parsec-import Text.Parsec.ByteString--import Language.Egison--runEgisonFile :: String -> IO (Either EgisonError Env)-runEgisonFile path = do-  env <- loadPrimitives nullEnv >>= loadLibraries-  evalEgisonTopExpr env $ LoadFile path--config :: Config-config = defaultConfig { cfgSamples   = ljust 3 -                       , cfgPerformGC = ljust True }--main :: IO ()-main = defaultMainWith config (return ()) [-    bgroup "collection" [ bench "cons-bench" $ runEgisonFile "benchmark/collection-bench-cons.egi"-                        , bench "cons-bench-large" $ runEgisonFile "benchmark/collection-bench-cons-large.egi"-                        , bench "snoc-bench" $ runEgisonFile "benchmark/collection-bench-snoc.egi"-                        ]-  ]-

@@ -6,22 +6,22 @@ import Control.DeepSeq (NFData(rnf)) import Criterion.Main import Criterion.Config-import Text.Parsec-import Text.Parsec.ByteString- import Language.Egison  runEgisonFile :: String -> IO (Either EgisonError Env)-runEgisonFile path = do-  env <- loadPrimitives nullEnv >>= loadLibraries-  evalEgisonTopExpr env $ LoadFile path+runEgisonFile path = loadPrimitives nullEnv >>= loadLibraries >>= flip loadEgisonFile path  config :: Config config = defaultConfig { cfgSamples   = ljust 3                         , cfgPerformGC = ljust True }  main :: IO ()-main = defaultMainWith config (return ()) [-    bgroup "fact" [ bench "30000" $ runEgisonFile "benchmark/fact-30000.egi" ]-  ]+main = defaultMainWith config (return ()) +       [ bgroup "fact" [ bench "30000" $ runEgisonFile "benchmark/fact-30000.egi" ]+       , bgroup "collection"  +         [ bench "cons-bench" $ runEgisonFile "benchmark/collection-bench-cons.egi"+         , bench "cons-bench-large" $ runEgisonFile "benchmark/collection-bench-cons-large.egi"+         , bench "snoc-bench" $ runEgisonFile "benchmark/collection-bench-snoc.egi"+         ]+       ] 

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.0.5+Version:             3.0.6 Synopsis:            An Interpreter for the Programming Language Egison Description:         An interpreter for the programming language Egison.                      A feature of Egison is the strong pattern match facility.@@ -46,13 +46,7 @@   Type: exitcode-stdio-1.0   Hs-Source-Dirs:  benchmark   Main-Is: Benchmark.hs-  Build-Depends: egison, base >= 4.0 && < 5, deepseq, criterion >= 0.5, transformers, mtl, parsec >= 3.0--Benchmark benchmark-collection-  Type: exitcode-stdio-1.0-  Hs-Source-Dirs:  benchmark-  Main-Is: Benchmark-Collection.hs-  Build-Depends: egison, base >= 4.0 && < 5, deepseq, criterion >= 0.5, transformers, mtl, parsec >= 3.0+  Build-Depends: egison, base >= 4.0 && < 5, deepseq, criterion >= 0.5, transformers, mtl  Executable egison   Main-is:             egisoni.hs

@@ -6,9 +6,6 @@ import Data.Version import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy.Char8 ()-import qualified Data.ByteString.Lazy.Char8 as B-import Text.Parsec-import Text.Parsec.ByteString.Lazy import Text.Regex.Posix  import System.Environment@@ -63,7 +60,7 @@   Option ['p'] ["prompt"]     (ReqArg (\prompt opts -> opts {optPrompt = prompt})             "String")-    "output file to write"+    "prompt string"   ]  printHelp :: IO ()@@ -110,10 +107,19 @@         Just "" ->  loop env prompt ""         Just input' -> do           let newInput = rest ++ input'-          result <- liftIO $ runEgisonTopExprs env newInput+          result <- liftIO $ runEgisonTopExpr env newInput           case result of             Left err | show err =~ "unexpected end of input" -> do               loop env (take (length prompt) (repeat ' ')) $ newInput ++ "\n"+            Left err | show err =~ "expecting (top-level|\"define\")" -> do+              result <- liftIO $ fromEgisonM (readExpr newInput) >>= either (return . Left) (evalEgisonExpr env)+              case result of+                Left err -> do+                  liftIO $ putStrLn $ show err+                  loop env prompt ""+                Right val -> do+                  liftIO $ putStrLn $ show val+                  loop env prompt ""             Left err -> do               liftIO $ putStrLn $ show err               loop env prompt ""

@@ -5,8 +5,11 @@        , module Language.Egison.Primitives        , version        , counter --danger+       , fromEgisonM        , loadLibraries        , loadPrimitives+       , loadEgisonFile+       , loadEgisonLibrary        , evalEgisonExpr        , evalEgisonTopExpr        , evalEgisonTopExprs@@ -20,11 +23,6 @@ import System.IO.Unsafe (unsafePerformIO) import Data.IORef import Data.Version-import Data.ByteString.Lazy (ByteString)-import Data.ByteString.Lazy.Char8 ()-import qualified Data.ByteString.Lazy.Char8 as B-import Text.Parsec-import Text.Parsec.ByteString.Lazy import qualified Paths_egison as P  import Language.Egison.Types@@ -69,10 +67,19 @@                 , "lib/core/collection.egi"                 , "lib/core/number.egi"                 , "lib/core/pattern.egi" ]-                ++fromEgisonM :: EgisonM a -> IO (Either EgisonError a)+fromEgisonM = modifyCounter . runEgisonM+ 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 @@ -83,10 +90,7 @@ 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

@@ -22,7 +22,6 @@ import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -import Text.Parsec.ByteString.Lazy (parseFromFile) import System.Directory (doesFileExist)  import Language.Egison.Types@@ -51,7 +50,7 @@         exprs' <- loadFile file         collectDefs (exprs' ++ exprs) bindings rest       _ -> collectDefs exprs bindings (expr : rest)-  collectDefs [] bindings rest = return (bindings, rest)+  collectDefs [] bindings rest = return (bindings, reverse rest)  evalTopExpr :: Env -> EgisonTopExpr -> EgisonM Env evalTopExpr env (Define name expr) = recursiveBind env [(name, expr)]@@ -68,21 +67,6 @@ 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 @@ -389,8 +373,6 @@ processMState' (MState env loops bindings ((MAtom pattern target matcher):trees)) = do   let env' = extendEnv env (bindings ++ map (\(LoopContext binding _ _ _) -> binding) loops)   case pattern of-    WildCard -> return $ msingleton $ MState env loops bindings trees -         VarPat _ -> throwError $ strMsg "cannot use variable except in pattern function"     ApplyPat func args -> do       func <- evalExpr env' func@@ -450,8 +432,8 @@       case matcher of         Value Something ->            case pattern of-            PatVar name -> do-              return $ msingleton $ MState env loops ((name, target):bindings) trees+            WildCard -> return $ msingleton $ MState env loops bindings trees +            PatVar name -> return $ msingleton $ MState env loops ((name, target):bindings) trees             IndexedPat (PatVar name) indices -> do               indices <- mapM (evalExpr env' >=> liftError . liftM fromInteger . fromIntegerValue) indices               case lookup name bindings of

@@ -16,9 +16,6 @@ newtype DesugarM a = DesugarM { unDesugarM :: ReaderT Subst (ErrorT EgisonError Fresh) a }   deriving (Functor, Applicative, Monad, MonadError EgisonError, MonadFresh, MonadReader Subst) -instance MonadFresh (ReaderT Subst (ErrorT EgisonError Fresh)) where-  fresh = lift $ lift $ fresh- runDesugarM :: DesugarM a -> Fresh (Either EgisonError a) runDesugarM = runErrorT . flip runReaderT [] . unDesugarM 

@@ -2,22 +2,28 @@        ( 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,22 +35,41 @@  import Language.Egison.Types import Language.Egison.Desugar+import Paths_egison (getDataFileName)    doParse :: Parser a -> String -> Either EgisonError a-doParse p input = either (throwError . Parser) return $ parse p "egison" $ B.pack input+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 -> Fresh (Either EgisonError EgisonTopExpr)-readTopExpr = runDesugarM . either throwError desugarTopExpr . parseTopExpr+readTopExpr :: String -> EgisonM EgisonTopExpr+readTopExpr = liftEgisonM . runDesugarM . either throwError desugarTopExpr . parseTopExpr -readExprs :: String -> Fresh (Either EgisonError [EgisonExpr])-readExprs = runDesugarM . either throwError (mapM desugar) . parseExprs+readExprs :: String -> EgisonM [EgisonExpr]+readExprs = liftEgisonM . runDesugarM . either throwError (mapM desugar) . parseExprs -readExpr :: String -> Fresh (Either EgisonError EgisonExpr)-readExpr = runDesugarM . either throwError desugar . parseExpr+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]++loadLibraryFile :: FilePath -> EgisonM [EgisonTopExpr]+loadLibraryFile file = liftIO (getDataFileName file) >>= loadFile+ parseTopExprs :: String -> Either EgisonError [EgisonTopExpr] parseTopExprs = doParse $ whiteSpace >> endBy topExpr whiteSpace @@ -63,11 +88,11 @@  topExpr :: Parser EgisonTopExpr topExpr = parens (defineExpr-                  <|> testExpr-                  <|> executeExpr-                  <|> loadFileExpr-                  <|> loadExpr-                  <?> "top-level expression")+              <|> testExpr+              <|> executeExpr+              <|> loadFileExpr+              <|> loadExpr)+      <?> "top-level expression"  defineExpr :: Parser EgisonTopExpr defineExpr = keywordDefine >> Define <$> varName <*> expr@@ -113,7 +138,7 @@                          <|> generateArrayExpr                          <|> arraySizeExpr                          <|> arrayRefExpr)-                         <?> "expression")+             <?> "expression")  varExpr :: Parser EgisonExpr varExpr = VarExpr <$> ident

@@ -7,9 +7,12 @@ import Control.Applicative import Control.Monad.Error import Control.Monad.State+import Control.Monad.Reader (ReaderT)+import Control.Monad.Writer (WriterT) import Control.Monad.Identity import Control.Monad.Trans.Maybe +import Data.Monoid (Monoid) import Data.Foldable (foldr, toList) import qualified Data.Sequence as Sq import Data.Sequence (Seq)@@ -18,8 +21,6 @@ import qualified Data.HashMap.Strict as HashMap  import System.IO-import Text.Parsec (ParseError)- import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap @@ -288,18 +289,18 @@ --  data EgisonError =-    Parser ParseError-  | UnboundVariable Var+    UnboundVariable Var   | TypeMismatch String WHNFData   | ArgumentsNum Int Int   | NotImplemented String   | Assertion String   | Match String+  | Parser String   | Desugar String   | Default String      instance Show EgisonError where-  show (Parser error) = "Parse error at: " ++ show error+  show (Parser error) = "Parse error at: " ++ error   show (UnboundVariable var) = "Unbound variable: " ++ var   show (TypeMismatch expected found) = "Expected " ++  expected ++                                         ", but found: " ++ show found@@ -340,7 +341,19 @@ instance (MonadState s m) => MonadState s (FreshT m) where   get = lift $ get   put s = lift $ put s-  ++instance (MonadFresh m) => MonadFresh (StateT s m) where+  fresh = lift $ fresh++instance (MonadFresh m, Error e) => MonadFresh (ErrorT e m) where+  fresh = lift $ fresh++instance (MonadFresh m, Monoid e) => MonadFresh (ReaderT e m) where+  fresh = lift $ fresh++instance (MonadFresh m, Monoid e) => MonadFresh (WriterT e m) where+  fresh = lift $ fresh+ instance MonadIO (FreshT IO) where   liftIO = lift @@ -352,7 +365,7 @@  newtype EgisonM a = EgisonM {     unEgisonM :: ErrorT EgisonError (FreshT IO) a-  } deriving (Functor, Applicative, Monad, MonadIO, MonadError EgisonError)+  } deriving (Functor, Applicative, Monad, MonadIO, MonadError EgisonError, MonadFresh)  runEgisonM :: EgisonM a -> FreshT IO (Either EgisonError a) runEgisonM = runErrorT . unEgisonM

@@ -19,21 +19,21 @@   defaultMain $ hUnitTestToTests $ test $ map runTestCase testCases  runTestCase :: FilePath -> Test-runTestCase file = TestLabel file . TestCase $ do +runTestCase file = TestLabel file . TestCase $ do   env <- primitiveEnv >>= loadLibraries-  seed <- readIORef counter-  (result, seed') <- runFreshT seed $ runEgisonM $ loadFile file >>= evalTopExprs' env-  writeIORef counter seed'-  assertString $ either show (const "") result--evalTopExprs' :: Env -> [EgisonTopExpr] -> EgisonM ()-evalTopExprs' env exprs = do-  let (bindings, tests) = foldr collectDefsAndTests ([], []) exprs-  env <- recursiveBind env bindings-  forM_ tests $ evalExpr' env- where-  collectDefsAndTests (Define name expr) (bindings, tests) =-    ((name, expr) : bindings, tests)-  collectDefsAndTests (Test expr) (bindings, tests) =-    (bindings, expr : tests)-  collectDefsAndTests _ r = r+  assertEgisonM $ do+    exprs <- loadFile file+    let (bindings, tests) = foldr collectDefsAndTests ([], []) exprs+    env' <- recursiveBind env bindings+    forM_ tests $ evalExpr' env'+      where+        assertEgisonM :: EgisonM a -> Assertion+        assertEgisonM m = fromEgisonM m >>= assertString . either show (const "")+    +        collectDefsAndTests (Define name expr) (bindings, tests) =+          ((name, expr) : bindings, tests)+        collectDefsAndTests (Test expr) (bindings, tests) =+          (bindings, expr : tests)+        collectDefsAndTests _ r = r+  +