packages feed

egison 3.2.20 → 3.2.21

raw patch · 8 files changed

+82/−11 lines, 8 files

Files

egison.cabal view
@@ -1,5 +1,5 @@ Name:                egison-Version:             3.2.20+Version:             3.2.21 Synopsis:            Programming language with non-linear pattern-matching against unfree data types Description:   An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.@@ -36,7 +36,7 @@  source-repository head   type: git-  location: https://github.com/egisatoshi/egison3.git+  location: https://github.com/egisatoshi/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
elisp/egison-mode.el view
@@ -36,6 +36,9 @@      "\\<next-match-all\\>"      "\\<next-match-all-lambda\\>"      "\\<next-matcher\\>"+     "\\<matcher\\>"+     "\\<matcher-bfs\\>"+     "\\<matcher-dfs\\>"      "\\<algebraic-data-matcher\\>"      "\\<pattern-function\\>" @@ -145,6 +148,8 @@         ((equal "next-match-all" name) 2)         ((equal "next-match-all-lambda" name) 2)         ((equal "matcher" name) 2)+        ((equal "matcher-bfs" name) 2)+        ((equal "matcher-dfs" name) 2)         ((equal "algebraic-data-matcher" name) 2)         ((equal "pattern-function" name) 2)         ((equal "do" name) 2)
hs-src/Interpreter/egisoni.hs view
@@ -1,5 +1,6 @@ module Main where +import Prelude hiding ( catch ) import Control.Exception ( AsyncException(..), catch ) import Control.Monad.Error
hs-src/Language/Egison/Core.hs view
@@ -391,7 +391,7 @@ newThunk env expr = Thunk $ evalExpr env expr  newObjectRef :: Env -> EgisonExpr -> EgisonM ObjectRef-newObjectRef env expr = liftIO . newIORef . Thunk $ evalExpr env expr+newObjectRef env expr = liftIO $ newIORef $ newThunk env expr  writeObjectRef :: ObjectRef -> WHNFData -> EgisonM () writeObjectRef ref val = liftIO . writeIORef ref $ WHNF val@@ -427,9 +427,9 @@  where   processMStates' :: MList EgisonM MatchingState -> EgisonM [MList EgisonM MatchingState]   processMStates' MNil = return []-  processMStates' stream@(MCons state _) = do+  processMStates' stream@(MCons state _) =     case topMAtom state of-      Nothing -> processMStatesBFS stream+      Nothing -> processMStatesDFS stream       Just matom -> do         case pmMode (getMatcher matom) of           DFSMode -> processMStatesDFS stream@@ -593,7 +593,7 @@                 Just ref -> do                   obj <- evalRef ref >>= updateHash indices >>= newEvalutedObjectRef                   return $ msingleton $ MState env loops (subst name obj bindings) trees-                Nothing  -> do+                Nothing  -> do -- throwError $ strMsg "Cannot reach here!\nIndexed-patttern-variable does not initialized."                   obj <- updateHash indices (Intermediate . IIntHash $ HL.empty) >>= newEvalutedObjectRef                   return $ msingleton $ MState env loops ((name,obj):bindings) trees                where
hs-src/Language/Egison/Desugar.hs view
@@ -223,7 +223,15 @@  desugar (VarExpr name) = do   asks $ maybe (VarExpr name) id . lookup name++desugar (MatcherBFSExpr matcherInfo) = do+  matcherInfo' <- desugarMatcherInfo matcherInfo+  return $ MatcherBFSExpr matcherInfo'   +desugar (MatcherDFSExpr matcherInfo) = do+  matcherInfo' <- desugarMatcherInfo matcherInfo+  return $ MatcherDFSExpr matcherInfo'+   desugar expr = return expr  desugarPattern :: EgisonPattern -> DesugarM EgisonPattern@@ -301,3 +309,18 @@   rest'   <- desugarMatchClauses rest   return $ clause' : rest' desugarMatchClauses [] = return []++desugarMatcherInfo :: MatcherInfo -> DesugarM MatcherInfo+desugarMatcherInfo [] = return []+desugarMatcherInfo ((pp, matcher, pds):matcherInfo) = do+  matcher' <- desugar matcher+  pds' <- desugarPrimitiveDataMatchClauses pds+  matcherInfo' <- desugarMatcherInfo matcherInfo+  return $ (pp, matcher', pds'):matcherInfo'++desugarPrimitiveDataMatchClauses :: [(PrimitiveDataPattern, EgisonExpr)] -> DesugarM [(PrimitiveDataPattern, EgisonExpr)]+desugarPrimitiveDataMatchClauses [] = return []+desugarPrimitiveDataMatchClauses ((pd, expr):pds) = do+  expr' <- desugar expr+  pds' <- desugarPrimitiveDataMatchClauses pds+  return $ (pd, expr'):pds'
hs-src/Language/Egison/Types.hs view
@@ -271,7 +271,8 @@   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) ++ "|}"-  show (UserMatcher _ _ _) = "#<matcher>"+  show (UserMatcher _ BFSMode _) = "#<matcher-bfs>"+  show (UserMatcher _ DFSMode _) = "#<matcher-dfs>"   show (Func _ names _) = "(lambda [" ++ unwords names ++ "] ...)"   show (PatternFunc _ _ _) = "#<pattern-function>"   show (PrimitiveFunc _) = "#<primitive-function>"@@ -506,23 +507,27 @@ type Match = [Binding]  data PMMode = BFSMode | DFSMode+ deriving (Show)  pmMode :: Matcher -> PMMode pmMode (UserMatcher _ mode _) = mode-pmMode (Tuple _) = BFSMode-pmMode Something = BFSMode+pmMode (Tuple _) = DFSMode+pmMode Something = DFSMode  data MatchingState = MState Env [LoopContext] [Binding] [MatchingTree]+ deriving (Show)  data MatchingTree =     MAtom EgisonPattern ObjectRef Matcher   | MNode [PatternBinding] MatchingState+ deriving (Show)  type PatternBinding = (Var, EgisonPattern)  data LoopContext =     LoopContextConstant Binding Integer EgisonPattern EgisonPattern   | LoopContextVariable Binding EgisonPattern EgisonPattern EgisonPattern+ deriving (Show)  -- -- Errors
lib/core/base.egi view
@@ -3,7 +3,7 @@ ;;  (define $buildin-data-matcher-  (matcher+  (matcher-dfs     {[,$val []       {[$tgt (if (eq? val tgt)                  {[]}
lib/core/collection.egi view
@@ -7,7 +7,7 @@ ;;; (define $list   (lambda [$a]-    (matcher+    (matcher-bfs       {[,$val []         {[$tgt (match [val tgt] [(list a) (list a)]                  {[[<nil> <nil>] {[]}]@@ -37,6 +37,43 @@                   rs])]}]        [<nioj $ $> [(list a) (list a)]         {[$tgt (match-all tgt (list a)+                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]+       [$ [something]+        {[$tgt {tgt}]}]+       })))++(define $flist+  (lambda [$a]+    (matcher-dfs+      {[,$val []+        {[$tgt (match [val tgt] [(flist a) (flist a)]+                 {[[<nil> <nil>] {[]}]+                  [[<cons $x $xs> <cons ,x ,xs>] {[]}]+                  [[_ _] {}]})]}]+       [<nil> []+        {[{} {[]}]+         [_ {}]}]+       [<cons $ $> [a (flist a)]+        {[{$x @$xs} {[x xs]}]+         [_ {}]}]+       [<snoc $ $> [a (flist a)]+        {[{@$xs $x} {[x xs]}]+         [_ {}]}]+       [<join ,$pxs $> [(flist a)]+        {[$tgt (match-all [pxs tgt] [(flist a) (flist a)]+                 [[(loop $i [1 $n] <cons $xa_i ...> <nil>)+                   (loop $i [1 ,n] <cons ,xa_i ...> $rs)]+                  rs])]}]+       [<join $ $> [(flist a) (flist a)]+        {[$tgt (match-all tgt (flist a)+                 [(loop $i [1 $n] <cons $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]+       [<nioj ,$pxs $> [(flist a)]+        {[$tgt (match-all [pxs tgt] [(flist a) (flist a)]+                 [[(loop $i [1 $n] <snoc $xa_i ...> <nil>)+                   (loop $i [1 ,n] <snoc ,xa_i ...> $rs)]+                  rs])]}]+       [<nioj $ $> [(flist a) (flist a)]+        {[$tgt (match-all tgt (flist a)                  [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]        [$ [something]         {[$tgt {tgt}]}]