egison 3.3.5 → 3.3.6

raw patch · 8 files changed

+98/−40 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +3/−3
• elisp/egison-mode.el +2/−0
• hs-src/Language/Egison.hs +1/−0
• hs-src/Language/Egison/Core.hs +59/−37
• hs-src/Language/Egison/Parser.hs +6/−0
• hs-src/Language/Egison/Types.hs +2/−0
• lib/core/collection.egi +17/−0
• lib/core/math.egi +8/−0

@@ -1,11 +1,11 @@ Name:                egison-Version:             3.3.5+Version:             3.3.6 Synopsis:            Programming language with non-linear pattern-matching against unfree data Description:   An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.   With Egison, we can directly represent pattern-matching against a wide range of data types such as lists, multisets, sets, trees and graphs.   We can find Egison programs in @lib@ and @sample@ directories.-  This package also include Emacs Lisp file @egison-mode.el@ in @elisp@ directory.+  This package also include Emacs Lisp file @elisp/egison-mode.el@.   .   The following code is the program that determines poker-hands written in Egison.   All hands are expressed in a single pattern.@@ -31,7 +31,7 @@  Extra-Source-Files:  benchmark/Benchmark.hs -Data-files:          lib/core/base.egi lib/core/collection.egi lib/core/order.egi lib/core/number.egi lib/core/natural-number.egi lib/core/string.egi lib/core/database.egi lib/core/io.egi+Data-files:          lib/core/base.egi lib/core/collection.egi lib/core/order.egi lib/core/number.egi lib/core/natural-number.egi lib/core/math.egi lib/core/string.egi lib/core/database.egi lib/core/io.egi                      lib/tree/xml.egi lib/math/prime.egi                      sample/*.egi sample/io/*.egi sample/io/*.egi                      elisp/egison-mode.el

@@ -18,6 +18,7 @@      "\\<load-file\\>"       "\\<lambda\\>"+     "\\<memoized-lambda\\>"      "\\<let\\>"      "\\<letrec\\>"      "\\<if\\>"@@ -131,6 +132,7 @@         ((equal "load-file" name) 2)         ((equal "execute" name) 2)         ((equal "lambda" name) 2)+        ((equal "memoized-lambda" name) 2)         ((equal "let" name) 2)         ((equal "letrec" name) 2)         ((equal "if" name) 2)

@@ -105,6 +105,7 @@   , "lib/core/order.egi"   , "lib/core/number.egi"   , "lib/core/natural-number.egi"+  , "lib/core/math.egi"   , "lib/core/string.egi"   , "lib/core/database.egi"   , "lib/core/io.egi"

@@ -186,42 +186,9 @@   array <- evalExpr env expr   indices <- mapM (evalExprDeep env) indices   refArray array indices- where-  refArray :: WHNFData -> [EgisonValue] -> EgisonM WHNFData-  refArray val [] = return val -  refArray (Value (Array array)) (index:indices) = do-    i <- (liftM fromInteger . fromEgison) index-    case IntMap.lookup (i + 1) array of-      Just val -> refArray (Value val) indices-      Nothing -> return $ Value Undefined-  refArray (Intermediate (IArray array)) (index:indices) = do-    i <- (liftM fromInteger . fromEgison) index-    case IntMap.lookup (i + 1) array of-      Just ref -> evalRef ref >>= flip refArray indices-      Nothing -> return $ Value Undefined-  refArray (Value (IntHash hash)) (index:indices) = do-    key <- fromEgison index-    case HL.lookup key hash of-      Just val -> refArray (Value val) indices-      Nothing -> return $ Value Undefined-  refArray (Intermediate (IIntHash hash)) (index:indices) = do-    key <- fromEgison 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 <- evalStringWHNF $ 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 <- evalStringWHNF $ 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 or hash" val -evalExpr env (LambdaExpr names expr) = return . Value $ Func env names expr +evalExpr env (LambdaExpr names expr) = return . Value $ Func env names expr+ evalExpr env (PatternFunctionExpr names pattern) = return . Value $ PatternFunc env names pattern  evalExpr env (IfExpr test expr expr') = do@@ -301,7 +268,22 @@ evalExpr env (ApplyExpr func arg) = do   func <- evalExpr env func   arg <- evalExpr env arg-  applyFunc func arg+  case func of+    Value (MemoizedFunc ref hashRef env names body) -> do+      indices <- evalWHNF arg+      indices' <- mapM fromEgison $ fromTupleValue indices+      hash <- liftIO $ readIORef hashRef+      case HL.lookup indices' hash of+        Just objRef -> do+          evalRef objRef+        Nothing -> do+          whnf <- applyFunc (Value (Func env names body)) arg+          retRef <- newEvalutedObjectRef whnf+          hash <- liftIO $ readIORef hashRef+          liftIO $ writeIORef hashRef (HL.insert indices' retRef hash)+          writeObjectRef ref (Value (MemoizedFunc ref hashRef env names body))+          return whnf+    _ -> applyFunc func arg  evalExpr env (MatcherBFSExpr info) = return $ Value $ UserMatcher env BFSMode info evalExpr env (MatcherDFSExpr info) = return $ Value $ UserMatcher env DFSMode info@@ -401,6 +383,40 @@       ref <- newEvalutedObjectRef (Value . Integer $ i)       return $ extendEnv env [(name, ref)] +refArray :: WHNFData -> [EgisonValue] -> EgisonM WHNFData+refArray val [] = return val +refArray (Value (Array array)) (index:indices) = do+  i <- (liftM fromInteger . fromEgison) index+  case IntMap.lookup (i + 1) array of+    Just val -> refArray (Value val) indices+    Nothing -> return $ Value Undefined+refArray (Intermediate (IArray array)) (index:indices) = do+  i <- (liftM fromInteger . fromEgison) index+  case IntMap.lookup (i + 1) array of+    Just ref -> evalRef ref >>= flip refArray indices+    Nothing -> return $ Value Undefined+refArray (Value (IntHash hash)) (index:indices) = do+  key <- fromEgison index+  case HL.lookup key hash of+    Just val -> refArray (Value val) indices+    Nothing -> return $ Value Undefined+refArray (Intermediate (IIntHash hash)) (index:indices) = do+  key <- fromEgison 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 <- evalStringWHNF $ 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 <- evalStringWHNF $ 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 or hash" val+ newThunk :: Env -> EgisonExpr -> Object newThunk env expr = Thunk $ evalExpr env expr @@ -421,7 +437,13 @@   let (names, exprs) = unzip bindings   refs <- replicateM (length bindings) $ newObjectRef nullEnv UndefinedExpr   let env' = extendEnv env $ makeBindings names refs-  zipWithM_ (\ref expr -> liftIO . writeIORef ref . Thunk $ evalExpr env' expr) refs exprs+  zipWithM_ (\ref expr ->+               case expr of+                 MemoizedLambdaExpr names body -> do+                   hashRef <- liftIO $ newIORef HL.empty+                   liftIO . writeIORef ref . WHNF . Value $ MemoizedFunc ref hashRef env' names body+                 _ -> liftIO . writeIORef ref . Thunk $ evalExpr env' expr)+            refs exprs   return env'  --

@@ -157,6 +157,7 @@              <|> collectionExpr              <|> parens (ifExpr                          <|> lambdaExpr+                         <|> memoizedLambdaExpr                          <|> patternFunctionExpr                          <|> letRecExpr                          <|> letExpr@@ -296,6 +297,9 @@ lambdaExpr :: Parser EgisonExpr lambdaExpr = keywordLambda >> LambdaExpr <$> varNames <*> expr +memoizedLambdaExpr :: Parser EgisonExpr+memoizedLambdaExpr = keywordMemoizedLambda >> MemoizedLambdaExpr <$> varNames <*> expr+ patternFunctionExpr :: Parser EgisonExpr patternFunctionExpr = keywordPatternFunction >> PatternFunctionExpr <$> varNames <*> pattern @@ -519,6 +523,7 @@   , "if"   , "apply"   , "lambda"+  , "memoized-lambda"   , "pattern-function"   , "letrec"   , "let"@@ -567,6 +572,7 @@ keywordElse                 = reserved "else" keywordApply                = reserved "apply" keywordLambda               = reserved "lambda"+keywordMemoizedLambda       = reserved "memoized-lambda" keywordPatternFunction      = reserved "pattern-function" keywordLetRec               = reserved "letrec" keywordLet                  = reserved "let"

@@ -136,6 +136,7 @@   | HashExpr [(EgisonExpr, EgisonExpr)]    | LambdaExpr [String] EgisonExpr+  | MemoizedLambdaExpr [String] EgisonExpr   | PatternFunctionExpr [String] EgisonPattern      | IfExpr EgisonExpr EgisonExpr EgisonExpr@@ -235,6 +236,7 @@   | StrHash (HashMap ByteString EgisonValue)   | UserMatcher Env PMMode MatcherInfo   | Func Env [String] EgisonExpr+  | MemoizedFunc ObjectRef (IORef (HashMap [Integer] ObjectRef)) Env [String] EgisonExpr   | PatternFunc Env [String] EgisonPattern   | PrimitiveFunc PrimitiveFunc   | IOFunc (EgisonM WHNFData)

@@ -114,6 +114,13 @@        [<cons $x $xs> (let {[$y (fn init x)]}                         (foldl fn y xs))]}))) +(define $scanl+  (lambda [$fn $init $ls]+    {init @(match ls (list something)+             {[<nil> {}]+              [<cons $x $xs> (let {[$y (fn init x)]}+                               (scanl fn y xs))]})}))+ (define $map2   (lambda [$fn $xs $ys]     (match [xs ys] [(list something) (list something)]@@ -194,6 +201,16 @@   (lambda [$a $x $xs]     (length (match-all xs (list a)               [<join _ <cons ,x _>> x]))))++(define $frequency+  (lambda [$xs]+    (let {[$us (unique xs)]}+      (map (lambda [$u] [u (count u xs)]) us))))++(define $frequency/m+  (lambda [$a $xs]+    (let {[$us (unique/m a xs)]}+      (map (lambda [$u] [u (count/m a u xs)]) us))))  ;; ;; Simple accessors

@@ -0,0 +1,8 @@+(define $permutation-count+  (lambda [$n $r]+    (foldl * 1 (between (- n (- r 1)) n))))++(define $combination-count+  (lambda [$n $r]+    (/ (permutation-count n r)+       (fact r))))