6

ファイルから生のバイトを読み取り、それを「プレーン」タイプに「キャスト」してからソートする関数を作成しようとしています。

これを行うには、バイナリ データをどのように解釈するか、つまりバイナリ データの型をソートに伝える必要があります。

「バイナリ」データであるためには、「このデータをディスクから読み書きするため、生のビットとして扱うことができる」という意味で、データのタイプはバイナリおよびビットでなければなりません。そして、並べ替えるには、Ord のメンバーである必要があります。

これらの方法で制約された型は、並べ替え可能である必要があります。

ちょっとしたハックとして、型をソート関数に渡すために、代わりに型の住民を渡しています。(型自体を渡して結果を達成する方法があれば、知りたいです。)

{-# LANGUAGE RankNTypes #-}

import Data.Binary.Get
import Data.Binary.Put

type Sortable = forall a. (Bits a, Binary a, Ord a) => a

data SortOpts = SortOpts { maxFiles :: Int
    , maxMemory :: Integer
    , maxThreads :: Int
    , binType    :: Sortable
}

defaultOpts = SortOpts { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = 0 :: Word32
};

putBinaryValues :: Binary a => Handle -> [a] -> IO ()
putBinaryValues out vals = do
    let bytes = runPut . mapM_ put $ vals
    BL.hPut out bytes

binaryValues :: (Binary a, Bits a) => a -> Handle -> IO [a]
binaryValues t inf = do 
    size <- hFileSize inf
    let cast = runGet (genericReplicateM (size `div` byteWidth) get)
    cast . BL.fromChunks . (:[]) <$> BS.hGetContents inf
    where genericReplicateM n = sequence . (DL.genericReplicate n)
          byteWidth = fromIntegral $ (bitSize t) `div` 8

しかし、これはコンパイルされません。Haskell は、レコードのすべての値が具象型であると主張しているようです。少なくとも、それは私がエラーメッセージから集めているものです:

Could not deduce (a ~ Word32)
    from the context (Bits a, Ord a, Binary a)
        bound by a type expected by the context:
             (Bits a, Ord a, Binary a) => a
at ...
    `a' is a rigid type variable bound by
        a type expected by the context: (Bits a, Ord a, Binary a) => a

では、どうすれこの一般化を達成できるでしょうか?

編集:

ソートを「構成」するためにレコード更新構文を使用したかったのです。例えば:

configure = defaultOpts -- and exporting that

以降

let myOpts = configure{ binType = 42 :: Word16 }

しかし、これは機能しません。NYI だけでない限り、その理由がよくわかりません。

Record update for insufficiently polymorphic field: binType :: a
In the expression: configure {binType = words !! 0}
In an equation for `o': o = configure {binType = words !! 0}
In the expression:
  do { inTestHandle <- inTest;
       words <- testRandomWords;
       putBinaryValues inTestHandle $ take 100 words;
       seekBeg inTestHandle;
       .... }

では、私のクライアント コードは、defaultOpts から値を少しずつコピーし、並べ替えを再構成するたびに新しいレコードを作成するだけでよいのでしょうか?

4

2 に答える 2

1

ExistentialQuantificationあなたのタイプで使用できますSortOpts。以下がコンパイルされます。

{-# LANGUAGE ExistentialQuantification #-}

import Data.Bits
import Data.Word
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put

data SortOpts = forall a. (Bits a, Binary a, Ord a) => SortOpts
    { maxFiles   :: Int
    , maxMemory  :: Integer
    , maxThreads :: Int
    , binType    :: a
    }

defaultOpts = SortOpts
    { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = 0 :: Word32
    }

ただし、binTypeのような型を持つため、関数として使用するexists a. SortOpts -> aことはできず、戻り値として存在する型を使用できないことに注意してください。ただし、たとえば、パターン マッチングによってフィールド値を取得できます。

test :: SortOpts -> ByteString -> ByteString -> Ordering
test (SortOpts{binType=binType}) bsa bsb = compare a b where
    a = runGet get bsa `asTypeOf` binType
    b = runGet get bsb `asTypeOf` binType

binTypeこれは、指定されたの存在を使用して、2 つのバイト文字列を逆シリアル化し、比較しSortOptsます。

お気づきのように、Haskell のレコード更新構文は存在フィールドをサポートしていないため、更新するには次のようにする必要がありますbinType

defaultOpts = SortOpts
    { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = 0 :: Word32
    }

alternativeOpts = withBinType (0 :: Word16) $ defaultOpts
    { maxFiles = 256 }

withBinType :: (Bits a, Binary a, Ord a) => a -> SortOpts -> SortOpts
withBinType bt (SortOpts{..}) = SortOpts maxFiles maxMemory maxThreads bt

上記はRecordWildCards、レコードのコピーを少し簡単にするために使用されます。これは、後でオプション レコードを使用する場合にも便利な拡張機能です。

または、jozefg が示唆したように、ラッパー タイプを使用することもできますbinType。次のように使用します。

{-# LANGUAGE ExistentialQuantification #-}

data BinType = forall a. (Bits a, Binary a, Ord a) => BinType a

data SortOpts = SortOpts
    { maxFiles   :: Int
    , maxMemory  :: Integer
    , maxThreads :: Int
    , binType    :: BinType
    }

defaultOpts = SortOpts
    { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = BinType (0 :: Word32)
    }

alternativeOpts = defaultOpts
    { binType = BinType (0 :: Word16) }

は通常のレコード タイプになったためSortOpts、すべてのレコード操作を通常どおり使用できます。unwrapped を参照するには、前の例が (using )になるbinTypeように、ラッパーでパターン マッチを行う必要があります。testRecordWildCards

test :: SortOpts -> ByteString -> ByteString -> Ordering
test (SortOpts{..}) bsa bsb = case binType of
    BinType bt -> compare a b where
        a = runGet get bsa `asTypeOf` bt
        b = runGet get bsb `asTypeOf` bt

上記のすべては、何らかの理由で存在の背後に正確な型パラメーターを隠すことができる必要がある特定のユースケースがあることを前提としていることに注意してください。通常、型パラメーターをSortOptsそのままにして、 を使用する関数で制約しますSortOpts。いえ

data SortOpts a = SortOpts
    { maxFiles   :: Int
    , maxMemory  :: Integer
    , maxThreads :: Int
    , binType    :: a
    }

test :: (Bits a, Binary a, Ord a) => SortOpts a -> ByteString -> ByteString -> Ordering
test (SortOpts{..}) bsa bsb = compare a b where
    a = runGet get bsa `asTypeOf` binType
    b = runGet get bsb `asTypeOf` binType

次のように、必要に応じて拡張子を使用しConstraintKindsて短いエイリアスを作成できます。

{-# LANGUAGE ConstraintKinds #-}

type BinType a = (Bits a, Binary a, Ord a)

test :: BinType a => SortOpts a -> ByteString -> ByteString -> Ordering
于 2013-09-03T18:25:23.887 に答える