egison 3.3.10 → 3.3.11

raw patch · 22 files changed

+308/−202 lines, 22 filesdep −bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: bytestring

API changes (from Hackage documentation)

Files

• egison.cabal +5/−5
• elisp/egison-mode.el +4/−2
• hs-src/Interpreter/egison.hs +7/−7
• hs-src/Language/Egison.hs +1/−1
• hs-src/Language/Egison/Core.hs +29/−45
• hs-src/Language/Egison/Parser.hs +4/−2
• hs-src/Language/Egison/Primitives.hs +58/−9
• hs-src/Language/Egison/Types.hs +40/−28
• lib/core/base.egi +5/−3
• lib/core/collection.egi +26/−4
• lib/core/database.egi +5/−3
• lib/core/io.egi +5/−3
• lib/core/math.egi +2/−0
• lib/core/number.egi +1/−1
• lib/core/order.egi +1/−1
• lib/core/string.egi +0/−49
• lib/string/string.egi +63/−0
• sample/io/args.egi +15/−0
• sample/io/argv.egi +0/−15
• sample/io/cut.egi +11/−0
• sample/primes.egi +26/−0
• sample/sequence.egi +0/−24

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.3.10+Version:             3.3.11 Synopsis:            Programming language with non-linear pattern-matching against unfree data Description:   An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.@@ -19,7 +19,7 @@   .   <http://www.egison.org/demonstrations/>   .  -  Egison is not popular at all now.+  Egison makes programming dramatically simple.   Please help us to make Egison popular. Homepage:            http://www.egison.org License:             MIT@@ -32,7 +32,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/math.egi lib/core/string.egi lib/core/database.egi lib/core/io.egi+Data-files:          lib/core/base.egi lib/core/collection.egi lib/core/order.egi lib/core/number.egi lib/core/math.egi lib/core/database.egi lib/core/io.egi lib/string/string.egi                       lib/tree/xml.egi lib/math/prime.egi lib/math/euler.egi                      sample/*.egi sample/io/*.egi sample/io/*.egi                      elisp/egison-mode.el@@ -42,7 +42,7 @@   location: https://github.com/egison/egison.git    Library-  Build-Depends:   base >= 4.0 && < 5, array, random, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, strict-io, bytestring, text, regex-posix, direct-sqlite+  Build-Depends:   base >= 4.0 && < 5, array, random, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, strict-io, text, regex-posix, direct-sqlite   Hs-Source-Dirs:  hs-src   Exposed-Modules:                    Language.Egison@@ -71,7 +71,7 @@  Executable egison   Main-is:             egison.hs-  Build-depends:       egison, base >= 4.0 && < 5, array, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, filepath, strict-io, bytestring+  Build-depends:       egison, base >= 4.0 && < 5, array, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, filepath, strict-io, text   Hs-Source-Dirs:      hs-src/Interpreter   Other-modules:       Paths_egison   ghc-prof-options:   -prof -auto-all

@@ -11,6 +11,7 @@ (defconst egison-font-lock-keywords-1   (eval-when-compile     (list+     "\\<module\\>"      "\\<define\\>"      "\\<test\\>"      "\\<execute\\>"@@ -128,7 +129,8 @@         0))))  (defun keyword-indent-point (name)-  (cond ((equal "define" name) 2)+  (cond ((equal "module" name) 2)+        ((equal "define" name) 2)         ((equal "test" name) 2)         ((equal "load" name) 2)         ((equal "load-file" name) 2)@@ -191,7 +193,7 @@   (set (make-local-variable 'font-lock-defaults)        '((egison-font-lock-keywords           egison-font-lock-keywords-1 egison-font-lock-keywords-2)-         nil t (("+-*/=?%:_'" . "w") ("<" . "(") (">" . ")"))+         nil t (("+-*/=?%:_.'" . "w") ("<" . "(") (">" . ")"))          ))   (set (make-local-variable 'indent-line-function) 'egison-indent-line)   (set (make-local-variable 'comment-start) ";")

@@ -4,7 +4,7 @@ import Control.Exception ( AsyncException(..), catch ) import Control.Monad.Error -import Data.ByteString.Lazy.Char8 ()+import qualified Data.Text as T  import Data.Version @@ -53,7 +53,7 @@                                               else evalEgisonTopExprsTestOnly env [LoadFile file]                                   either print (const $ return ()) result                                 Options {optTestOnly = False} -> do-                                  result <- evalEgisonTopExprs env [LoadFile file, Execute (ApplyExpr (VarExpr "main") (CollectionExpr (map (ElementExpr . StringExpr) args)))]+                                  result <- evalEgisonTopExprs env [LoadFile file, Execute (ApplyExpr (VarExpr "main") (CollectionExpr (map (ElementExpr . StringExpr) (map T.pack args))))]                                   either print (const $ return ()) result  data Options = Options {@@ -118,7 +118,7 @@  printHelp :: IO () printHelp = do-  putStrLn "Usage: egison [option]"+  putStrLn "Usage: egison [options]"   putStrLn "       egison [options] file"   putStrLn ""   putStrLn "Options:"@@ -144,10 +144,10 @@   putStrLn $ "Egison Version " ++ showVersion version ++ " (C) 2011-2014 Satoshi Egi"   putStrLn $ "http://www.egison.org"   putStrLn $ "Welcome to Egison Interpreter!"-  putStrLn $ "** Information **"-  putStrLn $ "We can use the tab key to complete keywords on the interpreter."-  putStrLn $ "If we press the tab key after a closed parenthesis, the next closed parenthesis will be completed."-  putStrLn $ "*****************"+--  putStrLn $ "** Information **"+--  putStrLn $ "We can use the tab key to complete keywords on the interpreter."+--  putStrLn $ "If we press the tab key after a closed parenthesis, the next closed parenthesis will be completed."+--  putStrLn $ "*****************"  showByebyeMessage :: IO () showByebyeMessage = do

@@ -110,7 +110,7 @@   , "lib/core/order.egi"   , "lib/core/number.egi"   , "lib/core/math.egi"-  , "lib/core/string.egi"   , "lib/core/database.egi"   , "lib/core/io.egi"+  , "lib/string/string.egi"   ]

@@ -30,8 +30,7 @@     , unconsCollection     , unsnocCollection     -- * Utiltiy functions-    , evalStringWHNF-    , fromStringValue+    , packStringValue     ) where  import Prelude hiding (mapM)@@ -53,9 +52,8 @@ import qualified Data.Array as Array import qualified Data.HashMap.Lazy as HL -import Data.ByteString.Lazy (ByteString)-import Data.ByteString.Lazy.Char8 ()-import qualified Data.ByteString.Lazy.Char8 as B+import Data.Text (Text)+import qualified Data.Text as T  import Language.Egison.Types import Language.Egison.Parser@@ -195,13 +193,9 @@   makeHashKey (Value val) =     case val of       Integer i -> return (IntKey i)-      Collection _ -> do-        str <- evalStringWHNF $ Value val-        return $ StrKey $ B.pack str+      String str -> return (StrKey str)       _ -> throwError $ TypeMismatch "integer or string" $ Value val-  makeHashKey whnf = do-    str <- evalStringWHNF whnf-    return $ StrKey $ B.pack str+  makeHashKey whnf = throwError $ TypeMismatch "integer or string" $ whnf  evalExpr env (IndexedExpr expr indices) = do   array <- evalExpr env expr@@ -431,13 +425,13 @@     Just ref -> evalRef ref >>= flip refArray indices     Nothing -> return $ Value Undefined refArray (Value (StrHash hash)) (index:indices) = do-  key <- evalStringWHNF $ Value index-  case HL.lookup (B.pack key) hash of+  key <- fromEgison index+  case HL.lookup key hash of     Just val -> refArray (Value val) indices     Nothing -> return $ Value Undefined refArray (Intermediate (IStrHash hash)) (index:indices) = do-  key <- evalStringWHNF $ Value index-  case HL.lookup (B.pack key) hash of+  key <- fromEgison index+  case HL.lookup key hash of     Just ref -> evalRef ref >>= flip refArray indices     Nothing -> return $ Value Undefined refArray val _ = throwError $ TypeMismatch "array or hash" val@@ -833,6 +827,16 @@ extendEnvForNonLinearPatterns :: Env -> [Binding] -> [LoopContext] -> Env extendEnvForNonLinearPatterns env bindings loops =  extendEnv env $ bindings ++ map (\(LoopContext binding _ _ _ _) -> binding) loops +evalMatcherWHNF :: WHNFData -> EgisonM Matcher+evalMatcherWHNF (Value matcher@Something) = return matcher+evalMatcherWHNF (Value matcher@(UserMatcher _ _ _)) = return matcher+evalMatcherWHNF (Value (Tuple ms)) = Tuple <$> mapM (evalMatcherWHNF . Value) ms+evalMatcherWHNF (Intermediate (ITuple refs)) = do+  whnfs <- mapM evalRef refs+  ms <- mapM evalMatcherWHNF whnfs+  return $ Tuple ms+evalMatcherWHNF whnf = throwError $ TypeMismatch "matcher" whnf+ -- -- Util --@@ -862,43 +866,23 @@ -- -- String ---evalStringWHNF :: WHNFData -> EgisonM String-evalStringWHNF (Value (Collection seq)) = do-  let ls = toList seq-  mapM (\val -> case val of-                  Char c -> return c-                  _ -> throwError $ TypeMismatch "char" (Value val))-       ls-evalStringWHNF (Value (Tuple [val])) = evalStringWHNF (Value val)-evalStringWHNF whnf@(Intermediate (ICollection _)) = evalWHNF whnf >>= evalStringWHNF . Value-evalStringWHNF whnf = throwError $ TypeMismatch "string" whnf--evalMatcherWHNF :: WHNFData -> EgisonM Matcher-evalMatcherWHNF (Value matcher@Something) = return matcher-evalMatcherWHNF (Value matcher@(UserMatcher _ _ _)) = return matcher-evalMatcherWHNF (Value (Tuple ms)) = Tuple <$> mapM (evalMatcherWHNF . Value) ms-evalMatcherWHNF (Intermediate (ITuple refs)) = do-  whnfs <- mapM evalRef refs-  ms <- mapM evalMatcherWHNF whnfs-  return $ Tuple ms-evalMatcherWHNF whnf = throwError $ TypeMismatch "matcher" whnf--fromStringValue :: EgisonValue -> EgisonM String-fromStringValue (Collection seq) = do+packStringValue :: EgisonValue -> EgisonM Text+packStringValue (Collection seq) = do   let ls = toList seq-  mapM (\val -> case val of-                  Char c -> return c-                  _ -> throwError $ TypeMismatch "char" (Value val))-       ls-fromStringValue (Tuple [val]) = fromStringValue val-fromStringValue val = throwError $ TypeMismatch "string" (Value val)+  str <- mapM (\val -> case val of+                         Char c -> return c+                         _ -> throwError $ TypeMismatch "char" (Value val))+              ls+  return $ T.pack str+packStringValue (Tuple [val]) = packStringValue val+packStringValue val = throwError $ TypeMismatch "string" (Value val)  -- -- Util -- data EgisonHashKey =     IntKey Integer-  | StrKey ByteString+  | StrKey Text  extractPrimitiveValue :: WHNFData -> Either EgisonError EgisonValue extractPrimitiveValue (Value val@(Char _)) = return val

@@ -43,6 +43,8 @@ import Text.Parsec.String import qualified Text.Parsec.Token as P +import qualified Data.Text as T+ import Language.Egison.Types import Language.Egison.Desugar import Paths_egison (getDataFileName)@@ -479,7 +481,7 @@ charExpr = CharExpr <$> charLiteral  stringExpr :: Parser EgisonExpr-stringExpr = StringExpr <$> stringLiteral+stringExpr = StringExpr . T.pack <$> stringLiteral  boolExpr :: Parser EgisonExpr boolExpr = BoolExpr <$> boolLiteral@@ -516,7 +518,7 @@                 , P.caseSensitive      = True }  where   symbol1 = oneOf "+-*/="-  symbol2 = symbol1 <|> oneOf "'!?"+  symbol2 = symbol1 <|> oneOf "'!?."  lexer :: P.GenTokenParser String () Identity lexer = P.makeTokenParser egisonDef

@@ -23,6 +23,7 @@ import qualified Data.Sequence as Sq  import qualified Data.Text as T+import qualified Data.Text.IO as T  -- {--  -- for 'egison-sqlite' import qualified Database.SQLite3 as SQLite@@ -140,6 +141,12 @@                              , ("itof", integerToFloat)              , ("rtof", rationalToFloat)++             , ("pack", pack)+             , ("unpack", unpack)+             , ("length-string", lengthString)+             , ("append-string", appendString)+             , ("split-string", splitString)                              , ("read", read')              , ("show", show')@@ -153,6 +160,7 @@              , ("rational?", isRational)              , ("float?", isFloat)              , ("char?", isChar)+             , ("string?", isString)              , ("tuple?", isTuple)              , ("collection?", isCollection)              , ("array?", isArray)@@ -364,18 +372,56 @@   case val of     Integer i -> return $ Float $ fromInteger i     Rational r -> return $ Float $ fromRational r+    _ -> throwError $ TypeMismatch "integer of rational number" (Value val)  floatToIntegerOp :: (Double -> Integer) -> PrimitiveFunc floatToIntegerOp op = oneArg $ \val -> do   f <- fromEgison val   return $ Integer $ op f +--+-- String+--+pack :: PrimitiveFunc+pack = oneArg $ \val -> do+  str <- packStringValue val+  return $ String str++unpack :: PrimitiveFunc+unpack = oneArg $ \val -> do+  case val of+    String str -> return $ toEgison (T.unpack str)+    _ -> throwError $ TypeMismatch "string" (Value val)++lengthString :: PrimitiveFunc+lengthString = oneArg $ \val -> do+  case val of+    String str -> return . Integer . toInteger $ T.length str+    _ -> throwError $ TypeMismatch "string" (Value val)++appendString :: PrimitiveFunc+appendString = twoArgs $ \val1 val2 -> do+  case (val1, val2) of+    (String str1, String str2) -> return . String $ T.append str1 str2+    (String _, _) -> throwError $ TypeMismatch "string" (Value val2)+    (_, _) -> throwError $ TypeMismatch "string" (Value val1)++splitString :: PrimitiveFunc+splitString = twoArgs $ \pat src -> do+  case (pat, src) of+    (String patStr, String srcStr) -> return . Collection . Sq.fromList $ map String $ T.splitOn patStr srcStr+    (String _, _) -> throwError $ TypeMismatch "string" (Value src)+    (_, _) -> throwError $ TypeMismatch "string" (Value pat)+ read' :: PrimitiveFunc-read'= oneArg $ \val -> fromStringValue val >>= readExpr >>= evalExprDeep nullEnv+read'= oneArg $ \val -> fromEgison val >>= readExpr . T.unpack >>= evalExprDeep nullEnv  show' :: PrimitiveFunc-show'= oneArg $ \val -> return $ toEgison $ show val+show'= oneArg $ \val -> return $ toEgison $ T.pack $ show val +--+-- Collection+-- isEmpty' :: PrimitiveFunc isEmpty' whnf = do   b <- isEmptyCollection whnf@@ -420,6 +466,10 @@ isChar (Value (Char _)) = return $ Value $ Bool True isChar _ = return $ Value $ Bool False +isString :: PrimitiveFunc+isString (Value (String _)) = return $ Value $ Bool True+isString _ = return $ Value $ Bool False+ isTuple :: PrimitiveFunc isTuple args = do   args' <- fromTuple args@@ -523,7 +573,7 @@ makePort :: IOMode -> PrimitiveFunc makePort mode = oneArg $ \val -> do   filename <- fromEgison val-  port <- liftIO $ openFile filename mode+  port <- liftIO $ openFile (T.unpack filename) mode   return $ makeIO $ return (Port port)  closePort :: PrimitiveFunc@@ -545,13 +595,13 @@ writeString :: PrimitiveFunc writeString = oneArg $ \val -> do   s <- fromEgison val-  return $ makeIO' $ liftIO $ putStr s+  return $ makeIO' $ liftIO $ T.putStr s    writeStringToPort :: PrimitiveFunc writeStringToPort = twoArgs $ \val val' -> do   port <- fromEgison val   s <- fromEgison val'-  return $ makeIO' $ liftIO $ hPutStr port s+  return $ makeIO' $ liftIO $ T.hPutStr port s  flushStdout :: PrimitiveFunc flushStdout = noArg $ return $ makeIO' $ liftIO $ hFlush stdout@@ -571,18 +621,18 @@   return $ makeIO $ return (Char c)  readLine :: PrimitiveFunc-readLine = noArg $ return $ makeIO $ liftIO $ liftM toEgison getLine+readLine = noArg $ return $ makeIO $ liftIO $ liftM toEgison T.getLine  readLineFromPort :: PrimitiveFunc readLineFromPort = oneArg $ \val -> do   port <- fromEgison val-  s <- liftIO $ hGetLine port+  s <- liftIO $ T.hGetLine port   return $ makeIO $ return $ toEgison s  readFile' :: PrimitiveFunc readFile' =  oneArg $ \val -> do   filename <- fromEgison val-  s <- liftIO $ readFile filename+  s <- liftIO $ T.readFile filename   return $ makeIO $ return $ toEgison s    isEOFStdin :: PrimitiveFunc@@ -623,4 +673,3 @@     ret <- readIORef rowsRef     return $ reverse ret -- --} -- for 'egison-sqlite'-

@@ -26,7 +26,7 @@     , EgisonValue (..)     , Matcher (..)     , PrimitiveFunc (..)-    , Egison (..)+    , EgisonData (..)     -- * Internal data     , Object (..)     , ObjectRef (..)@@ -97,9 +97,8 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.ByteString.Lazy (ByteString)-import Data.ByteString.Lazy.Char8 ()-import qualified Data.ByteString.Lazy.Char8 as B+import Data.Text (Text)+import qualified Data.Text as T  import System.IO import Data.Ratio@@ -121,7 +120,7 @@  data EgisonExpr =     CharExpr Char-  | StringExpr String+  | StringExpr Text   | BoolExpr Bool   | RationalExpr Rational   | IntegerExpr Integer@@ -225,6 +224,7 @@ data EgisonValue =     World   | Char Char+  | String Text   | Bool Bool   | Rational Rational   | Integer Integer@@ -234,7 +234,7 @@   | Collection (Seq EgisonValue)   | Array (Array.Array Integer EgisonValue)   | IntHash (HashMap Integer EgisonValue)-  | StrHash (HashMap ByteString EgisonValue)+  | StrHash (HashMap Text EgisonValue)   | UserMatcher Env PMMode MatcherInfo   | Func Env [String] EgisonExpr   | MemoizedFunc ObjectRef (IORef (HashMap [Integer] ObjectRef)) Env [String] EgisonExpr@@ -252,6 +252,7 @@  instance Show EgisonValue where   show (Char c) = "'" ++ [c] ++ "'"+  show (String str) = "\"" ++ T.unpack str ++ "\""   show (Bool True) = "#t"   show (Bool False) = "#f"   show (Rational x) = show (numerator x) ++ "/" ++ show (denominator x)@@ -262,19 +263,14 @@   show (Tuple vals) = "[" ++ unwords (map show vals) ++ "]"   show (Collection vals) = if Sq.null vals                              then "{}"-                             else if all isChar (toList vals)-                                    then "\"" ++ map (\(Char c) -> c) (toList vals) ++ "\""-                                    else "{" ++ unwords (map show (toList vals)) ++ "}"-                                   where-                                     isChar :: EgisonValue -> Bool-                                     isChar (Char _) = True-                                     isChar _ = False+                             else "{" ++ unwords (map show (toList vals)) ++ "}"   show (Array vals) = "[|" ++ unwords (map show $ Array.elems vals) ++ "|]"   show (IntHash hash) = "{|" ++ unwords (map (\(key, val) -> "[" ++ show key ++ " " ++ show val ++ "]") $ HashMap.toList hash) ++ "|}"-  show (StrHash hash) = "{|" ++ unwords (map (\(key, val) -> "[\"" ++ B.unpack key ++ "\" " ++ show val ++ "]") $ HashMap.toList hash) ++ "|}"+  show (StrHash hash) = "{|" ++ unwords (map (\(key, val) -> "[\"" ++ T.unpack key ++ "\" " ++ show val ++ "]") $ HashMap.toList hash) ++ "|}"   show (UserMatcher _ BFSMode _) = "#<matcher-bfs>"   show (UserMatcher _ DFSMode _) = "#<matcher-dfs>"   show (Func _ names _) = "(lambda [" ++ unwords names ++ "] ...)"+  show (MemoizedFunc _ _ _ names _) = "(memoized-lambda [" ++ unwords names ++ "] ...)"   show (PatternFunc _ _ _) = "#<pattern-function>"   show (PrimitiveFunc _) = "#<primitive-function>"   show (IOFunc _) = "#<io-function>"@@ -286,6 +282,7 @@  instance Eq EgisonValue where  (Char c) == (Char c') = c == c'+ (String str) == (String str') = str == str'  (Bool b) == (Bool b') = b == b'  (Integer i) == (Integer i') = i == i'  (Float f) == (Float f') = f == f'@@ -300,50 +297,54 @@ -- -- Egison data and Haskell data ---class Egison a where+class EgisonData a where   toEgison :: a -> EgisonValue   fromEgison :: EgisonValue -> EgisonM a -instance Egison Char where+instance EgisonData Char where   toEgison c = Char c   fromEgison = liftError . fromCharValue -instance Egison Bool where+instance EgisonData Text where+  toEgison str = String str+  fromEgison = liftError . fromStringValue++instance EgisonData Bool where   toEgison b = Bool b   fromEgison = liftError . fromBoolValue -instance Egison Integer where+instance EgisonData Integer where   toEgison i = Integer i   fromEgison = liftError . fromIntegerValue -instance Egison Rational where+instance EgisonData Rational where   toEgison r = Rational r   fromEgison = liftError . fromRationalValue -instance Egison Double where+instance EgisonData Double where   toEgison f = Float f   fromEgison = liftError . fromFloatValue -instance Egison Handle where+instance EgisonData Handle where   toEgison h = Port h   fromEgison = liftError . fromPortValue -instance (Egison a) => Egison [a] where+instance (EgisonData a) => EgisonData [a] where   toEgison xs = Collection $ Sq.fromList (map toEgison xs)   fromEgison (Collection seq) = mapM fromEgison (toList seq)   fromEgison val = liftError $ throwError $ TypeMismatch "collection" (Value val) -instance Egison () where+instance EgisonData () where   toEgison () = Tuple []   fromEgison (Tuple []) = return ()   fromEgison val = liftError $ throwError $ TypeMismatch "zero element tuple" (Value val) -instance (Egison a, Egison b) => Egison (a, b) where+instance (EgisonData a, EgisonData b) => EgisonData (a, b) where   toEgison (x, y) = Tuple [toEgison x, toEgison y]   fromEgison (Tuple (x:y:[])) = (liftM2 (,)) (fromEgison x) (fromEgison y)   fromEgison val = liftError $ throwError $ TypeMismatch "two elements tuple" (Value val) -instance (Egison a, Egison b, Egison c) => Egison (a, b, c) where+instance (EgisonData a, EgisonData b, EgisonData c) => EgisonData (a, b, c) where   toEgison (x, y, z) = Tuple [toEgison x, toEgison y, toEgison z]   fromEgison (Tuple (x:y:z:[])) = do     x' <- fromEgison x@@ -352,7 +353,7 @@     return (x', y', z')   fromEgison val = liftError $ throwError $ TypeMismatch "two elements tuple" (Value val) -instance (Egison a, Egison b, Egison c, Egison d) => Egison (a, b, c, d) where+instance (EgisonData a, EgisonData b, EgisonData c, EgisonData d) => EgisonData (a, b, c, d) where   toEgison (x, y, z, w) = Tuple [toEgison x, toEgison y, toEgison z, toEgison w]   fromEgison (Tuple (x:y:z:w:[])) = do     x' <- fromEgison x@@ -366,6 +367,10 @@ fromCharValue (Char c) = return c fromCharValue val = throwError $ TypeMismatch "char" (Value val) +fromStringValue :: EgisonValue -> Either EgisonError Text+fromStringValue (String str) = return str+fromStringValue val = throwError $ TypeMismatch "string" (Value val)+ fromBoolValue :: EgisonValue -> Either EgisonError Bool fromBoolValue (Bool b) = return b fromBoolValue val = throwError $ TypeMismatch "bool" (Value val)@@ -407,7 +412,7 @@   | ICollection (IORef (Seq Inner))   | IArray (Array.Array Integer ObjectRef)   | IIntHash (HashMap Integer ObjectRef)-  | IStrHash (HashMap ByteString ObjectRef)+  | IStrHash (HashMap Text ObjectRef)  data Inner =     IElement ObjectRef@@ -432,7 +437,7 @@ -- -- Extract data from WHNF ---class (Egison a) => EgisonWHNF a where+class (EgisonData a) => EgisonWHNF a where   toWHNF :: a -> WHNFData   fromWHNF :: WHNFData -> EgisonM a   toWHNF = Value . toEgison@@ -440,6 +445,9 @@ instance EgisonWHNF Char where   fromWHNF = liftError . fromCharWHNF   +instance EgisonWHNF Text where+  fromWHNF = liftError . fromStringWHNF+   instance EgisonWHNF Bool where   fromWHNF = liftError . fromBoolWHNF   @@ -458,6 +466,10 @@ fromCharWHNF :: WHNFData -> Either EgisonError Char fromCharWHNF (Value (Char c)) = return c fromCharWHNF whnf = throwError $ TypeMismatch "char" whnf++fromStringWHNF :: WHNFData -> Either EgisonError Text+fromStringWHNF (Value (String str)) = return str+fromStringWHNF whnf = throwError $ TypeMismatch "string" whnf  fromBoolWHNF :: WHNFData -> Either EgisonError Bool fromBoolWHNF (Value (Bool b)) = return b

@@ -1,6 +1,8 @@-;;-;; Base.egi-;;+;;;;;+;;;;;+;;;;; Base+;;;;;+;;;;;  (define $buildin-data-matcher   (matcher-dfs

@@ -1,13 +1,15 @@ ;;;;;-;;;;; Collection.egi ;;;;;+;;;;; Collection+;;;;;+;;;;;  ;;; ;;; List ;;; (define $list   (lambda [$a]-    (matcher-bfs+    (matcher       {[,$val []         {[$tgt (match [val tgt] [(list a) (list a)]                  {[[<nil> <nil>] {[]}]@@ -42,8 +44,6 @@         {[$tgt {tgt}]}]        }))) -(define $string (list char))- ;; ;; Helper function for List matcher, be careful for recursive calls ;;@@ -112,6 +112,10 @@                            [<cons $l $rs> (helper rs xs {l @ys})]}))]}       (helper ls {} {})))) +(define $append+  (lambda [$xs $ys]+    {@xs @ys}))+ (define $concat   (lambda [$xss]     (foldr (lambda [$xs $rs] {@xs @rs})@@ -296,6 +300,24 @@       {[<nil> {}]        [<snoc $x $rs>         {x @(reverse rs)}]})))++(define $intersperse+  (lambda [$in $ws]+    (foldl (lambda [$s1 $s2] {@s1 in s2}) {(car ws)} (cdr ws))))++(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}]})))  ;;; ;;; Multiset

@@ -1,6 +1,8 @@-;;;-;;; Database.egi-;;;+;;;;;+;;;;;+;;;;; Database.egi+;;;;;+;;;;;  (define $database-table   (algebraic-data-matcher

@@ -1,6 +1,8 @@-;;;;;-;;;;; Collection.egi-;;;;;+;;;;;;+;;;;;;+;;;;;; IO+;;;;;;+;;;;;;  ;;; ;;; IO

@@ -1,5 +1,7 @@ ;;;;;+;;;;; ;;;;; Math+;;;;; ;;;;;  (define $fact

@@ -1,6 +1,6 @@ ;;;;; ;;;;;-;;;;; Number Library+;;;;; Number ;;;;; ;;;;; 

@@ -1,6 +1,6 @@ ;;;;; ;;;;;-;;;;; Order Library+;;;;; Order ;;;;; ;;;;; 

@@ -1,49 +0,0 @@-;;;-;;; String.egi-;;;--(define $string?-  (lambda [$x]-    (if (collection? x)-      (letrec {[$helper (lambda [$cs]-                          (match cs (list something)-                            {[<nil> #t]-                             [<cons $c $rs>-                              (if (char? c)-                                (helper rs)-                                #f)]}))]}-        (helper x))-      #f)))--(define $chop-  (lambda [$xs]-    (match xs string-      {[<snoc (| ,'\n' ,' ') $ys> (chop ys)]-       [_ xs]})))--(define $intersperse-  (lambda [$in $ws]-    (foldl (lambda [$s1 $s2] {@s1 in s2}) {(car ws)} (cdr ws))))--(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-      {[(loop $i [1 $n]-          <cons $c_i <snoc ,c_i ...>>-          (| <nil> <cons $cm <nil>>))-        #t]-       [_ #f]})))

@@ -0,0 +1,63 @@+;;;;;+;;;;;+;;;;; String+;;;;;+;;;;;++(define $string+  (matcher+    {[,$val []+      {[$tgt  (if (eq? val tgt)+                {[]}+                {})]}]+     [<nil> []+      {[$tgt (if (eq? "" tgt)+               {[]}+               {})]}]+     [<cons $ $> [char string]+      {[$tgt (if (eq? "" tgt)+               {}+               {(unsnoc-string tgt)})]}]+     [<join $ <cons ,$px $>> [string string]+      {[$tgt (match-all (split (pack {px}) tgt) (list string)+               [<join $xs $ys> [(S.append (car xs) (S.concat (map (S.append (pack {px}) $) (cdr xs))))+                                (S.append (car ys) (S.concat (map (S.append (pack {px}) $) (cdr ys))))+                                ]])]}]+     [<join $ <join ,$pxs $>> [string string]+      {[$tgt (match-all (split-string tgt) (list string)+               [<join $xs $ys> [(S.append (car xs) (S.concat (map (S.append px $) (cdr xs))))+                                (S.append (car ys) (S.concat (map (S.append px $) (cdr ys))))+                                ]])]}]+     [$ [something]+      {[$tgt {tgt}]}]+     }))++(define $chop+  (lambda [$xs]+    (match xs string+      {[<snoc (| ,'\n' ,' ') $ys> (chop ys)]+       [_ xs]})))++;;;+;;; String as Collection+;;;++(define $S.length+  (lambda [$xs]+    (length-string xs)))++(define $S.split+  (lambda [$in $ls]+    (split-string in ls)))++(define $S.append+  (lambda [$xs $ys]+    (append-string xs ys)))++(define $S.concat+  (lambda [$xss]+    (foldr (lambda [$xs $rs] (S.append xs rs))+           ""+           xss)))++(define $S.intercalate (compose intersperse S.concat))

@@ -0,0 +1,15 @@+(define $write-each+  (lambda [$xs]+    (match xs (list something)+      {[<nil> (do {} (return []))]+       [<cons $x $rs>+        (do {[(write x)]+             [(write "\n")]}+          (write-each rs))]})))++(define $main+  (lambda [$args]+    (do {[(write "args: ")]+         [(write (show args))]+         [(write "\n")]}+      (write-each args))))

@@ -1,15 +0,0 @@-(define $write-each-  (lambda [$xs]-    (match xs (list something)-      {[<nil> (do {} [])]-       [<cons $x $rs>-        (do {[(write x)]-             [(write "\n")]}-          (write-each rs))]})))--(define $main-  (lambda [$argv]-    (do {[(write "argv: ")]-         [(write (show argv))]-         [(write "\n")]-         [(write-each argv)]})))

@@ -0,0 +1,11 @@+(define $main+  (lambda [$args]+    (match args (list string)+      {[<cons $file $nums> (cut file (map read nums))]})))++(define $cut+  (lambda [$file $nums]+    (do {[$port (open-input-file file)]+         [(each-line-from-port port (lambda [$line] (let {[$fs (S.split "," line)]}+                                                      (print (S.intercalate "," (map (nth $ fs) nums))))))]+         [(close-input-port port)]})))

@@ -0,0 +1,26 @@+;;;+;;;+;;; Pattern-matching against sequence of natural numbers+;;;+;;;++;; Extract all twin primes from the infinite list of prime numbers with pattern-matching!+(define $twin-primes+  (match-all primes (list integer)+    [<join _ <cons $p <cons ,(+ p 2) _>>>+     [p (+ p 2)]]))++;; Enumerate first 10 twin primes+(take 10 twin-primes)++;; Extract all prime-triplets from the infinite list of prime numbers with pattern-matching!+(define $prime-triplets+  (match-all primes (list integer)+    [<join _ <cons $p+              <cons (& $m (| ,(+ p 2) ,(+ p 4)))+               <cons ,(+ p 6) _>>>>+     [p m (+ p 6)]]))++;; Enumerate first 10 twin primes+(take 10 prime-triplets)+

@@ -1,24 +0,0 @@-;;;-;;;-;;; Pattern-matching against sequence of natural numbers-;;;-;;;--;; Extract all twin primes from the infinite list of prime numbers with pattern-matching!-(define $twin-primes-  (match-all primes (list integer)-    [<join _ <cons $p <cons ,(+ p 2) _>>>-     [p (+ p 2)]]))--;; Enumerate first 10 twin primes-(test (take 10 twin-primes))--;; Extract all prime-triplets from the infinite list of prime numbers with pattern-matching!-(define $prime-triplets-  (match-all primes (list integer)-    [<join _ <cons $n <cons (& $m (| ,(+ n 2) ,(+ n 4))) <cons ,(+ n 6) _>>>>-     [n m (+ n 6)]]))--;; Enumerate first 10 twin primes-(test (take 10 prime-triplets))-