egison 3.7.4 → 3.7.5

raw patch · 4 files changed

+32/−78 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Language/Egison/Core.hs +24/−56
• hs-src/Language/Egison/Parser.hs +6/−5
• hs-src/Language/Egison/Types.hs +1/−16

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

@@ -47,6 +47,7 @@ import Control.Monad.State hiding (mapM, state) import Control.Monad.Trans.Maybe +import Data.List (partition) import Data.Sequence (Seq, ViewL(..), ViewR(..), (><)) import qualified Data.Sequence as Sq import Data.Ratio@@ -424,65 +425,32 @@   let bindings = zip vars syms   whnf <- evalExpr (extendEnv env bindings) expr   case whnf of-    (Value val) -> removeVarsFromIndices symId val >>= return . Value+    (Value (TensorData (Tensor ns xs js))) -> do+      removeTmpscripts symId (Value (TensorData (Tensor ns xs js)))     (Intermediate (ITensor (Tensor ns xs js))) -> do-      js' <- removeVars symId (tClearIndex' js)-      return (Intermediate (ITensor (Tensor ns xs js')))+      removeTmpscripts symId (Intermediate (ITensor (Tensor ns xs js)))     _ -> return whnf  where-  removeVarsFromIndices :: String -> EgisonValue -> EgisonM EgisonValue-  removeVarsFromIndices symId (TensorData (Tensor ns xs js)) = do-    xs' <- mapM (removeVarsFromIndices symId) xs-    js' <- removeVars symId (tClearIndex' js)-    fromTensor (Tensor ns xs' js')-  removeVarsFromIndices symId (ScalarData s) = f symId s >>= return . ScalarData-  removeVarsFromIndices _ val = return val-  f :: String -> ScalarData -> EgisonM ScalarData-  f symId (Div (Plus ts1) (Plus ts2)) = do-    ts1' <- mapM (g symId) ts1-    ts2' <- mapM (g symId) ts2-    return (Div (Plus ts1') (Plus ts2'))-  g :: String -> TermExpr -> EgisonM TermExpr-  g symId (Term a xns) = do-    let (xs, ns) = unzip xns-    xs' <- mapM (h symId) xs-    return (Term a (zip xs' ns))-  h :: String -> SymbolExpr -> EgisonM SymbolExpr-  h symId (Symbol id name js) = do-    js' <- removeVars symId (map (\j -> case j of-                                          Superscript i -> Superscript (ScalarData i)-                                          Subscript i -> Subscript (ScalarData i)-                                          SupSubscript i -> SupSubscript (ScalarData i)-                                  )js)-    let js'' = map (\j -> case j of-                            Superscript (ScalarData i) -> Superscript i-                            Subscript (ScalarData i) -> Subscript i-                            SupSubscript (ScalarData i) -> SupSubscript i-                    ) js'-    return (Symbol id name js'')-  h symId (Apply fn xs) = do-    xs' <- mapM (f symId) xs-    return (Apply fn xs')-  h symId (Quote x) = do-    x' <- f symId x-    return (Quote x')-  removeVars :: String -> [Index EgisonValue] -> EgisonM [Index EgisonValue]-  removeVars _ [] = return []-  removeVars symId ((Subscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []])))):js)-    | symId == id = return []-    | otherwise = do js' <- removeVars symId js-                     return $ (Subscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []])))):js'-  removeVars symId ((Superscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []])))):js)-    | symId == id = return []-    | otherwise = do js' <- removeVars symId js-                     return $ (Superscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []])))):js'-  removeVars symId ((SupSubscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []])))):js)-    | symId == id = return []-    | otherwise = do js' <- removeVars symId js-                     return $ (SupSubscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []])))):js'-  removeVars symId (j:js) = do-    js' <- removeVars symId js-    return $ j:js'+  isTmpSymbol :: String -> (Index EgisonValue) -> Bool+  isTmpSymbol symId (Subscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []]))))+    | symId == id = True+    | otherwise = False+  isTmpSymbol symId (Superscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []]))))+    | symId == id = True+    | otherwise = False+  isTmpSymbol symId (SupSubscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []]))))+    | symId == id = True+    | otherwise = False+  removeTmpscripts :: String -> WHNFData -> EgisonM WHNFData+  removeTmpscripts symId (Intermediate (ITensor (Tensor s xs is))) = do+    let (ds, js) = partition (isTmpSymbol symId) is+    (Tensor s ys _) <- tTranspose (js ++ ds) (Tensor s xs is)+    return (Intermediate (ITensor (Tensor s ys js)))+  removeTmpscripts symId (Value (TensorData (Tensor s xs is))) = do+    let (ds, js) = partition (isTmpSymbol symId) is+    (Tensor s ys _) <- tTranspose (js ++ ds) (Tensor s xs is)+    return (Value (TensorData (Tensor s ys js)))+  removeDFscripts _ whnf = return whnf       evalExpr env (DoExpr bindings expr) = return $ Value $ IOFunc $ do

@@ -88,11 +88,12 @@  -- |Load a libary file loadLibraryFile :: FilePath -> EgisonM [EgisonTopExpr]-loadLibraryFile file =-  if file =~ "^lib/"-    then liftIO (getDataFileName file) >>= loadFile-    else do homeDir <- liftIO $ getHomeDirectory-            loadFile $ homeDir ++ "/.egison/" ++ file+loadLibraryFile file = do+  homeDir <- liftIO $ getHomeDirectory+  doesExist <- liftIO $ doesFileExist $ homeDir ++ "/.egison/" ++ file+  if doesExist+    then loadFile $ homeDir ++ "/.egison/" ++ file+    else liftIO (getDataFileName file) >>= loadFile  -- |Load a file loadFile :: FilePath -> EgisonM [EgisonTopExpr]

@@ -44,6 +44,7 @@     , tIndex     , tref     , enumTensorIndices+    , tTranspose     , tTranspose'     , appendDFscripts     , removeDFscripts@@ -56,8 +57,6 @@     , tContract'     , tConcat     , tConcat'-    , tClearIndex-    , tClearIndex'     -- * Scalar     , symbolScalarData     , mathExprToEgison@@ -1087,20 +1086,6 @@ tConcat' ts = do   ts' <- mapM getScalar ts   return $ Tensor [fromIntegral (length ts)] (V.fromList ts') []--tClearIndex :: HasTensor a => Tensor a -> Tensor a-tClearIndex (Tensor ns xs js) = Tensor ns xs (tClearIndex' js)-tClearIndex s@(Scalar _) = s--tClearIndex' :: [Index EgisonValue] -> [Index EgisonValue]-tClearIndex' js = reverse (g (reverse js))- where-  g :: [Index EgisonValue] -> [Index EgisonValue]-  g [] = []-  g ((Superscript (ScalarData (Div (Plus [(Term 1 [(Symbol _ (':':':':':':_) [], 1)])]) (Plus [(Term 1 [])])))):js) = g js-  g ((Subscript (ScalarData (Div (Plus [(Term 1 [(Symbol _ (':':':':':':_) [], 1)])]) (Plus [(Term 1 [])])))):js) = g js-  g ((SupSubscript (ScalarData (Div (Plus [(Term 1 [(Symbol _ (':':':':':':_) [], 1)])]) (Plus [(Term 1 [])])))):js) = g js-  g js = js  getScalar :: (Tensor a) -> EgisonM a getScalar (Scalar x) = return x