diff --git a/Configure.PL b/Configure.PL --- a/Configure.PL +++ b/Configure.PL @@ -83,8 +83,10 @@ . # Hack for OSX 10.6 -$info =~ s/-arch x86_64 (-arch i386) -arch ppc/$1/g; -$info =~ s/-opt[lc]-arch -opt[lc]x86_64 (-opt[lc]-arch -opt[lc]i386) -opt[lc]-arch -opt[lc]ppc/$1/g; +$info =~ s/-arch x86_64 (-arch i386)(?: -arch ppc)?/$1/g; +$info =~ s/(-arch i386) -arch x86_64(?: -arch ppc)?/$1/g; +$info =~ s/-opt[lc]-arch -opt[lc]x86_64 (-opt[lc]-arch -opt[lc]i386)(?: -opt[lc]-arch -opt[lc]ppc)?/$1/g; +$info =~ s/(-opt[lc]-arch -opt[lc]i386) -opt[lc]-arch -opt[lc]x86_64(?: -opt[lc]-arch -opt[lc]ppc)?/$1/g; open INFO, ">Pugs.buildinfo" or die "Cannot write build info: $!"; print INFO $info; diff --git a/Pugs.cabal b/Pugs.cabal --- a/Pugs.cabal +++ b/Pugs.cabal @@ -1,5 +1,5 @@ Name : Pugs -Version : 6.2.13.20110519 +Version : 6.2.13.20110925 license : BSD3 license-file : LICENSE cabal-version : >= 1.2.3 @@ -12,7 +12,7 @@ synopsis : A Perl 6 Implementation description : A Perl 6 Implementation author : Audrey Tang -Tested-With: GHC==6.8.2, GHC==6.8.3, GHC==6.10.1, GHC==6.12.1 +Tested-With: GHC==6.8.2, GHC==6.8.3, GHC==6.10.1, GHC==6.12.1, GHC==7.0.1, GHC==7.2.1 data-files : blib6/pugs/perl5/lib/Parse/Yapp/Driver.pm blib6/pugs/perl5/lib/Parse/Yapp/Grammar.pm @@ -161,7 +161,7 @@ extra-lib-dirs: /usr/lib /opt/local/lib build-depends: - base >= 4 && < 5, haskell98, filepath, mtl < 2.0.0.0, parsec >= 3.0.0.0, network, + base >= 4 && < 5, filepath, mtl < 2.0.0.0, parsec >= 3.0.0.0, network, pretty, time, random, process, containers, bytestring, array, directory, utf8-string, binary, haskeline >= 0.6.4.0, FindBin, control-timeout >= 0.1.2, diff --git a/src/Pugs/AST/Internals.hs b/src/Pugs/AST/Internals.hs --- a/src/Pugs/AST/Internals.hs +++ b/src/Pugs/AST/Internals.hs @@ -112,8 +112,11 @@ import Pugs.AST.SIO import Pugs.Embed.Perl5 import qualified Pugs.Val as Val -import GHC.PArr import {-# SOURCE #-} Pugs.AST +import Data.Sequence (Seq, (><), (<|), (|>), fromList) +import Data.Foldable (toList) +import qualified Data.Sequence as Seq +import qualified Data.Foldable as F -- CPP Includes @@ -362,7 +365,7 @@ a <- stm $ readTVar iv let size = a_size a if size > abs (idx+1) - then return (a !: (idx `mod` size)) + then return (a `Seq.index` (idx `mod` size)) else errIndex def idx -- now we are all positive; either extend or return getArrayIndex idx def getArr ext = do @@ -370,7 +373,7 @@ a <- stm $ readTVar iv let size = a_size a if size > idx - then return (a !: idx) + then return (a `Seq.index` idx) else case ext of Just doExt -> do { doExt; getArrayIndex idx def getArr Nothing } Nothing -> errIndex def idx @@ -728,7 +731,7 @@ "Item" -> io $ fmap scalarRef $ newTVarIO undef "Scalar" -> io $ fmap scalarRef $ newTVarIO undef "Array" -> io $ do - iv <- newTVarIO [::] + iv <- newTVarIO mempty return $ arrayRef (MkIArray iv) "Hash" -> do h <- io (H.new (==) H.hashString) @@ -863,7 +866,7 @@ newArray :: (MonadSTM m) => VArray -> m (IVar VArray) newArray vals = stm $ do tvs <- mapM newScalar vals - iv <- newTVar (toP tvs) + iv <- newTVar (fromList tvs) return $ IArray (MkIArray iv) newHash :: (MonadSTM m) => VHash -> m (IVar VHash) diff --git a/src/Pugs/AST/Internals/Instances.hs b/src/Pugs/AST/Internals/Instances.hs --- a/src/Pugs/AST/Internals/Instances.hs +++ b/src/Pugs/AST/Internals/Instances.hs @@ -50,6 +50,9 @@ import qualified Pugs.Val as Val import qualified Data.HashTable as H +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq +import qualified Data.Foldable as F import Data.Binary import GHC.Exts (unsafeCoerce#) @@ -1397,10 +1400,6 @@ put _ = put () get = return (const $ return VUndef) -instance Binary [a] => Binary [:a:] where - put = put . fromP - get = fmap toP get - instance Binary VRef where put (MkRef (ICode cv)) | Just (mc :: VMultiCode) <- fromTypeable cv = do @@ -1461,7 +1460,7 @@ newArray' :: VArray -> IO (IVar VArray) newArray' vals = do tvs <- mapM newScalar' vals - iv <- newTVarIO (toP tvs) + iv <- newTVarIO (Seq.fromList tvs) return $ IArray (MkIArray iv) instance Binary Pad where diff --git a/src/Pugs/AST/SIO.hs b/src/Pugs/AST/SIO.hs --- a/src/Pugs/AST/SIO.hs +++ b/src/Pugs/AST/SIO.hs @@ -53,9 +53,6 @@ class (Monad m, Functor m) => MonadSTM m where liftSIO :: SIO a -> m a liftSIO = fail "liftSIO not detailed for this monad" - {-# SPECIALISE liftSTM :: STM a -> STM a #-} - {-# SPECIALISE liftSTM :: STM a -> IO a #-} - {-# SPECIALISE liftSTM :: STM a -> SIO a #-} liftSTM :: STM a -> m a instance MonadSTM STM where diff --git a/src/Pugs/AST/Types.hs b/src/Pugs/AST/Types.hs --- a/src/Pugs/AST/Types.hs +++ b/src/Pugs/AST/Types.hs @@ -4,8 +4,9 @@ import Pugs.Types import qualified Data.Set as Set import qualified Data.Map as Map - import qualified Data.HashTable as H +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq import Pugs.AST.Eval import Pugs.AST.Utils @@ -281,7 +282,7 @@ , cu_ast :: !Exp -- AST of unit } deriving (Show, Eq, Ord, Typeable) {-!derive: YAML_Pos !-} -newtype IArray = MkIArray (TVar [:IVar VScalar:]) +newtype IArray = MkIArray (TVar (Seq (IVar VScalar))) deriving (Typeable) type IArraySlice = [IVar VScalar] diff --git a/src/Pugs/Class.hs b/src/Pugs/Class.hs --- a/src/Pugs/Class.hs +++ b/src/Pugs/Class.hs @@ -29,6 +29,9 @@ import Control.Monad.Fix import qualified StringTable.AtomMap as AtomMap import qualified Data.Typeable as Typeable +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq +import qualified Data.Foldable as F type Val = Invocant Eval type Call = MethodInvocation Eval @@ -57,7 +60,7 @@ | isLower x = takeTypeName (x:acc) xs | otherwise = x:acc -type MethodPrim a = (a -> [:Val:] -> Eval Val) +type MethodPrim a = (a -> Seq Val -> Eval Val) class Boxable b => MethodPrimable a b | a -> b where asPrim :: a -> MethodPrim b @@ -82,9 +85,9 @@ asPrim f x _ = fmap mkVal (f x) instance (Boxable a, Boxable z) => MethodPrimable (a -> Val -> Eval z) a where - asPrim f x args = fmap mkVal (f x (args !: 0)) + asPrim f x args = fmap mkVal (f x (args `Seq.index` 0)) -instance (Boxable a, Boxable z) => MethodPrimable (a -> [:Val:] -> Eval z) a where +instance (Boxable a, Boxable z) => MethodPrimable (a -> Seq Val -> Eval z) a where asPrim f x args = fmap mkVal (f x args) instance (Boxable a, Boxable z) => MethodPrimable (a -> [Val] -> Eval z) a where @@ -97,13 +100,13 @@ instance (Boxable a, Boxable b, Boxable z) => MethodPrimable (a -> b -> Eval z) a where asPrim f x args = do - y <- coerceVal (args !: 0) + y <- coerceVal (args `Seq.index` 0) fmap mkVal (f x y) instance (Boxable a, Boxable b, Boxable c, Boxable z) => MethodPrimable (a -> b -> c -> Eval z) a where asPrim f x args = do - y <- coerceVal (args !: 0) - z <- coerceVal (args !: 1) + y <- coerceVal (args `Seq.index` 0) + z <- coerceVal (args `Seq.index` 1) fmap mkVal (f x y z) (...) :: MethodPrimable a b => String -> a -> (ID, MethodPrim b) @@ -147,7 +150,7 @@ { sm_name = meth , sm_definition = MkMethodCompiled $ \args -> do inv <- fromInvocant args :: Eval a - fun inv $ concatMapP f_positionals (c_feeds args) + fun inv $ F.foldr mappend mempty (fmap f_positionals (c_feeds args)) } type PureClass = MOClass Eval @@ -155,7 +158,7 @@ instance (Show a, Typeable a, Ord a) => Boxable (Maybe a) instance Boxable a => Boxable [a] -instance Boxable a => Boxable [:a:] +instance Boxable a => Boxable (Seq a) instance Boxable ID instance Boxable PureClass where @@ -167,12 +170,12 @@ ] instance ((:>:) Call) String where - cast = (`MkMethodInvocation` CaptSub{ c_feeds = [::] }) . _cast + cast = (`MkMethodInvocation` CaptSub{ c_feeds = mempty }) . _cast instance ((:>:) Call) ByteString where - cast = (`MkMethodInvocation` CaptSub{ c_feeds = [::] }) . cast + cast = (`MkMethodInvocation` CaptSub{ c_feeds = mempty }) . cast instance ((:>:) Call (ByteString, [Val], AtomMap Val)) where cast (meth, pos, named) = MkMethodInvocation (cast meth) CaptSub - { c_feeds = [: MkFeed (toP pos) (AtomMap.map (\x -> [:x:]) named) :]} + { c_feeds = Seq.singleton $ MkFeed (Seq.fromList pos) (AtomMap.map Seq.singleton named)} diff --git a/src/Pugs/Compile/Pugs.hs b/src/Pugs/Compile/Pugs.hs --- a/src/Pugs/Compile/Pugs.hs +++ b/src/Pugs/Compile/Pugs.hs @@ -9,6 +9,9 @@ import qualified Data.ByteString.Char8 as Str -- XXX import qualified Data.Map as Map import qualified Data.Set as Set +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq +import qualified Data.Foldable as F type Str = Str.ByteString type Comp a = WriterT [a] Eval a @@ -27,8 +30,8 @@ instance (Compile x) => Compile [x] where compile = compileList -instance (Compile x) => Compile [:x:] where - compile xs = compWith "toP" [compileList (fromP xs)] +instance (Compile x) => Compile (Seq x) where + compile xs = compWith "Seq.fromList" [compileList (F.toList xs)] instance (Compile x) => Compile (Set x) where compile xs = compWith "Set.fromDistinctAscList" [compileList (Set.toAscList xs)] diff --git a/src/Pugs/Embed/Perl5.hs b/src/Pugs/Embed/Perl5.hs --- a/src/Pugs/Embed/Perl5.hs +++ b/src/Pugs/Embed/Perl5.hs @@ -182,7 +182,7 @@ module Pugs.Embed.Perl5 where import Pugs.Internals -import Foreign +import Foreign (Ptr, withArray, withArray0, deRefStablePtr, newStablePtr, peekArray0, nullPtr, advancePtr, StablePtr) import Foreign.C.Types import Foreign.C.String import {-# SOURCE #-} Pugs.AST.Internals diff --git a/src/Pugs/Eval.hs b/src/Pugs/Eval.hs --- a/src/Pugs/Eval.hs +++ b/src/Pugs/Eval.hs @@ -44,6 +44,9 @@ import GHC.PArr import qualified Data.ByteString.UTF8 as Str import qualified Data.ByteString.Char8 as Buf +import Data.Sequence (Seq, (|>), (<|), (><)) +import qualified Data.Sequence as Seq +import qualified Data.Foldable as F {-| @@ -1034,7 +1037,7 @@ , envPos = envPos caller } vcap <- case args of - [] -> return (CaptSub { c_feeds = [::] }) + [] -> return (CaptSub { c_feeds = mempty }) (x:_) -> castVal =<< fromVal =<< enterRValue (enterEvalContext (cxtItem "Capture") x) local callerEnv $ applyCapture sub vcap , "&assuming" ... \inv args -> do @@ -1044,7 +1047,7 @@ Right curriedSub -> return . castV $ curriedSub , "&infix:=>" ... reduceSyn "=>" , "&circumfix:\\( )" ... \invs args -> do - feeds <- argsFeed [::] Nothing [args] + feeds <- argsFeed mempty Nothing [args] case invs of Just i' -> do invVal <- reduce i' @@ -1083,20 +1086,20 @@ applyDisplaced sub invs args applyCapture :: VCode -> ValCapt -> Eval Val -applyCapture sub capt = applyDisplaced sub inv (fromP argsPos ++ argsNam) +applyCapture sub capt = applyDisplaced sub inv (F.toList argsPos ++ argsNam) where - argsPos = mapP (Val . castV) (f_positionals feed) - argsNam = [ Syn "named" [Val (VStr (cast k)), Val (castV (vs !: lst))] | (k, vs) <- AtomMap.toList (f_nameds feed), let lst = lengthP vs - 1, lst >= 0 ] + argsPos = fmap (Val . castV) (f_positionals feed) + argsNam = [ Syn "named" [Val (VStr (cast k)), Val (castV (vs `Seq.index` lst))] | (k, vs) <- AtomMap.toList (f_nameds feed), let lst = Seq.length vs - 1, lst >= 0 ] feed = concatFeeds (c_feeds capt) inv = case capt of CaptMeth { c_invocant = val } -> Just (Val (castV val)) _ -> Nothing -argsFeed :: [:ValFeed:] -> Maybe ValFeed -> [[Exp]] -> Eval [:ValFeed:] +argsFeed :: (Seq ValFeed) -> Maybe ValFeed -> [[Exp]] -> Eval (Seq ValFeed) argsFeed fAcc Nothing [] = return fAcc argsFeed fAcc Nothing [[]] = return fAcc -argsFeed fAcc (Just x) [] = return $ fAcc +:+ [:x:] -argsFeed fAcc (Just x) [[]] = return $ fAcc +:+ [:x:] +argsFeed fAcc (Just x) [] = return $ fAcc |> x +argsFeed fAcc (Just x) [[]] = return $ fAcc |> x argsFeed fAcc aAcc (argl:als) = do acc <- af aAcc argl argsFeed fAcc (Just acc) als @@ -1111,22 +1114,22 @@ af (Just $ resFeed{ f_nameds = addNamed (f_nameds resFeed) key argVal }) args | Syn "|" (capExp:_) <- unwrapN = do cap <- castVal =<< fromVal =<< enterRValue (enterEvalContext (cxtItem "Capture") capExp) - af (Just (mconcat (resFeed:fromP (c_feeds cap)))) args + af (Just (mconcat (resFeed:F.toList (c_feeds cap)))) args | App (Var var) Nothing capExps <- unwrapN , var == cast "&prefix:|<<" = do caps <- mapM castVal =<< fromVals =<< (enterRValue $ enterEvalContext (cxtSlurpy "Capture") (Syn "," capExps)) - af (Just (mconcat (resFeed:concatMap (fromP . c_feeds) caps))) args + af (Just (mconcat (resFeed:concatMap (F.toList . c_feeds) caps))) args | otherwise = do argVal <- fromVal =<< reduce n - af (Just resFeed{ f_positionals = (f_positionals resFeed) +:+ [:argVal:] }) args + af (Just resFeed{ f_positionals = (f_positionals resFeed) |> argVal }) args where unwrapN = unwrap n resFeed = feed res feed res = maybe emptyFeed id res - addNamed :: AtomMap [:a:] -> VStr -> a -> AtomMap [:a:] + addNamed :: AtomMap (Seq a) -> VStr -> a -> AtomMap (Seq a) addNamed mp k v = let id = cast k in - AtomMap.insertWith (flip (+:+)) id [:v:] mp + AtomMap.insertWith (flip (><)) id (Seq.singleton v) mp dummyVar :: Var dummyVar = cast "$" @@ -1178,13 +1181,18 @@ interpolateVal (VRef (MkRef (IPair pv))) = do (k, v) <- pair_fetch pv return [ Syn "named" [Val k, Val v] ] -interpolateVal (VV vv) | Just (CaptSub{ c_feeds = feeds } :: ValCapt) <- castVal vv = return . fromP $ - [: Val (castV v) | v <- concatMapP f_positionals feeds :] - +:+ [: Syn "named" [Val (VStr $ cast k), Val (concatNamed v)] | (k, v) <- concatMapP (toP . AtomMap.toList . f_nameds) feeds :] - where - concatNamed [:x:] = castV x - concatNamed xs = VList (fromP (mapP castV xs)) +interpolateVal (VV vv) + | Just (CaptSub{ c_feeds = feeds } :: ValCapt) <- castVal vv + = let posPart = fmap (\v -> Val (castV v)) (concatMapSeq f_positionals feeds) + kvs = concatMapSeq (Seq.fromList . AtomMap.toList . f_nameds) feeds + namPart = fmap kvToExp kvs + in return (F.toList (posPart >< namPart)) interpolateVal val = return [Val val] +kvToExp (k, v) = Syn "named" [Val (VStr $ cast k), Val (concatNamed v)] +concatMapSeq f xs = F.foldr mappend mempty (fmap f xs) +concatNamed xs = case Seq.length xs of + 1 -> castV (Seq.index xs 0) + _ -> VList (F.toList (fmap castV xs)) isInterpolated :: Exp -> Bool isInterpolated (Ann _ exp) = isInterpolated exp diff --git a/src/Pugs/Meta/Perl5.hs b/src/Pugs/Meta/Perl5.hs --- a/src/Pugs/Meta/Perl5.hs +++ b/src/Pugs/Meta/Perl5.hs @@ -8,6 +8,7 @@ import Data.Typeable (Typeable) import qualified Data.Map as Map import qualified StringTable.AtomMap as AtomMap +import qualified Data.Foldable as F import Pugs.AST.Internals (envContext, anyToVal, anyFromVal) import Pugs.Types @@ -40,10 +41,10 @@ | otherwise = do invSV <- coerceVal inv subSV <- liftIO . bufToSV . cast $ meth - posSVs <- mapM coerceVal (fromP $ f_positionals feed) + posSVs <- mapM coerceVal (F.toList $ f_positionals feed) namSVs <- fmap concat . forM (AtomMap.toList (f_nameds feed)) $ \(key, vals) -> do keySV <- liftIO (bufToSV $ cast key) - fmap concat . forM (fromP vals) $ \v -> do + fmap concat . forM (F.toList vals) $ \v -> do valSV <- coerceVal v return [keySV, valSV] env <- ask diff --git a/src/Pugs/Types.hs b/src/Pugs/Types.hs --- a/src/Pugs/Types.hs +++ b/src/Pugs/Types.hs @@ -35,6 +35,9 @@ import qualified Data.IntSet as IntSet import qualified Data.ByteString.Char8 as Buf -- Intentionally not UTF8! import qualified Data.ByteString as B (findSubstring) +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq +import qualified Data.Foldable as F data Type = MkType !ID -- ^ A regular type @@ -357,15 +360,15 @@ TGlobal -> ('*':) -- Cached Categ->ByteString mappings. -catBufMap :: [:ByteString:] -catBufMap = mapP (_cast . drop 2 . show) [:minBound..(maxBound :: VarCateg):] +catBufMap :: Seq ByteString +catBufMap = fmap (_cast . drop 2 . show) (Seq.fromList [minBound..(maxBound :: VarCateg)]) -- Cached ByteString->Categ mappings. bufCatMap :: Map ByteString VarCateg -bufCatMap = Map.fromList (fromP catBufMap `zip` [minBound..(maxBound :: VarCateg)]) +bufCatMap = Map.fromList (F.toList catBufMap `zip` [minBound..(maxBound :: VarCateg)]) instance ((:>:) ByteString) VarCateg where - cast categ = catBufMap !: fromEnum categ + cast categ = catBufMap `Seq.index` fromEnum categ instance ((:>:) (Maybe VarCateg)) ByteString where cast buf = Map.lookup buf bufCatMap diff --git a/src/Pugs/Types/Array.hs b/src/Pugs/Types/Array.hs --- a/src/Pugs/Types/Array.hs +++ b/src/Pugs/Types/Array.hs @@ -128,61 +128,61 @@ array_storeSize _ _ = return () -- XXX error? array_storeElem _ _ _ = retConstError undef -a_size :: [:IVar VScalar:] -> Int -a_size = lengthP +a_size :: Seq (IVar VScalar) -> Int +a_size = Seq.length -a_update :: Int -> IVar VScalar -> [:IVar VScalar:] -> [:IVar VScalar:] -a_update i x xs = takeP i xs +:+ [:x:] +:+ sliceP (i + 1) (lengthP xs - 1) xs +a_update :: Int -> IVar VScalar -> Seq (IVar VScalar) -> Seq (IVar VScalar) +a_update i x xs = Seq.take i xs >< Seq.singleton x >< Seq.drop (i + 1) xs instance ArrayClass IArray where array_clone (MkIArray iv) = do a <- readTVar iv - tvs <- mapM cloneIVar (fromP a) - fmap MkIArray (newTVar (toP tvs)) + tvs <- mapM cloneIVar (toList a) + fmap MkIArray (newTVar (fromList tvs)) array_store (MkIArray iv) vals = stm $ do tvs <- mapM newScalar vals - writeTVar iv (toP tvs) + writeTVar iv (fromList tvs) array_fetchSize (MkIArray iv) = stm $ do a <- readTVar iv return $ a_size a array_storeSize (MkIArray iv) sz = stm $ do a <- readTVar iv case a_size a `compare` sz of - GT -> writeTVar iv (takeP sz a) -- shrink + GT -> writeTVar iv (Seq.take sz a) -- shrink EQ -> return () LT -> do tvs <- replicateM (sz - a_size a) (newScalar undef) - writeTVar iv (a +:+ toP tvs) -- extend + writeTVar iv (a >< fromList tvs) -- extend array_shift (MkIArray iv) = join . stm $ do a <- readTVar iv case a_size a of 0 -> return (return undef) l -> do - writeTVar iv (sliceP 1 (l - 1) a) - return (readIVar (a !: 0)) + writeTVar iv (Seq.drop 1 a) + return (readIVar (a `Seq.index` 0)) array_unshift _ [] = return () array_unshift (MkIArray iv) vals = stm $ do a <- readTVar iv tvs <- mapM newScalar vals - writeTVar iv (toP tvs +:+ a) + writeTVar iv (fromList tvs >< a) array_pop (MkIArray iv) = join . stm $ do a <- readTVar iv case a_size a of 0 -> return (return undef) sz -> do - writeTVar iv (takeP (sz - 1) a) - return (readIVar (a !: (sz - 1))) + writeTVar iv (Seq.take (sz - 1) a) + return (readIVar (a `Seq.index` (sz - 1))) array_push _ [] = return () array_push (MkIArray iv) vals = stm $ do a <- readTVar iv tvs <- mapM newScalar vals - writeTVar iv (a +:+ toP tvs) + writeTVar iv (a >< fromList tvs) array_extendSize (MkIArray iv) sz = stm $ do a <- readTVar iv case a_size a `compare` sz of LT -> do tvs <- replicateM (sz - a_size a) (newScalar undef) - writeTVar iv (a +:+ toP tvs) + writeTVar iv (a >< fromList tvs) _ -> return () array_fetchVal arr idx = do rv <- getArrayIndex idx (Just $ constScalar undef) @@ -213,7 +213,7 @@ size = a_size a case (size-1) `compare` idx' of LT -> return () - EQ -> writeTVar iv (takeP (size-1) a) + EQ -> writeTVar iv (Seq.take (size-1) a) GT -> do tvar <- newScalar undef writeTVar iv (a_update idx' tvar a) @@ -224,13 +224,13 @@ len' = if len < 0 then len + size - off' else len size = a_size a - let result = mapM readIVar (fromP (sliceP off' (off' + len' - 1) a)) + let result = mapM readIVar (toList (Seq.take (len' - 1) (Seq.drop off' a))) let off = if off' > size then size else off' len = if off + len' > size then size - off else len' tvars <- mapM newScalar vals - writeTVar iv (takeP off a +:+ toP tvars +:+ sliceP (off+len) (size-1) a) + writeTVar iv (Seq.take off a >< fromList tvars >< Seq.drop (off+len) a) return result instance ArrayClass VArray where