diff --git a/egison.cabal b/egison.cabal --- a/egison.cabal +++ b/egison.cabal @@ -1,5 +1,5 @@ Name: egison -Version: 3.2.2 +Version: 3.2.3 Synopsis: The programming language with non-linear pattern-matching against unfree data 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, @@ -18,9 +18,13 @@ Extra-Source-Files: benchmark/Benchmark.hs Data-files: lib/core/base.egi lib/core/number.egi lib/core/collection.egi - lib/tree/tree.egi lib/tree/xml.egi lib/math/prime.egi + lib/tree/xml.egi lib/math/prime.egi elisp/egison-mode.el +source-repository head + type: git + location: https://github.com/egisatoshi/egison3.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 Hs-Source-Dirs: hs-src diff --git a/hs-src/Language/Egison/Core.hs b/hs-src/Language/Egison/Core.hs --- a/hs-src/Language/Egison/Core.hs +++ b/hs-src/Language/Egison/Core.hs @@ -443,13 +443,13 @@ startNumRef <- liftIO . newIORef . WHNF $ Value $ Integer startNum let loops' = LoopContextConstant (name, startNumRef) endNum pat pat' : loops return $ msingleton $ MState env loops' bindings (MAtom pat target matcher : trees) - LoopPat name (LoopRangeVariable start lastName) pat pat' -> do + LoopPat name (LoopRangeVariable start lastNumPat) pat pat' -> do startNum' <- evalExpr' env' start startNum <- extractInteger startNum' startNumRef <- liftIO . newIORef . WHNF $ Value $ Integer startNum lastNumRef <- liftIO . newIORef . WHNF $ Value $ Integer (startNum - 1) - return $ fromList [MState env loops ((lastName, lastNumRef):bindings) ((MAtom pat' target matcher):trees), - MState env ((LoopContextVariable (name, startNumRef) lastName pat pat'):loops) bindings ((MAtom pat target matcher):trees)] + return $ fromList [MState env loops bindings (MAtom lastNumPat lastNumRef (Value Something) : MAtom pat' target matcher : trees), + MState env (LoopContextVariable (name, startNumRef) lastNumPat pat pat' : loops) bindings (MAtom pat target matcher : trees)] ContPat -> case loops of [] -> throwError $ strMsg "cannot use cont pattern except in loop pattern" @@ -463,13 +463,13 @@ nextNumRef <- liftIO . newIORef . WHNF $ Value $ Integer nextNum let loops' = LoopContextConstant (name, nextNumRef) endNum pat pat' : loops return $ msingleton $ MState env loops' bindings (MAtom pat target matcher : trees) - LoopContextVariable (name, startNumRef) lastName pat pat' : loops -> do + LoopContextVariable (name, startNumRef) lastNumPat pat pat' : loops -> do startNum' <- evalRef' startNumRef startNum <- extractInteger startNum' let nextNum = startNum + 1 nextNumRef <- liftIO . newIORef . WHNF $ Value $ Integer nextNum - let loops' = LoopContextVariable (name, nextNumRef) lastName pat pat' : loops - return $ fromList [MState env loops ((lastName, startNumRef):bindings) (MAtom pat' target matcher : trees), + let loops' = LoopContextVariable (name, nextNumRef) lastNumPat pat pat' : loops + return $ fromList [MState env loops bindings (MAtom lastNumPat startNumRef (Value Something) : MAtom pat' target matcher : trees), MState env loops' bindings (MAtom pat target matcher : trees)] TuplePat patterns -> do diff --git a/hs-src/Language/Egison/Parser.hs b/hs-src/Language/Egison/Parser.hs --- a/hs-src/Language/Egison/Parser.hs +++ b/hs-src/Language/Egison/Parser.hs @@ -384,8 +384,8 @@ loopPat = keywordLoop >> LoopPat <$> varName <*> loopRange <*> pattern <*> option (NotPat WildCard) pattern loopRange :: Parser LoopRange -loopRange = brackets ((try $ LoopRangeConstant <$> expr <*> expr) - <|> LoopRangeVariable <$> expr <*> varName) +loopRange = brackets ((try $ LoopRangeConstant <$> expr <*> (reservedOp "," >> expr)) + <|> LoopRangeVariable <$> expr <*> pattern) -- Constants diff --git a/hs-src/Language/Egison/Types.hs b/hs-src/Language/Egison/Types.hs --- a/hs-src/Language/Egison/Types.hs +++ b/hs-src/Language/Egison/Types.hs @@ -109,7 +109,7 @@ data LoopRange = LoopRangeConstant EgisonExpr EgisonExpr - | LoopRangeVariable EgisonExpr String + | LoopRangeVariable EgisonExpr EgisonPattern deriving (Show) data PrimitivePatPattern = @@ -172,7 +172,15 @@ show (InductiveData name []) = "<" ++ name ++ ">" show (InductiveData name vals) = "<" ++ name ++ " " ++ unwords (map show vals) ++ ">" show (Tuple vals) = "[" ++ unwords (map show vals) ++ "]" - show (Collection vals) = "{" ++ unwords (map show (toList 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 show (Array vals) = "[|" ++ unwords (map show $ IntMap.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) ++ "|}" @@ -325,7 +333,7 @@ data LoopContext = LoopContextConstant Binding Integer EgisonPattern EgisonPattern - | LoopContextVariable Binding String EgisonPattern EgisonPattern + | LoopContextVariable Binding EgisonPattern EgisonPattern EgisonPattern -- -- Errors @@ -458,4 +466,3 @@ mfor :: Monad m => MList m a -> (a -> m b) -> m (MList m b) mfor = flip mmap - diff --git a/lib/core/collection.egi b/lib/core/collection.egi --- a/lib/core/collection.egi +++ b/lib/core/collection.egi @@ -22,7 +22,7 @@ [ [(list a)] {[$tgt (match-all [pxs tgt] [(list a) (list a)] [[(loop $i [1 $n] ) - (loop $i [1 n] $rs)] + (loop $i [1 ,n] $rs)] rs])]}] [ [(list a) (list a)] {[$tgt (match-all tgt (list a) @@ -30,7 +30,7 @@ [ [(list a)] {[$tgt (match-all [pxs tgt] [(list a) (list a)] [[(loop $i [1 $n] ) - (loop $i [1 n] $rs)] + (loop $i [1 ,n] $rs)] rs])]}] [ [(list a) (list a)] {[$tgt (match-all tgt (list a) diff --git a/lib/tree/tree.egi b/lib/tree/tree.egi deleted file mode 100644 --- a/lib/tree/tree.egi +++ /dev/null @@ -1,27 +0,0 @@ -(define $b-tree - (lambda [$a $b] - (algebraic-data-matcher - { }))) - -(define $tree - (lambda [$a $b] - (matcher - {[,$val [] - {[$tgt (match [val tgt] [(tree a b) (tree a b)] - {[[ ] {[]}] - [[_ _] {}]})]}] - [ b - {[ {x}] - [_ {}]}] - [ [a (list (tree a b))] ; Node whose children are seen as a list. - {[ {[x ts]}] - [_ {}]}] - [ [a (multiset (tree a b))] ; Node whose children are seen as a multiset. - {[ {[x ts]}] - [_ {}]}] - [ [(tree a b)] - {[$t {t @(match-all t (tree a b) - [ _>> x])}]}] - [$ [something] - {[$tgt {tgt}]}] - })))