egison 3.7.11 → 3.7.12

raw patch · 10 files changed

+87/−56 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +5/−5
• hs-src/Interpreter/egison.hs +1/−1
• hs-src/Language/Egison/Core.hs +9/−29
• hs-src/Language/Egison/Types.hs +4/−3
• sample/demo1-ja.egi +0/−0
• sample/demo1.egi +2/−2
• sample/math/geometry/exterior-derivative.egi +6/−3
• sample/primes.egi +2/−2
• test/Test.hs +54/−0
• test/UnitTest.hs +4/−11

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.7.11+Version:             3.7.12 Synopsis:            Programming language with non-linear pattern-matching against non-free data Description:   An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.@@ -51,7 +51,7 @@ Homepage:            http://www.egison.org License:             MIT License-file:        LICENSE-Author:              Satoshi Egi, Ryo Tanaka, Takahisa Watanabe, Kentaro Honda+Author:              Satoshi Egi, Ryo Tanaka, Takahisa Watanabe, Kentaro Honda, Mayuko Kori Maintainer:          Satoshi Egi <egi@egison.org> Category:            Compilers/Interpreters Build-type:          Simple@@ -85,9 +85,9 @@ Test-Suite test   Type:           exitcode-stdio-1.0   Hs-Source-Dirs: test-  Main-Is:        UnitTest.hs-  Build-Depends: egison, base >= 4.0 && < 5, transformers, mtl, Glob, HUnit, test-framework, test-framework-hunit-  Other-modules:   Paths_egison+  Main-Is:        Test.hs+  Build-Depends: egison, base >= 4.0 && < 5, transformers, mtl, Glob, HUnit, test-framework, test-framework-hunit, filepath+  Other-modules:   Paths_egison, UnitTest  Benchmark benchmark   Type: exitcode-stdio-1.0

@@ -223,7 +223,7 @@  showBanner :: IO () showBanner = do-  putStrLn $ "Egison Version " ++ showVersion version ++ " (C) 2011-2017 Satoshi Egi"+  putStrLn $ "Egison Version " ++ showVersion version ++ " (C) 2011-2018 Satoshi Egi"   putStrLn $ "https://www.egison.org"   putStrLn $ "Welcome to Egison Interpreter!" --  putStrLn $ "** Information **"

@@ -590,9 +590,13 @@     _ -> applyFunc env func (Value (makeTuple args))  evalExpr env (ApplyExpr func arg) = do-  func <- evalExpr env func+  func <- evalExpr env func >>= appendDFscripts 0   arg <- evalExpr env arg   case func of+    Value (TensorData t@(Tensor ns fs js)) -> do+      tMap (\f -> applyFunc env (Value f) arg >>= evalWHNF) t >>= fromTensor >>= return . Value >>= removeDFscripts+    Intermediate (ITensor t@(Tensor ns fs js)) -> do+      tMap (\f -> applyFunc env f arg) t >>= fromTensor     Value (MemoizedFunc name ref hashRef env names body) -> do       indices <- evalWHNF arg       indices' <- mapM fromEgison $ fromTupleValue indices@@ -608,32 +612,6 @@           writeObjectRef ref (Value (MemoizedFunc name ref hashRef env names body))           return whnf     _ -> applyFunc env func arg >>= removeDFscripts--- evalExpr env (ApplyExpr func arg) = do---   func <- evalExpr env func >>= appendDFscripts 0---   arg <- evalExpr env arg--- --  arg <- evalExpr env arg >>= fromTupleWHNF--- --  let k = fromIntegral (length arg)--- --  arg <-  mapM (\(_,j) -> appendDFscripts 0 j) (zip [1..k] arg) >>= makeITuple---   case func of---     Value (TensorData t@(Tensor ns fs js)) -> do---       tMap (\f -> applyFunc env (Value f) arg >>= evalWHNF) t >>= fromTensor >>= return . Value >>= removeDFscripts---     Intermediate (ITensor t@(Tensor ns fs js)) -> do---       tMap (\f -> applyFunc env f arg) t >>= fromTensor---     Value (MemoizedFunc name 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 env (Value (Func Nothing env names body)) arg---           retRef <- newEvaluatedObjectRef whnf---           hash <- liftIO $ readIORef hashRef---           liftIO $ writeIORef hashRef (HL.insert indices' retRef hash)---           writeObjectRef ref (Value (MemoizedFunc name ref hashRef env names body))---           return whnf---     _ -> applyFunc env func arg >>= removeDFscripts  evalExpr env (WedgeApplyExpr func arg) = do   func <- evalExpr env func >>= appendDFscripts 0@@ -1226,12 +1204,14 @@             then return MNil             else do               (carEndsRef, cdrEndsRef) <- fromJust <$> runMaybeT (unconsCollection ends)+              b2 <- evalRef cdrEndsRef >>= isEmptyCollection               carEndsNum <- evalRef carEndsRef >>= fromWHNF               if startNum > carEndsNum                 then return MNil                 else if startNum == carEndsNum-                       then return $ fromList [MState env loops' bindings ((MAtom endPat startNumWhnf Something):(MAtom pat' target matcher):trees),-                                               MState env ((LoopPatContext (name, nextNumRef) cdrEndsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]+                       then if b2+                              then return $ fromList [MState env loops' bindings ((MAtom endPat startNumWhnf Something):(MAtom pat' target matcher):trees)]+                              else return $ fromList [MState env loops' bindings ((MAtom endPat startNumWhnf Something):(MAtom pat' target matcher):trees), MState env ((LoopPatContext (name, nextNumRef) cdrEndsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]                        else return $ fromList [MState env ((LoopPatContext (name, nextNumRef) endsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]     AndPat patterns ->       let trees' = map (\pat -> MAtom pat target matcher) patterns ++ trees

@@ -956,8 +956,8 @@   let k2 = fromIntegral $ length ns2 - length js2'   let js2 = js2' ++ map (DFscript 0) [1..k2]   let (cjs, tjs1, tjs2) = h js1 js2-  t1' <- tTranspose (cjs ++ tjs1) t1-  t2' <- tTranspose (cjs ++ tjs2) t2+  t1' <- tTranspose (cjs ++ tjs1) (Tensor ns1 xs1 js1)+  t2' <- tTranspose (cjs ++ tjs2) (Tensor ns2 xs2 js2)   let cns = take (length cjs) (tSize t1')   rts1 <- mapM (`tIntRef` t1') (enumTensorIndices cns)   rts2 <- mapM (`tIntRef` t2') (enumTensorIndices cns)@@ -1186,6 +1186,7 @@   show (ApplyExpr fn (TupleExpr [])) = "(" ++ show fn ++ ")"   show (ApplyExpr fn (TupleExpr args)) = "(" ++ show fn ++ " " ++ unwords (map show args) ++ ")"   show (ApplyExpr fn arg) = "(" ++ show fn ++ " " ++ show arg ++ ")"+  show _ = "(not supported)"  instance Show EgisonValue where   show (Char c) = "c#" ++ [c]@@ -1582,7 +1583,7 @@ extendEnv (Env env idx) bdg = Env ((: env) $ HashMap.fromList bdg) idx  refVar :: Env -> Var -> Maybe ObjectRef-refVar (Env env idx) var = msum $ map (HashMap.lookup var) env+refVar (Env env _) var = msum $ map (HashMap.lookup var) env  -- -- Pattern Match

@@ -1,9 +1,9 @@-;; Extract all twin primes from the infinite list of prime numbers with pattern-matching!+;; Extract all twin primes from the infinite list of prime numbers with pattern matching! (define $twin-primes   (match-all primes (list integer)     [<join _ <cons $p <cons ,(+ p 2) _>>>      [p (+ p 2)]])) -;; Enumerate first 10 twin primes+;; Enumerate first 10 twin primes. (take 10 twin-primes) ;=>{[3 5] [5 7] [11 13] [17 19] [29 31] [41 43] [59 61] [71 73] [101 103] [107 109]}

@@ -6,8 +6,11 @@   (lambda [%X]     !((flip ∂/∂) params X))) -(d (f x y z))-;[| (f|1 x y z) (f|2 x y z) (f|3 x y z) |] -(df-normalize (d (d (f x y z))))+(define $f (function [x y z]))++(d f)+;[| f|x f|y f|z |]++(df-normalize (d (d f))) ;[| [| 0 0 0 |] [| 0 0 0 |] [| 0 0 0 |] |]

@@ -10,7 +10,7 @@     [<join _ <cons $p <cons ,(+ p 2) _>>>      [p (+ p 2)]])) -;; Enumerate first 10 twin primes+;; Enumerate the first 10 twin primes (take 10 twin-primes)  ;; Extract all prime-triplets from the infinite list of prime numbers with pattern-matching!@@ -21,6 +21,6 @@                <cons ,(+ p 6) _>>>>      [p m (+ p 6)]])) -;; Enumerate first 10 twin primes+;; Enumerate the first 10 prime triplets (take 10 prime-triplets) 

@@ -0,0 +1,54 @@+module Main where++import Control.Applicative+import Control.Monad+import Control.Monad.IO.Class+import Data.IORef+import Data.List++import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit (hUnitTestToTests)+import Test.HUnit+import System.FilePath.Glob (glob)+import System.FilePath (takeDirectory, replaceDirectory, splitPath)++import Language.Egison.Types+import Language.Egison.Core+import Language.Egison.Primitives+import Language.Egison++import UnitTest++main = do+  unitTestCases <- glob "test/[^answer]**/*.egi"+  sampleTestCases <- glob "test/answer/**/*.egi"+  defaultMain $ hUnitTestToTests $ test $ map runUnitTestCase unitTestCases ++ map runSampleTestCase sampleTestCases++runSampleTestCase :: FilePath -> Test+runSampleTestCase file = TestLabel file . TestCase $ do+  env <- initialEnv+  let directory_path = takeDirectory file+  answers <- readFile file+  assertEgisonM (lines answers) $ do+    exprs <- loadFile (replaceDirectory file $ concat $ drop 2 $ splitPath directory_path)+    let (bindings, tests) = foldr collectDefsAndTests ([], []) exprs+    env' <- recursiveBind env bindings+    vals <- forM tests (evalExprDeep env')+    return $ zip tests vals+      where+        assertEgisonM :: [String] -> EgisonM [(EgisonExpr, EgisonValue)] -> Assertion+        assertEgisonM answers m = fromEgisonM m >>= assertString . either show (f answers)+    +        collectDefsAndTests (Define name expr) (bindings, tests) =+          ((name, expr) : bindings, tests)+        collectDefsAndTests (Test expr) (bindings, tests) =+          (bindings, expr : tests)+        collectDefsAndTests _ r = r++        f :: [String] -> [(EgisonExpr, EgisonValue)] -> String+        f answers ls = g answers ls 0+        g x y i = let (e, v) = unzip y in+                  if (x !! i) == show (v !! i)+                     then (if i < (length y - 1) then g x y (i + 1)+                                                 else "")+                     else "failed " ++ show (e !! i) ++ "\n expected: " ++ (x !! i) ++ "\n but found: " ++ show (v !! i)

@@ -1,25 +1,18 @@-module Main where+module UnitTest ( runUnitTestCase ) where  import Control.Applicative import Control.Monad import Data.IORef -import Test.Framework (defaultMain)-import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.HUnit-import System.FilePath.Glob (glob)  import Language.Egison.Types import Language.Egison.Core import Language.Egison.Primitives import Language.Egison -main = do-  testCases <- glob "test/**/*.egi"-  defaultMain $ hUnitTestToTests $ test $ map runTestCase testCases--runTestCase :: FilePath -> Test-runTestCase file = TestLabel file . TestCase $ do+runUnitTestCase :: FilePath -> Test+runUnitTestCase file = TestLabel file . TestCase $ do   env <- initialEnv   assertEgisonM $ do     exprs <- loadFile file@@ -31,7 +24,7 @@         assertEgisonM m = fromEgisonM m >>= assertString . either show (const "")              collectDefsAndTests (Define name expr) (bindings, tests) =-          (((stringToVar $ show name), expr) : bindings, tests)+          ((name, expr) : bindings, tests)         collectDefsAndTests (Test expr) (bindings, tests) =           (bindings, expr : tests)         collectDefsAndTests _ r = r