-- |
-- Module      :  Cryptol.Prims.Eval
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Cryptol.Prims.Eval where

import Control.Monad (join, unless)

import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat (Nat'(..),fromNat,genLog, nMul)
import Cryptol.Eval.Monad
import Cryptol.Eval.Type
import Cryptol.Eval.Value
import Cryptol.Testing.Random (randomValue)
import Cryptol.Utils.Panic (panic)
import Cryptol.ModuleSystem.Name (asPrim)
import Cryptol.Utils.Ident (Ident,mkIdent)
import Cryptol.Utils.PP
import Cryptol.Utils.Logger(logPrint)

import qualified Data.Foldable as Fold
import Data.List (sortBy)
import qualified Data.Sequence as Seq
import Data.Ord (comparing)
import Data.Bits (Bits(..))

import qualified Data.Map.Strict as Map
import qualified Data.Text as T

import System.Random.TF.Gen (seedTFGen)

-- Primitives ------------------------------------------------------------------

instance EvalPrims Bool BV Integer where
  evalPrim :: Decl -> Maybe (GenValue Bool BV Integer)
evalPrim Decl { dName :: Decl -> Name
dName = Name
n, .. } =
    do Ident
prim <- Name -> Maybe Ident
asPrim Name
n
       Ident
-> Map Ident (GenValue Bool BV Integer)
-> Maybe (GenValue Bool BV Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
prim Map Ident (GenValue Bool BV Integer)
primTable

  iteValue :: Bool
-> Eval (GenValue Bool BV Integer)
-> Eval (GenValue Bool BV Integer)
-> Eval (GenValue Bool BV Integer)
iteValue b :: Bool
b t :: Eval (GenValue Bool BV Integer)
t f :: Eval (GenValue Bool BV Integer)
f = if Bool
b then Eval (GenValue Bool BV Integer)
t else Eval (GenValue Bool BV Integer)
f


primTable :: Map.Map Ident Value
primTable :: Map Ident (GenValue Bool BV Integer)
primTable = [(Ident, GenValue Bool BV Integer)]
-> Map Ident (GenValue Bool BV Integer)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Ident, GenValue Bool BV Integer)]
 -> Map Ident (GenValue Bool BV Integer))
-> [(Ident, GenValue Bool BV Integer)]
-> Map Ident (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ ((String, GenValue Bool BV Integer)
 -> (Ident, GenValue Bool BV Integer))
-> [(String, GenValue Bool BV Integer)]
-> [(Ident, GenValue Bool BV Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: String
n, v :: GenValue Bool BV Integer
v) -> (Text -> Ident
mkIdent (String -> Text
T.pack String
n), GenValue Bool BV Integer
v))
  [ ("+"          , {-# SCC "Prelude::(+)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer) -> BinArith BV
liftBinArith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftBinInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
                            ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Integer -> Eval Integer
liftBinIntMod Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))))
  , ("-"          , {-# SCC "Prelude::(-)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer) -> BinArith BV
liftBinArith (-)) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftBinInteger (-))
                            ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Integer -> Eval Integer
liftBinIntMod (-))))
  , ("*"          , {-# SCC "Prelude::(*)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer) -> BinArith BV
liftBinArith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftBinInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
                            ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Integer -> Eval Integer
liftBinIntMod Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))))
  , ("/"          , {-# SCC "Prelude::(/)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer) -> BinArith BV
liftDivArith Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div)
                            ((Integer -> Integer -> Eval Integer)
-> Integer -> Integer -> Integer -> Eval Integer
forall a b. a -> b -> a
const ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div))))
  , ("%"          , {-# SCC "Prelude::(%)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer) -> BinArith BV
liftDivArith Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod)
                            ((Integer -> Integer -> Eval Integer)
-> Integer -> Integer -> Integer -> Eval Integer
forall a b. a -> b -> a
const ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod))))
  , ("^^"         , {-# SCC "Prelude::(^^)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary BinArith BV
modExp Integer -> Integer -> Eval Integer
integerExp Integer -> Integer -> Integer -> Eval Integer
intModExp))
  , ("lg2"        , {-# SCC "Prelude::lg2" #-}
                    Unary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Unary b w i -> GenValue b w i
unary  (UnaryArith BV
-> (Integer -> Eval Integer)
-> (Integer -> Integer -> Eval Integer)
-> Unary Bool BV Integer
forall b w i.
BitWord b w i =>
UnaryArith w
-> (i -> Eval i) -> (Integer -> i -> Eval i) -> Unary b w i
arithUnary ((Integer -> Integer) -> UnaryArith BV
liftUnaryArith Integer -> Integer
lg2) Integer -> Eval Integer
integerLg2 ((Integer -> Eval Integer) -> Integer -> Integer -> Eval Integer
forall a b. a -> b -> a
const Integer -> Eval Integer
integerLg2)))
  , ("negate"     , {-# SCC "Prelude::negate" #-}
                    Unary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Unary b w i -> GenValue b w i
unary  (UnaryArith BV
-> (Integer -> Eval Integer)
-> (Integer -> Integer -> Eval Integer)
-> Unary Bool BV Integer
forall b w i.
BitWord b w i =>
UnaryArith w
-> (i -> Eval i) -> (Integer -> i -> Eval i) -> Unary b w i
arithUnary ((Integer -> Integer) -> UnaryArith BV
liftUnaryArith Integer -> Integer
forall a. Num a => a -> a
negate) Integer -> Eval Integer
integerNeg Integer -> Integer -> Eval Integer
intModNeg))
  , ("<"          , {-# SCC "Prelude::(<)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder "<"  (\o :: Ordering
o -> Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT           )))
  , (">"          , {-# SCC "Prelude::(>)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder ">"  (\o :: Ordering
o -> Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT           )))
  , ("<="         , {-# SCC "Prelude::(<=)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder "<=" (\o :: Ordering
o -> Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
|| Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ)))
  , (">="         , {-# SCC "Prelude::(>=)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder ">=" (\o :: Ordering
o -> Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
|| Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ)))
  , ("=="         , {-# SCC "Prelude::(==)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder "==" (\o :: Ordering
o ->            Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ)))
  , ("!="         , {-# SCC "Prelude::(!=)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder "!=" (\o :: Ordering
o ->            Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ)))
  , ("<$"         , {-# SCC "Prelude::(<$)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (String -> (Ordering -> Bool) -> Binary Bool BV Integer
signedCmpOrder "<$" (\o :: Ordering
o -> Ordering
o Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT)))
  , ("/$"         , {-# SCC "Prelude::(/$)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer -> Eval BV) -> BinArith BV
liftSigned Integer -> Integer -> Integer -> Eval BV
bvSdiv) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div)
                            ((Integer -> Integer -> Eval Integer)
-> Integer -> Integer -> Integer -> Eval Integer
forall a b. a -> b -> a
const ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div))))
  , ("%$"         , {-# SCC "Prelude::(%$)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary (BinArith BV
-> (Integer -> Integer -> Eval Integer)
-> (Integer -> Integer -> Integer -> Eval Integer)
-> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary ((Integer -> Integer -> Integer -> Eval BV) -> BinArith BV
liftSigned Integer -> Integer -> Integer -> Eval BV
bvSrem) ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod)
                            ((Integer -> Integer -> Eval Integer)
-> Integer -> Integer -> Integer -> Eval Integer
forall a b. a -> b -> a
const ((Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod))))
  , (">>$"        , {-# SCC "Prelude::(>>$)" #-}
                    GenValue Bool BV Integer
sshrV)
  , ("&&"         , {-# SCC "Prelude::(&&)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary ((Bool -> Bool -> Bool)
-> (BV -> BV -> BV) -> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
(b -> b -> b) -> (w -> w -> w) -> Binary b w i
logicBinary Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
(.&.) ((Integer -> Integer -> Integer) -> BV -> BV -> BV
binBV Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.&.))))
  , ("||"         , {-# SCC "Prelude::(||)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary ((Bool -> Bool -> Bool)
-> (BV -> BV -> BV) -> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
(b -> b -> b) -> (w -> w -> w) -> Binary b w i
logicBinary Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
(.|.) ((Integer -> Integer -> Integer) -> BV -> BV -> BV
binBV Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
(.|.))))
  , ("^"          , {-# SCC "Prelude::(^)" #-}
                    Binary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Binary b w i -> GenValue b w i
binary ((Bool -> Bool -> Bool)
-> (BV -> BV -> BV) -> Binary Bool BV Integer
forall b w i.
BitWord b w i =>
(b -> b -> b) -> (w -> w -> w) -> Binary b w i
logicBinary Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
xor ((Integer -> Integer -> Integer) -> BV -> BV -> BV
binBV Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor)))
  , ("complement" , {-# SCC "Prelude::complement" #-}
                    Unary Bool BV Integer -> GenValue Bool BV Integer
forall b w i. Unary b w i -> GenValue b w i
unary  ((Bool -> Bool) -> (BV -> BV) -> Unary Bool BV Integer
forall b w i. BitWord b w i => (b -> b) -> (w -> w) -> Unary b w i
logicUnary Bool -> Bool
forall a. Bits a => a -> a
complement ((Integer -> Integer) -> BV -> BV
unaryBV Integer -> Integer
forall a. Bits a => a -> a
complement)))
  , ("toInteger"  , GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
ecToIntegerV)
  , ("fromInteger", (Integer -> Integer -> Integer) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(Integer -> i -> i) -> GenValue b w i
ecFromIntegerV ((Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod))
  , ("fromZ"      , {-# SCC "Prelude::fromZ" #-}
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ _modulus :: Nat'
_modulus ->
                    (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ x :: Eval (GenValue Bool BV Integer)
x -> Eval (GenValue Bool BV Integer)
x)
  , ("<<"         , {-# SCC "Prelude::(<<)" #-}
                    (Integer -> Integer -> Integer -> Integer)
-> (Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool))
-> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap)
-> GenValue Bool BV Integer
logicShift Integer -> Integer -> Integer -> Integer
shiftLW Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
shiftLB Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
shiftLS)
  , (">>"         , {-# SCC "Prelude::(>>)" #-}
                    (Integer -> Integer -> Integer -> Integer)
-> (Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool))
-> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap)
-> GenValue Bool BV Integer
logicShift Integer -> Integer -> Integer -> Integer
shiftRW Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
shiftRB Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
shiftRS)
  , ("<<<"        , {-# SCC "Prelude::(<<<)" #-}
                    (Integer -> Integer -> Integer -> Integer)
-> (Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool))
-> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap)
-> GenValue Bool BV Integer
logicShift Integer -> Integer -> Integer -> Integer
rotateLW Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
rotateLB Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
rotateLS)
  , (">>>"        , {-# SCC "Prelude::(>>>)" #-}
                    (Integer -> Integer -> Integer -> Integer)
-> (Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool))
-> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap)
-> GenValue Bool BV Integer
logicShift Integer -> Integer -> Integer -> Integer
rotateRW Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
rotateRB Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
rotateRS)
  , ("True"       , Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit Bool
True)
  , ("False"      , Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit Bool
False)

  , ("carry"      , {-# SCC "Prelude::carry" #-}
                    GenValue Bool BV Integer
carryV)
  , ("scarry"     , {-# SCC "Prelude::scarry" #-}
                    GenValue Bool BV Integer
scarryV)
  , ("number"     , {-# SCC "Prelude::number" #-}
                    GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
ecNumberV)

  , ("#"          , {-# SCC "Prelude::(#)" #-}
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ front :: Nat'
front ->
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ back :: Nat'
back  ->
                    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ elty :: TValue
elty  ->
                    (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ l :: Eval (GenValue Bool BV Integer)
l     -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
                    (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ r :: Eval (GenValue Bool BV Integer)
r     -> Eval (Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Nat' -> Nat' -> Binary Bool BV Integer
forall b w i.
(Show b, Show w, BitWord b w i) =>
Nat'
-> Nat'
-> TValue
-> GenValue b w i
-> GenValue b w i
-> Eval (GenValue b w i)
ccatV Nat'
front Nat'
back TValue
elty (GenValue Bool BV Integer
 -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
-> Eval
     (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (GenValue Bool BV Integer)
l Eval (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
-> Eval (Eval (GenValue Bool BV Integer))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval (GenValue Bool BV Integer)
r))

  , ("@"          , {-# SCC "Prelude::(@)" #-}
                    (Maybe Integer
 -> TValue
 -> SeqValMap
 -> Seq Bool
 -> Eval (GenValue Bool BV Integer))
-> (Maybe Integer
    -> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(Maybe Integer
 -> TValue -> SeqMap b w i -> Seq b -> Eval (GenValue b w i))
-> (Maybe Integer
    -> TValue -> SeqMap b w i -> w -> Eval (GenValue b w i))
-> GenValue b w i
indexPrim Maybe Integer
-> TValue
-> SeqValMap
-> Seq Bool
-> Eval (GenValue Bool BV Integer)
indexFront_bits Maybe Integer
-> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer)
indexFront)
  , ("!"          , {-# SCC "Prelude::(!)" #-}
                    (Maybe Integer
 -> TValue
 -> SeqValMap
 -> Seq Bool
 -> Eval (GenValue Bool BV Integer))
-> (Maybe Integer
    -> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(Maybe Integer
 -> TValue -> SeqMap b w i -> Seq b -> Eval (GenValue b w i))
-> (Maybe Integer
    -> TValue -> SeqMap b w i -> w -> Eval (GenValue b w i))
-> GenValue b w i
indexPrim Maybe Integer
-> TValue
-> SeqValMap
-> Seq Bool
-> Eval (GenValue Bool BV Integer)
indexBack_bits Maybe Integer
-> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer)
indexBack)

  , ("update"     , {-# SCC "Prelude::update" #-}
                    (Nat'
 -> TValue
 -> WordValue Bool BV Integer
 -> WordValue Bool BV Integer
 -> Eval (GenValue Bool BV Integer)
 -> Eval (WordValue Bool BV Integer))
-> (Nat'
    -> TValue
    -> SeqValMap
    -> WordValue Bool BV Integer
    -> Eval (GenValue Bool BV Integer)
    -> Eval SeqValMap)
-> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(Nat'
 -> TValue
 -> WordValue b w i
 -> WordValue b w i
 -> Eval (GenValue b w i)
 -> Eval (WordValue b w i))
-> (Nat'
    -> TValue
    -> SeqMap b w i
    -> WordValue b w i
    -> Eval (GenValue b w i)
    -> Eval (SeqMap b w i))
-> GenValue b w i
updatePrim Nat'
-> TValue
-> WordValue Bool BV Integer
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval (WordValue Bool BV Integer)
updateFront_word Nat'
-> TValue
-> SeqValMap
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval SeqValMap
updateFront)

  , ("updateEnd"  , {-# SCC "Prelude::updateEnd" #-}
                    (Nat'
 -> TValue
 -> WordValue Bool BV Integer
 -> WordValue Bool BV Integer
 -> Eval (GenValue Bool BV Integer)
 -> Eval (WordValue Bool BV Integer))
-> (Nat'
    -> TValue
    -> SeqValMap
    -> WordValue Bool BV Integer
    -> Eval (GenValue Bool BV Integer)
    -> Eval SeqValMap)
-> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(Nat'
 -> TValue
 -> WordValue b w i
 -> WordValue b w i
 -> Eval (GenValue b w i)
 -> Eval (WordValue b w i))
-> (Nat'
    -> TValue
    -> SeqMap b w i
    -> WordValue b w i
    -> Eval (GenValue b w i)
    -> Eval (SeqMap b w i))
-> GenValue b w i
updatePrim Nat'
-> TValue
-> WordValue Bool BV Integer
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval (WordValue Bool BV Integer)
updateBack_word Nat'
-> TValue
-> SeqValMap
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval SeqValMap
updateBack)

  , ("zero"       , {-# SCC "Prelude::zero" #-}
                    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam TValue -> GenValue Bool BV Integer
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV)

  , ("join"       , {-# SCC "Prelude::join" #-}
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ parts :: Nat'
parts ->
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ (Nat' -> Integer
finNat' -> Integer
each)  ->
                    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ a :: TValue
a     ->
                    (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ x :: Eval (GenValue Bool BV Integer)
x     ->
                      Nat' -> Integer -> Unary Bool BV Integer
forall b w i.
BitWord b w i =>
Nat'
-> Integer -> TValue -> GenValue b w i -> Eval (GenValue b w i)
joinV Nat'
parts Integer
each TValue
a (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
-> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
x)

  , ("split"      , {-# SCC "Prelude::split" #-}
                    GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
ecSplitV)

  , ("splitAt"    , {-# SCC "Prelude::splitAt" #-}
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ front :: Nat'
front ->
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ back :: Nat'
back  ->
                    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ a :: TValue
a     ->
                    (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ x :: Eval (GenValue Bool BV Integer)
x     ->
                       Nat' -> Nat' -> Unary Bool BV Integer
forall b w i.
BitWord b w i =>
Nat' -> Nat' -> TValue -> GenValue b w i -> Eval (GenValue b w i)
splitAtV Nat'
front Nat'
back TValue
a (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
-> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
x)

  , ("fromTo"     , {-# SCC "Prelude::fromTo" #-}
                    GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
fromToV)
  , ("fromThenTo" , {-# SCC "Prelude::fromThenTo" #-}
                    GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
fromThenToV)
  , ("infFrom"    , {-# SCC "Prelude::infFrom" #-}
                    GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
infFromV)
  , ("infFromThen", {-# SCC "Prelude::infFromThen" #-}
                    GenValue Bool BV Integer
forall b w i. BitWord b w i => GenValue b w i
infFromThenV)

  , ("error"      , {-# SCC "Prelude::error" #-}
                      (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \a :: TValue
a ->
                      (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_ ->
                       (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \s :: Eval (GenValue Bool BV Integer)
s -> TValue -> String -> Eval (GenValue Bool BV Integer)
forall b w i.
BitWord b w i =>
TValue -> String -> Eval (GenValue b w i)
errorV TValue
a (String -> Eval (GenValue Bool BV Integer))
-> Eval String -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (GenValue Bool BV Integer -> Eval String
fromStr (GenValue Bool BV Integer -> Eval String)
-> Eval (GenValue Bool BV Integer) -> Eval String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
s))

  , ("reverse"    , {-# SCC "Prelude::reverse" #-}
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_a :: Nat'
_a ->
                    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_b :: TValue
_b ->
                     (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \xs :: Eval (GenValue Bool BV Integer)
xs -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall b w i.
BitWord b w i =>
GenValue b w i -> Eval (GenValue b w i)
reverseV (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
-> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
xs)

  , ("transpose"  , {-# SCC "Prelude::transpose" #-}
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \a :: Nat'
a ->
                    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \b :: Nat'
b ->
                    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \c :: TValue
c ->
                     (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \xs :: Eval (GenValue Bool BV Integer)
xs -> Nat' -> Nat' -> Unary Bool BV Integer
forall b w i.
BitWord b w i =>
Nat' -> Nat' -> TValue -> GenValue b w i -> Eval (GenValue b w i)
transposeV Nat'
a Nat'
b TValue
c (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
-> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
xs)

  , ("random"      , {-# SCC "Prelude::random" #-}
                     (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \a :: TValue
a ->
                     (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \(BV -> Integer
bvVal -> Integer
x) -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ TValue -> Integer -> GenValue Bool BV Integer
forall b w i. BitWord b w i => TValue -> Integer -> GenValue b w i
randomV TValue
a Integer
x)
  , ("trace"       , {-# SCC "Prelude::trace" #-}
                     (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_n :: Nat'
_n ->
                     (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_a :: TValue
_a ->
                     (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_b :: TValue
_b ->
                      (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \s :: Eval (GenValue Bool BV Integer)
s -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
                      (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \x :: Eval (GenValue Bool BV Integer)
x -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
                      (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \y :: Eval (GenValue Bool BV Integer)
y -> do
                         String
msg <- GenValue Bool BV Integer -> Eval String
fromStr (GenValue Bool BV Integer -> Eval String)
-> Eval (GenValue Bool BV Integer) -> Eval String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
s
                         EvalOpts { PPOpts
evalPPOpts :: EvalOpts -> PPOpts
evalPPOpts :: PPOpts
evalPPOpts, Logger
evalLogger :: EvalOpts -> Logger
evalLogger :: Logger
evalLogger } <- Eval EvalOpts
getEvalOpts
                         Doc
doc <- PPOpts -> GenValue Bool BV Integer -> Eval Doc
forall b w i. BitWord b w i => PPOpts -> GenValue b w i -> Eval Doc
ppValue PPOpts
evalPPOpts (GenValue Bool BV Integer -> Eval Doc)
-> Eval (GenValue Bool BV Integer) -> Eval Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
x
                         GenValue Bool BV Integer
yv <- Eval (GenValue Bool BV Integer)
y
                         IO () -> Eval ()
forall a. IO a -> Eval a
io (IO () -> Eval ()) -> IO () -> Eval ()
forall a b. (a -> b) -> a -> b
$ Logger -> Doc -> IO ()
forall a. Show a => Logger -> a -> IO ()
logPrint Logger
evalLogger
                             (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg then Doc
doc else String -> Doc
text String
msg Doc -> Doc -> Doc
<+> Doc
doc
                         GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return GenValue Bool BV Integer
yv)
  ]

-- | Make a numeric literal value at the given type.
mkLit :: BitWord b w i => TValue -> Integer -> GenValue b w i
mkLit :: TValue -> Integer -> GenValue b w i
mkLit ty :: TValue
ty =
  case TValue
ty of
    TVInteger                    -> i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (i -> GenValue b w i)
-> (Integer -> i) -> Integer -> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit
    TVIntMod _                   -> i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (i -> GenValue b w i)
-> (Integer -> i) -> Integer -> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit
    TVSeq w :: Integer
w TVBit                -> Integer -> Integer -> GenValue b w i
forall b w i. BitWord b w i => Integer -> Integer -> GenValue b w i
word Integer
w
    _                            -> String -> [String] -> Integer -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "Cryptol.Eval.Prim.evalConst"
                                    [ "Invalid type for number" ]

-- | Make a numeric constant.
ecNumberV :: BitWord b w i => GenValue b w i
ecNumberV :: GenValue b w i
ecNumberV = (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \valT :: Nat'
valT ->
            (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ty :: TValue
ty ->
            case Nat'
valT of
              Nat v :: Integer
v -> TValue -> Integer -> GenValue b w i
forall b w i. BitWord b w i => TValue -> Integer -> GenValue b w i
mkLit TValue
ty Integer
v
              _ -> String -> [String] -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "Cryptol.Eval.Prim.evalConst"
                       ["Unexpected Inf in constant."
                       , Nat' -> String
forall a. Show a => a -> String
show Nat'
valT
                       , TValue -> String
forall a. Show a => a -> String
show TValue
ty
                       ]

-- | Convert a word to a non-negative integer.
ecToIntegerV :: BitWord b w i => GenValue b w i
ecToIntegerV :: GenValue b w i
ecToIntegerV =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ _ ->
  (w -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((w -> Eval (GenValue b w i)) -> GenValue b w i)
-> (w -> Eval (GenValue b w i)) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ w :: w
w -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (w -> i
forall b w i. BitWord b w i => w -> i
wordToInt w
w)

-- | Convert an unbounded integer to a packed bitvector.
ecFromIntegerV :: BitWord b w i => (Integer -> i -> i) -> GenValue b w i
ecFromIntegerV :: (Integer -> i -> i) -> GenValue b w i
ecFromIntegerV opz :: Integer -> i -> i
opz =
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: TValue
a ->
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ x :: Eval (GenValue b w i)
x ->
  do i
i <- GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger (GenValue b w i -> i) -> Eval (GenValue b w i) -> Eval i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (GenValue b w i)
x
     GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ (Integer -> w) -> i -> (Integer -> i) -> TValue -> GenValue b w i
forall b w i.
BitWord b w i =>
(Integer -> w) -> i -> (Integer -> i) -> TValue -> GenValue b w i
arithNullary ((Integer -> i -> w) -> i -> Integer -> w
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> i -> w
forall b w i. BitWord b w i => Integer -> i -> w
wordFromInt i
i) i
i ((Integer -> i -> i) -> i -> Integer -> i
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> i -> i
opz i
i) TValue
a


--------------------------------------------------------------------------------

-- | Create a packed word
modExp :: Integer -- ^ bit size of the resulting word
       -> BV      -- ^ base
       -> BV      -- ^ exponent
       -> Eval BV
modExp :: BinArith BV
modExp bits :: Integer
bits (BV _ base :: Integer
base) (BV _ e :: Integer
e)
  | Integer
bits Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0            = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
BV Integer
bits 0
  | Integer
base Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Integer
bits Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> [String] -> Eval BV
forall a. HasCallStack => String -> [String] -> a
evalPanic "modExp"
                             [ "bad args: "
                             , "  base = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
base
                             , "  e    = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
e
                             , "  bits = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
modulus
                             ]
  | Bool
otherwise            = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv Integer
bits (Integer -> BV) -> Integer -> BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
doubleAndAdd Integer
base Integer
e Integer
modulus
  where
  modulus :: Integer
modulus = 0 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`setBit` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
bits

intModExp :: Integer -> Integer -> Integer -> Eval Integer
intModExp :: Integer -> Integer -> Integer -> Eval Integer
intModExp modulus :: Integer
modulus base :: Integer
base e :: Integer
e
  | Integer
modulus Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0  = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
doubleAndAdd Integer
base Integer
e Integer
modulus
  | Integer
modulus Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Integer -> Integer -> Eval Integer
integerExp Integer
base Integer
e
  | Bool
otherwise    = String -> [String] -> Eval Integer
forall a. HasCallStack => String -> [String] -> a
evalPanic "intModExp" [ "negative modulus: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
modulus ]

integerExp :: Integer -> Integer -> Eval Integer
integerExp :: Integer -> Integer -> Eval Integer
integerExp x :: Integer
x y :: Integer
y
  | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Eval Integer
forall a. Eval a
negativeExponent
  | Bool
otherwise = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
y

integerLg2 :: Integer -> Eval Integer
integerLg2 :: Integer -> Eval Integer
integerLg2 x :: Integer
x
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Eval Integer
forall a. Eval a
logNegative
  | Bool
otherwise = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
lg2 Integer
x

integerNeg :: Integer -> Eval Integer
integerNeg :: Integer -> Eval Integer
integerNeg x :: Integer
x = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
x

intModNeg :: Integer -> Integer -> Eval Integer
intModNeg :: Integer -> Integer -> Eval Integer
intModNeg modulus :: Integer
modulus x :: Integer
x = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
modulus

doubleAndAdd :: Integer -- ^ base
             -> Integer -- ^ exponent mask
             -> Integer -- ^ modulus
             -> Integer
doubleAndAdd :: Integer -> Integer -> Integer -> Integer
doubleAndAdd base0 :: Integer
base0 expMask :: Integer
expMask modulus :: Integer
modulus = Integer -> Integer -> Integer -> Integer
forall a.
(Ord a, Num a, Bits a) =>
Integer -> Integer -> a -> Integer
go 1 Integer
base0 Integer
expMask
  where
  go :: Integer -> Integer -> a -> Integer
go acc :: Integer
acc base :: Integer
base k :: a
k
    | a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0     = Integer
acc' Integer -> Integer -> Integer
forall a b. a -> b -> b
`seq` Integer
base' Integer -> Integer -> Integer
forall a b. a -> b -> b
`seq` Integer -> Integer -> a -> Integer
go Integer
acc' Integer
base' (a
k a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 1)
    | Bool
otherwise = Integer
acc
    where
    acc' :: Integer
acc' | a
k a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 0 = Integer
acc Integer -> Integer -> Integer
`modMul` Integer
base
         | Bool
otherwise     = Integer
acc

    base' :: Integer
base' = Integer
base Integer -> Integer -> Integer
`modMul` Integer
base

    modMul :: Integer -> Integer -> Integer
modMul x :: Integer
x y :: Integer
y = (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
modulus



-- Operation Lifting -----------------------------------------------------------

type Binary b w i = TValue -> GenValue b w i -> GenValue b w i -> Eval (GenValue b w i)

binary :: Binary b w i -> GenValue b w i
binary :: Binary b w i -> GenValue b w i
binary f :: Binary b w i
f = (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ ty :: TValue
ty ->
            (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: Eval (GenValue b w i)
a  -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$
            (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ b :: Eval (GenValue b w i)
b  -> do
               --io $ putStrLn "Entering a binary function"
               Eval (Eval (GenValue b w i)) -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Binary b w i
f TValue
ty (GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
-> Eval (GenValue b w i -> Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (GenValue b w i)
a Eval (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval (GenValue b w i)
b)

type Unary b w i = TValue -> GenValue b w i -> Eval (GenValue b w i)

unary :: Unary b w i -> GenValue b w i
unary :: Unary b w i -> GenValue b w i
unary f :: Unary b w i
f = (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ ty :: TValue
ty ->
           (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: Eval (GenValue b w i)
a  -> Unary b w i
f TValue
ty (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
a


-- Arith -----------------------------------------------------------------------

-- | Turn a normal binop on Integers into one that can also deal with a bitsize.
--   However, if the bitvector size is 0, always return the 0
--   bitvector.
liftBinArith :: (Integer -> Integer -> Integer) -> BinArith BV
liftBinArith :: (Integer -> Integer -> Integer) -> BinArith BV
liftBinArith _  0 _        _        = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv 0 0
liftBinArith op :: Integer -> Integer -> Integer
op w :: Integer
w (BV _ x :: Integer
x) (BV _ y :: Integer
y) = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv Integer
w (Integer -> BV) -> Integer -> BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
op Integer
x Integer
y

-- | Turn a normal binop on Integers into one that can also deal with a bitsize.
--   Generate a thunk that throws a divide by 0 error when forced if the second
--   argument is 0.  However, if the bitvector size is 0, always return the 0
--   bitvector.
liftDivArith :: (Integer -> Integer -> Integer) -> BinArith BV
liftDivArith :: (Integer -> Integer -> Integer) -> BinArith BV
liftDivArith _  0 _        _        = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv 0 0
liftDivArith _  _ _        (BV _ 0) = Eval BV
forall a. Eval a
divideByZero
liftDivArith op :: Integer -> Integer -> Integer
op w :: Integer
w (BV _ x :: Integer
x) (BV _ y :: Integer
y) = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv Integer
w (Integer -> BV) -> Integer -> BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
op Integer
x Integer
y

type BinArith w = Integer -> w -> w -> Eval w

liftBinInteger :: (Integer -> Integer -> Integer) -> Integer -> Integer -> Eval Integer
liftBinInteger :: (Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftBinInteger op :: Integer -> Integer -> Integer
op x :: Integer
x y :: Integer
y = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
op Integer
x Integer
y

liftBinIntMod ::
  (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer -> Eval Integer
liftBinIntMod :: (Integer -> Integer -> Integer)
-> Integer -> Integer -> Integer -> Eval Integer
liftBinIntMod op :: Integer -> Integer -> Integer
op m :: Integer
m x :: Integer
x y :: Integer
y
  | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0    = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
op Integer
x Integer
y
  | Bool
otherwise = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer
op Integer
x Integer
y) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m

liftDivInteger :: (Integer -> Integer -> Integer) -> Integer -> Integer -> Eval Integer
liftDivInteger :: (Integer -> Integer -> Integer)
-> Integer -> Integer -> Eval Integer
liftDivInteger _  _ 0 = Eval Integer
forall a. Eval a
divideByZero
liftDivInteger op :: Integer -> Integer -> Integer
op x :: Integer
x y :: Integer
y = Integer -> Eval Integer
forall a. a -> Eval a
ready (Integer -> Eval Integer) -> Integer -> Eval Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
op Integer
x Integer
y

modWrap :: Integral a => a -> a -> Eval a
modWrap :: a -> a -> Eval a
modWrap _ 0 = Eval a
forall a. Eval a
divideByZero
modWrap x :: a
x y :: a
y = a -> Eval a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
y)

arithBinary :: forall b w i
             . BitWord b w i
            => BinArith w
            -> (i -> i -> Eval i)
            -> (Integer -> i -> i -> Eval i)
            -> Binary b w i
arithBinary :: BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary opw :: BinArith w
opw opi :: i -> i -> Eval i
opi opz :: Integer -> i -> i -> Eval i
opz = Binary b w i
loop
  where
  loop' :: TValue
        -> Eval (GenValue b w i)
        -> Eval (GenValue b w i)
        -> Eval (GenValue b w i)
  loop' :: TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' ty :: TValue
ty l :: Eval (GenValue b w i)
l r :: Eval (GenValue b w i)
r = Eval (Eval (GenValue b w i)) -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Binary b w i
loop TValue
ty (GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
-> Eval (GenValue b w i -> Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (GenValue b w i)
l Eval (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval (GenValue b w i)
r)

  loop :: TValue
       -> GenValue b w i
       -> GenValue b w i
       -> Eval (GenValue b w i)
  loop :: Binary b w i
loop ty :: TValue
ty l :: GenValue b w i
l r :: GenValue b w i
r = case TValue
ty of
    TVBit ->
      String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "arithBinary" ["Bit not in class Arith"]

    TVInteger ->
      i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (i -> GenValue b w i) -> Eval i -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> i -> Eval i
opi (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
l) (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
r)

    TVIntMod n :: Integer
n ->
      i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (i -> GenValue b w i) -> Eval i -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> i -> i -> Eval i
opz Integer
n (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
l) (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
r)

    TVSeq w :: Integer
w a :: TValue
a
      -- words and finite sequences
      | TValue -> Bool
isTBit TValue
a -> do
                  w
lw <- String -> GenValue b w i -> Eval w
forall b w i. BitWord b w i => String -> GenValue b w i -> Eval w
fromVWord "arithLeft" GenValue b w i
l
                  w
rw <- String -> GenValue b w i -> Eval w
forall b w i. BitWord b w i => String -> GenValue b w i -> Eval w
fromVWord "arithRight" GenValue b w i
r
                  GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w (w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> WordValue b w i) -> Eval w -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinArith w
opw Integer
w w
lw w
rw)
      | Bool
otherwise -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Eval (Eval (SeqMap b w i)) -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
zipSeqMap (Binary b w i
loop TValue
a) (SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i)
-> Eval (SeqMap b w i -> Eval (SeqMap b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                      (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "arithBinary left" GenValue b w i
l) Eval (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                      (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "arithBinary right" GenValue b w i
r)))

    TVStream a :: TValue
a ->
      -- streams
      SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Eval (Eval (SeqMap b w i)) -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
zipSeqMap (Binary b w i
loop TValue
a) (SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i)
-> Eval (SeqMap b w i -> Eval (SeqMap b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "arithBinary left" GenValue b w i
l) Eval (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                             (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "arithBinary right" GenValue b w i
r)))

    -- functions
    TVFun _ ety :: TValue
ety ->
      GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ x :: Eval (GenValue b w i)
x -> TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' TValue
ety (GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall b w i.
GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
fromVFun GenValue b w i
l Eval (GenValue b w i)
x) (GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall b w i.
GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
fromVFun GenValue b w i
r Eval (GenValue b w i)
x)

    -- tuples
    TVTuple tys :: [TValue]
tys ->
      do [Eval (GenValue b w i)]
ls <- (Eval (GenValue b w i) -> Eval (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Eval [Eval (GenValue b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
l)
         [Eval (GenValue b w i)]
rs <- (Eval (GenValue b w i) -> Eval (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Eval [Eval (GenValue b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
r)
         GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ((TValue
 -> Eval (GenValue b w i)
 -> Eval (GenValue b w i)
 -> Eval (GenValue b w i))
-> [TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' [TValue]
tys [Eval (GenValue b w i)]
ls [Eval (GenValue b w i)]
rs)

    -- records
    TVRec fs :: [(Ident, TValue)]
fs ->
      do [(Ident, Eval (GenValue b w i))]
fs' <- [Eval (Ident, Eval (GenValue b w i))]
-> Eval [(Ident, Eval (GenValue b w i))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ (Ident
f,) (Eval (GenValue b w i) -> (Ident, Eval (GenValue b w i)))
-> Eval (Eval (GenValue b w i))
-> Eval (Ident, Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' TValue
fty (Ident -> GenValue b w i -> Eval (GenValue b w i)
forall b w i. Ident -> GenValue b w i -> Eval (GenValue b w i)
lookupRecord Ident
f GenValue b w i
l) (Ident -> GenValue b w i -> Eval (GenValue b w i)
forall b w i. Ident -> GenValue b w i -> Eval (GenValue b w i)
lookupRecord Ident
f GenValue b w i
r))
                 | (f :: Ident
f,fty :: TValue
fty) <- [(Ident, TValue)]
fs
                 ]
         GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [(Ident, Eval (GenValue b w i))]
fs'

    TVAbstract {} ->
      String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "arithBinary" ["Abstract type not in `Arith`"]

type UnaryArith w = Integer -> w -> Eval w

liftUnaryArith :: (Integer -> Integer) -> UnaryArith BV
liftUnaryArith :: (Integer -> Integer) -> UnaryArith BV
liftUnaryArith op :: Integer -> Integer
op w :: Integer
w (BV _ x :: Integer
x) = BV -> Eval BV
forall a. a -> Eval a
ready (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv Integer
w (Integer -> BV) -> Integer -> BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
op Integer
x

arithUnary :: forall b w i
            . BitWord b w i
           => UnaryArith w
           -> (i -> Eval i)
           -> (Integer -> i -> Eval i)
           -> Unary b w i
arithUnary :: UnaryArith w
-> (i -> Eval i) -> (Integer -> i -> Eval i) -> Unary b w i
arithUnary opw :: UnaryArith w
opw opi :: i -> Eval i
opi opz :: Integer -> i -> Eval i
opz = Unary b w i
loop
  where
  loop' :: TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
  loop' :: TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' ty :: TValue
ty x :: Eval (GenValue b w i)
x = Unary b w i
loop TValue
ty (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
x

  loop :: TValue -> GenValue b w i -> Eval (GenValue b w i)
  loop :: Unary b w i
loop ty :: TValue
ty x :: GenValue b w i
x = case TValue
ty of

    TVBit ->
      String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "arithUnary" ["Bit not in class Arith"]

    TVInteger ->
      i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (i -> GenValue b w i) -> Eval i -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> Eval i
opi (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
x)

    TVIntMod n :: Integer
n ->
      i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (i -> GenValue b w i) -> Eval i -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> i -> Eval i
opz Integer
n (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
x)

    TVSeq w :: Integer
w a :: TValue
a
      -- words and finite sequences
      | TValue -> Bool
isTBit TValue
a -> do
              w
wx <- String -> GenValue b w i -> Eval w
forall b w i. BitWord b w i => String -> GenValue b w i -> Eval w
fromVWord "arithUnary" GenValue b w i
x
              GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w (w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> WordValue b w i) -> Eval w -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnaryArith w
opw Integer
w w
wx)
      | Bool
otherwise -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
mapSeqMap (Unary b w i
loop TValue
a) (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "arithUnary" GenValue b w i
x)

    TVStream a :: TValue
a ->
      SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
mapSeqMap (Unary b w i
loop TValue
a) (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "arithUnary" GenValue b w i
x)

    -- functions
    TVFun _ ety :: TValue
ety ->
      GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ y :: Eval (GenValue b w i)
y -> TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' TValue
ety (GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall b w i.
GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
fromVFun GenValue b w i
x Eval (GenValue b w i)
y)

    -- tuples
    TVTuple tys :: [TValue]
tys ->
      do [Eval (GenValue b w i)]
as <- (Eval (GenValue b w i) -> Eval (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Eval [Eval (GenValue b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
x)
         GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ((TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i))
-> [TValue] -> [Eval (GenValue b w i)] -> [Eval (GenValue b w i)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' [TValue]
tys [Eval (GenValue b w i)]
as)

    -- records
    TVRec fs :: [(Ident, TValue)]
fs ->
      do [(Ident, Eval (GenValue b w i))]
fs' <- [Eval (Ident, Eval (GenValue b w i))]
-> Eval [(Ident, Eval (GenValue b w i))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ (Ident
f,) (Eval (GenValue b w i) -> (Ident, Eval (GenValue b w i)))
-> Eval (Eval (GenValue b w i))
-> Eval (Ident, Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' TValue
fty (Ident -> GenValue b w i -> Eval (GenValue b w i)
forall b w i. Ident -> GenValue b w i -> Eval (GenValue b w i)
lookupRecord Ident
f GenValue b w i
x))
                 | (f :: Ident
f,fty :: TValue
fty) <- [(Ident, TValue)]
fs
                 ]
         GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [(Ident, Eval (GenValue b w i))]
fs'

    TVAbstract {} -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "arithUnary" ["Abstract type not in `Arith`"]

arithNullary ::
  forall b w i.
  BitWord b w i =>
  (Integer -> w) ->
  i ->
  (Integer -> i) ->
  TValue -> GenValue b w i
arithNullary :: (Integer -> w) -> i -> (Integer -> i) -> TValue -> GenValue b w i
arithNullary opw :: Integer -> w
opw opi :: i
opi opz :: Integer -> i
opz = TValue -> GenValue b w i
loop
  where
    loop :: TValue -> GenValue b w i
    loop :: TValue -> GenValue b w i
loop ty :: TValue
ty =
      case TValue
ty of
        TVBit -> String -> [String] -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "arithNullary" ["Bit not in class Arith"]

        TVInteger -> i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger i
opi

        TVIntMod n :: Integer
n -> i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (Integer -> i
opz Integer
n)

        TVSeq w :: Integer
w a :: TValue
a
          -- words and finite sequences
          | TValue -> Bool
isTBit TValue
a -> Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w (Eval (WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> WordValue b w i) -> w -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Integer -> w
opw Integer
w
          | Bool
otherwise -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ Eval (GenValue b w i) -> Integer -> Eval (GenValue b w i)
forall a b. a -> b -> a
const (Eval (GenValue b w i) -> Integer -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Integer -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
loop TValue
a

        TVStream a :: TValue
a -> SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ Eval (GenValue b w i) -> Integer -> Eval (GenValue b w i)
forall a b. a -> b -> a
const (Eval (GenValue b w i) -> Integer -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Integer -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
loop TValue
a

        TVFun _ b :: TValue
b -> (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ Eval (GenValue b w i)
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall a b. a -> b -> a
const (Eval (GenValue b w i)
 -> Eval (GenValue b w i) -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
loop TValue
b

        TVTuple tys :: [TValue]
tys -> [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ([Eval (GenValue b w i)] -> GenValue b w i)
-> [Eval (GenValue b w i)] -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (TValue -> Eval (GenValue b w i))
-> [TValue] -> [Eval (GenValue b w i)]
forall a b. (a -> b) -> [a] -> [b]
map (GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> (TValue -> GenValue b w i) -> TValue -> Eval (GenValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TValue -> GenValue b w i
loop) [TValue]
tys

        TVRec fs :: [(Ident, TValue)]
fs -> [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [ (Ident
f, GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (TValue -> GenValue b w i
loop TValue
a)) | (f :: Ident
f, a :: TValue
a) <- [(Ident, TValue)]
fs ]

        TVAbstract {} ->
          String -> [String] -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "arithNullary" ["Abstract type not in `Arith`"]

lg2 :: Integer -> Integer
lg2 :: Integer -> Integer
lg2 i :: Integer
i = case Integer -> Integer -> Maybe (Integer, Bool)
genLog Integer
i 2 of
  Just (i' :: Integer
i',isExact :: Bool
isExact) | Bool
isExact   -> Integer
i'
                    | Bool
otherwise -> Integer
i' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
  Nothing                       -> 0

addV :: BitWord b w i => Binary b w i
addV :: Binary b w i
addV = BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary BinArith w
forall b a i p. BitWord b a i => p -> a -> a -> Eval a
opw i -> i -> Eval i
forall b w a. BitWord b w a => a -> a -> Eval a
opi Integer -> i -> i -> Eval i
forall b w a. BitWord b w a => Integer -> a -> a -> Eval a
opz
  where
    opw :: p -> a -> a -> Eval a
opw _w :: p
_w x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b w i. BitWord b w i => w -> w -> w
wordPlus a
x a
y
    opi :: a -> a -> Eval a
opi x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b w i. BitWord b w i => i -> i -> i
intPlus a
x a
y
    opz :: Integer -> a -> a -> Eval a
opz m :: Integer
m x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ Integer -> a -> a -> a
forall b w i. BitWord b w i => Integer -> i -> i -> i
intModPlus Integer
m a
x a
y

subV :: BitWord b w i => Binary b w i
subV :: Binary b w i
subV = BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary BinArith w
forall b a i p. BitWord b a i => p -> a -> a -> Eval a
opw i -> i -> Eval i
forall b w a. BitWord b w a => a -> a -> Eval a
opi Integer -> i -> i -> Eval i
forall b w a. BitWord b w a => Integer -> a -> a -> Eval a
opz
  where
    opw :: p -> a -> a -> Eval a
opw _w :: p
_w x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b w i. BitWord b w i => w -> w -> w
wordMinus a
x a
y
    opi :: a -> a -> Eval a
opi x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b w i. BitWord b w i => i -> i -> i
intMinus a
x a
y
    opz :: Integer -> a -> a -> Eval a
opz m :: Integer
m x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ Integer -> a -> a -> a
forall b w i. BitWord b w i => Integer -> i -> i -> i
intModMinus Integer
m a
x a
y

mulV :: BitWord b w i => Binary b w i
mulV :: Binary b w i
mulV = BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
forall b w i.
BitWord b w i =>
BinArith w
-> (i -> i -> Eval i)
-> (Integer -> i -> i -> Eval i)
-> Binary b w i
arithBinary BinArith w
forall b a i p. BitWord b a i => p -> a -> a -> Eval a
opw i -> i -> Eval i
forall b w a. BitWord b w a => a -> a -> Eval a
opi Integer -> i -> i -> Eval i
forall b w a. BitWord b w a => Integer -> a -> a -> Eval a
opz
  where
    opw :: p -> a -> a -> Eval a
opw _w :: p
_w x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b w i. BitWord b w i => w -> w -> w
wordMult a
x a
y
    opi :: a -> a -> Eval a
opi x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b w i. BitWord b w i => i -> i -> i
intMult a
x a
y
    opz :: Integer -> a -> a -> Eval a
opz m :: Integer
m x :: a
x y :: a
y = a -> Eval a
forall a. a -> Eval a
ready (a -> Eval a) -> a -> Eval a
forall a b. (a -> b) -> a -> b
$ Integer -> a -> a -> a
forall b w i. BitWord b w i => Integer -> i -> i -> i
intModMult Integer
m a
x a
y

intV :: BitWord b w i => i -> TValue -> GenValue b w i
intV :: i -> TValue -> GenValue b w i
intV i :: i
i = (Integer -> w) -> i -> (Integer -> i) -> TValue -> GenValue b w i
forall b w i.
BitWord b w i =>
(Integer -> w) -> i -> (Integer -> i) -> TValue -> GenValue b w i
arithNullary ((Integer -> i -> w) -> i -> Integer -> w
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> i -> w
forall b w i. BitWord b w i => Integer -> i -> w
wordFromInt i
i) i
i (i -> Integer -> i
forall a b. a -> b -> a
const i
i)

-- Cmp -------------------------------------------------------------------------

cmpValue :: BitWord b w i
         => (b -> b -> Eval a -> Eval a)
         -> (w -> w -> Eval a -> Eval a)
         -> (i -> i -> Eval a -> Eval a)
         -> (Integer -> i -> i -> Eval a -> Eval a)
         -> (TValue -> GenValue b w i -> GenValue b w i -> Eval a -> Eval a)
cmpValue :: (b -> b -> Eval a -> Eval a)
-> (w -> w -> Eval a -> Eval a)
-> (i -> i -> Eval a -> Eval a)
-> (Integer -> i -> i -> Eval a -> Eval a)
-> TValue
-> GenValue b w i
-> GenValue b w i
-> Eval a
-> Eval a
cmpValue fb :: b -> b -> Eval a -> Eval a
fb fw :: w -> w -> Eval a -> Eval a
fw fi :: i -> i -> Eval a -> Eval a
fi fz :: Integer -> i -> i -> Eval a -> Eval a
fz = TValue -> GenValue b w i -> GenValue b w i -> Eval a -> Eval a
cmp
  where
    cmp :: TValue -> GenValue b w i -> GenValue b w i -> Eval a -> Eval a
cmp ty :: TValue
ty v1 :: GenValue b w i
v1 v2 :: GenValue b w i
v2 k :: Eval a
k =
      case TValue
ty of
        TVBit         -> b -> b -> Eval a -> Eval a
fb (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
v1) (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
v2) Eval a
k
        TVInteger     -> i -> i -> Eval a -> Eval a
fi (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
v1) (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
v2) Eval a
k
        TVIntMod n :: Integer
n    -> Integer -> i -> i -> Eval a -> Eval a
fz Integer
n (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
v1) (GenValue b w i -> i
forall b w i. GenValue b w i -> i
fromVInteger GenValue b w i
v2) Eval a
k
        TVSeq n :: Integer
n t :: TValue
t
          | TValue -> Bool
isTBit TValue
t  -> do w
w1 <- String -> GenValue b w i -> Eval w
forall b w i. BitWord b w i => String -> GenValue b w i -> Eval w
fromVWord "cmpValue" GenValue b w i
v1
                            w
w2 <- String -> GenValue b w i -> Eval w
forall b w i. BitWord b w i => String -> GenValue b w i -> Eval w
fromVWord "cmpValue" GenValue b w i
v2
                            w -> w -> Eval a -> Eval a
fw w
w1 w
w2 Eval a
k
          | Bool
otherwise -> [TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> Eval a
-> Eval a
cmpValues (TValue -> [TValue]
forall a. a -> [a]
repeat TValue
t)
                         (Integer -> SeqMap b w i -> [Eval (GenValue b w i)]
forall n b w i.
Integral n =>
n -> SeqMap b w i -> [Eval (GenValue b w i)]
enumerateSeqMap Integer
n (GenValue b w i -> SeqMap b w i
forall b w i. GenValue b w i -> SeqMap b w i
fromVSeq GenValue b w i
v1))
                         (Integer -> SeqMap b w i -> [Eval (GenValue b w i)]
forall n b w i.
Integral n =>
n -> SeqMap b w i -> [Eval (GenValue b w i)]
enumerateSeqMap Integer
n (GenValue b w i -> SeqMap b w i
forall b w i. GenValue b w i -> SeqMap b w i
fromVSeq GenValue b w i
v2)) Eval a
k
        TVStream _    -> String -> [String] -> Eval a
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Prims.Value.cmpValue"
                         [ "Infinite streams are not comparable" ]
        TVFun _ _     -> String -> [String] -> Eval a
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Prims.Value.cmpValue"
                         [ "Functions are not comparable" ]
        TVTuple tys :: [TValue]
tys   -> [TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> Eval a
-> Eval a
cmpValues [TValue]
tys (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
v1) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
v2) Eval a
k
        TVRec fields :: [(Ident, TValue)]
fields  -> do let vals :: [(Ident, b)] -> [b]
vals = ((Ident, b) -> b) -> [(Ident, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, b) -> b
forall a b. (a, b) -> b
snd ([(Ident, b)] -> [b])
-> ([(Ident, b)] -> [(Ident, b)]) -> [(Ident, b)] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ident, b) -> (Ident, b) -> Ordering)
-> [(Ident, b)] -> [(Ident, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Ident, b) -> Ident) -> (Ident, b) -> (Ident, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Ident, b) -> Ident
forall a b. (a, b) -> a
fst)
                            let tys :: [TValue]
tys = [(Ident, TValue)] -> [TValue]
forall b. [(Ident, b)] -> [b]
vals [(Ident, TValue)]
fields
                            [TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> Eval a
-> Eval a
cmpValues [TValue]
tys
                              ([(Ident, Eval (GenValue b w i))] -> [Eval (GenValue b w i)]
forall b. [(Ident, b)] -> [b]
vals (GenValue b w i -> [(Ident, Eval (GenValue b w i))]
forall b w i. GenValue b w i -> [(Ident, Eval (GenValue b w i))]
fromVRecord GenValue b w i
v1))
                              ([(Ident, Eval (GenValue b w i))] -> [Eval (GenValue b w i)]
forall b. [(Ident, b)] -> [b]
vals (GenValue b w i -> [(Ident, Eval (GenValue b w i))]
forall b w i. GenValue b w i -> [(Ident, Eval (GenValue b w i))]
fromVRecord GenValue b w i
v2)) Eval a
k
        TVAbstract {} -> String -> [String] -> Eval a
forall a. HasCallStack => String -> [String] -> a
evalPanic "cmpValue"
                          [ "Abstract type not in `Cmp`" ]

    cmpValues :: [TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> Eval a
-> Eval a
cmpValues (t :: TValue
t : ts :: [TValue]
ts) (x1 :: Eval (GenValue b w i)
x1 : xs1 :: [Eval (GenValue b w i)]
xs1) (x2 :: Eval (GenValue b w i)
x2 : xs2 :: [Eval (GenValue b w i)]
xs2) k :: Eval a
k =
      do GenValue b w i
x1' <- Eval (GenValue b w i)
x1
         GenValue b w i
x2' <- Eval (GenValue b w i)
x2
         TValue -> GenValue b w i -> GenValue b w i -> Eval a -> Eval a
cmp TValue
t GenValue b w i
x1' GenValue b w i
x2' ([TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> Eval a
-> Eval a
cmpValues [TValue]
ts [Eval (GenValue b w i)]
xs1 [Eval (GenValue b w i)]
xs2 Eval a
k)
    cmpValues _ _ _ k :: Eval a
k = Eval a
k


lexCompare :: TValue -> Value -> Value -> Eval Ordering
lexCompare :: TValue
-> GenValue Bool BV Integer
-> GenValue Bool BV Integer
-> Eval Ordering
lexCompare ty :: TValue
ty a :: GenValue Bool BV Integer
a b :: GenValue Bool BV Integer
b = (Bool -> Bool -> Eval Ordering -> Eval Ordering)
-> (BV -> BV -> Eval Ordering -> Eval Ordering)
-> (Integer -> Integer -> Eval Ordering -> Eval Ordering)
-> (Integer
    -> Integer -> Integer -> Eval Ordering -> Eval Ordering)
-> TValue
-> GenValue Bool BV Integer
-> GenValue Bool BV Integer
-> Eval Ordering
-> Eval Ordering
forall b w i a.
BitWord b w i =>
(b -> b -> Eval a -> Eval a)
-> (w -> w -> Eval a -> Eval a)
-> (i -> i -> Eval a -> Eval a)
-> (Integer -> i -> i -> Eval a -> Eval a)
-> TValue
-> GenValue b w i
-> GenValue b w i
-> Eval a
-> Eval a
cmpValue Bool -> Bool -> Eval Ordering -> Eval Ordering
forall a. Ord a => a -> a -> Eval Ordering -> Eval Ordering
op BV -> BV -> Eval Ordering -> Eval Ordering
opw Integer -> Integer -> Eval Ordering -> Eval Ordering
forall a. Ord a => a -> a -> Eval Ordering -> Eval Ordering
op ((Integer -> Integer -> Eval Ordering -> Eval Ordering)
-> Integer -> Integer -> Integer -> Eval Ordering -> Eval Ordering
forall a b. a -> b -> a
const Integer -> Integer -> Eval Ordering -> Eval Ordering
forall a. Ord a => a -> a -> Eval Ordering -> Eval Ordering
op) TValue
ty GenValue Bool BV Integer
a GenValue Bool BV Integer
b (Ordering -> Eval Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ)
 where
   opw :: BV -> BV -> Eval Ordering -> Eval Ordering
   opw :: BV -> BV -> Eval Ordering -> Eval Ordering
opw x :: BV
x y :: BV
y k :: Eval Ordering
k = Integer -> Integer -> Eval Ordering -> Eval Ordering
forall a. Ord a => a -> a -> Eval Ordering -> Eval Ordering
op (BV -> Integer
bvVal BV
x) (BV -> Integer
bvVal BV
y) Eval Ordering
k

   op :: Ord a => a -> a -> Eval Ordering -> Eval Ordering
   op :: a -> a -> Eval Ordering -> Eval Ordering
op x :: a
x y :: a
y k :: Eval Ordering
k = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
                     EQ  -> Eval Ordering
k
                     cmp :: Ordering
cmp -> Ordering -> Eval Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
cmp

signedLexCompare :: TValue -> Value -> Value -> Eval Ordering
signedLexCompare :: TValue
-> GenValue Bool BV Integer
-> GenValue Bool BV Integer
-> Eval Ordering
signedLexCompare ty :: TValue
ty a :: GenValue Bool BV Integer
a b :: GenValue Bool BV Integer
b = (Bool -> Bool -> Eval Ordering -> Eval Ordering)
-> (BV -> BV -> Eval Ordering -> Eval Ordering)
-> (Integer -> Integer -> Eval Ordering -> Eval Ordering)
-> (Integer
    -> Integer -> Integer -> Eval Ordering -> Eval Ordering)
-> TValue
-> GenValue Bool BV Integer
-> GenValue Bool BV Integer
-> Eval Ordering
-> Eval Ordering
forall b w i a.
BitWord b w i =>
(b -> b -> Eval a -> Eval a)
-> (w -> w -> Eval a -> Eval a)
-> (i -> i -> Eval a -> Eval a)
-> (Integer -> i -> i -> Eval a -> Eval a)
-> TValue
-> GenValue b w i
-> GenValue b w i
-> Eval a
-> Eval a
cmpValue Bool -> Bool -> Eval Ordering -> Eval Ordering
opb BV -> BV -> Eval Ordering -> Eval Ordering
opw Integer -> Integer -> Eval Ordering -> Eval Ordering
opi ((Integer -> Integer -> Eval Ordering -> Eval Ordering)
-> Integer -> Integer -> Integer -> Eval Ordering -> Eval Ordering
forall a b. a -> b -> a
const Integer -> Integer -> Eval Ordering -> Eval Ordering
opi) TValue
ty GenValue Bool BV Integer
a GenValue Bool BV Integer
b (Ordering -> Eval Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ)
 where
   opb :: Bool -> Bool -> Eval Ordering -> Eval Ordering
   opb :: Bool -> Bool -> Eval Ordering -> Eval Ordering
opb _x :: Bool
_x _y :: Bool
_y _k :: Eval Ordering
_k = String -> [String] -> Eval Ordering
forall a. HasCallStack => String -> [String] -> a
panic "signedLexCompare"
                    ["Attempted to perform signed comparisons on bare Bit type"]

   opw :: BV -> BV -> Eval Ordering -> Eval Ordering
   opw :: BV -> BV -> Eval Ordering -> Eval Ordering
opw x :: BV
x y :: BV
y k :: Eval Ordering
k = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BV -> Integer
signedBV BV
x) (BV -> Integer
signedBV BV
y) of
                     EQ  -> Eval Ordering
k
                     cmp :: Ordering
cmp -> Ordering -> Eval Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
cmp

   opi :: Integer -> Integer -> Eval Ordering -> Eval Ordering
   opi :: Integer -> Integer -> Eval Ordering -> Eval Ordering
opi _x :: Integer
_x _y :: Integer
_y _k :: Eval Ordering
_k = String -> [String] -> Eval Ordering
forall a. HasCallStack => String -> [String] -> a
panic "signedLexCompare"
                    ["Attempted to perform signed comparisons on Integer type"]

-- | Process two elements based on their lexicographic ordering.
cmpOrder :: String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder :: String -> (Ordering -> Bool) -> Binary Bool BV Integer
cmpOrder _nm :: String
_nm op :: Ordering -> Bool
op ty :: TValue
ty l :: GenValue Bool BV Integer
l r :: GenValue Bool BV Integer
r = Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit (Bool -> GenValue Bool BV Integer)
-> (Ordering -> Bool) -> Ordering -> GenValue Bool BV Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Bool
op (Ordering -> GenValue Bool BV Integer)
-> Eval Ordering -> Eval (GenValue Bool BV Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TValue
-> GenValue Bool BV Integer
-> GenValue Bool BV Integer
-> Eval Ordering
lexCompare TValue
ty GenValue Bool BV Integer
l GenValue Bool BV Integer
r

-- | Process two elements based on their lexicographic ordering, using signed comparisons
signedCmpOrder :: String -> (Ordering -> Bool) -> Binary Bool BV Integer
signedCmpOrder :: String -> (Ordering -> Bool) -> Binary Bool BV Integer
signedCmpOrder _nm :: String
_nm op :: Ordering -> Bool
op ty :: TValue
ty l :: GenValue Bool BV Integer
l r :: GenValue Bool BV Integer
r = Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit (Bool -> GenValue Bool BV Integer)
-> (Ordering -> Bool) -> Ordering -> GenValue Bool BV Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Bool
op (Ordering -> GenValue Bool BV Integer)
-> Eval Ordering -> Eval (GenValue Bool BV Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TValue
-> GenValue Bool BV Integer
-> GenValue Bool BV Integer
-> Eval Ordering
signedLexCompare TValue
ty GenValue Bool BV Integer
l GenValue Bool BV Integer
r


-- Signed arithmetic -----------------------------------------------------------

-- | Lifted operation on finite bitsequences.  Used
--   for signed comparisons and arithemtic.
liftWord :: BitWord b w i
         => (w -> w -> Eval (GenValue b w i))
         -> GenValue b w i
liftWord :: (w -> w -> Eval (GenValue b w i)) -> GenValue b w i
liftWord op :: w -> w -> Eval (GenValue b w i)
op =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \_n :: Nat'
_n ->
  (w -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((w -> Eval (GenValue b w i)) -> GenValue b w i)
-> (w -> Eval (GenValue b w i)) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \w1 :: w
w1 -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$
  (w -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((w -> Eval (GenValue b w i)) -> GenValue b w i)
-> (w -> Eval (GenValue b w i)) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \w2 :: w
w2 -> w -> w -> Eval (GenValue b w i)
op w
w1 w
w2


liftSigned :: (Integer -> Integer -> Integer -> Eval BV)
           -> BinArith BV
liftSigned :: (Integer -> Integer -> Integer -> Eval BV) -> BinArith BV
liftSigned _  0    = \_ _ -> BV -> Eval BV
forall (m :: * -> *) a. Monad m => a -> m a
return (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> BV
mkBv 0 0
liftSigned op :: Integer -> Integer -> Integer -> Eval BV
op size :: Integer
size = BV -> BV -> Eval BV
f
 where
 f :: BV -> BV -> Eval BV
f (BV i :: Integer
i x :: Integer
x) (BV j :: Integer
j y :: Integer
y)
   | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j Bool -> Bool -> Bool
&& Integer
size Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i = Integer -> Integer -> Integer -> Eval BV
op Integer
size Integer
sx Integer
sy
   | Bool
otherwise = String -> [String] -> Eval BV
forall a. HasCallStack => String -> [String] -> a
evalPanic "liftSigned" ["Attempt to compute with words of different sizes"]
   where sx :: Integer
sx = Integer -> Integer -> Integer
signedValue Integer
i Integer
x
         sy :: Integer
sy = Integer -> Integer -> Integer
signedValue Integer
j Integer
y

signedBV :: BV -> Integer
signedBV :: BV -> Integer
signedBV (BV i :: Integer
i x :: Integer
x) = Integer -> Integer -> Integer
signedValue Integer
i Integer
x

signedValue :: Integer -> Integer -> Integer
signedValue :: Integer -> Integer -> Integer
signedValue i :: Integer
i x :: Integer
x = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)) then Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)) else Integer
x

bvSlt :: Integer -> Integer -> Integer -> Eval Value
bvSlt :: Integer -> Integer -> Integer -> Eval (GenValue Bool BV Integer)
bvSlt _sz :: Integer
_sz x :: Integer
x y :: Integer
y = GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> (Bool -> GenValue Bool BV Integer)
-> Bool
-> Eval (GenValue Bool BV Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit (Bool -> Eval (GenValue Bool BV Integer))
-> Bool -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$! (Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
y)

bvSdiv :: Integer -> Integer -> Integer -> Eval BV
bvSdiv :: Integer -> Integer -> Integer -> Eval BV
bvSdiv  _ _ 0 = Eval BV
forall a. Eval a
divideByZero
bvSdiv sz :: Integer
sz x :: Integer
x y :: Integer
y = BV -> Eval BV
forall (m :: * -> *) a. Monad m => a -> m a
return (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> BV
mkBv Integer
sz (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
y)

bvSrem :: Integer -> Integer -> Integer -> Eval BV
bvSrem :: Integer -> Integer -> Integer -> Eval BV
bvSrem  _ _ 0 = Eval BV
forall a. Eval a
divideByZero
bvSrem sz :: Integer
sz x :: Integer
x y :: Integer
y = BV -> Eval BV
forall (m :: * -> *) a. Monad m => a -> m a
return (BV -> Eval BV) -> BV -> Eval BV
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> BV
mkBv Integer
sz (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
y)

sshrV :: Value
sshrV :: GenValue Bool BV Integer
sshrV =
  (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_n :: Nat'
_n ->
  (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_k :: Nat'
_k ->
  (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \(BV i :: Integer
i x :: Integer
x) -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
  (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \y :: BV
y ->
   let signx :: Bool
signx = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
       amt :: Int
amt   = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (BV -> Integer
bvVal BV
y)
       negv :: Integer
negv  = (((-1) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
amt) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
x) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
amt
       posv :: Integer
posv  = Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
amt
    in GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> (Integer -> GenValue Bool BV Integer)
-> Integer
-> Eval (GenValue Bool BV Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer
-> Eval (WordValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
i (Eval (WordValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Integer -> Eval (WordValue Bool BV Integer))
-> Integer
-> GenValue Bool BV Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall a. a -> Eval a
ready (WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer))
-> (Integer -> WordValue Bool BV Integer)
-> Integer
-> Eval (WordValue Bool BV Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BV -> WordValue Bool BV Integer
forall b w i. w -> WordValue b w i
WordVal (BV -> WordValue Bool BV Integer)
-> (Integer -> BV) -> Integer -> WordValue Bool BV Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> BV
mkBv Integer
i (Integer -> Eval (GenValue Bool BV Integer))
-> Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$! if Bool
signx then Integer
negv else Integer
posv

-- | Signed carry bit.
scarryV :: Value
scarryV :: GenValue Bool BV Integer
scarryV =
  (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_n :: Nat'
_n ->
  (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \(BV i :: Integer
i x :: Integer
x) -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
  (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \(BV j :: Integer
j y :: Integer
y) ->
    if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j
      then let z :: Integer
z     = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y
               xsign :: Bool
xsign = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
               ysign :: Bool
ysign = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
y (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
               zsign :: Bool
zsign = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
z (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
               sc :: Bool
sc    = (Bool
xsign Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
ysign) Bool -> Bool -> Bool
&& (Bool
xsign Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
zsign)
            in GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit Bool
sc
      else String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
evalPanic "scarryV" ["Attempted to compute with words of different sizes"]

-- | Unsigned carry bit.
carryV :: Value
carryV :: GenValue Bool BV Integer
carryV =
  (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \_n :: Nat'
_n ->
  (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \(BV i :: Integer
i x :: Integer
x) -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
  (BV -> Eval (GenValue Bool BV Integer)) -> GenValue Bool BV Integer
forall b w i.
BitWord b w i =>
(w -> Eval (GenValue b w i)) -> GenValue b w i
wlam ((BV -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (BV -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \(BV j :: Integer
j y :: Integer
y) ->
    if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j
      then GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> (Bool -> GenValue Bool BV Integer)
-> Bool
-> Eval (GenValue Bool BV Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GenValue Bool BV Integer
forall b w i. b -> GenValue b w i
VBit (Bool -> Eval (GenValue Bool BV Integer))
-> Bool -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
      else String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
evalPanic "carryV" ["Attempted to compute with words of different sizes"]

-- Logic -----------------------------------------------------------------------

zeroV :: forall b w i
       . BitWord b w i
      => TValue
      -> GenValue b w i
zeroV :: TValue -> GenValue b w i
zeroV ty :: TValue
ty = case TValue
ty of

  -- bits
  TVBit ->
    b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (Bool -> b
forall b w i. BitWord b w i => Bool -> b
bitLit Bool
False)

  -- integers
  TVInteger ->
    i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit 0)

  -- integers mod n
  TVIntMod _ ->
    i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit 0)

  -- sequences
  TVSeq w :: Integer
w ety :: TValue
ety
      | TValue -> Bool
isTBit TValue
ety -> Integer -> Integer -> GenValue b w i
forall b w i. BitWord b w i => Integer -> Integer -> GenValue b w i
word Integer
w 0
      | Bool
otherwise  -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \_ -> GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
ety)

  TVStream ety :: TValue
ety ->
    SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \_ -> GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
ety)

  -- functions
  TVFun _ bty :: TValue
bty ->
    (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam (\ _ -> GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
bty))

  -- tuples
  TVTuple tys :: [TValue]
tys ->
    [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ((TValue -> Eval (GenValue b w i))
-> [TValue] -> [Eval (GenValue b w i)]
forall a b. (a -> b) -> [a] -> [b]
map (GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> (TValue -> GenValue b w i) -> TValue -> Eval (GenValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV) [TValue]
tys)

  -- records
  TVRec fields :: [(Ident, TValue)]
fields ->
    [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [ (Ident
f,GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
fty) | (f :: Ident
f,fty :: TValue
fty) <- [(Ident, TValue)]
fields ]

  TVAbstract {} -> String -> [String] -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "zeroV" [ "Abstract type not in `Zero`" ]

--  | otherwise = evalPanic "zeroV" ["invalid type for zero"]


joinWordVal :: BitWord b w i =>
            WordValue b w i -> WordValue b w i -> WordValue b w i
joinWordVal :: WordValue b w i -> WordValue b w i -> WordValue b w i
joinWordVal (WordVal w1 :: w
w1) (WordVal w2 :: w
w2)
  | w -> Integer
forall b w i. BitWord b w i => w -> Integer
wordLen w
w1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ w -> Integer
forall b w i. BitWord b w i => w -> Integer
wordLen w
w2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
largeBitSize
  = w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> WordValue b w i) -> w -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ w -> w -> w
forall b w i. BitWord b w i => w -> w -> w
joinWord w
w1 w
w2
joinWordVal (BitsVal xs :: Seq (Eval b)
xs) (WordVal w2 :: w
w2)
  | Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Seq (Eval b) -> Int
forall a. Seq a -> Int
Seq.length Seq (Eval b)
xs) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ w -> Integer
forall b w i. BitWord b w i => w -> Integer
wordLen w
w2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
largeBitSize
  = Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b)
xs Seq (Eval b) -> Seq (Eval b) -> Seq (Eval b)
forall a. Seq a -> Seq a -> Seq a
Seq.>< [Eval b] -> Seq (Eval b)
forall a. [a] -> Seq a
Seq.fromList ((b -> Eval b) -> [b] -> [Eval b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Eval b
forall a. a -> Eval a
ready ([b] -> [Eval b]) -> [b] -> [Eval b]
forall a b. (a -> b) -> a -> b
$ w -> [b]
forall b w i. BitWord b w i => w -> [b]
unpackWord w
w2))
joinWordVal (WordVal w1 :: w
w1) (BitsVal ys :: Seq (Eval b)
ys)
  | w -> Integer
forall b w i. BitWord b w i => w -> Integer
wordLen w
w1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Seq (Eval b) -> Int
forall a. Seq a -> Int
Seq.length Seq (Eval b)
ys) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
largeBitSize
  = Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal ([Eval b] -> Seq (Eval b)
forall a. [a] -> Seq a
Seq.fromList ((b -> Eval b) -> [b] -> [Eval b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Eval b
forall a. a -> Eval a
ready ([b] -> [Eval b]) -> [b] -> [Eval b]
forall a b. (a -> b) -> a -> b
$ w -> [b]
forall b w i. BitWord b w i => w -> [b]
unpackWord w
w1) Seq (Eval b) -> Seq (Eval b) -> Seq (Eval b)
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq (Eval b)
ys)
joinWordVal (BitsVal xs :: Seq (Eval b)
xs) (BitsVal ys :: Seq (Eval b)
ys)
  | Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Seq (Eval b) -> Int
forall a. Seq a -> Int
Seq.length Seq (Eval b)
xs) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Seq (Eval b) -> Int
forall a. Seq a -> Int
Seq.length Seq (Eval b)
ys) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
largeBitSize
  = Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b)
xs Seq (Eval b) -> Seq (Eval b) -> Seq (Eval b)
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq (Eval b)
ys)
joinWordVal w1 :: WordValue b w i
w1 w2 :: WordValue b w i
w2
  = Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal (Integer
n1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
n2) (Integer -> SeqMap b w i -> SeqMap b w i -> SeqMap b w i
forall b w i.
Integer -> SeqMap b w i -> SeqMap b w i -> SeqMap b w i
concatSeqMap Integer
n1 (WordValue b w i -> SeqMap b w i
forall b w i. BitWord b w i => WordValue b w i -> SeqMap b w i
asBitsMap WordValue b w i
w1) (WordValue b w i -> SeqMap b w i
forall b w i. BitWord b w i => WordValue b w i -> SeqMap b w i
asBitsMap WordValue b w i
w2))
 where n1 :: Integer
n1 = WordValue b w i -> Integer
forall b w i. BitWord b w i => WordValue b w i -> Integer
wordValueSize WordValue b w i
w1
       n2 :: Integer
n2 = WordValue b w i -> Integer
forall b w i. BitWord b w i => WordValue b w i -> Integer
wordValueSize WordValue b w i
w2


joinWords :: forall b w i
           . BitWord b w i
          => Integer
          -> Integer
          -> SeqMap b w i
          -> Eval (GenValue b w i)
joinWords :: Integer -> Integer -> SeqMap b w i -> Eval (GenValue b w i)
joinWords nParts :: Integer
nParts nEach :: Integer
nEach xs :: SeqMap b w i
xs =
  Eval (WordValue b w i)
-> [Eval (GenValue b w i)] -> Eval (GenValue b w i)
loop (WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (Integer -> Integer -> w
forall b w i. BitWord b w i => Integer -> Integer -> w
wordLit 0 0)) (Integer -> SeqMap b w i -> [Eval (GenValue b w i)]
forall n b w i.
Integral n =>
n -> SeqMap b w i -> [Eval (GenValue b w i)]
enumerateSeqMap Integer
nParts SeqMap b w i
xs)

 where
 loop :: Eval (WordValue b w i) -> [Eval (GenValue b w i)] -> Eval (GenValue b w i)
 loop :: Eval (WordValue b w i)
-> [Eval (GenValue b w i)] -> Eval (GenValue b w i)
loop !Eval (WordValue b w i)
wv [] = GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord (Integer
nParts Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
nEach) Eval (WordValue b w i)
wv
 loop !Eval (WordValue b w i)
wv (w :: Eval (GenValue b w i)
w : ws :: [Eval (GenValue b w i)]
ws) = do
    Eval (GenValue b w i)
w Eval (GenValue b w i)
-> (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VWord _ w' :: Eval (WordValue b w i)
w' -> Eval (WordValue b w i)
-> [Eval (GenValue b w i)] -> Eval (GenValue b w i)
loop (WordValue b w i -> WordValue b w i -> WordValue b w i
forall b w i.
BitWord b w i =>
WordValue b w i -> WordValue b w i -> WordValue b w i
joinWordVal (WordValue b w i -> WordValue b w i -> WordValue b w i)
-> Eval (WordValue b w i)
-> Eval (WordValue b w i -> WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (WordValue b w i)
wv Eval (WordValue b w i -> WordValue b w i)
-> Eval (WordValue b w i) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval (WordValue b w i)
w') [Eval (GenValue b w i)]
ws
      _ -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "joinWords: expected word value" []


joinSeq :: BitWord b w i
        => Nat'
        -> Integer
        -> TValue
        -> SeqMap b w i
        -> Eval (GenValue b w i)

-- Special case for 0 length inner sequences.
joinSeq :: Nat' -> Integer -> TValue -> SeqMap b w i -> Eval (GenValue b w i)
joinSeq _parts :: Nat'
_parts 0 a :: TValue
a _xs :: SeqMap b w i
_xs
  = GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV (Integer -> TValue -> TValue
TVSeq 0 TValue
a)

-- finite sequence of words
joinSeq (Nat parts :: Integer
parts) each :: Integer
each TVBit xs :: SeqMap b w i
xs
  | Integer
parts Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
each Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
largeBitSize
  = Integer -> Integer -> SeqMap b w i -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
Integer -> Integer -> SeqMap b w i -> Eval (GenValue b w i)
joinWords Integer
parts Integer
each SeqMap b w i
xs
  | Bool
otherwise
  = do let zs :: SeqMap b w i
zs = (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
                  do let (q :: Integer
q,r :: Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
each
                     WordValue b w i
ys <- String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "join seq" (GenValue b w i -> Eval (WordValue b w i))
-> Eval (GenValue b w i) -> Eval (WordValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs Integer
q
                     b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> Eval b -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue b w i -> Integer -> Eval b
forall b w i. BitWord b w i => WordValue b w i -> Integer -> Eval b
indexWordValue WordValue b w i
ys (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
r)
       GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord (Integer
parts Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
each) (Eval (WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal (Integer
parts Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
each) SeqMap b w i
forall w i. SeqMap b w i
zs

-- infinite sequence of words
joinSeq Inf each :: Integer
each TVBit xs :: SeqMap b w i
xs
  = GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
      do let (q :: Integer
q,r :: Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
each
         WordValue b w i
ys <- String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "join seq" (GenValue b w i -> Eval (WordValue b w i))
-> Eval (GenValue b w i) -> Eval (WordValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs Integer
q
         b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> Eval b -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue b w i -> Integer -> Eval b
forall b w i. BitWord b w i => WordValue b w i -> Integer -> Eval b
indexWordValue WordValue b w i
ys (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
r)

-- finite or infinite sequence of non-words
joinSeq parts :: Nat'
parts each :: Integer
each _a :: TValue
_a xs :: SeqMap b w i
xs
  = GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
vSeq (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i -> do
      let (q :: Integer
q,r :: Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
each
      SeqMap b w i
ys <- String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "join seq" (GenValue b w i -> Eval (SeqMap b w i))
-> Eval (GenValue b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs Integer
q
      SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
ys Integer
r
  where
  len :: Nat'
len = Nat'
parts Nat' -> Nat' -> Nat'
`nMul` (Integer -> Nat'
Nat Integer
each)
  vSeq :: SeqMap b w i -> GenValue b w i
vSeq = case Nat'
len of
           Inf    -> SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream
           Nat n :: Integer
n  -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
n


-- | Join a sequence of sequences into a single sequence.
joinV :: BitWord b w i
      => Nat'
      -> Integer
      -> TValue
      -> GenValue b w i
      -> Eval (GenValue b w i)
joinV :: Nat'
-> Integer -> TValue -> GenValue b w i -> Eval (GenValue b w i)
joinV parts :: Nat'
parts each :: Integer
each a :: TValue
a val :: GenValue b w i
val = Nat' -> Integer -> TValue -> SeqMap b w i -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
Nat' -> Integer -> TValue -> SeqMap b w i -> Eval (GenValue b w i)
joinSeq Nat'
parts Integer
each TValue
a (SeqMap b w i -> Eval (GenValue b w i))
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "joinV" GenValue b w i
val


splitWordVal :: BitWord b w i
             => Integer
             -> Integer
             -> WordValue b w i
             -> (WordValue b w i, WordValue b w i)
splitWordVal :: Integer
-> Integer -> WordValue b w i -> (WordValue b w i, WordValue b w i)
splitWordVal leftWidth :: Integer
leftWidth rightWidth :: Integer
rightWidth (WordVal w :: w
w) =
  let (lw :: w
lw, rw :: w
rw) = Integer -> Integer -> w -> (w, w)
forall b w i. BitWord b w i => Integer -> Integer -> w -> (w, w)
splitWord Integer
leftWidth Integer
rightWidth w
w
   in (w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal w
lw, w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal w
rw)
splitWordVal leftWidth :: Integer
leftWidth _rightWidth :: Integer
_rightWidth (BitsVal bs :: Seq (Eval b)
bs) =
  let (lbs :: Seq (Eval b)
lbs, rbs :: Seq (Eval b)
rbs) = Int -> Seq (Eval b) -> (Seq (Eval b), Seq (Eval b))
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
leftWidth) Seq (Eval b)
bs
   in (Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal Seq (Eval b)
lbs, Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal Seq (Eval b)
rbs)
splitWordVal leftWidth :: Integer
leftWidth rightWidth :: Integer
rightWidth (LargeBitsVal _n :: Integer
_n xs :: SeqMap b w i
xs) =
  let (lxs :: SeqMap b w i
lxs, rxs :: SeqMap b w i
rxs) = Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
forall b w i.
Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
splitSeqMap Integer
leftWidth SeqMap b w i
xs
   in (Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal Integer
leftWidth SeqMap b w i
lxs, Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal Integer
rightWidth SeqMap b w i
rxs)

splitAtV :: BitWord b w i
         => Nat'
         -> Nat'
         -> TValue
         -> GenValue b w i
         -> Eval (GenValue b w i)
splitAtV :: Nat' -> Nat' -> TValue -> GenValue b w i -> Eval (GenValue b w i)
splitAtV front :: Nat'
front back :: Nat'
back a :: TValue
a val :: GenValue b w i
val =
  case Nat'
back of

    Nat rightWidth :: Integer
rightWidth | Bool
aBit -> do
          Eval (WordValue b w i, WordValue b w i)
ws <- Maybe String
-> Eval (WordValue b w i, WordValue b w i)
-> Eval (Eval (WordValue b w i, WordValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (Integer
-> Integer -> WordValue b w i -> (WordValue b w i, WordValue b w i)
forall b w i.
BitWord b w i =>
Integer
-> Integer -> WordValue b w i -> (WordValue b w i, WordValue b w i)
splitWordVal Integer
leftWidth Integer
rightWidth (WordValue b w i -> (WordValue b w i, WordValue b w i))
-> Eval (WordValue b w i)
-> Eval (WordValue b w i, WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "splitAtV" GenValue b w i
val)
          GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple
                   [ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
leftWidth  (Eval (WordValue b w i) -> GenValue b w i)
-> ((WordValue b w i, WordValue b w i) -> Eval (WordValue b w i))
-> (WordValue b w i, WordValue b w i)
-> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> ((WordValue b w i, WordValue b w i) -> WordValue b w i)
-> (WordValue b w i, WordValue b w i)
-> Eval (WordValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WordValue b w i, WordValue b w i) -> WordValue b w i
forall a b. (a, b) -> a
fst ((WordValue b w i, WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i, WordValue b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (WordValue b w i, WordValue b w i)
ws
                   , Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
rightWidth (Eval (WordValue b w i) -> GenValue b w i)
-> ((WordValue b w i, WordValue b w i) -> Eval (WordValue b w i))
-> (WordValue b w i, WordValue b w i)
-> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> ((WordValue b w i, WordValue b w i) -> WordValue b w i)
-> (WordValue b w i, WordValue b w i)
-> Eval (WordValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WordValue b w i, WordValue b w i) -> WordValue b w i
forall a b. (a, b) -> b
snd ((WordValue b w i, WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i, WordValue b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (WordValue b w i, WordValue b w i)
ws
                   ]

    Inf | Bool
aBit -> do
       Eval (SeqMap b w i)
vs <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "splitAtV" GenValue b w i
val)
       Eval (Seq (Eval b))
ls <- Maybe String -> Eval (Seq (Eval b)) -> Eval (Eval (Seq (Eval b)))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (do SeqMap b w i
m <- (SeqMap b w i, SeqMap b w i) -> SeqMap b w i
forall a b. (a, b) -> a
fst ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i)
-> (SeqMap b w i -> (SeqMap b w i, SeqMap b w i))
-> SeqMap b w i
-> SeqMap b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
forall b w i.
Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
splitSeqMap Integer
leftWidth (SeqMap b w i -> SeqMap b w i)
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
vs
                               let ms :: [Eval b]
ms = (Eval (GenValue b w i) -> Eval b)
-> [Eval (GenValue b w i)] -> [Eval b]
forall a b. (a -> b) -> [a] -> [b]
map (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit (GenValue b w i -> b) -> Eval (GenValue b w i) -> Eval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Integer -> SeqMap b w i -> [Eval (GenValue b w i)]
forall n b w i.
Integral n =>
n -> SeqMap b w i -> [Eval (GenValue b w i)]
enumerateSeqMap Integer
leftWidth SeqMap b w i
m)
                               Seq (Eval b) -> Eval (Seq (Eval b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (Eval b) -> Eval (Seq (Eval b)))
-> Seq (Eval b) -> Eval (Seq (Eval b))
forall a b. (a -> b) -> a -> b
$ [Eval b] -> Seq (Eval b)
forall a. [a] -> Seq a
Seq.fromList ([Eval b] -> Seq (Eval b)) -> [Eval b] -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ [Eval b]
ms)
       Eval (SeqMap b w i)
rs <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i
forall a b. (a, b) -> b
snd ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i)
-> (SeqMap b w i -> (SeqMap b w i, SeqMap b w i))
-> SeqMap b w i
-> SeqMap b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
forall b w i.
Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
splitSeqMap Integer
leftWidth (SeqMap b w i -> SeqMap b w i)
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
vs)
       GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple [ GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
leftWidth (Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Eval (Seq (Eval b)) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (Seq (Eval b))
ls)
                       , SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
rs
                       ]

    _ -> do
       Eval (SeqMap b w i)
vs <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "splitAtV" GenValue b w i
val)
       Eval (SeqMap b w i)
ls <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i
forall a b. (a, b) -> a
fst ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i)
-> (SeqMap b w i -> (SeqMap b w i, SeqMap b w i))
-> SeqMap b w i
-> SeqMap b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
forall b w i.
Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
splitSeqMap Integer
leftWidth (SeqMap b w i -> SeqMap b w i)
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
vs)
       Eval (SeqMap b w i)
rs <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i
forall a b. (a, b) -> b
snd ((SeqMap b w i, SeqMap b w i) -> SeqMap b w i)
-> (SeqMap b w i -> (SeqMap b w i, SeqMap b w i))
-> SeqMap b w i
-> SeqMap b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
forall b w i.
Integer -> SeqMap b w i -> (SeqMap b w i, SeqMap b w i)
splitSeqMap Integer
leftWidth (SeqMap b w i -> SeqMap b w i)
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
vs)
       GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple [ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
leftWidth (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
ls
                       , Nat' -> TValue -> SeqMap b w i -> GenValue b w i
forall b w i. Nat' -> TValue -> SeqMap b w i -> GenValue b w i
mkSeq Nat'
back TValue
a (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
rs
                       ]

  where
  aBit :: Bool
aBit = TValue -> Bool
isTBit TValue
a

  leftWidth :: Integer
leftWidth = case Nat'
front of
    Nat n :: Integer
n -> Integer
n
    _     -> String -> [String] -> Integer
forall a. HasCallStack => String -> [String] -> a
evalPanic "splitAtV" ["invalid `front` len"]


  -- | Extract a subsequence of bits from a @WordValue@.
  --   The first integer argument is the number of bits in the
  --   resulting word.  The second integer argument is the
  --   number of less-significant digits to discard.  Stated another
  --   way, the operation `extractWordVal n i w` is equivalent to
  --   first shifting `w` right by `i` bits, and then truncating to
  --   `n` bits.
extractWordVal :: BitWord b w i
               => Integer
               -> Integer
               -> WordValue b w i
               -> WordValue b w i
extractWordVal :: Integer -> Integer -> WordValue b w i -> WordValue b w i
extractWordVal len :: Integer
len start :: Integer
start (WordVal w :: w
w) =
   w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> WordValue b w i) -> w -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> w -> w
forall b w i. BitWord b w i => Integer -> Integer -> w -> w
extractWord Integer
len Integer
start w
w
extractWordVal len :: Integer
len start :: Integer
start (BitsVal bs :: Seq (Eval b)
bs) =
   Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Int -> Seq (Eval b) -> Seq (Eval b)
forall a. Int -> Seq a -> Seq a
Seq.take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len) (Seq (Eval b) -> Seq (Eval b)) -> Seq (Eval b) -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$
     Int -> Seq (Eval b) -> Seq (Eval b)
forall a. Int -> Seq a -> Seq a
Seq.drop (Seq (Eval b) -> Int
forall a. Seq a -> Int
Seq.length Seq (Eval b)
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len) Seq (Eval b)
bs
extractWordVal len :: Integer
len start :: Integer
start (LargeBitsVal n :: Integer
n xs :: SeqMap b w i
xs) =
   let xs' :: SeqMap b w i
xs' = Integer -> SeqMap b w i -> SeqMap b w i
forall b w i. Integer -> SeqMap b w i -> SeqMap b w i
dropSeqMap (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
start Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
len) SeqMap b w i
xs
    in Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal Integer
len SeqMap b w i
xs'


-- | Split implementation.
ecSplitV :: BitWord b w i
         => GenValue b w i
ecSplitV :: GenValue b w i
ecSplitV =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ parts :: Nat'
parts ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ each :: Nat'
each  ->
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: TValue
a     ->
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ val :: Eval (GenValue b w i)
val ->
    case (Nat'
parts, Nat'
each) of
       (Nat p :: Integer
p, Nat e :: Integer
e) | TValue -> Bool
isTBit TValue
a -> do
          ~(VWord _ val' :: Eval (WordValue b w i)
val') <- Eval (GenValue b w i)
val
          GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
p (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i -> do
            GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
e (Integer -> Integer -> WordValue b w i -> WordValue b w i
forall b w i.
BitWord b w i =>
Integer -> Integer -> WordValue b w i -> WordValue b w i
extractWordVal Integer
e ((Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
e) (WordValue b w i -> WordValue b w i)
-> Eval (WordValue b w i) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (WordValue b w i)
val')
       (Inf, Nat e :: Integer
e) | TValue -> Bool
isTBit TValue
a -> do
          Eval (SeqMap b w i)
val' <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "ecSplitV" (GenValue b w i -> Eval (SeqMap b w i))
-> Eval (GenValue b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
val)
          GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
            GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
e (Eval (WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ WordValue b w i -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Eval b) -> Seq (Eval b)
forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e) ((Int -> Eval b) -> Seq (Eval b))
-> (Int -> Eval b) -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ \j :: Int
j ->
              let idx :: Integer
idx = Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
j
               in Integer
idx Integer -> Eval b -> Eval b
forall a b. a -> b -> b
`seq` do
                      SeqMap b w i
xs <- Eval (SeqMap b w i)
val'
                      GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit (GenValue b w i -> b) -> Eval (GenValue b w i) -> Eval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs Integer
idx
       (Nat p :: Integer
p, Nat e :: Integer
e) -> do
          Eval (SeqMap b w i)
val' <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "ecSplitV" (GenValue b w i -> Eval (SeqMap b w i))
-> Eval (GenValue b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
val)
          GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
p (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
            GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
e (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \j :: Integer
j -> do
              SeqMap b w i
xs <- Eval (SeqMap b w i)
val'
              SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j)
       (Inf  , Nat e :: Integer
e) -> do
          Eval (SeqMap b w i)
val' <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "ecSplitV" (GenValue b w i -> Eval (SeqMap b w i))
-> Eval (GenValue b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
val)
          GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
            GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
e (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \j :: Integer
j -> do
              SeqMap b w i
xs <- Eval (SeqMap b w i)
val'
              SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j)
       _              -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "splitV" ["invalid type arguments to split"]


reverseV :: forall b w i
          . BitWord b w i
         => GenValue b w i
         -> Eval (GenValue b w i)
reverseV :: GenValue b w i -> Eval (GenValue b w i)
reverseV (VSeq n :: Integer
n xs :: SeqMap b w i
xs) =
  GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
n (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> SeqMap b w i
forall b w i. Integer -> SeqMap b w i -> SeqMap b w i
reverseSeqMap Integer
n SeqMap b w i
xs
reverseV (VWord n :: Integer
n wv :: Eval (WordValue b w i)
wv) = GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
n (WordValue b w i -> WordValue b w i
forall b w i i. BitWord b w i => WordValue b w i -> WordValue b w i
revword (WordValue b w i -> WordValue b w i)
-> Eval (WordValue b w i) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (WordValue b w i)
wv))
 where
 revword :: WordValue b w i -> WordValue b w i
revword (WordVal w :: w
w)         = Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> Seq (Eval b)
forall a. Seq a -> Seq a
Seq.reverse (Seq (Eval b) -> Seq (Eval b)) -> Seq (Eval b) -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ [Eval b] -> Seq (Eval b)
forall a. [a] -> Seq a
Seq.fromList ([Eval b] -> Seq (Eval b)) -> [Eval b] -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ (b -> Eval b) -> [b] -> [Eval b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Eval b
forall a. a -> Eval a
ready ([b] -> [Eval b]) -> [b] -> [Eval b]
forall a b. (a -> b) -> a -> b
$ w -> [b]
forall b w i. BitWord b w i => w -> [b]
unpackWord w
w
 revword (BitsVal bs :: Seq (Eval b)
bs)        = Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> Seq (Eval b)
forall a. Seq a -> Seq a
Seq.reverse Seq (Eval b)
bs
 revword (LargeBitsVal m :: Integer
m xs :: SeqMap b w i
xs) = Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal Integer
m (SeqMap b w i -> WordValue b w i)
-> SeqMap b w i -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> SeqMap b w i
forall b w i. Integer -> SeqMap b w i -> SeqMap b w i
reverseSeqMap Integer
m SeqMap b w i
xs
reverseV _ =
  String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "reverseV" ["Not a finite sequence"]


transposeV :: BitWord b w i
           => Nat'
           -> Nat'
           -> TValue
           -> GenValue b w i
           -> Eval (GenValue b w i)
transposeV :: Nat' -> Nat' -> TValue -> GenValue b w i -> Eval (GenValue b w i)
transposeV a :: Nat'
a b :: Nat'
b c :: TValue
c xs :: GenValue b w i
xs
  | TValue -> Bool
isTBit TValue
c, Nat na :: Integer
na <- Nat'
a = -- Fin a => [a][b]Bit -> [b][a]Bit
      GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
bseq (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \bi :: Integer
bi ->
        GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
na (Eval (WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ WordValue b w i -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$
          Int -> (Int -> Eval b) -> Seq (Eval b)
forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
na) ((Int -> Eval b) -> Seq (Eval b))
-> (Int -> Eval b) -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ \ai :: Int
ai -> do
            GenValue b w i
ys <- (SeqMap b w i -> Integer -> Eval (GenValue b w i))
-> Integer -> SeqMap b w i -> Eval (GenValue b w i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
ai) (SeqMap b w i -> Eval (GenValue b w i))
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "transposeV" GenValue b w i
xs
            case GenValue b w i
ys of
              VStream ys' :: SeqMap b w i
ys' -> GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit (GenValue b w i -> b) -> Eval (GenValue b w i) -> Eval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
ys' Integer
bi
              VWord _ wv :: Eval (WordValue b w i)
wv  -> (WordValue b w i -> Integer -> Eval b)
-> Integer -> WordValue b w i -> Eval b
forall a b c. (a -> b -> c) -> b -> a -> c
flip WordValue b w i -> Integer -> Eval b
forall b w i. BitWord b w i => WordValue b w i -> Integer -> Eval b
indexWordValue Integer
bi (WordValue b w i -> Eval b) -> Eval (WordValue b w i) -> Eval b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (WordValue b w i)
wv
              _ -> String -> [String] -> Eval b
forall a. HasCallStack => String -> [String] -> a
evalPanic "transpose" ["expected sequence of bits"]

  | TValue -> Bool
isTBit TValue
c, Nat'
Inf <- Nat'
a = -- [inf][b]Bit -> [b][inf]Bit
      GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
bseq (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \bi :: Integer
bi ->
        GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \ai :: Integer
ai ->
         do GenValue b w i
ys <- (SeqMap b w i -> Integer -> Eval (GenValue b w i))
-> Integer -> SeqMap b w i -> Eval (GenValue b w i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap Integer
ai (SeqMap b w i -> Eval (GenValue b w i))
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "transposeV" GenValue b w i
xs
            case GenValue b w i
ys of
              VStream ys' :: SeqMap b w i
ys' -> b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i)
-> (GenValue b w i -> b) -> GenValue b w i -> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit (GenValue b w i -> GenValue b w i)
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
ys' Integer
bi
              VWord _ wv :: Eval (WordValue b w i)
wv  -> b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> Eval b -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WordValue b w i -> Integer -> Eval b)
-> Integer -> WordValue b w i -> Eval b
forall a b c. (a -> b -> c) -> b -> a -> c
flip WordValue b w i -> Integer -> Eval b
forall b w i. BitWord b w i => WordValue b w i -> Integer -> Eval b
indexWordValue Integer
bi (WordValue b w i -> Eval b) -> Eval (WordValue b w i) -> Eval b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (WordValue b w i)
wv)
              _ -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "transpose" ["expected sequence of bits"]

  | Bool
otherwise = -- [a][b]c -> [b][a]c
      GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
bseq (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \bi :: Integer
bi ->
        GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
aseq (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \ai :: Integer
ai -> do
          GenValue b w i
ys  <- (SeqMap b w i -> Integer -> Eval (GenValue b w i))
-> Integer -> SeqMap b w i -> Eval (GenValue b w i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap Integer
ai (SeqMap b w i -> Eval (GenValue b w i))
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "transposeV 1" GenValue b w i
xs
          GenValue b w i
z   <- (SeqMap b w i -> Integer -> Eval (GenValue b w i))
-> Integer -> SeqMap b w i -> Eval (GenValue b w i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap Integer
bi (SeqMap b w i -> Eval (GenValue b w i))
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "transposeV 2" GenValue b w i
ys
          GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return GenValue b w i
z

 where
  bseq :: SeqMap b w i -> GenValue b w i
bseq =
        case Nat'
b of
          Nat nb :: Integer
nb -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
nb
          Inf    -> SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream
  aseq :: SeqMap b w i -> GenValue b w i
aseq =
        case Nat'
a of
          Nat na :: Integer
na -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
na
          Inf    -> SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream




ccatV :: (Show b, Show w, BitWord b w i)
      => Nat'
      -> Nat'
      -> TValue
      -> (GenValue b w i)
      -> (GenValue b w i)
      -> Eval (GenValue b w i)

ccatV :: Nat'
-> Nat'
-> TValue
-> GenValue b w i
-> GenValue b w i
-> Eval (GenValue b w i)
ccatV _front :: Nat'
_front _back :: Nat'
_back _elty :: TValue
_elty (VWord m :: Integer
m l :: Eval (WordValue b w i)
l) (VWord n :: Integer
n r :: Eval (WordValue b w i)
r) =
  GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
n) (WordValue b w i -> WordValue b w i -> WordValue b w i
forall b w i.
BitWord b w i =>
WordValue b w i -> WordValue b w i -> WordValue b w i
joinWordVal (WordValue b w i -> WordValue b w i -> WordValue b w i)
-> Eval (WordValue b w i)
-> Eval (WordValue b w i -> WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (WordValue b w i)
l Eval (WordValue b w i -> WordValue b w i)
-> Eval (WordValue b w i) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval (WordValue b w i)
r)

ccatV _front :: Nat'
_front _back :: Nat'
_back _elty :: TValue
_elty (VWord m :: Integer
m l :: Eval (WordValue b w i)
l) (VStream r :: SeqMap b w i
r) = do
  Eval (WordValue b w i)
l' <- Maybe String
-> Eval (WordValue b w i) -> Eval (Eval (WordValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing Eval (WordValue b w i)
l
  GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
    if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
m then
      b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> Eval b -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WordValue b w i -> Integer -> Eval b)
-> Integer -> WordValue b w i -> Eval b
forall a b c. (a -> b -> c) -> b -> a -> c
flip WordValue b w i -> Integer -> Eval b
forall b w i. BitWord b w i => WordValue b w i -> Integer -> Eval b
indexWordValue Integer
i (WordValue b w i -> Eval b) -> Eval (WordValue b w i) -> Eval b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (WordValue b w i)
l')
    else
      SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
r (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
m)

ccatV front :: Nat'
front back :: Nat'
back elty :: TValue
elty l :: GenValue b w i
l r :: GenValue b w i
r = do
       Eval (SeqMap b w i)
l'' <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "ccatV left" GenValue b w i
l)
       Eval (SeqMap b w i)
r'' <- Maybe String -> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "ccatV right" GenValue b w i
r)
       let Nat n :: Integer
n = Nat'
front
       Nat' -> TValue -> SeqMap b w i -> GenValue b w i
forall b w i. Nat' -> TValue -> SeqMap b w i -> GenValue b w i
mkSeq (HasCallStack => TFun -> [Nat'] -> Nat'
TFun -> [Nat'] -> Nat'
evalTF TFun
TCAdd [Nat'
front,Nat'
back]) TValue
elty (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap b w i -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
        if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n then do
         SeqMap b w i
ls <- Eval (SeqMap b w i)
l''
         SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
ls Integer
i
        else do
         SeqMap b w i
rs <- Eval (SeqMap b w i)
r''
         SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
rs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n))

wordValLogicOp :: BitWord b w i
               => (b -> b -> b)
               -> (w -> w -> w)
               -> WordValue b w i
               -> WordValue b w i
               -> Eval (WordValue b w i)
wordValLogicOp :: (b -> b -> b)
-> (w -> w -> w)
-> WordValue b w i
-> WordValue b w i
-> Eval (WordValue b w i)
wordValLogicOp _ wop :: w -> w -> w
wop (WordVal w1 :: w
w1) (WordVal w2 :: w
w2) = WordValue b w i -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> w -> w
wop w
w1 w
w2)
wordValLogicOp bop :: b -> b -> b
bop _ (BitsVal xs :: Seq (Eval b)
xs) (BitsVal ys :: Seq (Eval b)
ys) =
  Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Eval (Seq (Eval b)) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Eval (Eval b)) -> Eval (Seq (Eval b))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Eval b -> Eval b -> Eval (Eval b))
-> Seq (Eval b) -> Seq (Eval b) -> Seq (Eval (Eval b))
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\x :: Eval b
x y :: Eval b
y -> Maybe String -> Eval b -> Eval (Eval b)
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (b -> b -> b
bop (b -> b -> b) -> Eval b -> Eval (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval b
x Eval (b -> b) -> Eval b -> Eval b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval b
y)) Seq (Eval b)
xs Seq (Eval b)
ys)
wordValLogicOp bop :: b -> b -> b
bop _ (WordVal w1 :: w
w1) (BitsVal ys :: Seq (Eval b)
ys) =
  WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ (Eval b -> Eval b -> Eval b)
-> Seq (Eval b) -> Seq (Eval b) -> Seq (Eval b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\x :: Eval b
x y :: Eval b
y -> b -> b -> b
bop (b -> b -> b) -> Eval b -> Eval (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval b
x Eval (b -> b) -> Eval b -> Eval b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval b
y) ([Eval b] -> Seq (Eval b)
forall a. [a] -> Seq a
Seq.fromList ([Eval b] -> Seq (Eval b)) -> [Eval b] -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ (b -> Eval b) -> [b] -> [Eval b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Eval b
forall a. a -> Eval a
ready ([b] -> [Eval b]) -> [b] -> [Eval b]
forall a b. (a -> b) -> a -> b
$ w -> [b]
forall b w i. BitWord b w i => w -> [b]
unpackWord w
w1) Seq (Eval b)
ys
wordValLogicOp bop :: b -> b -> b
bop _ (BitsVal xs :: Seq (Eval b)
xs) (WordVal w2 :: w
w2) =
  WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$ (Eval b -> Eval b -> Eval b)
-> Seq (Eval b) -> Seq (Eval b) -> Seq (Eval b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (\x :: Eval b
x y :: Eval b
y -> b -> b -> b
bop (b -> b -> b) -> Eval b -> Eval (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval b
x Eval (b -> b) -> Eval b -> Eval b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval b
y) Seq (Eval b)
xs ([Eval b] -> Seq (Eval b)
forall a. [a] -> Seq a
Seq.fromList ([Eval b] -> Seq (Eval b)) -> [Eval b] -> Seq (Eval b)
forall a b. (a -> b) -> a -> b
$ (b -> Eval b) -> [b] -> [Eval b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Eval b
forall a. a -> Eval a
ready ([b] -> [Eval b]) -> [b] -> [Eval b]
forall a b. (a -> b) -> a -> b
$ w -> [b]
forall b w i. BitWord b w i => w -> [b]
unpackWord w
w2)
wordValLogicOp bop :: b -> b -> b
bop _ w1 :: WordValue b w i
w1 w2 :: WordValue b w i
w2 = Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal (WordValue b w i -> Integer
forall b w i. BitWord b w i => WordValue b w i -> Integer
wordValueSize WordValue b w i
w1) (SeqMap b w i -> WordValue b w i)
-> Eval (SeqMap b w i) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (SeqMap b w i)
forall w i. Eval (SeqMap b w i)
zs
     where zs :: Eval (SeqMap b w i)
zs = SeqMap b w i -> Eval (SeqMap b w i)
forall b w i. SeqMap b w i -> Eval (SeqMap b w i)
memoMap (SeqMap b w i -> Eval (SeqMap b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i -> GenValue b w i -> GenValue b w i -> GenValue b w i
forall w i w i w i.
GenValue b w i -> GenValue b w i -> GenValue b w i
op (GenValue b w i -> GenValue b w i -> GenValue b w i)
-> Eval (GenValue b w i) -> Eval (GenValue b w i -> GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
xs Integer
i) Eval (GenValue b w i -> GenValue b w i)
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SeqMap b w i -> Integer -> Eval (GenValue b w i)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqMap b w i
ys Integer
i)
           xs :: SeqMap b w i
xs = WordValue b w i -> SeqMap b w i
forall b w i. BitWord b w i => WordValue b w i -> SeqMap b w i
asBitsMap WordValue b w i
w1
           ys :: SeqMap b w i
ys = WordValue b w i -> SeqMap b w i
forall b w i. BitWord b w i => WordValue b w i -> SeqMap b w i
asBitsMap WordValue b w i
w2
           op :: GenValue b w i -> GenValue b w i -> GenValue b w i
op x :: GenValue b w i
x y :: GenValue b w i
y = b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> b -> b
bop (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
x) (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
y))

-- | Merge two values given a binop.  This is used for and, or and xor.
logicBinary :: forall b w i
             . BitWord b w i
            => (b -> b -> b)
            -> (w -> w -> w)
            -> Binary b w i
logicBinary :: (b -> b -> b) -> (w -> w -> w) -> Binary b w i
logicBinary opb :: b -> b -> b
opb opw :: w -> w -> w
opw = Binary b w i
loop
  where
  loop' :: TValue
        -> Eval (GenValue b w i)
        -> Eval (GenValue b w i)
        -> Eval (GenValue b w i)
  loop' :: TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' ty :: TValue
ty l :: Eval (GenValue b w i)
l r :: Eval (GenValue b w i)
r = Eval (Eval (GenValue b w i)) -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Binary b w i
loop TValue
ty (GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
-> Eval (GenValue b w i -> Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (GenValue b w i)
l Eval (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eval (GenValue b w i)
r)

  loop :: TValue
        -> GenValue b w i
        -> GenValue b w i
        -> Eval (GenValue b w i)

  loop :: Binary b w i
loop ty :: TValue
ty l :: GenValue b w i
l r :: GenValue b w i
r = case TValue
ty of
    TVBit -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> b -> b
opb (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
l) (GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
r))
    TVInteger -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "logicBinary" ["Integer not in class Logic"]
    TVIntMod _ -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "logicBinary" ["Z not in class Logic"]
    TVSeq w :: Integer
w aty :: TValue
aty
         -- words
         | TValue -> Bool
isTBit TValue
aty
              -> do Eval (WordValue b w i)
v <- Maybe String
-> Eval (WordValue b w i) -> Eval (Eval (WordValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (Eval (WordValue b w i) -> Eval (Eval (WordValue b w i)))
-> Eval (WordValue b w i) -> Eval (Eval (WordValue b w i))
forall a b. (a -> b) -> a -> b
$ Eval (Eval (WordValue b w i)) -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
                            ((b -> b -> b)
-> (w -> w -> w)
-> WordValue b w i
-> WordValue b w i
-> Eval (WordValue b w i)
forall b w i.
BitWord b w i =>
(b -> b -> b)
-> (w -> w -> w)
-> WordValue b w i
-> WordValue b w i
-> Eval (WordValue b w i)
wordValLogicOp b -> b -> b
opb w -> w -> w
opw (WordValue b w i -> WordValue b w i -> Eval (WordValue b w i))
-> Eval (WordValue b w i)
-> Eval (WordValue b w i -> Eval (WordValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                    String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "logicBinary l" GenValue b w i
l Eval (WordValue b w i -> Eval (WordValue b w i))
-> Eval (WordValue b w i) -> Eval (Eval (WordValue b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                    String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "logicBinary r" GenValue b w i
r)
                    GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w Eval (WordValue b w i)
v

         -- finite sequences
         | Bool
otherwise -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                           (Eval (Eval (SeqMap b w i)) -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
zipSeqMap (Binary b w i
loop TValue
aty) (SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i)
-> Eval (SeqMap b w i -> Eval (SeqMap b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                    (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicBinary left" GenValue b w i
l)
                                    Eval (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicBinary right" GenValue b w i
r)))

    TVStream aty :: TValue
aty ->
        SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Eval (Eval (SeqMap b w i)) -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i)
zipSeqMap (Binary b w i
loop TValue
aty) (SeqMap b w i -> SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i)
-> Eval (SeqMap b w i -> Eval (SeqMap b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicBinary left" GenValue b w i
l) Eval (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (Eval (SeqMap b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                          (String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicBinary right" GenValue b w i
r)))

    TVTuple etys :: [TValue]
etys -> do
        [Eval (GenValue b w i)]
ls <- (Eval (GenValue b w i) -> Eval (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Eval [Eval (GenValue b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
l)
        [Eval (GenValue b w i)]
rs <- (Eval (GenValue b w i) -> Eval (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Eval [Eval (GenValue b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
r)
        GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ([Eval (GenValue b w i)] -> GenValue b w i)
-> [Eval (GenValue b w i)] -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (TValue
 -> Eval (GenValue b w i)
 -> Eval (GenValue b w i)
 -> Eval (GenValue b w i))
-> [TValue]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
-> [Eval (GenValue b w i)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' [TValue]
etys [Eval (GenValue b w i)]
ls [Eval (GenValue b w i)]
rs

    TVFun _ bty :: TValue
bty ->
        GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: Eval (GenValue b w i)
a -> TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' TValue
bty (GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall b w i.
GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
fromVFun GenValue b w i
l Eval (GenValue b w i)
a) (GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall b w i.
GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
fromVFun GenValue b w i
r Eval (GenValue b w i)
a)

    TVRec fields :: [(Ident, TValue)]
fields ->
        do [(Ident, Eval (GenValue b w i))]
fs <- [Eval (Ident, Eval (GenValue b w i))]
-> Eval [(Ident, Eval (GenValue b w i))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                   [ (Ident
f,) (Eval (GenValue b w i) -> (Ident, Eval (GenValue b w i)))
-> Eval (Eval (GenValue b w i))
-> Eval (Ident, Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (TValue
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
-> Eval (GenValue b w i)
loop' TValue
fty Eval (GenValue b w i)
a Eval (GenValue b w i)
b)
                   | (f :: Ident
f,fty :: TValue
fty) <- [(Ident, TValue)]
fields
                   , let a :: Eval (GenValue b w i)
a = Ident -> GenValue b w i -> Eval (GenValue b w i)
forall b w i. Ident -> GenValue b w i -> Eval (GenValue b w i)
lookupRecord Ident
f GenValue b w i
l
                         b :: Eval (GenValue b w i)
b = Ident -> GenValue b w i -> Eval (GenValue b w i)
forall b w i. Ident -> GenValue b w i -> Eval (GenValue b w i)
lookupRecord Ident
f GenValue b w i
r
                   ]
           GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [(Ident, Eval (GenValue b w i))]
fs

    TVAbstract {} -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "logicBinary"
                        [ "Abstract type not in `Logic`" ]


wordValUnaryOp :: BitWord b w i
               => (b -> b)
               -> (w -> w)
               -> WordValue b w i
               -> Eval (WordValue b w i)
wordValUnaryOp :: (b -> b) -> (w -> w) -> WordValue b w i -> Eval (WordValue b w i)
wordValUnaryOp _ wop :: w -> w
wop (WordVal w :: w
w)  = WordValue b w i -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (w -> w
wop w
w)
wordValUnaryOp bop :: b -> b
bop _ (BitsVal bs :: Seq (Eval b)
bs) = WordValue b w i -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal ((Eval b -> Eval b) -> Seq (Eval b) -> Seq (Eval b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b
bop (b -> b) -> Eval b -> Eval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Seq (Eval b)
bs)
wordValUnaryOp bop :: b -> b
bop _ (LargeBitsVal n :: Integer
n xs :: SeqMap b w i
xs) = Integer -> SeqMap b w i -> WordValue b w i
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal Integer
n (SeqMap b w i -> WordValue b w i)
-> Eval (SeqMap b w i) -> Eval (WordValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
mapSeqMap GenValue b w i -> Eval (GenValue b w i)
forall w i w i. GenValue b w i -> Eval (GenValue b w i)
f SeqMap b w i
xs
  where f :: GenValue b w i -> Eval (GenValue b w i)
f x :: GenValue b w i
x = b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> (b -> b) -> b -> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bop (b -> GenValue b w i) -> Eval b -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenValue b w i -> Eval b
forall b w i. GenValue b w i -> Eval b
fromBit GenValue b w i
x

logicUnary :: forall b w i
            . BitWord b w i
           => (b -> b)
           -> (w -> w)
           -> Unary b w i
logicUnary :: (b -> b) -> (w -> w) -> Unary b w i
logicUnary opb :: b -> b
opb opw :: w -> w
opw = Unary b w i
loop
  where
  loop' :: TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
  loop' :: TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' ty :: TValue
ty val :: Eval (GenValue b w i)
val = Unary b w i
loop TValue
ty (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
val

  loop :: TValue -> GenValue b w i -> Eval (GenValue b w i)
  loop :: Unary b w i
loop ty :: TValue
ty val :: GenValue b w i
val = case TValue
ty of
    TVBit -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> (b -> GenValue b w i) -> b -> Eval (GenValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> (b -> b) -> b -> GenValue b w i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
opb (b -> Eval (GenValue b w i)) -> b -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ GenValue b w i -> b
forall b w i. GenValue b w i -> b
fromVBit GenValue b w i
val

    TVInteger -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "logicUnary" ["Integer not in class Logic"]
    TVIntMod _ -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "logicUnary" ["Z not in class Logic"]

    TVSeq w :: Integer
w ety :: TValue
ety
         -- words
         | TValue -> Bool
isTBit TValue
ety
              -> do Eval (WordValue b w i)
v <- Maybe String
-> Eval (WordValue b w i) -> Eval (Eval (WordValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing ((b -> b) -> (w -> w) -> WordValue b w i -> Eval (WordValue b w i)
forall b w i.
BitWord b w i =>
(b -> b) -> (w -> w) -> WordValue b w i -> Eval (WordValue b w i)
wordValUnaryOp b -> b
opb w -> w
opw (WordValue b w i -> Eval (WordValue b w i))
-> Eval (WordValue b w i) -> Eval (WordValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "logicUnary" GenValue b w i
val)
                    GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w Eval (WordValue b w i)
v

         -- finite sequences
         | Bool
otherwise
              -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
mapSeqMap (Unary b w i
loop TValue
ety) (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicUnary" GenValue b w i
val)

         -- streams
    TVStream ety :: TValue
ety ->
         SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall b w i.
(GenValue b w i -> Eval (GenValue b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
mapSeqMap (Unary b w i
loop TValue
ety) (SeqMap b w i -> Eval (SeqMap b w i))
-> Eval (SeqMap b w i) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue b w i -> Eval (SeqMap b w i)
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicUnary" GenValue b w i
val)

    TVTuple etys :: [TValue]
etys ->
      do [Eval (GenValue b w i)]
as <- (Eval (GenValue b w i) -> Eval (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Eval [Eval (GenValue b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing) (GenValue b w i -> [Eval (GenValue b w i)]
forall b w i. GenValue b w i -> [Eval (GenValue b w i)]
fromVTuple GenValue b w i
val)
         GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ((TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i))
-> [TValue] -> [Eval (GenValue b w i)] -> [Eval (GenValue b w i)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' [TValue]
etys [Eval (GenValue b w i)]
as)

    TVFun _ bty :: TValue
bty ->
      GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: Eval (GenValue b w i)
a -> TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' TValue
bty (GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall b w i.
GenValue b w i -> Eval (GenValue b w i) -> Eval (GenValue b w i)
fromVFun GenValue b w i
val Eval (GenValue b w i)
a)

    TVRec fields :: [(Ident, TValue)]
fields ->
      do [(Ident, Eval (GenValue b w i))]
fs <- [Eval (Ident, Eval (GenValue b w i))]
-> Eval [(Ident, Eval (GenValue b w i))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ (Ident
f,) (Eval (GenValue b w i) -> (Ident, Eval (GenValue b w i)))
-> Eval (Eval (GenValue b w i))
-> Eval (Ident, Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> Eval (GenValue b w i) -> Eval (Eval (GenValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing (TValue -> Eval (GenValue b w i) -> Eval (GenValue b w i)
loop' TValue
fty Eval (GenValue b w i)
a)
                 | (f :: Ident
f,fty :: TValue
fty) <- [(Ident, TValue)]
fields, let a :: Eval (GenValue b w i)
a = Ident -> GenValue b w i -> Eval (GenValue b w i)
forall b w i. Ident -> GenValue b w i -> Eval (GenValue b w i)
lookupRecord Ident
f GenValue b w i
val
                 ]
         GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [(Ident, Eval (GenValue b w i))]
fs

    TVAbstract {} -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "logicUnary" [ "Abstract type not in `Logic`" ]


logicShift :: (Integer -> Integer -> Integer -> Integer)
              -- ^ The function may assume its arguments are masked.
              -- It is responsible for masking its result if needed.
           -> (Integer -> Seq.Seq (Eval Bool) -> Integer -> Seq.Seq (Eval Bool))
           -> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap)
           -> Value
logicShift :: (Integer -> Integer -> Integer -> Integer)
-> (Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool))
-> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap)
-> GenValue Bool BV Integer
logicShift opW :: Integer -> Integer -> Integer -> Integer
opW obB :: Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
obB opS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
opS
  = (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ a :: Nat'
a ->
    (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (Nat' -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ _ ->
    (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer)
-> (TValue -> GenValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ c :: TValue
c ->
     (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ l :: Eval (GenValue Bool BV Integer)
l -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$
     (Eval (GenValue Bool BV Integer)
 -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue Bool BV Integer)
  -> Eval (GenValue Bool BV Integer))
 -> GenValue Bool BV Integer)
-> (Eval (GenValue Bool BV Integer)
    -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ \ r :: Eval (GenValue Bool BV Integer)
r -> do
        BV _ i :: Integer
i <- String -> GenValue Bool BV Integer -> Eval BV
forall b w i. BitWord b w i => String -> GenValue b w i -> Eval w
fromVWord "logicShift amount" (GenValue Bool BV Integer -> Eval BV)
-> Eval (GenValue Bool BV Integer) -> Eval BV
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
r
        Eval (GenValue Bool BV Integer)
l Eval (GenValue Bool BV Integer)
-> (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          VWord w :: Integer
w wv :: Eval (WordValue Bool BV Integer)
wv -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ Integer
-> Eval (WordValue Bool BV Integer) -> GenValue Bool BV Integer
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w (Eval (WordValue Bool BV Integer) -> GenValue Bool BV Integer)
-> Eval (WordValue Bool BV Integer) -> GenValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ Eval (WordValue Bool BV Integer)
wv Eval (WordValue Bool BV Integer)
-> (WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer))
-> Eval (WordValue Bool BV Integer)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                          WordVal (BV _ x :: Integer
x) -> WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer))
-> WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ BV -> WordValue Bool BV Integer
forall b w i. w -> WordValue b w i
WordVal (Integer -> Integer -> BV
BV Integer
w (Integer -> Integer -> Integer -> Integer
opW Integer
w Integer
x Integer
i))
                          BitsVal bs :: Seq (Eval Bool)
bs -> WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer))
-> WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ Seq (Eval Bool) -> WordValue Bool BV Integer
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
obB Integer
w Seq (Eval Bool)
bs Integer
i)
                          LargeBitsVal n :: Integer
n xs :: SeqValMap
xs -> WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer))
-> WordValue Bool BV Integer -> Eval (WordValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqValMap -> WordValue Bool BV Integer
forall b w i. Integer -> SeqMap b w i -> WordValue b w i
LargeBitsVal Integer
n (SeqValMap -> WordValue Bool BV Integer)
-> SeqValMap -> WordValue Bool BV Integer
forall a b. (a -> b) -> a -> b
$ Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
opS (Integer -> Nat'
Nat Integer
n) TValue
c SeqValMap
xs Integer
i

          _ -> Nat' -> TValue -> SeqValMap -> GenValue Bool BV Integer
forall b w i. Nat' -> TValue -> SeqMap b w i -> GenValue b w i
mkSeq Nat'
a TValue
c (SeqValMap -> GenValue Bool BV Integer)
-> Eval SeqValMap -> Eval (GenValue Bool BV Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
opS Nat'
a TValue
c (SeqValMap -> Integer -> SeqValMap)
-> Eval SeqValMap -> Eval (Integer -> SeqValMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> GenValue Bool BV Integer -> Eval SeqValMap
forall b w i.
BitWord b w i =>
String -> GenValue b w i -> Eval (SeqMap b w i)
fromSeq "logicShift" (GenValue Bool BV Integer -> Eval SeqValMap)
-> Eval (GenValue Bool BV Integer) -> Eval SeqValMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
l) Eval (Integer -> SeqValMap) -> Eval Integer -> Eval SeqValMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Eval Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i)

-- Left shift for words.
shiftLW :: Integer -> Integer -> Integer -> Integer
shiftLW :: Integer -> Integer -> Integer -> Integer
shiftLW w :: Integer
w ival :: Integer
ival by :: Integer
by
  | Integer
by Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
w   = 0
  | Bool
otherwise = Integer -> Integer -> Integer
mask Integer
w (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
ival (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
by))

shiftLB :: Integer -> Seq.Seq (Eval Bool) -> Integer -> Seq.Seq (Eval Bool)
shiftLB :: Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
shiftLB w :: Integer
w bs :: Seq (Eval Bool)
bs by :: Integer
by =
  Int -> Seq (Eval Bool) -> Seq (Eval Bool)
forall a. Int -> Seq a -> Seq a
Seq.drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
w Integer
by)) Seq (Eval Bool)
bs
  Seq (Eval Bool) -> Seq (Eval Bool) -> Seq (Eval Bool)
forall a. Seq a -> Seq a -> Seq a
Seq.><
  Int -> Eval Bool -> Seq (Eval Bool)
forall a. Int -> a -> Seq a
Seq.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
w Integer
by)) (Bool -> Eval Bool
forall a. a -> Eval a
ready Bool
False)

shiftLS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
shiftLS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
shiftLS w :: Nat'
w ety :: TValue
ety vs :: SeqValMap
vs by :: Integer
by = (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap)
-> (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
  case Nat'
w of
    Nat len :: Integer
len
      | Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
by Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
len -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
by)
      | Integer
i    Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
len -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue Bool BV Integer
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
ety
      | Bool
otherwise  -> String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
evalPanic "shiftLS" ["Index out of bounds"]
    Inf            -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
by)

shiftRW :: Integer -> Integer -> Integer -> Integer
shiftRW :: Integer -> Integer -> Integer -> Integer
shiftRW w :: Integer
w i :: Integer
i by :: Integer
by
  | Integer
by Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
w   = 0
  | Bool
otherwise = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftR Integer
i (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
by)

shiftRB :: Integer -> Seq.Seq (Eval Bool) -> Integer -> Seq.Seq (Eval Bool)
shiftRB :: Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
shiftRB w :: Integer
w bs :: Seq (Eval Bool)
bs by :: Integer
by =
  Int -> Eval Bool -> Seq (Eval Bool)
forall a. Int -> a -> Seq a
Seq.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
w Integer
by)) (Bool -> Eval Bool
forall a. a -> Eval a
ready Bool
False)
  Seq (Eval Bool) -> Seq (Eval Bool) -> Seq (Eval Bool)
forall a. Seq a -> Seq a -> Seq a
Seq.><
  Int -> Seq (Eval Bool) -> Seq (Eval Bool)
forall a. Int -> Seq a -> Seq a
Seq.take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
w Integer
by)) Seq (Eval Bool)
bs

shiftRS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
shiftRS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
shiftRS w :: Nat'
w ety :: TValue
ety vs :: SeqValMap
vs by :: Integer
by = (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap)
-> (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
  case Nat'
w of
    Nat len :: Integer
len
      | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
by   -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
by)
      | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
len   -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue Bool BV Integer
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
ety
      | Bool
otherwise -> String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
evalPanic "shiftLS" ["Index out of bounds"]
    Inf
      | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
by   -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
by)
      | Bool
otherwise -> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer))
-> GenValue Bool BV Integer -> Eval (GenValue Bool BV Integer)
forall a b. (a -> b) -> a -> b
$ TValue -> GenValue Bool BV Integer
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
ety


-- XXX integer doesn't implement rotateL, as there's no bit bound
rotateLW :: Integer -> Integer -> Integer -> Integer
rotateLW :: Integer -> Integer -> Integer -> Integer
rotateLW 0 i :: Integer
i _  = Integer
i
rotateLW w :: Integer
w i :: Integer
i by :: Integer
by = Integer -> Integer -> Integer
mask Integer
w (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
b) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b))
  where b :: Int
b = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
by Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
w)

rotateLB :: Integer -> Seq.Seq (Eval Bool) -> Integer -> Seq.Seq (Eval Bool)
rotateLB :: Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
rotateLB w :: Integer
w bs :: Seq (Eval Bool)
bs by :: Integer
by =
  let (hd :: Seq (Eval Bool)
hd,tl :: Seq (Eval Bool)
tl) = Int -> Seq (Eval Bool) -> (Seq (Eval Bool), Seq (Eval Bool))
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
by Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
w)) Seq (Eval Bool)
bs
   in Seq (Eval Bool)
tl Seq (Eval Bool) -> Seq (Eval Bool) -> Seq (Eval Bool)
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq (Eval Bool)
hd

rotateLS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
rotateLS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
rotateLS w :: Nat'
w _ vs :: SeqValMap
vs by :: Integer
by = (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap)
-> (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
  case Nat'
w of
    Nat len :: Integer
len -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs ((Integer
by Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
len)
    _ -> String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Eval.Prim.rotateLS" [ "unexpected infinite sequence" ]

-- XXX integer doesn't implement rotateR, as there's no bit bound
rotateRW :: Integer -> Integer -> Integer -> Integer
rotateRW :: Integer -> Integer -> Integer -> Integer
rotateRW 0 i :: Integer
i _  = Integer
i
rotateRW w :: Integer
w i :: Integer
i by :: Integer
by = Integer -> Integer -> Integer
mask Integer
w (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
b) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b))
  where b :: Int
b = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
by Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
w)

rotateRB :: Integer -> Seq.Seq (Eval Bool) -> Integer -> Seq.Seq (Eval Bool)
rotateRB :: Integer -> Seq (Eval Bool) -> Integer -> Seq (Eval Bool)
rotateRB w :: Integer
w bs :: Seq (Eval Bool)
bs by :: Integer
by =
  let (hd :: Seq (Eval Bool)
hd,tl :: Seq (Eval Bool)
tl) = Int -> Seq (Eval Bool) -> (Seq (Eval Bool), Seq (Eval Bool))
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
by Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
w))) Seq (Eval Bool)
bs
   in Seq (Eval Bool)
tl Seq (Eval Bool) -> Seq (Eval Bool) -> Seq (Eval Bool)
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq (Eval Bool)
hd

rotateRS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
rotateRS :: Nat' -> TValue -> SeqValMap -> Integer -> SeqValMap
rotateRS w :: Nat'
w _ vs :: SeqValMap
vs by :: Integer
by = (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap)
-> (Integer -> Eval (GenValue Bool BV Integer)) -> SeqValMap
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
  case Nat'
w of
    Nat len :: Integer
len -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs ((Integer
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
by Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
len)
    _ -> String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Eval.Prim.rotateRS" [ "unexpected infinite sequence" ]


-- Sequence Primitives ---------------------------------------------------------

-- | Indexing operations.
indexPrim :: BitWord b w i
          => (Maybe Integer -> TValue -> SeqMap b w i -> Seq.Seq b -> Eval (GenValue b w i))
          -> (Maybe Integer -> TValue -> SeqMap b w i -> w -> Eval (GenValue b w i))
          -> GenValue b w i
indexPrim :: (Maybe Integer
 -> TValue -> SeqMap b w i -> Seq b -> Eval (GenValue b w i))
-> (Maybe Integer
    -> TValue -> SeqMap b w i -> w -> Eval (GenValue b w i))
-> GenValue b w i
indexPrim bits_op :: Maybe Integer
-> TValue -> SeqMap b w i -> Seq b -> Eval (GenValue b w i)
bits_op word_op :: Maybe Integer
-> TValue -> SeqMap b w i -> w -> Eval (GenValue b w i)
word_op =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ n :: Nat'
n  ->
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ a :: TValue
a ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ _i :: Nat'
_i ->
   (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ l :: Eval (GenValue b w i)
l  -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$
   (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ r :: Eval (GenValue b w i)
r  -> do
      SeqMap b w i
vs <- Eval (GenValue b w i)
l Eval (GenValue b w i)
-> (GenValue b w i -> Eval (SeqMap b w i)) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               VWord _ w :: Eval (WordValue b w i)
w  -> Eval (WordValue b w i)
w Eval (WordValue b w i)
-> (WordValue b w i -> Eval (SeqMap b w i)) -> Eval (SeqMap b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w' :: WordValue b w i
w' -> SeqMap b w i -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (SeqMap b w i -> Eval (SeqMap b w i))
-> SeqMap b w i -> Eval (SeqMap b w i)
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap (\i :: Integer
i -> b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (b -> GenValue b w i) -> Eval b -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue b w i -> Integer -> Eval b
forall b w i. BitWord b w i => WordValue b w i -> Integer -> Eval b
indexWordValue WordValue b w i
w' Integer
i)
               VSeq _ vs :: SeqMap b w i
vs  -> SeqMap b w i -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return SeqMap b w i
vs
               VStream vs :: SeqMap b w i
vs -> SeqMap b w i -> Eval (SeqMap b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return SeqMap b w i
vs
               _ -> String -> [String] -> Eval (SeqMap b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "Expected sequence value" ["indexPrim"]
      Eval (GenValue b w i)
r Eval (GenValue b w i)
-> (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
         VWord _ w :: Eval (WordValue b w i)
w -> Eval (WordValue b w i)
w Eval (WordValue b w i)
-> (WordValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
           WordVal w' :: w
w' -> Maybe Integer
-> TValue -> SeqMap b w i -> w -> Eval (GenValue b w i)
word_op (Nat' -> Maybe Integer
fromNat Nat'
n) TValue
a SeqMap b w i
vs w
w'
           BitsVal bs :: Seq (Eval b)
bs -> Maybe Integer
-> TValue -> SeqMap b w i -> Seq b -> Eval (GenValue b w i)
bits_op (Nat' -> Maybe Integer
fromNat Nat'
n) TValue
a SeqMap b w i
vs (Seq b -> Eval (GenValue b w i))
-> Eval (Seq b) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Seq (Eval b) -> Eval (Seq b)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Seq (Eval b)
bs
           LargeBitsVal m :: Integer
m xs :: SeqMap b w i
xs -> Maybe Integer
-> TValue -> SeqMap b w i -> Seq b -> Eval (GenValue b w i)
bits_op (Nat' -> Maybe Integer
fromNat Nat'
n) TValue
a SeqMap b w i
vs (Seq b -> Eval (GenValue b w i))
-> ([b] -> Seq b) -> [b] -> Eval (GenValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Seq b
forall a. [a] -> Seq a
Seq.fromList ([b] -> Eval (GenValue b w i)) -> Eval [b] -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Eval (GenValue b w i) -> Eval b)
-> [Eval (GenValue b w i)] -> Eval [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (GenValue b w i -> Eval b
forall b w i. GenValue b w i -> Eval b
fromBit (GenValue b w i -> Eval b) -> Eval (GenValue b w i) -> Eval b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Integer -> SeqMap b w i -> [Eval (GenValue b w i)]
forall n b w i.
Integral n =>
n -> SeqMap b w i -> [Eval (GenValue b w i)]
enumerateSeqMap Integer
m SeqMap b w i
xs)
         _ -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "Expected word value" ["indexPrim"]

indexFront :: Maybe Integer -> TValue -> SeqValMap -> BV -> Eval Value
indexFront :: Maybe Integer
-> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer)
indexFront mblen :: Maybe Integer
mblen _a :: TValue
_a vs :: SeqValMap
vs (BV -> Integer
bvVal -> Integer
ix) =
  case Maybe Integer
mblen of
    Just len :: Integer
len | Integer
len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
ix -> Integer -> Eval (GenValue Bool BV Integer)
forall a. Integer -> Eval a
invalidIndex Integer
ix
    _                    -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs Integer
ix

indexFront_bits :: Maybe Integer -> TValue -> SeqValMap -> Seq.Seq Bool -> Eval Value
indexFront_bits :: Maybe Integer
-> TValue
-> SeqValMap
-> Seq Bool
-> Eval (GenValue Bool BV Integer)
indexFront_bits mblen :: Maybe Integer
mblen a :: TValue
a vs :: SeqValMap
vs = Maybe Integer
-> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer)
indexFront Maybe Integer
mblen TValue
a SeqValMap
vs (BV -> Eval (GenValue Bool BV Integer))
-> (Seq Bool -> BV) -> Seq Bool -> Eval (GenValue Bool BV Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> BV
forall b w i. BitWord b w i => [b] -> w
packWord ([Bool] -> BV) -> (Seq Bool -> [Bool]) -> Seq Bool -> BV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Bool -> [Bool]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList

indexBack :: Maybe Integer -> TValue -> SeqValMap -> BV -> Eval Value
indexBack :: Maybe Integer
-> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer)
indexBack mblen :: Maybe Integer
mblen _a :: TValue
_a vs :: SeqValMap
vs (BV -> Integer
bvVal -> Integer
ix) =
  case Maybe Integer
mblen of
    Just len :: Integer
len | Integer
len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
ix  -> SeqValMap -> Integer -> Eval (GenValue Bool BV Integer)
forall b w i. SeqMap b w i -> Integer -> Eval (GenValue b w i)
lookupSeqMap SeqValMap
vs (Integer
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ix Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
             | Bool
otherwise -> Integer -> Eval (GenValue Bool BV Integer)
forall a. Integer -> Eval a
invalidIndex Integer
ix
    Nothing              -> String -> [String] -> Eval (GenValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
evalPanic "indexBack"
                            ["unexpected infinite sequence"]

indexBack_bits :: Maybe Integer -> TValue -> SeqValMap -> Seq.Seq Bool -> Eval Value
indexBack_bits :: Maybe Integer
-> TValue
-> SeqValMap
-> Seq Bool
-> Eval (GenValue Bool BV Integer)
indexBack_bits mblen :: Maybe Integer
mblen a :: TValue
a vs :: SeqValMap
vs = Maybe Integer
-> TValue -> SeqValMap -> BV -> Eval (GenValue Bool BV Integer)
indexBack Maybe Integer
mblen TValue
a SeqValMap
vs (BV -> Eval (GenValue Bool BV Integer))
-> (Seq Bool -> BV) -> Seq Bool -> Eval (GenValue Bool BV Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> BV
forall b w i. BitWord b w i => [b] -> w
packWord ([Bool] -> BV) -> (Seq Bool -> [Bool]) -> Seq Bool -> BV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Bool -> [Bool]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList


updateFront
  :: Nat'
  -> TValue
  -> SeqMap Bool BV Integer
  -> WordValue Bool BV Integer
  -> Eval (GenValue Bool BV Integer)
  -> Eval (SeqMap Bool BV Integer)
updateFront :: Nat'
-> TValue
-> SeqValMap
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval SeqValMap
updateFront len :: Nat'
len _eltTy :: TValue
_eltTy vs :: SeqValMap
vs w :: WordValue Bool BV Integer
w val :: Eval (GenValue Bool BV Integer)
val = do
  Integer
idx <- BV -> Integer
bvVal (BV -> Integer) -> Eval BV -> Eval Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue Bool BV Integer -> Eval BV
forall b w i. BitWord b w i => WordValue b w i -> Eval w
asWordVal WordValue Bool BV Integer
w
  case Nat'
len of
    Inf -> () -> Eval ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Nat n :: Integer
n -> Bool -> Eval () -> Eval ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
idx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n) (Integer -> Eval ()
forall a. Integer -> Eval a
invalidIndex Integer
idx)
  SeqValMap -> Eval SeqValMap
forall (m :: * -> *) a. Monad m => a -> m a
return (SeqValMap -> Eval SeqValMap) -> SeqValMap -> Eval SeqValMap
forall a b. (a -> b) -> a -> b
$ SeqValMap
-> Integer -> Eval (GenValue Bool BV Integer) -> SeqValMap
forall b w i.
SeqMap b w i -> Integer -> Eval (GenValue b w i) -> SeqMap b w i
updateSeqMap SeqValMap
vs Integer
idx Eval (GenValue Bool BV Integer)
val

updateFront_word
 :: Nat'
 -> TValue
 -> WordValue Bool BV Integer
 -> WordValue Bool BV Integer
 -> Eval (GenValue Bool BV Integer)
 -> Eval (WordValue Bool BV Integer)
updateFront_word :: Nat'
-> TValue
-> WordValue Bool BV Integer
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval (WordValue Bool BV Integer)
updateFront_word _len :: Nat'
_len _eltTy :: TValue
_eltTy bs :: WordValue Bool BV Integer
bs w :: WordValue Bool BV Integer
w val :: Eval (GenValue Bool BV Integer)
val = do
  Integer
idx <- BV -> Integer
bvVal (BV -> Integer) -> Eval BV -> Eval Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue Bool BV Integer -> Eval BV
forall b w i. BitWord b w i => WordValue b w i -> Eval w
asWordVal WordValue Bool BV Integer
w
  WordValue Bool BV Integer
-> Integer -> Eval Bool -> Eval (WordValue Bool BV Integer)
forall b w i.
BitWord b w i =>
WordValue b w i -> Integer -> Eval b -> Eval (WordValue b w i)
updateWordValue WordValue Bool BV Integer
bs Integer
idx (GenValue Bool BV Integer -> Eval Bool
forall b w i. GenValue b w i -> Eval b
fromBit (GenValue Bool BV Integer -> Eval Bool)
-> Eval (GenValue Bool BV Integer) -> Eval Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
val)

updateBack
  :: Nat'
  -> TValue
  -> SeqMap Bool BV Integer
  -> WordValue Bool BV Integer
  -> Eval (GenValue Bool BV Integer)
  -> Eval (SeqMap Bool BV Integer)
updateBack :: Nat'
-> TValue
-> SeqValMap
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval SeqValMap
updateBack Inf _eltTy :: TValue
_eltTy _vs :: SeqValMap
_vs _w :: WordValue Bool BV Integer
_w _val :: Eval (GenValue Bool BV Integer)
_val =
  String -> [String] -> Eval SeqValMap
forall a. HasCallStack => String -> [String] -> a
evalPanic "Unexpected infinite sequence in updateEnd" []
updateBack (Nat n :: Integer
n) _eltTy :: TValue
_eltTy vs :: SeqValMap
vs w :: WordValue Bool BV Integer
w val :: Eval (GenValue Bool BV Integer)
val = do
  Integer
idx <- BV -> Integer
bvVal (BV -> Integer) -> Eval BV -> Eval Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue Bool BV Integer -> Eval BV
forall b w i. BitWord b w i => WordValue b w i -> Eval w
asWordVal WordValue Bool BV Integer
w
  Bool -> Eval () -> Eval ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
idx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n) (Integer -> Eval ()
forall a. Integer -> Eval a
invalidIndex Integer
idx)
  SeqValMap -> Eval SeqValMap
forall (m :: * -> *) a. Monad m => a -> m a
return (SeqValMap -> Eval SeqValMap) -> SeqValMap -> Eval SeqValMap
forall a b. (a -> b) -> a -> b
$ SeqValMap
-> Integer -> Eval (GenValue Bool BV Integer) -> SeqValMap
forall b w i.
SeqMap b w i -> Integer -> Eval (GenValue b w i) -> SeqMap b w i
updateSeqMap SeqValMap
vs (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
idx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) Eval (GenValue Bool BV Integer)
val

updateBack_word
 :: Nat'
 -> TValue
 -> WordValue Bool BV Integer
 -> WordValue Bool BV Integer
 -> Eval (GenValue Bool BV Integer)
 -> Eval (WordValue Bool BV Integer)
updateBack_word :: Nat'
-> TValue
-> WordValue Bool BV Integer
-> WordValue Bool BV Integer
-> Eval (GenValue Bool BV Integer)
-> Eval (WordValue Bool BV Integer)
updateBack_word Inf _eltTy :: TValue
_eltTy _bs :: WordValue Bool BV Integer
_bs _w :: WordValue Bool BV Integer
_w _val :: Eval (GenValue Bool BV Integer)
_val =
  String -> [String] -> Eval (WordValue Bool BV Integer)
forall a. HasCallStack => String -> [String] -> a
evalPanic "Unexpected infinite sequence in updateEnd" []
updateBack_word (Nat n :: Integer
n) _eltTy :: TValue
_eltTy bs :: WordValue Bool BV Integer
bs w :: WordValue Bool BV Integer
w val :: Eval (GenValue Bool BV Integer)
val = do
  Integer
idx <- BV -> Integer
bvVal (BV -> Integer) -> Eval BV -> Eval Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordValue Bool BV Integer -> Eval BV
forall b w i. BitWord b w i => WordValue b w i -> Eval w
asWordVal WordValue Bool BV Integer
w
  WordValue Bool BV Integer
-> Integer -> Eval Bool -> Eval (WordValue Bool BV Integer)
forall b w i.
BitWord b w i =>
WordValue b w i -> Integer -> Eval b -> Eval (WordValue b w i)
updateWordValue WordValue Bool BV Integer
bs (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
idx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) (GenValue Bool BV Integer -> Eval Bool
forall b w i. GenValue b w i -> Eval b
fromBit (GenValue Bool BV Integer -> Eval Bool)
-> Eval (GenValue Bool BV Integer) -> Eval Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue Bool BV Integer)
val)

{-
  idx <- bvVal <$> asWordVal w
  unless (idx < n) (invalidIndex idx)
  let idx' = n - idx - 1
  return $! Seq.update (fromInteger idx') (fromVBit <$> val) bs
-}


updatePrim
     :: BitWord b w i
     => (Nat' -> TValue -> WordValue b w i -> WordValue b w i -> Eval (GenValue b w i) -> Eval (WordValue b w i))
     -> (Nat' -> TValue -> SeqMap b w i    -> WordValue b w i -> Eval (GenValue b w i) -> Eval (SeqMap b w i))
     -> GenValue b w i
updatePrim :: (Nat'
 -> TValue
 -> WordValue b w i
 -> WordValue b w i
 -> Eval (GenValue b w i)
 -> Eval (WordValue b w i))
-> (Nat'
    -> TValue
    -> SeqMap b w i
    -> WordValue b w i
    -> Eval (GenValue b w i)
    -> Eval (SeqMap b w i))
-> GenValue b w i
updatePrim updateWord :: Nat'
-> TValue
-> WordValue b w i
-> WordValue b w i
-> Eval (GenValue b w i)
-> Eval (WordValue b w i)
updateWord updateSeq :: Nat'
-> TValue
-> SeqMap b w i
-> WordValue b w i
-> Eval (GenValue b w i)
-> Eval (SeqMap b w i)
updateSeq =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \len :: Nat'
len ->
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \eltTy :: TValue
eltTy ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \_idxLen :: Nat'
_idxLen ->
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \xs :: Eval (GenValue b w i)
xs  -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \idx :: Eval (GenValue b w i)
idx -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \val :: Eval (GenValue b w i)
val -> do
    WordValue b w i
idx' <- String -> GenValue b w i -> Eval (WordValue b w i)
forall b w i. String -> GenValue b w i -> Eval (WordValue b w i)
fromWordVal "update" (GenValue b w i -> Eval (WordValue b w i))
-> Eval (GenValue b w i) -> Eval (WordValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eval (GenValue b w i)
idx
    Eval (GenValue b w i)
xs Eval (GenValue b w i)
-> (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VWord l :: Integer
l w :: Eval (WordValue b w i)
w  -> do Eval (WordValue b w i)
w' <- Maybe String
-> Eval (WordValue b w i) -> Eval (Eval (WordValue b w i))
forall a. Maybe String -> Eval a -> Eval (Eval a)
delay Maybe String
forall a. Maybe a
Nothing Eval (WordValue b w i)
w
                       GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
l (Eval (WordValue b w i)
w' Eval (WordValue b w i)
-> (WordValue b w i -> Eval (WordValue b w i))
-> Eval (WordValue b w i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w'' :: WordValue b w i
w'' -> Nat'
-> TValue
-> WordValue b w i
-> WordValue b w i
-> Eval (GenValue b w i)
-> Eval (WordValue b w i)
updateWord Nat'
len TValue
eltTy WordValue b w i
w'' WordValue b w i
idx' Eval (GenValue b w i)
val)
      VSeq l :: Integer
l vs :: SeqMap b w i
vs  -> Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
l  (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Nat'
-> TValue
-> SeqMap b w i
-> WordValue b w i
-> Eval (GenValue b w i)
-> Eval (SeqMap b w i)
updateSeq Nat'
len TValue
eltTy SeqMap b w i
vs WordValue b w i
idx' Eval (GenValue b w i)
val
      VStream vs :: SeqMap b w i
vs -> SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i)
-> Eval (SeqMap b w i) -> Eval (GenValue b w i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Nat'
-> TValue
-> SeqMap b w i
-> WordValue b w i
-> Eval (GenValue b w i)
-> Eval (SeqMap b w i)
updateSeq Nat'
len TValue
eltTy SeqMap b w i
vs WordValue b w i
idx' Eval (GenValue b w i)
val
      _ -> String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
evalPanic "Expected sequence value" ["updatePrim"]

-- @[ 0 .. 10 ]@
fromToV :: BitWord b w i
        => GenValue b w i
fromToV :: GenValue b w i
fromToV  =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ first :: Nat'
first ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ lst :: Nat'
lst   ->
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ ty :: TValue
ty    ->
    let !f :: Integer -> GenValue b w i
f = TValue -> Integer -> GenValue b w i
forall b w i. BitWord b w i => TValue -> Integer -> GenValue b w i
mkLit TValue
ty in
    case (Nat'
first, Nat'
lst) of
      (Nat first' :: Integer
first', Nat lst' :: Integer
lst') ->
        let len :: Integer
len = 1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
lst' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
first')
        in Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
len (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i -> GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> GenValue b w i
f (Integer
first' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)
      _ -> String -> [String] -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "fromToV" ["invalid arguments"]

-- @[ 0, 1 .. 10 ]@
fromThenToV :: BitWord b w i
            => GenValue b w i
fromThenToV :: GenValue b w i
fromThenToV  =
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ first :: Nat'
first ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ next :: Nat'
next  ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ lst :: Nat'
lst   ->
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ ty :: TValue
ty    ->
  (Nat' -> GenValue b w i) -> GenValue b w i
forall b w i. (Nat' -> GenValue b w i) -> GenValue b w i
nlam ((Nat' -> GenValue b w i) -> GenValue b w i)
-> (Nat' -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ len :: Nat'
len   ->
    let !f :: Integer -> GenValue b w i
f = TValue -> Integer -> GenValue b w i
forall b w i. BitWord b w i => TValue -> Integer -> GenValue b w i
mkLit TValue
ty in
    case (Nat'
first, Nat'
next, Nat'
lst, Nat'
len) of
      (Nat first' :: Integer
first', Nat next' :: Integer
next', Nat _lst' :: Integer
_lst', Nat len' :: Integer
len') ->
        let diff :: Integer
diff = Integer
next' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
first'
        in Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
len' (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i -> GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> GenValue b w i
f (Integer
first' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
diff)
      _ -> String -> [String] -> GenValue b w i
forall a. HasCallStack => String -> [String] -> a
evalPanic "fromThenToV" ["invalid arguments"]


infFromV :: BitWord b w i => GenValue b w i
infFromV :: GenValue b w i
infFromV =
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ ty :: TValue
ty ->
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam  ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ x' :: Eval (GenValue b w i)
x' ->
  GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
  do GenValue b w i
x <- Eval (GenValue b w i)
x'
     Binary b w i
forall b w i. BitWord b w i => Binary b w i
addV TValue
ty GenValue b w i
x (i -> TValue -> GenValue b w i
forall b w i. BitWord b w i => i -> TValue -> GenValue b w i
intV (Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit Integer
i) TValue
ty)

infFromThenV :: BitWord b w i => GenValue b w i
infFromThenV :: GenValue b w i
infFromThenV =
  (TValue -> GenValue b w i) -> GenValue b w i
forall b w i. (TValue -> GenValue b w i) -> GenValue b w i
tlam ((TValue -> GenValue b w i) -> GenValue b w i)
-> (TValue -> GenValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ ty :: TValue
ty ->
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ first :: Eval (GenValue b w i)
first -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$
  (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam ((Eval (GenValue b w i) -> Eval (GenValue b w i))
 -> GenValue b w i)
-> (Eval (GenValue b w i) -> Eval (GenValue b w i))
-> GenValue b w i
forall a b. (a -> b) -> a -> b
$ \ next :: Eval (GenValue b w i)
next ->
  do GenValue b w i
x <- Eval (GenValue b w i)
first
     GenValue b w i
y <- Eval (GenValue b w i)
next
     GenValue b w i
d <- Binary b w i
forall b w i. BitWord b w i => Binary b w i
subV TValue
ty GenValue b w i
y GenValue b w i
x
     GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \i :: Integer
i ->
       Binary b w i
forall b w i. BitWord b w i => Binary b w i
addV TValue
ty GenValue b w i
x (GenValue b w i -> Eval (GenValue b w i))
-> Eval (GenValue b w i) -> Eval (GenValue b w i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Binary b w i
forall b w i. BitWord b w i => Binary b w i
mulV TValue
ty GenValue b w i
d (i -> TValue -> GenValue b w i
forall b w i. BitWord b w i => i -> TValue -> GenValue b w i
intV (Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit Integer
i) TValue
ty)

-- Random Values ---------------------------------------------------------------

-- | Produce a random value with the given seed. If we do not support
-- making values of the given type, return zero of that type.
-- TODO: do better than returning zero
randomV :: BitWord b w i => TValue -> Integer -> GenValue b w i
randomV :: TValue -> Integer -> GenValue b w i
randomV ty :: TValue
ty seed :: Integer
seed =
  case Type -> Maybe (Gen TFGen b w i)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue (TValue -> Type
tValTy TValue
ty) of
    Nothing -> TValue -> GenValue b w i
forall b w i. BitWord b w i => TValue -> GenValue b w i
zeroV TValue
ty
    Just gen :: Gen TFGen b w i
gen ->
      -- unpack the seed into four Word64s
      let mask64 :: Integer
mask64 = 0xFFFFFFFFFFFFFFFF
          unpack :: Integer -> [a]
unpack s :: Integer
s = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
s Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask64) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a]
unpack (Integer
s Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` 64)
          [a :: Word64
a, b :: Word64
b, c :: Word64
c, d :: Word64
d] = Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take 4 (Integer -> [Word64]
forall a. Num a => Integer -> [a]
unpack Integer
seed)
      in (GenValue b w i, TFGen) -> GenValue b w i
forall a b. (a, b) -> a
fst ((GenValue b w i, TFGen) -> GenValue b w i)
-> (GenValue b w i, TFGen) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ Gen TFGen b w i
gen 100 (TFGen -> (GenValue b w i, TFGen))
-> TFGen -> (GenValue b w i, TFGen)
forall a b. (a -> b) -> a -> b
$ (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen (Word64
a, Word64
b, Word64
c, Word64
d)

-- Miscellaneous ---------------------------------------------------------------

errorV :: forall b w i
       . BitWord b w i
      => TValue
      -> String
      -> Eval (GenValue b w i)
errorV :: TValue -> String -> Eval (GenValue b w i)
errorV ty :: TValue
ty msg :: String
msg = case TValue
ty of
  -- bits
  TVBit -> String -> Eval (GenValue b w i)
forall a. String -> Eval a
cryUserError String
msg
  TVInteger -> String -> Eval (GenValue b w i)
forall a. String -> Eval a
cryUserError String
msg
  TVIntMod _ -> String -> Eval (GenValue b w i)
forall a. String -> Eval a
cryUserError String
msg

  -- sequences
  TVSeq w :: Integer
w ety :: TValue
ety
     | TValue -> Bool
isTBit TValue
ety -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w (Eval (WordValue b w i) -> GenValue b w i)
-> Eval (WordValue b w i) -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ WordValue b w i -> Eval (WordValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordValue b w i -> Eval (WordValue b w i))
-> WordValue b w i -> Eval (WordValue b w i)
forall a b. (a -> b) -> a -> b
$ Seq (Eval b) -> WordValue b w i
forall b w i. Seq (Eval b) -> WordValue b w i
BitsVal (Seq (Eval b) -> WordValue b w i)
-> Seq (Eval b) -> WordValue b w i
forall a b. (a -> b) -> a -> b
$
                         Int -> Eval b -> Seq (Eval b)
forall a. Int -> a -> Seq a
Seq.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
w) (String -> Eval b
forall a. String -> Eval a
cryUserError String
msg)
     | Bool
otherwise  -> GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \_ -> TValue -> String -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
TValue -> String -> Eval (GenValue b w i)
errorV TValue
ety String
msg)

  TVStream ety :: TValue
ety ->
    GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ \_ -> TValue -> String -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
TValue -> String -> Eval (GenValue b w i)
errorV TValue
ety String
msg)

  -- functions
  TVFun _ bty :: TValue
bty ->
    GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ (Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
forall b w i.
(Eval (GenValue b w i) -> Eval (GenValue b w i)) -> GenValue b w i
lam (\ _ -> TValue -> String -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
TValue -> String -> Eval (GenValue b w i)
errorV TValue
bty String
msg)

  -- tuples
  TVTuple tys :: [TValue]
tys ->
    GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ((TValue -> Eval (GenValue b w i))
-> [TValue] -> [Eval (GenValue b w i)]
forall a b. (a -> b) -> [a] -> [b]
map ((TValue -> String -> Eval (GenValue b w i))
-> String -> TValue -> Eval (GenValue b w i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TValue -> String -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
TValue -> String -> Eval (GenValue b w i)
errorV String
msg) [TValue]
tys)

  -- records
  TVRec fields :: [(Ident, TValue)]
fields ->
    GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue b w i -> Eval (GenValue b w i))
-> GenValue b w i -> Eval (GenValue b w i)
forall a b. (a -> b) -> a -> b
$ [(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord [ (Ident
f,TValue -> String -> Eval (GenValue b w i)
forall b w i.
BitWord b w i =>
TValue -> String -> Eval (GenValue b w i)
errorV TValue
fty String
msg) | (f :: Ident
f,fty :: TValue
fty) <- [(Ident, TValue)]
fields ]

  TVAbstract {} -> String -> Eval (GenValue b w i)
forall a. String -> Eval a
cryUserError String
msg