egison 3.1.0 → 3.1.1

raw patch · 6 files changed

+75/−46 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Language/Egison/Core.hs +32/−11
• hs-src/Language/Egison/Primitives.hs +8/−7
• hs-src/Language/Egison/Types.hs +32/−17
• lib/core/base.egi +0/−10
• lib/core/collection.egi +2/−0

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.1.0+Version:             3.1.1 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,

@@ -17,7 +17,7 @@ import Data.Maybe  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@@ -63,7 +63,7 @@   return env evalTopExpr env (Execute argv) = do   main <- refVar env "main" >>= evalRef-  io <- applyFunc main $ Value $ Collection $ Sq.fromList $ map (String . B.pack) argv+  io <- applyFunc main $ Value $ Collection $ Sq.fromList $ map makeStringValue argv   case io of     Value (IOFunc m) -> m >> return env     _ -> throwError $ TypeMismatch "io" io@@ -72,7 +72,7 @@  evalExpr :: Env -> EgisonExpr -> EgisonM WHNFData evalExpr _ (CharExpr c) = return . Value $ Char c-evalExpr _ (StringExpr s) = return . Value $ String $ B.pack s +evalExpr _ (StringExpr s) = return $ Value $ makeStringValue s evalExpr _ (BoolExpr b) = return . Value $ Bool b evalExpr _ (IntegerExpr i) = return . Value $ Integer i evalExpr _ (FloatExpr d) = return . Value $ Float d@@ -104,9 +104,17 @@ evalExpr env (HashExpr assocs) = do   let (keyExprs, exprs) = unzip assocs   keyVals <- mapM (evalExpr' env) keyExprs-  keys <- mapM makeKey keyVals+  keys <- liftError $ mapM makeKey keyVals   refs <- mapM (newThunk env) exprs-  return . Intermediate . IHash $ HL.fromList $ zip keys refs+  case head keys of+    IntKey _ -> do+      let keys' = map (\key -> case key of+                                 IntKey i -> i) keys+      return . Intermediate . IIntHash $ HL.fromList $ zip keys' refs+    StrKey _ -> do+      let keys' = map (\key -> case key of+                                 StrKey s -> s) keys+      return . Intermediate . IStrHash $ HL.fromList $ zip keys' refs  evalExpr env (IndexedExpr expr indices) = do   array <- evalExpr env expr@@ -125,16 +133,26 @@     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+  refArray (Value (IntHash hash)) (index:indices) = do+    key <- liftError $ fromIntegerValue $ Value 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+  refArray (Intermediate (IIntHash hash)) (index:indices) = do+    key <- liftError $ fromIntegerValue $ Value index     case HL.lookup key hash of       Just ref -> evalRef ref >>= flip refArray indices       Nothing -> return $ Value Undefined+  refArray (Value (StrHash hash)) (index:indices) = do+    key <- liftError $ fromStringValue $ Value index+    case HL.lookup (B.pack key) hash of+      Just val -> refArray (Value val) indices+      Nothing -> return $ Value Undefined+  refArray (Intermediate (IStrHash hash)) (index:indices) = do+    key <- liftError $ fromStringValue $ Value index+    case HL.lookup (B.pack 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 @@ -265,9 +283,12 @@ 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+evalDeep (Intermediate (IIntHash refs)) = do   refs' <- mapM evalRef' refs-  return $ Hash refs'+  return $ IntHash refs'+evalDeep (Intermediate (IStrHash refs)) = do+  refs' <- mapM evalRef' refs+  return $ StrHash refs' evalDeep (Intermediate (ITuple refs)) = Tuple <$> mapM evalRef' refs evalDeep coll = Collection <$> (fromCollection coll >>= fromMList >>= mapM evalRef' . Sq.fromList) 

@@ -15,6 +15,7 @@ import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Char8 () import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.Sequence as Sq  import Language.Egison.Types import Language.Egison.Core@@ -211,8 +212,8 @@   stringAppend :: PrimitiveFunc-stringAppend = (liftError .) $ twoArgs $ \val val' ->-  (String .) . BL.append <$> fromStringValue val+stringAppend = (liftError .) $ twoArgs $ \val val' -> do+  (makeStringValue .) . (++) <$> fromStringValue val                          <*> fromStringValue val'  assert ::  PrimitiveFunc@@ -276,7 +277,7 @@ makePort :: IOMode -> PrimitiveFunc makePort mode = (liftError .) $ oneArg $ \val -> do   filename <- fromStringValue val -  return . makeIO . liftIO $ Port <$> openFile (B.unpack filename) mode+  return . makeIO . liftIO $ Port <$> openFile filename mode  closePort :: PrimitiveFunc closePort = (liftError .) $ oneArg $ \val ->@@ -288,7 +289,7 @@  writeString :: PrimitiveFunc writeString = (liftError .) $ oneArg $ \val ->-  makeIO' . liftIO . putStr . B.unpack <$> fromStringValue val+  makeIO' . liftIO . putStr <$> fromStringValue val  write :: PrimitiveFunc write = oneArg $ \val ->@@ -298,7 +299,7 @@ readChar = noArg $ return $ makeIO $ liftIO $ liftM Char getChar  readLine :: PrimitiveFunc-readLine = noArg $ return $ makeIO $ liftIO $ liftM (String . B.pack) getLine+readLine = noArg $ return $ makeIO $ liftIO $ liftM makeStringValue getLine  flushStdout :: PrimitiveFunc flushStdout = noArg $ return $ makeIO' $ liftIO $ hFlush stdout@@ -312,7 +313,7 @@  writeStringToPort :: PrimitiveFunc writeStringToPort = (liftError .) $ twoArgs $ \val val' ->-  ((makeIO' . liftIO) .) . hPutStr <$> fromPortValue val <*> (B.unpack <$> fromStringValue val')+  ((makeIO' . liftIO) .) . hPutStr <$> fromPortValue val <*> fromStringValue val'  writeToPort :: PrimitiveFunc writeToPort = twoArgs $ \val val' -> do@@ -325,7 +326,7 @@  readLineFromPort :: PrimitiveFunc readLineFromPort = (liftError .) $ oneArg $ \val ->-  makeIO . liftIO . liftM (String . B.pack) . hGetLine <$> fromPortValue val+  makeIO . liftIO . liftM makeStringValue . hGetLine <$> fromPortValue val  flushPort :: PrimitiveFunc flushPort = (liftError .) $ oneArg $ \val ->

@@ -136,7 +136,6 @@ data EgisonValue =     World   | Char Char-  | String ByteString   | Bool Bool   | Integer Integer   | Float Double@@ -144,7 +143,8 @@   | Tuple [EgisonValue]   | Collection (Seq EgisonValue)   | Array (IntMap EgisonValue)-  | Hash (HashMap ByteString EgisonValue)+  | IntHash (HashMap Integer EgisonValue)+  | StrHash (HashMap ByteString EgisonValue)   | Matcher Matcher   | Func Env [String] EgisonExpr   | PatternFunc Env [String] EgisonPattern@@ -159,8 +159,7 @@ type PrimitiveFunc = [WHNFData] -> EgisonM EgisonValue  instance Show EgisonValue where-  show (Char c) = return c-  show (String s) = "\"" ++ B.unpack s ++ "\""+  show (Char c) = show c   show (Bool True) = "#t"   show (Bool False) = "#f"   show (Integer i) = show i@@ -170,7 +169,8 @@   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 (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 (Matcher _) = "#<matcher>"   show (Func _ names _) = "(lambda [" ++ unwords names ++ "] ...)"   show (PatternFunc _ _ _) = "#<pattern-function>"@@ -184,7 +184,6 @@  instance Eq EgisonValue where  (Char c) == (Char c') = c == c'- (String s) == (String s') = s == s'  (Bool b) == (Bool b') = b == b'  (Integer i) == (Integer i') = i == i'  (Float f) == (Float f') = f == f'@@ -194,12 +193,6 @@  (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 --@@ -219,7 +212,8 @@   | ITuple [ObjectRef]   | ICollection (Seq Inner)   | IArray (IntMap ObjectRef)-  | IHash (HashMap ByteString ObjectRef)+  | IIntHash (HashMap Integer ObjectRef)+  | IStrHash (HashMap ByteString ObjectRef)  data Inner =     IElement ObjectRef@@ -231,16 +225,38 @@   show (Intermediate (ITuple _)) = "[...]"   show (Intermediate (ICollection _)) = "{...}"   show (Intermediate (IArray _)) = "[|...|]" -  show (Intermediate (IHash _)) = "{|...|}" +  show (Intermediate (IIntHash _)) = "{|...|}" +  show (Intermediate (IStrHash _)) = "{|...|}"  +data EgisonHashKey =+    IntKey Integer+  | StrKey ByteString++makeKey :: EgisonValue -> Either EgisonError EgisonHashKey+makeKey val =+  case val of+    Integer i -> return (IntKey i)+    Collection _ -> do+      str <- fromStringValue $ Value val+      return $ StrKey $ B.pack str+    _ -> throwError $ TypeMismatch "integer or string" $ Value val+ fromCharValue :: WHNFData -> Either EgisonError Char fromCharValue (Value (Char c)) = return c fromCharValue val = throwError $ TypeMismatch "char" val -fromStringValue :: WHNFData -> Either EgisonError ByteString-fromStringValue (Value (String s)) = return s+fromStringValue :: WHNFData -> Either EgisonError String+fromStringValue (Value (Collection seq)) = do+  let ls = toList seq+  mapM (\val -> case val of+                  Char c -> return c+                  _ -> throwError $ TypeMismatch "char" (Value val))+       ls fromStringValue val = throwError $ TypeMismatch "string" val +makeStringValue :: String -> EgisonValue+makeStringValue str = Collection $ Sq.fromList $ map Char str+ fromBoolValue :: WHNFData -> Either EgisonError Bool fromBoolValue (Value (Bool b)) = return b fromBoolValue val = throwError $ TypeMismatch "bool" val@@ -263,7 +279,6 @@  fromPrimitiveValue :: WHNFData -> Either EgisonError EgisonValue fromPrimitiveValue (Value val@(Char _)) = return val-fromPrimitiveValue (Value val@(String _)) = return val fromPrimitiveValue (Value val@(Bool _)) = return val fromPrimitiveValue (Value val@(Integer _)) = return val fromPrimitiveValue (Value val@(Float _)) = return val

@@ -40,16 +40,6 @@       {[$tgt {tgt}]}]      })) -(define $string-  (matcher-    {[,$s []-      {[$tgt (if (eq? tgt s)-                 {[]}-                 {})]}]-     [$ [something]-      {[$tgt {tgt}]}]-     }))- (define $ordering   (algebraic-data-matcher      {<less> <equal> <greater>}))

@@ -49,6 +49,8 @@         {[$tgt {tgt}]}]        }))) +(define $string (list char))+ (define $map   (lambda [$fn $ls]     (match ls (list something)