{-|
  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 :: 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)
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 (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 (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 (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 (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
bbCtxName :: BlackBoxContext -> Maybe Text
bbCompName :: BlackBoxContext -> Identifier
bbLevel :: BlackBoxContext -> Size
bbQsysIncName :: BlackBoxContext -> [Text]
bbFunctions :: BlackBoxContext
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), Usage,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext)]
bbResults :: BlackBoxContext -> [(Expr, HWType)]
bbName :: BlackBoxContext -> Text
bbCtxName :: Maybe Text
bbCompName :: Identifier
bbLevel :: Size
bbQsysIncName :: [Text]
bbFunctions :: IntMap
  [(Either BlackBox (Identifier, [Declaration]), Usage,
    [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
    BlackBoxContext)]
bbInputs :: [(Expr, HWType, Bool)]
bbResults :: [(Expr, HWType)]
bbName :: Text
bbInputs :: BlackBoxContext -> [(Expr, HWType, Bool)]
..} 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. [a] -> Size -> a
!! Size
i) [Expr]
es
      [Bool]
bs <- Tree [Bool] -> [Bool]
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 (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 :: [a] -> Either b (Tree [a])
leaf [a]
x = Tree [a] -> Either b (Tree [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 :: [Tree [a]] -> Either b (Tree [a])
inner = Tree [a] -> Either b (Tree [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 :: 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 :: [Bool] -> a
fromBits [Bool]
xs =
  (a -> Size -> a) -> a -> [Size] -> a
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 (t :: Type -> Type) a. Foldable t => t a -> Size
length [Bool]
xs