egison 3.0.12 → 3.1.0

raw patch · 6 files changed

+82/−24 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +2/−3
• hs-src/Interpreter/egisoni.hs +4/−1
• hs-src/Language/Egison/Core.hs +35/−10
• hs-src/Language/Egison/Parser.hs +9/−0
• hs-src/Language/Egison/Primitives.hs +12/−7
• hs-src/Language/Egison/Types.hs +20/−3

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.0.12+Version:             3.1.0 Synopsis:            The world's first language with non-linear pattern-matching against unfree data Description:         An interpreter for Egison, the world's first programming langugage which realized non-linear pattern-matching with unfree data types.                      With Egison, you can represent pattern-matching with unfree data types intuitively,@@ -10,13 +10,12 @@ License:             MIT License-file:        LICENSE Author:              Satoshi Egi, Ryo Tanaka, Takahisa Watanabe, Kentaro Honda-Maintainer:          egi@egison.org+Maintainer:          Satoshi Egi <egi@egison.org> Category:            Compilers/Interpreters Build-type:          Simple Cabal-version:       >=1.8  Extra-Source-Files:  benchmark/Benchmark.hs-  Data-files:          lib/core/base.egi lib/core/number.egi lib/core/collection.egi lib/core/pattern.egi                      lib/graph/graph.egi lib/tree/xml.egi lib/math/prime.egi

@@ -104,7 +104,10 @@       case input of         Nothing -> return ()          Just "quit" -> return () -        Just "" ->  loop env prompt ""+        Just "" ->+          case rest of+            "" -> loop env prompt rest+            _ -> loop env (take (length prompt) (repeat ' ')) rest         Just input' -> do           let newInput = rest ++ input'           result <- liftIO $ runEgisonTopExpr env newInput

@@ -16,8 +16,11 @@ import Data.List import Data.Maybe -import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashMap.Lazy as HL+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy.Char8 ()+import qualified Data.ByteString.Lazy.Char8 as B  import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap@@ -60,7 +63,7 @@   return env evalTopExpr env (Execute argv) = do   main <- refVar env "main" >>= evalRef-  io <- applyFunc main $ Value $ Collection $ Sq.fromList $ map String argv+  io <- applyFunc main $ Value $ Collection $ Sq.fromList $ map (String . B.pack) argv   case io of     Value (IOFunc m) -> m >> return env     _ -> throwError $ TypeMismatch "io" io@@ -69,7 +72,7 @@  evalExpr :: Env -> EgisonExpr -> EgisonM WHNFData evalExpr _ (CharExpr c) = return . Value $ Char c-evalExpr _ (StringExpr s) = return . Value $ String s +evalExpr _ (StringExpr s) = return . Value $ String $ B.pack s  evalExpr _ (BoolExpr b) = return . Value $ Bool b evalExpr _ (IntegerExpr i) = return . Value $ Integer i evalExpr _ (FloatExpr d) = return . Value $ Float d@@ -98,21 +101,40 @@   ref' <- mapM (newThunk env) exprs   return . Intermediate . IArray $ IntMap.fromList $ zip (enumFromTo 1 (length exprs)) ref' +evalExpr env (HashExpr assocs) = do+  let (keyExprs, exprs) = unzip assocs+  keyVals <- mapM (evalExpr' env) keyExprs+  keys <- mapM makeKey keyVals+  refs <- mapM (newThunk env) exprs+  return . Intermediate . IHash $ HL.fromList $ zip keys refs+ evalExpr env (IndexedExpr expr indices) = do   array <- evalExpr env expr-  indices <- mapM (evalExpr env >=> liftError . liftM fromInteger . fromIntegerValue) indices+  indices <- mapM (evalExpr' env) indices   refArray array indices  where-  refArray :: WHNFData -> [Int] -> EgisonM WHNFData+  refArray :: WHNFData -> [EgisonValue] -> EgisonM WHNFData   refArray val [] = return val -  refArray (Value (Array array)) (index:indices) =-    case IntMap.lookup index array of+  refArray (Value (Array array)) (index:indices) = do+    i <- (liftError . liftM fromInteger . fromIntegerValue) (Value index)+    case IntMap.lookup i array of       Just val -> refArray (Value val) indices       Nothing -> return $ Value Undefined-  refArray (Intermediate (IArray array)) (index:indices) =-    case IntMap.lookup index array of+  refArray (Intermediate (IArray array)) (index:indices) = do+    i <- (liftError . liftM fromInteger . fromIntegerValue) (Value index)+    case IntMap.lookup i array of       Just ref -> evalRef ref >>= flip refArray indices       Nothing -> return $ Value Undefined+  refArray (Value (Hash hash)) (index:indices) = do+    key <- makeKey index+    case HL.lookup key hash of+      Just val -> refArray (Value val) indices+      Nothing -> return $ Value Undefined+  refArray (Intermediate (IHash hash)) (index:indices) = do+    key <- makeKey index+    case HL.lookup key hash of+      Just ref -> evalRef ref >>= flip refArray indices+      Nothing -> return $ Value Undefined   refArray val _ = throwError $ TypeMismatch "array" val  evalExpr env (LambdaExpr names expr) = return . Value $ Func env names expr @@ -243,6 +265,9 @@ evalDeep (Intermediate (IArray refs)) = do   refs' <- mapM evalRef' $ IntMap.elems refs   return $ Array $ IntMap.fromList $ zip (enumFromTo 1 (IntMap.size refs)) refs'+evalDeep (Intermediate (IHash refs)) = do+  refs' <- mapM evalRef' refs+  return $ Hash refs' evalDeep (Intermediate (ITuple refs)) = Tuple <$> mapM evalRef' refs evalDeep coll = Collection <$> (fromCollection coll >>= fromMList >>= mapM evalRef' . Sq.fromList) 

@@ -123,6 +123,7 @@              <|> inductiveDataExpr              <|> try arrayExpr              <|> try tupleExpr+             <|> try hashExpr              <|> collectionExpr              <|> parens (ifExpr                          <|> lambdaExpr@@ -162,6 +163,14 @@   where     lp = P.lexeme lexer (string "[|")     rp = P.lexeme lexer (string "|]")++hashExpr :: Parser EgisonExpr+hashExpr = between lp rp $ HashExpr <$> sepEndBy pairExpr whiteSpace+  where+    lp = P.lexeme lexer (string "{|")+    rp = P.lexeme lexer (string "|}")+    pairExpr :: Parser (EgisonExpr, EgisonExpr)+    pairExpr = brackets $ (,) <$> expr <*> expr  matchAllExpr :: Parser EgisonExpr matchAllExpr = keywordMatchAll >> MatchAllExpr <$> expr <*> expr <*> matchClause

@@ -11,6 +11,11 @@ import System.IO import System.Random +import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy.Char8 ()+import qualified Data.ByteString.Lazy.Char8 as B+ import Language.Egison.Types import Language.Egison.Core @@ -207,8 +212,8 @@  stringAppend :: PrimitiveFunc stringAppend = (liftError .) $ twoArgs $ \val val' ->-  (String .) . (++) <$> fromStringValue val-                    <*> fromStringValue val'+  (String .) . BL.append <$> fromStringValue val+                         <*> fromStringValue val'  assert ::  PrimitiveFunc assert = (liftError .) $ twoArgs $ \label test -> do@@ -271,7 +276,7 @@ makePort :: IOMode -> PrimitiveFunc makePort mode = (liftError .) $ oneArg $ \val -> do   filename <- fromStringValue val -  return . makeIO . liftIO $ Port <$> openFile filename mode+  return . makeIO . liftIO $ Port <$> openFile (B.unpack filename) mode  closePort :: PrimitiveFunc closePort = (liftError .) $ oneArg $ \val ->@@ -283,7 +288,7 @@  writeString :: PrimitiveFunc writeString = (liftError .) $ oneArg $ \val ->-  makeIO' . liftIO . putStr <$> fromStringValue val+  makeIO' . liftIO . putStr . B.unpack <$> fromStringValue val  write :: PrimitiveFunc write = oneArg $ \val ->@@ -293,7 +298,7 @@ readChar = noArg $ return $ makeIO $ liftIO $ liftM Char getChar  readLine :: PrimitiveFunc-readLine = noArg $ return $ makeIO $ liftIO $ liftM String getLine+readLine = noArg $ return $ makeIO $ liftIO $ liftM (String . B.pack) getLine  flushStdout :: PrimitiveFunc flushStdout = noArg $ return $ makeIO' $ liftIO $ hFlush stdout@@ -307,7 +312,7 @@  writeStringToPort :: PrimitiveFunc writeStringToPort = (liftError .) $ twoArgs $ \val val' ->-  ((makeIO' . liftIO) .) . hPutStr <$> fromPortValue val <*> fromStringValue val'+  ((makeIO' . liftIO) .) . hPutStr <$> fromPortValue val <*> (B.unpack <$> fromStringValue val')  writeToPort :: PrimitiveFunc writeToPort = twoArgs $ \val val' -> do@@ -320,7 +325,7 @@  readLineFromPort :: PrimitiveFunc readLineFromPort = (liftError .) $ oneArg $ \val ->-  makeIO . liftIO . liftM String . hGetLine <$> fromPortValue val+  makeIO . liftIO . liftM (String . B.pack) . hGetLine <$> fromPortValue val  flushPort :: PrimitiveFunc flushPort = (liftError .) $ oneArg $ \val ->

@@ -20,6 +20,12 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashMap.Lazy as HL+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy.Char8 ()+import qualified Data.ByteString.Lazy.Char8 as B+ import System.IO import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap@@ -49,6 +55,7 @@   | TupleExpr [EgisonExpr]   | CollectionExpr (Seq InnerExpr)   | ArrayExpr [EgisonExpr]+  | HashExpr [(EgisonExpr, EgisonExpr)]    | LambdaExpr [String] EgisonExpr   | PatternFunctionExpr [String] EgisonPattern@@ -129,7 +136,7 @@ data EgisonValue =     World   | Char Char-  | String String+  | String ByteString   | Bool Bool   | Integer Integer   | Float Double@@ -137,6 +144,7 @@   | Tuple [EgisonValue]   | Collection (Seq EgisonValue)   | Array (IntMap EgisonValue)+  | Hash (HashMap ByteString EgisonValue)   | Matcher Matcher   | Func Env [String] EgisonExpr   | PatternFunc Env [String] EgisonPattern@@ -152,7 +160,7 @@  instance Show EgisonValue where   show (Char c) = return c-  show (String s) = s+  show (String s) = "\"" ++ B.unpack s ++ "\""   show (Bool True) = "#t"   show (Bool False) = "#f"   show (Integer i) = show i@@ -162,6 +170,7 @@   show (Tuple vals) = "[" ++ unwords (map show vals) ++ "]"   show (Collection vals) = "{" ++ unwords (map show (toList vals)) ++ "}"   show (Array vals) = "[|" ++ unwords (map show $ IntMap.elems vals) ++ "|]"+  show (Hash hash) = "{|" ++ unwords (map (\(key, val) -> B.unpack key ++ " " ++ show val) $ HashMap.toList hash) ++ "|}"   show (Matcher _) = "#<matcher>"   show (Func _ names _) = "(lambda [" ++ unwords names ++ "] ...)"   show (PatternFunc _ _ _) = "#<pattern-function>"@@ -185,6 +194,12 @@  (Collection vals) == (Collection vals') = vals == vals'  _ == _ = False +makeKey :: EgisonValue ->  EgisonM ByteString+makeKey (Integer i) = return $ B.pack $ show i+makeKey (Char i) = return $ B.pack $ show i+makeKey (String s) = return s+makeKey val = throwError $ TypeMismatch "integer, char or string" (Value val)+ -- -- Internal Data --@@ -204,6 +219,7 @@   | ITuple [ObjectRef]   | ICollection (Seq Inner)   | IArray (IntMap ObjectRef)+  | IHash (HashMap ByteString ObjectRef)  data Inner =     IElement ObjectRef@@ -215,12 +231,13 @@   show (Intermediate (ITuple _)) = "[...]"   show (Intermediate (ICollection _)) = "{...}"   show (Intermediate (IArray _)) = "[|...|]" +  show (Intermediate (IHash _)) = "{|...|}"   fromCharValue :: WHNFData -> Either EgisonError Char fromCharValue (Value (Char c)) = return c fromCharValue val = throwError $ TypeMismatch "char" val -fromStringValue :: WHNFData -> Either EgisonError String+fromStringValue :: WHNFData -> Either EgisonError ByteString fromStringValue (Value (String s)) = return s fromStringValue val = throwError $ TypeMismatch "string" val