egison 3.2.11 → 3.2.12

raw patch · 11 files changed

+113/−24 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +2/−2
• hs-src/Interpreter/egisoni.hs +4/−1
• hs-src/Language/Egison.hs +1/−0
• hs-src/Language/Egison/Core.hs +11/−3
• hs-src/Language/Egison/Parser.hs +7/−1
• hs-src/Language/Egison/Primitives.hs +31/−15
• hs-src/Language/Egison/Types.hs +2/−1
• lib/core/base.egi +2/−0
• lib/core/collection.egi +1/−1
• lib/core/io.egi +40/−0
• lib/core/string.egi +12/−0

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.2.11+Version:             3.2.12 Synopsis:            Programming language with non-linear pattern-matching against unfree data types Description:         An interpreter for Egison, the programming langugage that realized non-linear pattern-matching with unfree data types.                      With Egison, you can represent pattern-matching with unfree data types intuitively,@@ -17,7 +17,7 @@  Extra-Source-Files:  benchmark/Benchmark.hs -Data-files:          lib/core/base.egi lib/core/collection.egi lib/core/order.egi lib/core/number.egi lib/core/natural-number.egi lib/core/string.egi lib/core/database.egi+Data-files:          lib/core/base.egi lib/core/collection.egi lib/core/order.egi lib/core/number.egi lib/core/natural-number.egi lib/core/string.egi lib/core/database.egi lib/core/io.egi                      lib/tree/xml.egi lib/math/prime.egi                      elisp/egison-mode.el 

@@ -10,6 +10,9 @@ import Control.Applicative ((<$>), (<*>)) import Control.Monad.Error +import Data.Sequence (Seq, ViewL(..), ViewR(..), (><))+import qualified Data.Sequence as Sq+ import Data.Version import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy.Char8 ()@@ -44,7 +47,7 @@                             either print (const $ return ()) result                           Options {optLoadOnly = False} -> do                             env <- primitiveEnv >>= loadLibraries-                            result <- evalEgisonTopExprs env [LoadFile file, Execute args]+                            result <- evalEgisonTopExprs env [LoadFile file, Execute (ApplyExpr (VarExpr "main") (CollectionExpr (Sq.fromList (map (ElementExpr . StringExpr) args))))]                             either print (const $ return ()) result  data Options = Options {

@@ -70,6 +70,7 @@                 , "lib/core/natural-number.egi"                 , "lib/core/string.egi"                 , "lib/core/database.egi"+                , "lib/core/io.egi"                  ]  fromEgisonM :: EgisonM a -> IO (Either EgisonError a)

@@ -61,9 +61,8 @@   val <- evalExpr' env expr   liftIO $ print val   return env-evalTopExpr env (Execute argv) = do-  main <- refVar env "main" >>= evalRef-  io <- applyFunc main $ Value $ Collection $ Sq.fromList $ map makeStringValue argv+evalTopExpr env (Execute expr) = do+  io <- evalExpr env expr   case io of     Value (IOFunc m) -> m >> return env     _ -> throwError $ TypeMismatch "io" io@@ -199,6 +198,15 @@   genLet (names, expr) expr' =     LetExpr [(["#1", "#2"], ApplyExpr expr $ TupleExpr [VarExpr "#1"])] $     LetExpr [(names, VarExpr "#2")] expr'++evalExpr env (IoExpr expr) = do+  io <- evalExpr env expr+  case io of+    Value (IOFunc m) -> do+      val <- m >>= evalDeep+      case val of+        Tuple [_, val'] -> return $ Value val'+    _ -> throwError $ TypeMismatch "io" io  evalExpr env (MatchAllExpr target matcher (pattern, expr)) = do   target <- newThunk env target

@@ -101,7 +101,7 @@ testExpr = keywordTest >> Test <$> expr  executeExpr :: Parser EgisonTopExpr-executeExpr = keywordExecute >> Execute <$> sepEndBy stringLiteral whiteSpace+executeExpr = keywordExecute >> Execute <$> expr  loadFileExpr :: Parser EgisonTopExpr loadFileExpr = keywordLoadFile >> LoadFile <$> stringLiteral@@ -130,6 +130,7 @@                          <|> letRecExpr                          <|> letExpr                          <|> doExpr+                         <|> ioExpr                          <|> matchAllExpr                          <|> matchExpr                          <|> matcherExpr@@ -267,6 +268,9 @@ varName :: Parser String varName = char '$' >> ident +ioExpr :: Parser EgisonExpr+ioExpr = keywordIo >> IoExpr <$> expr+ applyExpr :: Parser EgisonExpr applyExpr = (keywordApply >> ApplyExpr <$> expr <*> expr)               <|> applyExpr'@@ -464,6 +468,7 @@   , "match"   , "matcher"   , "do"+  , "io"   , "algebraic-data-matcher"   , "generate-array"   , "array-size"@@ -508,6 +513,7 @@ keywordMatchLambda          = reserved "match-lambda" keywordMatcher              = reserved "matcher" keywordDo                   = reserved "do"+keywordIo                   = reserved "io" keywordSomething            = reserved "something" keywordUndefined            = reserved "undefined" keywordAlgebraicDataMatcher = reserved "algebraic-data-matcher"

@@ -20,12 +20,18 @@ import qualified Data.ByteString.Char8 as BC import qualified Data.Text as T ---import qualified Database.SQLite3 as SQLite -- for 'egison-sqlite'---import qualified Database.MySQL.Base as MySQL -- for 'egison-mysql'+{--  -- for 'egison-sqlite'+import qualified Database.SQLite3 as SQLite+--}  -- for 'egison-sqlite' +{--  -- for 'egison-mysql'+import qualified Database.MySQL.Base as MySQL+--}  -- for 'egison-mysql'+ import Control.Monad  import Language.Egison.Types+import Language.Egison.Parser import Language.Egison.Core  primitiveEnv :: IO Env@@ -147,8 +153,13 @@              , ("assert", assert)              , ("assert-equal", assertEqual) ---             , ("pure-sqlite", pureSQLite) -- for 'egison-sqlite'---             , ("pure-mysql", pureMySQL) -- for 'egison-mysql'+{-- -- for 'egison-sqlite'+             , ("pure-sqlite", pureSQLite)+--} -- for 'egison-sqlite'++{-- -- for 'egison-mysql'+             , ("pure-mysql", pureMySQL)+--} -- for 'egison-mysql'              ]  integerUnaryOp :: (Integer -> Integer) -> PrimitiveFunc@@ -365,7 +376,7 @@     SQLite.close db     ret <- readIORef rowsRef     return $ reverse ret---}+--} -- for 'egison-sqlite'  {--  -- for 'egison-mysql' pureMySQL :: PrimitiveFunc@@ -391,7 +402,7 @@                                            Nothing -> return "null")               rows' <- fetchAllRows ret               return $ row':rows'---}+--}  -- for 'egison-mysql'  -- -- IO Primitives@@ -405,11 +416,10 @@                , ("close-output-port", closePort)                , ("read-char", readChar)                , ("read-line", readLine)---             , ("read", readFromStdin)+               , ("read", readFromStdin)                , ("write-char", writeChar)                , ("write-string", writeString)-               , ("write", write)---             , ("print", writeStringLine)+               , ("write", writeToStdout)                , ("eof?", isEOFStdin)                , ("flush", flushStdout)                , ("read-char-from-port", readCharFromPort)@@ -419,8 +429,10 @@                , ("write-string-to-port", writeStringToPort)                , ("write-to-port", writeToPort)                , ("eof-port?", isEOFPort)---             , ("print-to-port", writeStringLineToPort)                , ("flush-port", flushPort)++               , ("read-file", readFile')+                                 , ("rand", randRange) ] --             , ("get-lib-dir-name", getLibDirName) ] @@ -450,8 +462,8 @@ writeString = (liftError .) $ oneArg $ \val ->   makeIO' . liftIO . putStr <$> fromStringValue val -write :: PrimitiveFunc-write = oneArg $ \val ->+writeToStdout :: PrimitiveFunc+writeToStdout = oneArg $ \val ->   makeIO' . liftIO . putStr . show <$> evalDeep val  readChar :: PrimitiveFunc@@ -460,6 +472,9 @@ readLine :: PrimitiveFunc readLine = noArg $ return $ makeIO $ liftIO $ liftM makeStringValue getLine +readFromStdin :: PrimitiveFunc+readFromStdin = noArg $ return $ makeIO $ (liftIO getLine) >>= readExpr >>= evalExpr' nullEnv+ flushStdout :: PrimitiveFunc flushStdout = noArg $ return $ makeIO' $ liftIO $ hFlush stdout @@ -495,9 +510,10 @@ isEOFPort = (liftError .) $ oneArg $ \val ->   makeIO . liftIO . liftM Bool . hIsEOF <$> fromPortValue val ---rand :: PrimitiveFunc---rand = noArg $ return $ makeIO $ liftIO $ liftM Integer $ getStdRandom random-+readFile' :: PrimitiveFunc+readFile' =  (liftError .) $ oneArg $ \val ->+  makeIO . liftIO . liftM makeStringValue . readFile <$> fromStringValue val+   randRange :: PrimitiveFunc randRange = (liftError .) $ twoArgs $ \val val' ->   return . makeIO . liftIO . liftM Integer . getStdRandom . randomR =<< liftM2 (,) (fromIntegerValue val) (fromIntegerValue val')

@@ -40,7 +40,7 @@ data EgisonTopExpr =     Define String EgisonExpr   | Test EgisonExpr-  | Execute [String]+  | Execute EgisonExpr     -- temporary : we will replace load to import and export   | LoadFile String   | Load String@@ -75,6 +75,7 @@   | MatcherExpr MatcherInfo      | DoExpr [BindingExpr] EgisonExpr+  | IoExpr EgisonExpr        | ApplyExpr EgisonExpr EgisonExpr 

@@ -2,6 +2,8 @@ ;; Base.egi ;; +(define $id (lambda [$x] x))+ (define $bool   (matcher     {[,$val []

@@ -82,7 +82,7 @@             {x @(filter pred rs)}             (filter pred rs))]}))) -(define $split+(define $separate   (lambda [$pred $ls]     (letrec {[$helper (lambda [$ls $xs $ys]                         (match ls (list something)

@@ -0,0 +1,40 @@+;;;;;+;;;;; Collection.egi+;;;;;++;;;+;;; IO+;;;+(define $print+  (lambda [$x]+    (do {[(write-string x)]+         [(write-string "\n")]+         }+        [])))++(define $print-to-port+  (lambda [$port $x]+    (do {[(write-string-to-port port x)]+         [(write-string-to-port port "\n")]+         }+        [])))++;;;+;;; Collection+;;;+(define $each+  (lambda [$proc $xs]+    (match xs (list something)+      {[<nil> (do {} [])]+       [<cons $x $rs>+        (do {[(proc x)]+             [(each proc rs)]+             }+          [])]})))++;;;+;;; Others+;;;+(define $pure-rand+  (lambda [$s $e]+    (io (rand s e))))

@@ -8,6 +8,18 @@  (define $intercalate (compose intersperse concat)) +(define $split+  (lambda [$in $ls]+    (match ls (list something)+      {[<join $xs <join ,in $rs>> {xs @(split in rs)}]+       [_ {ls}]})))++(define $split/m+  (lambda [$a $in $ls]+    (match ls (list a)+      {[<join $xs <join ,in $rs>> {xs @(split/m $a in rs)}]+       [_ {ls}]})))+ (define $palindrome?   (lambda [$str]     (match str string