implement pmap

Author: egisatoshi

hs-src/Language/Egison/Core.hs

@@ -204,7 +204,7 @@ evalExpr env (ArrayExpr exprs) = do
   return . Intermediate . IArray $ Array.listArray (1, toInteger (length exprs)) refs'
 
 evalExpr env (VectorExpr exprs) = do
-  whnfs <- parallelMapM (evalExpr env) exprs
+  whnfs <- mapM (evalExpr env) exprs
   case whnfs of
     ((Intermediate (ITensor (Tensor _ _ _))):_) -> do
       ret <- mapM toTensor whnfs >>= tConcat' >>= fromTensor
@@ -216,7 +216,7 @@ evalExpr env (TensorExpr nsExpr xsExpr supExpr subExpr) = do
   nsWhnf <- evalExpr env nsExpr
   ns <- ((fromCollection nsWhnf >>= fromMList >>= mapM evalRef >>= mapM fromWHNF) :: EgisonM [Integer])
   xsWhnf <- evalExpr env xsExpr
-  xs <- fromCollection xsWhnf >>= fromMList >>= parallelMapM evalRef
+  xs <- fromCollection xsWhnf >>= fromMList >>= mapM evalRef
   supWhnf <- evalExpr env supExpr
   sup <- fromCollection supWhnf >>= fromMList >>= mapM evalRefDeep -- >>= mapM extractScalar'
   subWhnf <- evalExpr env subExpr
@@ -559,7 +559,7 @@ evalExpr env (GenerateTensorExpr fnExpr sizeExpr) = do
   size'' <- collectionToList size'
   ns <- (mapM fromEgison size'') :: EgisonM [Integer]
   fn <- evalExpr env fnExpr
-  xs <-  parallelMapM (\ms -> applyFunc env fn (Value (makeTuple ms))) (map (\ms -> map toEgison ms) (enumTensorIndices ns))
+  xs <-  mapM (\ms -> applyFunc env fn (Value (makeTuple ms))) (map (\ms -> map toEgison ms) (enumTensorIndices ns))
   case (ns, xs) of
     ([1], x:[]) -> return $ x
     _ -> fromTensor (Tensor ns (V.fromList xs) [])
@@ -632,6 +632,19 @@ evalExpr env (TensorMap2Expr fnExpr t1Expr t2Expr) = do
     yRef <- newEvaluatedObjectRef y
     applyFunc env fn (Intermediate (ITuple [xRef, yRef]))
 
+evalExpr env (ParExpr expr1 expr2) = undefined
+evalExpr env (PseqExpr expr1 expr2) = undefined
+
+evalExpr env (PmapExpr fnExpr cExpr) = do
+  fn <- evalExpr env fnExpr
+  xs <- evalExpr env cExpr >>= collectionToList
+  ys <- parallelMapM (applyFunc' env fn) xs
+  return $ Value $ Collection (Sq.fromList ys)
+ where
+  applyFunc' :: Env -> WHNFData -> EgisonValue -> EgisonM EgisonValue
+  applyFunc' env fn x = applyFunc env fn (Value x) >>= evalWHNF
+  
+
 evalExpr _ SomethingExpr = return $ Value Something
 evalExpr _ UndefinedExpr = return $ Value Undefined
 evalExpr _ expr = throwError $ NotImplemented ("evalExpr for " ++ show expr)
@@ -682,7 +695,7 @@ evalWHNF (Intermediate (IStrHash refs)) = do
 evalWHNF (Intermediate (ITuple [ref])) = evalRefDeep ref
 evalWHNF (Intermediate (ITuple refs)) = Tuple <$> mapM evalRefDeep refs
 evalWHNF (Intermediate (ITensor (Tensor ns whnfs js))) = do
-  vals <- parallelMapM evalWHNF (V.toList whnfs)
+  vals <- mapM evalWHNF (V.toList whnfs)
   return $ TensorData $ Tensor ns (V.fromList vals) js
 --  vals <- mapM evalWHNF whnfs
 --  return $ TensorData $ Tensor ns vals js

hs-src/Language/Egison/Desugar.hs

@@ -308,6 +308,21 @@ desugar (TransposeExpr vars expr) = do
   expr' <- desugar expr
   return $ TransposeExpr vars' expr'
 
+desugar (ParExpr expr1 expr2) = do
+  expr1' <- desugar expr1
+  expr2' <- desugar expr2
+  return $ ParExpr expr1' expr2'
+
+desugar (PseqExpr expr1 expr2) = do
+  expr1' <- desugar expr1
+  expr2' <- desugar expr2
+  return $ PseqExpr expr1' expr2'
+
+desugar (PmapExpr expr1 expr2) = do
+  expr1' <- desugar expr1
+  expr2' <- desugar expr2
+  return $ PmapExpr expr1' expr2'
+
 desugar (ApplyExpr expr0 expr1) = do
   expr0' <- desugar expr0
   expr1' <- desugar expr1

hs-src/Language/Egison/Parser.hs

@@ -238,6 +238,9 @@ expr' = (try partialExpr
                          <|> tensorMapExpr
                          <|> tensorMap2Expr
                          <|> transposeExpr
+                         <|> parExpr
+                         <|> pseqExpr
+                         <|> pmapExpr
                          )
              <?> "expression")
 
@@ -560,6 +563,15 @@ tensorMap2Expr = keywordTensorMap2 >> TensorMap2Expr <$> expr <*> expr <*> expr
 transposeExpr :: Parser EgisonExpr
 transposeExpr = keywordTranspose >> TransposeExpr <$> expr <*> expr
 
+parExpr :: Parser EgisonExpr
+parExpr = keywordPar >> ParExpr <$> expr <*> expr
+
+pseqExpr :: Parser EgisonExpr
+pseqExpr = keywordPseq >> PseqExpr <$> expr <*> expr
+
+pmapExpr :: Parser EgisonExpr
+pmapExpr = keywordPmap >> PmapExpr <$> expr <*> expr
+
 -- Patterns
 
 pattern :: Parser EgisonPattern
@@ -793,6 +805,9 @@ reservedKeywords =
   , "tensor-map"
   , "tensor-map2"
   , "transpose"
+  , "par"
+  , "pseq"
+  , "pmap"
   , "something"
   , "undefined"]
 
@@ -869,6 +884,9 @@ keywordTensorContract       = reserved "contract"
 keywordTensorMap            = reserved "tensor-map"
 keywordTensorMap2           = reserved "tensor-map2"
 keywordTranspose            = reserved "transpose"
+keywordPar                  = reserved "par"
+keywordPseq                 = reserved "pseq"
+keywordPmap                 = reserved "pmap"
 
 sign :: Num a => Parser (a -> a)
 sign = (char '-' >> return negate)

hs-src/Language/Egison/Types.hs

@@ -256,6 +256,10 @@ data EgisonExpr =
   | ArrayBoundsExpr EgisonExpr
   | ArrayRefExpr EgisonExpr EgisonExpr
 
+  | ParExpr EgisonExpr EgisonExpr
+  | PseqExpr EgisonExpr EgisonExpr
+  | PmapExpr EgisonExpr EgisonExpr
+
   | GenerateTensorExpr EgisonExpr EgisonExpr
   | TensorExpr EgisonExpr EgisonExpr EgisonExpr EgisonExpr
   | TensorContractExpr EgisonExpr EgisonExpr
@@ -838,7 +842,7 @@ tTranspose' is t@(Tensor ns xs js) = do
 
 tMap :: HasTensor a => (a -> EgisonM a) -> (Tensor a) -> EgisonM (Tensor a)
 tMap f (Tensor ns xs js) = do
-  xs' <- parallelMapM f (V.toList xs) >>= return . V.fromList
+  xs' <- mapM f (V.toList xs) >>= return . V.fromList
   t <- toTensor (V.head xs')
   case t of
     (Tensor ns1 _ js1) ->
@@ -848,9 +852,9 @@ tMap f (Scalar x) = f x >>= return . Scalar
 
 tMapN :: HasTensor a => ([a] -> EgisonM a) -> [Tensor a] -> EgisonM (Tensor a)
 tMapN f ts@((Tensor ns xs js):_) = do
-  xs' <- parallelMapM (\is -> mapM (tIntRef is) ts >>= mapM fromTensor >>= f) (enumTensorIndices ns)
+  xs' <- mapM (\is -> mapM (tIntRef is) ts >>= mapM fromTensor >>= f) (enumTensorIndices ns)
   return $ Tensor ns (V.fromList xs') js
-tMapN f xs = parallelMapM fromTensor xs >>= f >>= return . Scalar
+tMapN f xs = mapM fromTensor xs >>= f >>= return . Scalar
 
 tMap2 :: HasTensor a => (a -> a -> EgisonM a) -> Tensor a -> Tensor a -> EgisonM (Tensor a)
 tMap2 f t1@(Tensor ns1 xs1 js1) t2@(Tensor ns2 xs2 js2) = do
@@ -860,7 +864,7 @@ tMap2 f t1@(Tensor ns1 xs1 js1) t2@(Tensor ns2 xs2 js2) = do
   let cns = take (length cjs) (tSize t1')
   rts1 <- mapM (flip tIntRef t1') (enumTensorIndices cns)
   rts2 <- mapM (flip tIntRef t2') (enumTensorIndices cns)
-  rts' <- parallelMapM (\(t1, t2) -> tProduct f t1 t2) (zip rts1 rts2)
+  rts' <- mapM (\(t1, t2) -> tProduct f t1 t2) (zip rts1 rts2)
   let ret = Tensor (cns ++ (tSize (head rts'))) (V.concat (map tToVector rts')) (cjs ++ tIndex (head rts'))
   tTranspose (uniq (tDiagIndex (js1 ++ js2))) ret
  where