egison 3.3.7 → 3.3.8

raw patch · 8 files changed

+62/−49 lines, 8 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 +30/−31
• hs-src/Language/Egison/Desugar.hs +4/−0
• hs-src/Language/Egison/Parser.hs +3/−3
• hs-src/Language/Egison/Primitives.hs +3/−2
• hs-src/Language/Egison/Types.hs +5/−6
• sample/graph.egi +4/−4
• sample/tak.egi +12/−2

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

@@ -48,15 +48,14 @@ import Data.IORef import Data.Maybe +import Data.Array ((!))+import qualified Data.Array as Array import qualified Data.HashMap.Lazy as HL  import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy.Char8 () import qualified Data.ByteString.Lazy.Char8 as B -import qualified Data.IntMap as IntMap-- import Language.Egison.Types import Language.Egison.Parser @@ -149,8 +148,8 @@   fromInnerExpr (SubCollectionExpr expr) = ISubCollection <$> newObjectRef env expr  evalExpr env (ArrayExpr exprs) = do-  ref' <- mapM (newObjectRef env) exprs-  return . Intermediate . IArray $ IntMap.fromList $ zip (enumFromTo 1 (length exprs)) ref'+  refs' <- mapM (newObjectRef env) exprs+  return . Intermediate . IArray $ Array.listArray (1, toInteger (length exprs)) refs'  evalExpr env (HashExpr assocs) = do   let (keyExprs, exprs) = unzip assocs@@ -292,20 +291,20 @@ evalExpr env (MatcherBFSExpr info) = return $ Value $ UserMatcher env BFSMode info evalExpr env (MatcherDFSExpr info) = return $ Value $ UserMatcher env DFSMode info -evalExpr env (GenerateArrayExpr (name:[]) (TupleExpr (size:[])) expr) =-  generateArray env name size expr-evalExpr env (GenerateArrayExpr (name:xs) (TupleExpr (size:ys)) expr) = -  generateArray env name size (GenerateArrayExpr xs (TupleExpr ys) expr)+evalExpr env (GenerateArrayExpr (name:[]) (TupleExpr (sizeExpr:[])) expr) =+  generateArray env name sizeExpr expr+evalExpr env (GenerateArrayExpr (name:xs) (TupleExpr (sizeExpr:ys)) expr) = +  generateArray env name sizeExpr (GenerateArrayExpr xs (TupleExpr ys) expr) evalExpr env (GenerateArrayExpr names size expr) =    evalExpr env (GenerateArrayExpr names (TupleExpr [size]) expr) -evalExpr env (ArraySizeExpr expr) = -  evalExpr env expr >>= arraySize+evalExpr env (ArrayBoundsExpr expr) = +  evalExpr env expr >>= arrayBounds   where-    arraySize :: WHNFData -> EgisonM WHNFData-    arraySize (Intermediate (IArray vals)) = return . Value . Integer . toInteger $ IntMap.size vals-    arraySize (Value (Array vals))         = return . Value . Integer . toInteger $ IntMap.size vals-    arraySize val                          = throwError $ TypeMismatch "array" val+    arrayBounds :: WHNFData -> EgisonM WHNFData+    arrayBounds (Intermediate (IArray arr)) = return . Value . toEgison $ Array.bounds arr+    arrayBounds (Value (Array arr))         = return . Value . toEgison $ Array.bounds arr+    arrayBounds val                          = throwError $ TypeMismatch "array" val  evalExpr _ SomethingExpr = return $ Value Something evalExpr _ UndefinedExpr = return $ Value Undefined@@ -343,8 +342,8 @@ evalWHNF (Intermediate (IInductiveData name refs)) =   InductiveData name <$> mapM evalRefDeep refs evalWHNF (Intermediate (IArray refs)) = do-  refs' <- mapM evalRefDeep $ IntMap.elems refs-  return $ Array $ IntMap.fromList $ zip (enumFromTo 1 (IntMap.size refs)) refs'+  refs' <- mapM evalRefDeep $ Array.elems refs+  return $ Array $ Array.listArray (Array.bounds refs) refs' evalWHNF (Intermediate (IIntHash refs)) = do   refs' <- mapM evalRefDeep refs   return $ IntHash refs'@@ -372,15 +371,14 @@ applyFunc val _ = throwError $ TypeMismatch "function" val  generateArray :: Env -> String -> EgisonExpr -> EgisonExpr -> EgisonM WHNFData-generateArray env name size expr = do  -  size' <- evalExpr env size >>= fromWHNF >>= return . fromInteger-  elems <- mapM genElem (enumFromTo 1 size')-  return $ Intermediate $ IArray $ IntMap.fromList elems+generateArray env name sizeExpr expr = do+  size <- evalExpr env sizeExpr >>= fromWHNF >>= return . fromInteger+  elems <- mapM genElem (enumFromTo 1 size)+  return $ Intermediate $ IArray $ Array.listArray (1, size) elems   where-    genElem :: Int -> EgisonM (Int, ObjectRef)-    genElem i = do env <- bindEnv env name $ toInteger i-                   val <- evalExpr env expr >>= newEvalutedObjectRef                   -                   return (i, val)+    genElem :: Integer -> EgisonM ObjectRef+    genElem i = do env' <- bindEnv env name $ toInteger i+                   newObjectRef env' expr          bindEnv :: Env -> String -> Integer -> EgisonM Env     bindEnv env name i = do@@ -391,14 +389,15 @@ 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+  if (\(a,b) -> if a <= i && i <= b then True else False) $ Array.bounds array+    then refArray (Value (array ! i)) indices+    else 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+  if (\(a,b) -> if a <= i && i <= b then True else False) $ Array.bounds array+    then let ref = array ! i in+           evalRef ref >>= flip refArray indices+    else return  $ Value Undefined refArray (Value (IntHash hash)) (index:indices) = do   key <- fromEgison index   case HL.lookup key hash of

@@ -137,6 +137,10 @@ desugar (IndexedExpr expr indices) =    IndexedExpr <$> desugar expr <*> (mapM desugar indices) +desugar (ArrayBoundsExpr expr) = do+  expr' <- desugar expr+  return $ ArrayBoundsExpr expr'+ desugar (InductiveDataExpr name exprs) = do    exprs' <- mapM desugar exprs   return $ InductiveDataExpr name exprs'

@@ -384,7 +384,7 @@ generateArrayExpr = keywordGenerateArray >> GenerateArrayExpr <$> varNames <*> expr <*> expr  arraySizeExpr :: Parser EgisonExpr-arraySizeExpr = keywordArraySize >> ArraySizeExpr <$> expr+arraySizeExpr = keywordArrayBounds >> ArrayBoundsExpr <$> expr  arrayRefExpr :: Parser EgisonExpr arrayRefExpr = keywordArrayRef >> ArrayRefExpr <$> expr <*> expr@@ -549,7 +549,7 @@   , "io"   , "algebraic-data-matcher"   , "generate-array"-  , "array-size"+  , "array-bounds"   , "array-ref"   , "something"   , "undefined"]@@ -606,7 +606,7 @@ keywordUndefined            = reserved "undefined" keywordAlgebraicDataMatcher = reserved "algebraic-data-matcher" keywordGenerateArray        = reserved "generate-array"-keywordArraySize            = reserved "array-size"+keywordArrayBounds          = reserved "array-bounds" keywordArrayRef             = reserved "array-ref"  sign :: Num a => Parser (a -> a)

@@ -361,8 +361,9 @@  rationalToFloat :: PrimitiveFunc rationalToFloat = oneArg $ \val -> do-  r <- fromEgison val-  return $ Float $ fromRational r+  case val of+    Integer i -> return $ Float $ fromInteger i+    Rational r -> return $ Float $ fromRational r  floatToIntegerOp :: (Double -> Integer) -> PrimitiveFunc floatToIntegerOp op = oneArg $ \val -> do

@@ -89,6 +89,7 @@ import Control.Monad.Trans.Maybe  import Data.Monoid (Monoid)+import qualified Data.Array as Array import qualified Data.Sequence as Sq import Data.Sequence (Seq) import Data.Foldable (foldr, toList)@@ -101,8 +102,6 @@ import qualified Data.ByteString.Lazy.Char8 as B  import System.IO-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap import Data.Ratio  import System.IO.Unsafe (unsafePerformIO)@@ -165,7 +164,7 @@    | AlgebraicDataMatcherExpr [(String, [EgisonExpr])]   | GenerateArrayExpr [String] EgisonExpr EgisonExpr-  | ArraySizeExpr EgisonExpr+  | ArrayBoundsExpr EgisonExpr   | ArrayRefExpr EgisonExpr EgisonExpr    | SomethingExpr@@ -233,7 +232,7 @@   | InductiveData String [EgisonValue]   | Tuple [EgisonValue]   | Collection (Seq EgisonValue)-  | Array (IntMap EgisonValue)+  | Array (Array.Array Integer EgisonValue)   | IntHash (HashMap Integer EgisonValue)   | StrHash (HashMap ByteString EgisonValue)   | UserMatcher Env PMMode MatcherInfo@@ -270,7 +269,7 @@                                      isChar :: EgisonValue -> Bool                                      isChar (Char _) = True                                      isChar _ = False-  show (Array vals) = "[|" ++ unwords (map show $ IntMap.elems vals) ++ "|]"+  show (Array vals) = "[|" ++ unwords (map show $ Array.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 _ BFSMode _) = "#<matcher-bfs>"@@ -406,7 +405,7 @@     IInductiveData String [ObjectRef]   | ITuple [ObjectRef]   | ICollection (IORef (Seq Inner))-  | IArray (IntMap ObjectRef)+  | IArray (Array.Array Integer ObjectRef)   | IIntHash (HashMap Integer ObjectRef)   | IStrHash (HashMap ByteString ObjectRef) 

@@ -1,6 +1,6 @@ ;;; ;;;-;;; Graph demonstartion+;;; Graph demonstration ;;; ;;; @@ -47,15 +47,15 @@ ;; ;; Demonstration code ;;-;; find all nodes who have an edege from 's' but not have an edge to 's'+;; find all nodes who have an edge from 's' but not have an edge to 's' (test (let {[$s 1]}         (match-all graph-data1 (graph integer)           [<cons <edge ,s $x>-                 ^<cons <edge ,x ,x>+                 ^<cons <edge ,x ,s>                         _>>            x]))) -;; find all nodes in two path from 's'+;; find all nodes in two paths from 's' (test (let {[$s 1]}         (match-all graph-data1 (graph integer)           [<cons <edge (& ,s $x_1) $x_2>

@@ -1,11 +1,21 @@-(define $tak+(define $tarai   (lambda [$x $y $z]     (if (lte? x y)       y+      (tarai (tarai (- x 1) y z)+             (tarai (- y 1) z x)+             (tarai (- z 1) x y)))))++(test (tarai 1 1 1))+(test (tarai 4 2 1))++(define $tak+  (lambda [$x $y $z]+    (if (lte? x y)+      z       (tak (tak (- x 1) y z)            (tak (- y 1) z x)            (tak (- z 1) x y)))))  (test (tak 1 1 1))- (test (tak 4 2 1))