    {-|
      Copyright  :  (C) 2012-2016, University of Twente,
                        2017     , Myrtle Software Ltd,
                        2017-2018, Google Inc.
                        2020-2022, QBayLogic B.V.
                        2022     , Google Inc.
      License    :  BSD2 (see the file LICENSE)
      Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

      Functions for expression manipulation
    -}

    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Clash.Netlist.Expr where

    import Control.Monad (zipWithM)
    import Control.Exception (assert)
    import Data.Set (fromList, member)
    import Data.Bits (Bits, testBit, setBit, zeroBits)
    import Data.Foldable (fold)
    import Data.Tree (Tree(..))
    import GHC.Stack (HasCallStack)
    import Data.Text (unpack)
    import Language.Haskell.TH.Quote (dataToPatQ)

    import qualified Clash.Sized.Vector as V (replicate)
    import qualified Clash.Sized.Internal.Index as I (fromInteger#)
    import qualified Clash.Sized.Internal.Signed as S (fromInteger#)
    import qualified Clash.Sized.Internal.Unsigned as U (fromInteger#)
    import qualified Clash.Sized.Internal.BitVector as BV
      (high, low, fromInteger#, fromInteger##)
    import GHC.Int (Int8(I8#), Int16(I16#), Int32(I32#), Int64(I64#))
    import GHC.Word (Word8(W8#), Word16(W16#), Word32(W32#), Word64(W64#))

    import Clash.Primitives.DSL (tySize)
    import Clash.Netlist.Types
      ( Size, Bit(..), Expr(..), HWType(..), Literal(..), Modifier(..)
      , BlackBoxContext(..)
      )

    -- | Turns a constant expression of known bitsize into their
    -- corresponding bitstream representation, arranged as a tree
    -- that corresponds to the structure of the expression.
    --
    -- NOTE: This conversion serves as a best effort approach and can be
    -- considered a hack. Fully featured constant expression evaluation is
    -- not available in clash yet and will replace this implementation
    -- once it is officially supported.
    bits :: HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    bits :: HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    size Expr
    expr = case Expr
    expr of
      Literal Maybe (HWType, Size)
    _ Literal
    lit -> case Literal
    lit of
        BitLit Bit
    bLit   -> case Bit
    bLit of
          Bit
    H -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf [Bool
    True]
          Bit
    L -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf [Bool
    False]
          Bit
    _ -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
        BoolLit Bool
    bLit      -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf [Bool
    bLit]
        NumLit Integer
    nLit       -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf ([Bool] -> Either Expr (Tree [Bool]))
    -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ Size -> Integer -> [Bool]
    forall a. Bits a => Size -> a -> [Bool]
    toBits Size
    size Integer
    nLit
        BitVecLit Integer
    _ Integer
    bvLit -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf ([Bool] -> Either Expr (Tree [Bool]))
    -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ Size -> Integer -> [Bool]
    forall a. Bits a => Size -> a -> [Bool]
    toBits Size
    size Integer
    bvLit
        VecLit [Literal]
    lits       ->
          (Literal -> Either Expr (Tree [Bool]))
    -> [Literal] -> Either Expr [Tree [Bool]]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM (HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits (Size
    size Size -> Size -> Size
    forall a. Integral a => a -> a -> a
    `div` [Literal] -> Size
    forall a. [a] -> Size
    forall (t :: Type -> Type) a. Foldable t => t a -> Size
    length [Literal]
    lits) (Expr -> Either Expr (Tree [Bool]))
    -> (Literal -> Expr) -> Literal -> Either Expr (Tree [Bool])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Literal -> Expr
    lit2Expr) [Literal]
    lits Either Expr [Tree [Bool]]
    -> ([Tree [Bool]] -> Either Expr (Tree [Bool]))
    -> Either Expr (Tree [Bool])
    forall a b. Either Expr a -> (a -> Either Expr b) -> Either Expr b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. [Tree [a]] -> Either b (Tree [a])
    inner
        StringLit{}       -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
      DataCon HWType
    ty Modifier
    m [Expr]
    subs -> Bool -> Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool])
    forall a. HasCallStack => Bool -> a -> a
    assert (HWType -> Size
    forall i. Num i => HWType -> i
    tySize HWType
    ty Size -> Size -> Bool
    forall a. Eq a => a -> a -> Bool
    == Size
    size) (Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool]))
    -> Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ case HWType
    ty of
        Vector Size
    s HWType
    t      -> Size -> Size -> [Expr] -> Either Expr (Tree [Bool])
    vecBits (HWType -> Size
    forall i. Num i => HWType -> i
    tySize HWType
    t) Size
    s [Expr]
    subs
        Product Text
    _ Maybe [Text]
    _ [HWType]
    tys -> (Size -> Expr -> Either Expr (Tree [Bool]))
    -> [Size] -> [Expr] -> Either Expr [Tree [Bool]]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits ((HWType -> Size) -> [HWType] -> [Size]
    forall a b. (a -> b) -> [a] -> [b]
    map HWType -> Size
    forall i. Num i => HWType -> i
    tySize [HWType]
    tys) [Expr]
    subs Either Expr [Tree [Bool]]
    -> ([Tree [Bool]] -> Either Expr (Tree [Bool]))
    -> Either Expr (Tree [Bool])
    forall a b. Either Expr a -> (a -> Either Expr b) -> Either Expr b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. [Tree [a]] -> Either b (Tree [a])
    inner
        Sum Text
    _ [Text]
    cs        -> Expr
    -> Size
    -> Modifier
    -> [Expr]
    -> [[Size]]
    -> Either Expr (Tree [Bool])
    spBits Expr
    expr Size
    size Modifier
    m [Expr]
    subs ([[Size]] -> Either Expr (Tree [Bool]))
    -> [[Size]] -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ (Text -> [Size]) -> [Text] -> [[Size]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Size] -> Text -> [Size]
    forall a b. a -> b -> a
    const []) [Text]
    cs
        SP Text
    _ [(Text, [HWType])]
    xs         -> Expr
    -> Size
    -> Modifier
    -> [Expr]
    -> [[Size]]
    -> Either Expr (Tree [Bool])
    spBits Expr
    expr Size
    size Modifier
    m [Expr]
    subs ([[Size]] -> Either Expr (Tree [Bool]))
    -> [[Size]] -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ ((Text, [HWType]) -> [Size]) -> [(Text, [HWType])] -> [[Size]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((HWType -> Size) -> [HWType] -> [Size]
    forall a b. (a -> b) -> [a] -> [b]
    map HWType -> Size
    forall i. Num i => HWType -> i
    tySize ([HWType] -> [Size])
    -> ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [Size]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) [(Text, [HWType])]
    xs
        HWType
    _               -> case [Expr]
    subs of
          [Expr
    e] -> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    size Expr
    e
          []  -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf []
          [Expr]
    _   -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
      -- appears in case of complex transformations, e.g.,
      -- >>> (bv2v 0b010) :: Vec 3 Bit
      -- >>> (iterate (SNat @3) not True) :: Vec 3 Bool
      -- >>> (complement <$> (True :> False :> Nil)) :: Vec 2 Bool
      Identifier{} -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
      DataTag{} -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
      BlackBoxE Text
    bbName [BlackBoxTemplate]
    _ [BlackBoxTemplate]
    _ [((Text, Text), BlackBox)]
    _ BlackBox
    _ BlackBoxContext
    bbCtx Bool
    _ -> case Text -> String
    unpack Text
    bbName of
        $(dataToPatQ (const Nothing) $ show 'BV.low) -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf [Bool
    False]
        $(dataToPatQ (const Nothing) $ show 'BV.high) -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf [Bool
    True]
        $(dataToPatQ (const Nothing) $ show 'V.replicate) -> case BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs BlackBoxContext
    bbCtx of
          [ (Expr
    eSize, HWType
    ty, Bool
    _), (Expr
    eValue, HWType
    _, Bool
    _) ] -> do
            Tree [Bool]
    bs <- HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits (HWType -> Size
    forall i. Num i => HWType -> i
    tySize HWType
    ty) Expr
    eSize
            let s :: Size
    s = [Bool] -> Size
    forall a. Bits a => [Bool] -> a
    fromBits ([Bool] -> Size) -> [Bool] -> Size
    forall a b. (a -> b) -> a -> b
    $ Tree [Bool] -> [Bool]
    forall m. Monoid m => Tree m -> m
    forall (t :: Type -> Type) m. (Foldable t, Monoid m) => t m -> m
    fold Tree [Bool]
    bs
            Tree [Bool]
    v <- HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits (Size
    size Size -> Size -> Size
    forall a. Integral a => a -> a -> a
    `div` Size
    s) Expr
    eValue
            [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. [Tree [a]] -> Either b (Tree [a])
    inner ([Tree [Bool]] -> Either Expr (Tree [Bool]))
    -> [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ Size -> Tree [Bool] -> [Tree [Bool]]
    forall a. Size -> a -> [a]
    replicate Size
    s Tree [Bool]
    v
          [(Expr, HWType, Bool)]
    _ -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
        String
    _ ->
          if Text -> String
    unpack Text
    bbName String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `member` Set String
    skippableBBs
          then Expr -> BlackBoxContext -> Size -> Either Expr (Tree [Bool])
    skippableBBBits Expr
    expr BlackBoxContext
    bbCtx Size
    size
          else Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
      ToBv Maybe Identifier
    _ HWType
    _ Expr
    e -> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    size Expr
    e
      FromBv Maybe Identifier
    _ HWType
    _ Expr
    e -> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    size Expr
    e
      IfThenElse Expr
    cond Expr
    match Expr
    alt -> case HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    1 Expr
    cond of
        Right (Node [Bool
    True] [])  -> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    size Expr
    match
        Right (Node [Bool
    False] []) -> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    size Expr
    alt
        Either Expr (Tree [Bool])
    _ -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    expr
      Expr
    Noop -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf []

     where
      -- known skippable blackboxes
      skippableBBs :: Set String
    skippableBBs = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    fromList ([String] -> Set String) -> [String] -> Set String
    forall a b. (a -> b) -> a -> b
    $ (Name -> String) -> [Name] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> String
    forall a. Show a => a -> String
    show
        [ 'I.fromInteger#, 'S.fromInteger#, 'U.fromInteger#
        , 'BV.fromInteger#, 'BV.fromInteger##
        , 'I8#, 'I16#, 'I32#, 'I64#
        , 'W8#, 'W16#, 'W32#, 'W64#
        ]

      -- skips the blackbox conversion and obtains the constant result
      -- directly from the last input argument instead
      skippableBBBits :: Expr -> BlackBoxContext -> Size -> Either Expr (Tree [Bool])
    skippableBBBits Expr
    e Context{Size
    [(Expr, HWType)]
    [(Expr, HWType, Bool)]
    [Text]
    Maybe Text
    Text
    IntMap
      [(Either BlackBox (Identifier, [Declaration]), Usage,
        [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
        BlackBoxContext)]
    Identifier
    bbInputs :: BlackBoxContext -> [(Expr, HWType, Bool)]
    bbName :: Text
    bbResults :: [(Expr, HWType)]
    bbInputs :: [(Expr, HWType, Bool)]
    bbFunctions :: IntMap
      [(Either BlackBox (Identifier, [Declaration]), Usage,
        [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
        BlackBoxContext)]
    bbQsysIncName :: [Text]
    bbLevel :: Size
    bbCompName :: Identifier
    bbCtxName :: Maybe Text
    bbName :: BlackBoxContext -> Text
    bbResults :: BlackBoxContext -> [(Expr, HWType)]
    bbFunctions :: BlackBoxContext
    -> IntMap
         [(Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext)]
    bbQsysIncName :: BlackBoxContext -> [Text]
    bbLevel :: BlackBoxContext -> Size
    bbCompName :: BlackBoxContext -> Identifier
    bbCtxName :: BlackBoxContext -> Maybe Text
    ..} Size
    n = case [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
    forall a. [a] -> [a]
    reverse [(Expr, HWType, Bool)]
    bbInputs of
        (Expr
    x, HWType
    _, Bool
    _) : [(Expr, HWType, Bool)]
    _ -> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    n Expr
    x
        [(Expr, HWType, Bool)]
    _             -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    e

      -- turns sum (& product) expressions into bitstreams (preserving the
      -- expressions' tree layout)
      spBits :: Expr -> Size -> Modifier -> [Expr] -> [[Size]]
             -> Either Expr (Tree [Bool])
      spBits :: Expr
    -> Size
    -> Modifier
    -> [Expr]
    -> [[Size]]
    -> Either Expr (Tree [Bool])
    spBits Expr
    e Size
    n Modifier
    m [Expr]
    es [[Size]]
    sizes = case Modifier
    m of
        DC (HWType
    _, Size
    i) -> do
          [Tree [Bool]]
    xs <- (Size -> Expr -> Either Expr (Tree [Bool]))
    -> [Size] -> [Expr] -> Either Expr [Tree [Bool]]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits ([[Size]]
    sizes [[Size]] -> Size -> [Size]
    forall a. HasCallStack => [a] -> Size -> a
    !! Size
    i) [Expr]
    es
          [Bool]
    bs <- Tree [Bool] -> [Bool]
    forall m. Monoid m => Tree m -> m
    forall (t :: Type -> Type) m. (Foldable t, Monoid m) => t m -> m
    fold (Tree [Bool] -> [Bool])
    -> Either Expr (Tree [Bool]) -> Either Expr [Bool]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. [Tree [a]] -> Either b (Tree [a])
    inner [Tree [Bool]]
    xs
          Tree [Bool]
    l <- [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf ([Bool] -> Either Expr (Tree [Bool]))
    -> [Bool] -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ Size -> Size -> [Bool]
    forall a. Bits a => Size -> a -> [Bool]
    toBits (Size
    n Size -> Size -> Size
    forall a. Num a => a -> a -> a
    - [Bool] -> Size
    forall a. [a] -> Size
    forall (t :: Type -> Type) a. Foldable t => t a -> Size
    length [Bool]
    bs) Size
    i
          Tree [Bool]
    r <- [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf [Bool]
    bs
          [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. [Tree [a]] -> Either b (Tree [a])
    inner [ Tree [Bool]
    l, Tree [Bool]
    r ]
        Modifier
    _ -> Expr -> Either Expr (Tree [Bool])
    forall a b. a -> Either a b
    Left Expr
    e

      -- turns vector expressions into bitstream (preserving the
      -- expressions' tree layout)
      vecBits :: Size -> Int -> [Expr] -> Either Expr (Tree [Bool])
      vecBits :: Size -> Size -> [Expr] -> Either Expr (Tree [Bool])
    vecBits Size
    elemSize Size
    elems = \case
        []   -> Bool -> Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool])
    forall a. HasCallStack => Bool -> a -> a
    assert (Size
    elems Size -> Size -> Bool
    forall a. Eq a => a -> a -> Bool
    == Size
    0) (Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool]))
    -> Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> Either Expr (Tree [Bool])
    forall a b. [a] -> Either b (Tree [a])
    leaf []
        Expr
    x:[Expr]
    xr -> Bool -> Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool])
    forall a. HasCallStack => Bool -> a -> a
    assert (Size
    elems Size -> Size -> Bool
    forall a. Ord a => a -> a -> Bool
    > Size
    0) (Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool]))
    -> Either Expr (Tree [Bool]) -> Either Expr (Tree [Bool])
    forall a b. (a -> b) -> a -> b
    $ do
          (Size
    processedElems, Tree [Bool]
    cur) <- case Expr
    x of
            DataCon HWType
    t Modifier
    _ [Expr]
    xs -> case HWType
    t of
              Vector Size
    subElems (HWType -> Size
    forall i. Num i => HWType -> i
    tySize -> Size
    subTySize) ->
                Bool
    -> Either Expr (Size, Tree [Bool])
    -> Either Expr (Size, Tree [Bool])
    forall a. HasCallStack => Bool -> a -> a
    assert (Size
    subElems Size -> Size -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Size
    elems Bool -> Bool -> Bool
    && Size
    subTySize Size -> Size -> Bool
    forall a. Eq a => a -> a -> Bool
    == Size
    elemSize)
                  ((Size
    subElems,) (Tree [Bool] -> (Size, Tree [Bool]))
    -> Either Expr (Tree [Bool]) -> Either Expr (Size, Tree [Bool])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Size -> Size -> [Expr] -> Either Expr (Tree [Bool])
    vecBits Size
    elemSize Size
    subElems [Expr]
    xs)
              HWType
    _ -> (Size
    1,) (Tree [Bool] -> (Size, Tree [Bool]))
    -> Either Expr (Tree [Bool]) -> Either Expr (Size, Tree [Bool])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    elemSize Expr
    x
            Expr
    _ -> (Size
    1,) (Tree [Bool] -> (Size, Tree [Bool]))
    -> Either Expr (Tree [Bool]) -> Either Expr (Size, Tree [Bool])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> HasCallStack => Size -> Expr -> Either Expr (Tree [Bool])
    Size -> Expr -> Either Expr (Tree [Bool])
    bits Size
    elemSize Expr
    x
          Tree [Bool]
    sub <- Size -> Size -> [Expr] -> Either Expr (Tree [Bool])
    vecBits Size
    elemSize (Size
    elems Size -> Size -> Size
    forall a. Num a => a -> a -> a
    - Size
    processedElems) [Expr]
    xr
          [Tree [Bool]] -> Either Expr (Tree [Bool])
    forall a b. [Tree [a]] -> Either b (Tree [a])
    inner [Tree [Bool]
    cur, Tree [Bool]
    sub]

      -- creates a leaf node holding the leaf value
      leaf :: [a] -> Either b (Tree [a])
      leaf :: forall a b. [a] -> Either b (Tree [a])
    leaf [a]
    x = Tree [a] -> Either b (Tree [a])
    forall a. a -> Either b a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Tree [a] -> Either b (Tree [a]))
    -> Tree [a] -> Either b (Tree [a])
    forall a b. (a -> b) -> a -> b
    $ [a] -> [Tree [a]] -> Tree [a]
    forall a. a -> [Tree a] -> Tree a
    Node [a]
    x []

      -- creates an inner node (holding no value) with the given
      -- sub-trees
      inner :: [Tree [a]] -> Either b (Tree [a])
      inner :: forall a b. [Tree [a]] -> Either b (Tree [a])
    inner = Tree [a] -> Either b (Tree [a])
    forall a. a -> Either b a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Tree [a] -> Either b (Tree [a]))
    -> ([Tree [a]] -> Tree [a]) -> [Tree [a]] -> Either b (Tree [a])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [Tree [a]] -> Tree [a]
    forall a. a -> [Tree a] -> Tree a
    Node []

      -- turns a literal into an expression
      lit2Expr :: Literal -> Expr
    lit2Expr = Maybe (HWType, Size) -> Literal -> Expr
    Literal Maybe (HWType, Size)
    forall a. Maybe a
    Nothing

    -- | Turns values into bitstreams of known length. If the bit stream
    -- requires more bits for representing the given value, then only the
    -- suffix of the corresponding bitstream gets returned.
    toBits :: Bits a => Int -> a -> [Bool]
    toBits :: forall a. Bits a => Size -> a -> [Bool]
    toBits Size
    n a
    x =
      (Size -> Bool) -> [Size] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (a -> Size -> Bool
    forall a. Bits a => a -> Size -> Bool
    testBit a
    x) [Size
    nSize -> Size -> Size
    forall a. Num a => a -> a -> a
    -Size
    1,Size
    nSize -> Size -> Size
    forall a. Num a => a -> a -> a
    -Size
    2..Size
    0]

    -- | Turns bitstreams into values.
    fromBits :: Bits a => [Bool] -> a
    fromBits :: forall a. Bits a => [Bool] -> a
    fromBits [Bool]
    xs =
      (a -> Size -> a) -> a -> [Size] -> a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl a -> Size -> a
    forall a. Bits a => a -> Size -> a
    setBit a
    forall a. Bits a => a
    zeroBits ([Size] -> a) -> [Size] -> a
    forall a b. (a -> b) -> a -> b
    $ ((Bool, Size) -> Size) -> [(Bool, Size)] -> [Size]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, Size) -> Size
    forall a b. (a, b) -> b
    snd ([(Bool, Size)] -> [Size]) -> [(Bool, Size)] -> [Size]
    forall a b. (a -> b) -> a -> b
    $ ((Bool, Size) -> Bool) -> [(Bool, Size)] -> [(Bool, Size)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool, Size) -> Bool
    forall a b. (a, b) -> a
    fst ([(Bool, Size)] -> [(Bool, Size)])
    -> [(Bool, Size)] -> [(Bool, Size)]
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> [Size] -> [(Bool, Size)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Bool]
    xs [Size
    nSize -> Size -> Size
    forall a. Num a => a -> a -> a
    -Size
    1,Size
    nSize -> Size -> Size
    forall a. Num a => a -> a -> a
    -Size
    2..Size
    0]
     where
      n :: Size
    n = [Bool] -> Size
    forall a. [a] -> Size
    forall (t :: Type -> Type) a. Foldable t => t a -> Size
    length [Bool]
    xs