egison 3.0.6 → 3.0.7

raw patch · 5 files changed

+61/−21 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Interpreter/egisoni.hs +2/−0
• hs-src/Language/Egison/Core.hs +4/−1
• hs-src/Language/Egison/Desugar.hs +45/−17
• hs-src/Language/Egison/Parser.hs +9/−2

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.0.6+Version:             3.0.7 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.

@@ -114,6 +114,8 @@             Left err | show err =~ "expecting (top-level|\"define\")" -> do               result <- liftIO $ fromEgisonM (readExpr newInput) >>= either (return . Left) (evalEgisonExpr env)               case result of+                Left err | show err =~ "unexpected end of input" -> do+                  loop env (take (length prompt) (repeat ' ')) $ newInput ++ "\n"                 Left err -> do                   liftIO $ putStrLn $ show err                   loop env prompt ""

@@ -194,7 +194,8 @@   generateArray env name size expr evalExpr env (GenerateArrayExpr (name:xs) (TupleExpr (size:ys)) expr) =    generateArray env name size (GenerateArrayExpr xs (TupleExpr ys) expr)-evalExpr _ (GenerateArrayExpr _ _ _) = throwError $ strMsg "invalid generate-array expression"+evalExpr env (GenerateArrayExpr names size expr) = +  evalExpr env (GenerateArrayExpr names (TupleExpr [size]) expr)  evalExpr env (ArraySizeExpr expr) =    evalExpr env expr >>= arraySize@@ -461,6 +462,8 @@                   keys <- return $ IntMap.keys ary                   vals <- mapM (newEvaluatedThunk . Value) $ IntMap.elems ary                   return . Intermediate . IArray $ IntMap.insert index ref (IntMap.fromList $ zip keys vals)+                updateArray _ _ = do+                  throwError $ strMsg "expected array value"                 subst :: (Eq a) => a -> b -> [(a, b)] -> [(a, b)]                 subst k nv ((k', v'):xs) | k == k'   = (k', nv):(subst k nv xs)                                          | otherwise = (k', v'):(subst k nv xs)

@@ -4,6 +4,8 @@ import Control.Applicative ((<$>), (<*>), (<*), (*>), pure) import qualified Data.Sequence as Sq import Data.Sequence (ViewL(..), (<|))+import qualified Data.Set as S+import Data.Set (Set) import Data.Char (toUpper) import Control.Monad.Error import Control.Monad.State@@ -54,7 +56,7 @@         where           genClauses :: [(String, [EgisonExpr])] -> DesugarM [MatchClause]           genClauses patterns = (++) <$> mapM genClause patterns-                                     <*> pure [(WildCard, matchingFailure)]+                                     <*> pure [((TuplePat [WildCard, WildCard]), matchingFailure)]                      genClause :: (String, [EgisonExpr]) -> DesugarM MatchClause           genClause pattern = do@@ -185,22 +187,48 @@ desugar expr = return expr  desugarPattern :: EgisonPattern -> DesugarM EgisonPattern-desugarPattern (ValuePat expr) = ValuePat <$> desugar expr-desugarPattern (PredPat expr) = PredPat <$> desugar expr-desugarPattern (CutPat pattern) = CutPat <$> desugarPattern pattern-desugarPattern (NotPat pattern) = NotPat <$> desugarPattern pattern-desugarPattern (AndPat patterns) = AndPat <$> mapM desugarPattern patterns-desugarPattern (OrPat patterns)  = OrPat <$> mapM desugarPattern patterns-desugarPattern (TuplePat patterns)  = TuplePat <$> mapM desugarPattern patterns-desugarPattern (InductivePat name patterns) =-  InductivePat name <$> mapM desugarPattern patterns-desugarPattern (IndexedPat pattern exprs) =-  IndexedPat <$> desugarPattern pattern <*> mapM desugar exprs-desugarPattern (ApplyPat expr patterns) =-  ApplyPat <$> desugar expr <*> mapM desugarPattern patterns -desugarPattern (LoopPat name expr pattern1 pattern2) =-  LoopPat name <$> desugar expr <*> desugarPattern pattern1 <*> desugarPattern pattern2-desugarPattern pattern = return pattern+desugarPattern pattern = LetPat (map makeBinding $ S.elems $ collectName pattern) <$> desugarPattern' pattern + where+   collectNames :: [EgisonPattern] -> Set String+   collectNames patterns = S.unions $ map collectName patterns++   collectName :: EgisonPattern -> Set String+   collectName (CutPat pattern) = collectName pattern +   collectName (NotPat pattern) = collectName pattern+   collectName (AndPat patterns) = collectNames patterns+   collectName (TuplePat patterns) = collectNames patterns+   collectName (InductivePat _ patterns) = collectNames patterns+   collectName (ApplyPat _ patterns) = collectNames patterns+   collectName (LoopPat _ _ pattern1 pattern2) = collectName pattern1 `S.union` collectName pattern2+   collectName (LetPat _ pattern) = collectName pattern+   collectName (IndexedPat (PatVar name) _) = S.singleton name+   collectName (OrPat patterns) = collectNames patterns+   collectName _ = S.empty+   +   makeBinding :: String -> BindingExpr+   makeBinding name = ([name], ArrayExpr [])++desugarPattern' :: EgisonPattern -> DesugarM EgisonPattern+desugarPattern' (ValuePat expr) = ValuePat <$> desugar expr+desugarPattern' (PredPat expr) = PredPat <$> desugar expr+desugarPattern' (CutPat pattern) = CutPat <$> desugarPattern' pattern+desugarPattern' (NotPat pattern) = NotPat <$> desugarPattern' pattern+desugarPattern' (AndPat patterns) = AndPat <$> mapM desugarPattern' patterns+desugarPattern' (TuplePat patterns)  = TuplePat <$> mapM desugarPattern' patterns+desugarPattern' (InductivePat name patterns) =+  InductivePat name <$> mapM desugarPattern' patterns+desugarPattern' (IndexedPat pattern exprs) =+  IndexedPat <$> desugarPattern' pattern <*> mapM desugar exprs+desugarPattern' (ApplyPat expr patterns) =+  ApplyPat <$> desugar expr <*> mapM desugarPattern' patterns +desugarPattern' (LoopPat name expr pattern1 pattern2) =+  LoopPat name <$> desugar expr <*> desugarPattern' pattern1 <*> desugarPattern' pattern2+desugarPattern' (LetPat binds pattern) = do+  LetPat <$> desugarBindings binds <*> desugarPattern' pattern+desugarPattern' (OrPat patterns)  = +  OrPat <$> mapM desugarPattern' patterns+desugarPattern' pattern = return pattern+  desugarBinding :: BindingExpr -> DesugarM BindingExpr desugarBinding (name, expr) = do

@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} module Language.Egison.Parser         ( readTopExprs        , readTopExpr@@ -121,7 +122,7 @@              <|> try varExpr              <|> inductiveDataExpr              <|> try arrayExpr-             <|> tupleExpr+             <|> try tupleExpr              <|> collectionExpr              <|> parens (ifExpr                          <|> lambdaExpr@@ -237,7 +238,13 @@ letExpr = keywordLet >> LetExpr <$> bindings <*> expr  doExpr :: Parser EgisonExpr-doExpr = keywordDo >> DoExpr <$> bindings <*> expr+doExpr = keywordDo >> DoExpr <$> statements <*> expr++statements :: Parser [BindingExpr]+statements = braces $ sepEndBy statement whiteSpace++statement :: Parser BindingExpr+statement = try binding <|> brackets (([],) <$> expr)  bindings :: Parser [BindingExpr] bindings = braces $ sepEndBy binding whiteSpace