Сжатие списка и вектора без повторных обходов

Question

Скажем, у меня есть список и вектор, и я хочу сжать их вместе.Простое решение состоит в том, чтобы преобразовать вектор в список и объединить оба списка.Но для этого требуется два обхода для вектора (а также выделение памяти для преобразования его в список) - один для преобразования вектора в список, а другой для сжатия его вместе с другим списком.

Есть лиспособ сжать оба вместе в одном обходе?Я предполагаю, что это потребует некоторого сохранения состояния для zipper (я думаю, что это сохранит состояние для векторного индекса, так как он может быть проиндексирован за O (1) раз).

Псевдокод:

let l1 = [1..10] :: [CInt]
let v1 = Data.Vector.Storable.fromList l1

map (\(x,y) -> x + y) (zipListVector l1 v1) -- zipListVector function is what I am after

Answer 1

Fusion запускает здесь.

Для следующей программы:

import Data.Vector
import Prelude hiding (zip)

zipMe :: [a] -> Vector b -> Vector (a, b)
zipMe xs ys = zip (fromList xs) ys

генерируется следующее ядро:

Foo.$wzipMe
  :: forall a_auS b_auT.
[a_auS]
-> GHC.Prim.Int#
-> GHC.Prim.Int#
-> GHC.Prim.Array# b_auT
-> Data.Vector.Vector (a_auS, b_auT)
[GblId,
Arity=4,
Str=DmdType LLLL,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=4, Value=True,
    ConLike=True, Cheap=True, Expandable=True,
    Guidance=IF_ARGS [0 0 0 0] 302 0}]
Foo.$wzipMe =
  \ (@ a_auS)
(@ b_auT)
(w_sW7 :: [a_auS])
(ww_sWa :: GHC.Prim.Int#)
(ww1_sWb :: GHC.Prim.Int#)
(ww2_sWc :: GHC.Prim.Array# b_auT) ->
GHC.ST.runSTRep
  @ (Data.Vector.Vector (a_auS, b_auT))
  (\ (@ s_aBU) (s_aBV :: GHC.Prim.State# s_aBU) ->
    case GHC.Prim.newArray#
        @ (a_auS, b_auT)
        @ (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))
        ww1_sWb
        (Data.Vector.Mutable.uninitialised @ (a_auS, b_auT))
        (s_aBV
        `cast` (GHC.Prim.State#
              (Sym (Control.Monad.Primitive.TFCo:R:PrimStateST <s_aBU>))
            :: GHC.Prim.State# (Control.Monad.Primitive.R:PrimStateST s_aBU)
              ~
            GHC.Prim.State#
              (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))))
    of _ { (# s'#_aSF, arr#_aSG #) ->
    letrec {
      $s$wa_sX0 [Occ=LoopBreaker]
    :: GHC.Prim.Int#
        -> [a_auS]
        -> GHC.Prim.Int#
        -> GHC.Prim.State# (Control.Monad.Primitive.R:PrimStateST s_aBU)
        -> (# GHC.Prim.State# s_aBU, GHC.Types.Int #)
      [LclId, Arity=4, Str=DmdType LLLL]
      $s$wa_sX0 =
    \ (sc_sWB :: GHC.Prim.Int#)
      (sc1_sWC :: [a_auS])
      (sc2_sWD :: GHC.Prim.Int#)
      (sc3_sWE
          :: GHC.Prim.State#
          (Control.Monad.Primitive.R:PrimStateST s_aBU)) ->
      case sc1_sWC of _ {
        [] -> (# sc3_sWE, GHC.Types.I# sc_sWB #);
        : x_aGx xs1_aGy ->
          case GHC.Prim.indexArray#
              @ b_auT ww2_sWc (GHC.Prim.+# ww_sWa sc2_sWD)
          of _ { (# x1_sWp #) ->
          case GHC.Prim.>=# sc2_sWD ww1_sWb of _ {
        GHC.Types.False ->
          $s$wa_sX0
            (GHC.Prim.+# sc_sWB 1)
            xs1_aGy
            (GHC.Prim.+# sc2_sWD 1)
            ((GHC.Prim.writeArray#
            @ (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))
            @ (a_auS, b_auT)
            arr#_aSG
            sc_sWB
            (x_aGx, x1_sWp)
            (sc3_sWE
              `cast` (GHC.Prim.State#
                    (Sym (Control.Monad.Primitive.TFCo:R:PrimStateST <s_aBU>))
                  :: GHC.Prim.State#
                      (Control.Monad.Primitive.R:PrimStateST s_aBU)
                      ~
                    GHC.Prim.State#
                      (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU)))))
              `cast` (GHC.Prim.State#
                (Control.Monad.Primitive.TFCo:R:PrimStateST <s_aBU>)
                  :: GHC.Prim.State#
                  (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))
                  ~
                GHC.Prim.State#
                  (Control.Monad.Primitive.R:PrimStateST s_aBU)));
        GHC.Types.True -> (# sc3_sWE, GHC.Types.I# sc_sWB #)
          }
          }
      }; } in
    case $s$wa_sX0
        0
        w_sW7
        0
        (s'#_aSF
        `cast` (GHC.Prim.State#
              (Control.Monad.Primitive.TFCo:R:PrimStateST <s_aBU>)
            :: GHC.Prim.State#
              (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))
              ~
            GHC.Prim.State# (Control.Monad.Primitive.R:PrimStateST s_aBU)))
    of _ { (# new_s1_aDv, r1_aDw #) ->
    case r1_aDw of _ { GHC.Types.I# tpl1_aU1 ->
    case GHC.Prim.unsafeFreezeArray#
        @ (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))
        @ (a_auS, b_auT)
        arr#_aSG
        (new_s1_aDv
        `cast` (GHC.Prim.State#
              (Sym (Control.Monad.Primitive.TFCo:R:PrimStateST <s_aBU>))
            :: GHC.Prim.State# (Control.Monad.Primitive.R:PrimStateST s_aBU)
              ~
            GHC.Prim.State#
              (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))))
    of _ { (# s'#1_aV8, arr'#_aV9 #) ->
    (# s'#1_aV8
    `cast` (GHC.Prim.State#
          (Control.Monad.Primitive.TFCo:R:PrimStateST <s_aBU>)
        :: GHC.Prim.State#
            (Control.Monad.Primitive.PrimState (GHC.ST.ST s_aBU))
            ~
          GHC.Prim.State# (Control.Monad.Primitive.R:PrimStateST s_aBU)),
    Data.Vector.Vector @ (a_auS, b_auT) 0 tpl1_aU1 arr'#_aV9 #)
    }
    }
    }
    })

, которое выполняет только одно выделениеи соединяет эти петли.(Я полагаю, что он использует тот факт, что длина сжатого вектора не превышает длину исходного Vector и изначально выделяет такой большой вектор.)

Answer 2

GHC, кажется, делает умную оптимизацию обхода вектора один раз при преобразовании его в список. Отдавая должное ответу @Louis Wasserman и добавляя здесь очищенный ghc-core - мой код отличается от кода Луи - я копируюсь в списке вместо вектора (удобнее, так как список небольшой, и генерироваться не часто ):

Первый код:

module Foo where

import Data.Vector
import Prelude

zipMe :: [a] -> Vector b -> [(a,b)]
zipMe xs ys = Prelude.zip xs (toList ys)

Как получить ghc-core (я использовал 7.4.1): ghc -O -fforce-recomp Foo.hs -ddump-simpl -dsuppress-all

Очищен вывод ядра GHC ниже:

--| this is called by zipMeHelper at loop termination
zipMe1 = \ _ -> []

--| Helper function called by zipMe - ys is converted into vector representation (start end array) - that is what I think. Correct me if I got the representation wrong
zipMeHelper =
  \ xs start end array ->
    letrec {
      go =
        \ index ->
          case >=# index end of _ { --| is index >= end? (>=#) is prim version of >=
            False -> --| note vector is being traversed here only once - vector element vecElem is: array at (start + index)
              case indexArray# array (+# start index) of _ { (# vecElem #) ->
              let { --| call a recursive function go2 if end of vector is not reached
                go2 = go (+# index 1) } in
              \ list -> --| take the list element and combine with vecElem
                case list of _ {
                  [] -> [];
                  : x1 xs1 -> : (x1, vecElem) (go2 xs1)
                }
              };
            True -> zipMe1 |-- if here, end of index was reached - terminate with []
          }; } in
    go 0 xs

|-- zipMe function from Foo.hs
zipMe =
  \ xs ys ->
    case ys of _ { Vector start end array ->
    zipMeHelper xs start end array
    }