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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
-- See Note [-Wincomplete-uni-patterns and irrefutable patterns] in Cryptol.TypeCheck.TypePat
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Cryptol.Eval.Generic where

import qualified Control.Exception as X
import Control.Monad(join)
import Control.Monad.IO.Class (MonadIO(..))
import System.Random.TF.Gen (seedTFGen)

import Data.Bits ((.&.), shiftR)
import Data.Maybe (fromMaybe)
import qualified Data.Map.Strict as Map
import Data.Map(Map)
import Data.Ratio ((%))

import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.Solver.InfNat (Nat'(..),nMul,nAdd)
import Cryptol.Backend
import Cryptol.Backend.Concrete (Concrete(..))
import Cryptol.Backend.Monad( Eval, evalPanic, EvalError(..), Unsupported(..) )
import Cryptol.Backend.SeqMap
import Cryptol.Backend.WordValue
import Cryptol.Testing.Random( randomValue )

import Cryptol.Eval.Prims
import Cryptol.Eval.Type
import Cryptol.Eval.Value
import Cryptol.Utils.Ident (PrimIdent, prelPrim, floatPrim)
import Cryptol.Utils.Logger(logPrint)
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.PP
import Cryptol.Utils.RecordMap


{-# SPECIALIZE mkLit :: Concrete -> TValue -> Integer -> Eval (GenValue Concrete)
  #-}

-- | Make a numeric literal value at the given type.
mkLit :: Backend sym => sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit :: forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty Integer
i =
  case TValue
ty of
    TValue
TVBit                        -> GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0))
    TValue
TVInteger                    -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
i
    TVIntMod Integer
m
      | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0                   -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"mkLit" [String
"0 modulus not allowed"]
      | Bool
otherwise                -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m)
    TVFloat Integer
e Integer
p                  -> SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
fpLit sym
sym Integer
e Integer
p (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i)
    TVSeq Integer
w TValue
TVBit                -> sym -> Integer -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (GenValue sym)
word sym
sym Integer
w Integer
i
    TValue
TVRational                   -> SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> SInteger sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SEval sym (SRational sym)
intToRational sym
sym (SInteger sym -> SEval sym (SRational sym))
-> SEval sym (SInteger sym) -> SEval sym (SRational sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
i)
    TValue
_                            -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"Cryptol.Eval.Prim.evalConst"
                                    [ String
"Invalid type for number" ]

{-# SPECIALIZE ecNumberV :: Concrete -> Prim Concrete
  #-}

-- | Make a numeric constant.
ecNumberV :: Backend sym => sym -> Prim sym
ecNumberV :: forall sym. Backend sym => sym -> Prim sym
ecNumberV sym
sym =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
valT ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
  case Nat'
valT of
    Nat Integer
v -> sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty Integer
v
    Nat'
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"Cryptol.Eval.Prim.evalConst"
             [String
"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
             ]


{-# SPECIALIZE intV :: Concrete -> Integer -> TValue -> Eval (GenValue Concrete)
  #-}
intV :: Backend sym => sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV :: forall sym.
Backend sym =>
sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV sym
sym SInteger sym
i =
  sym
-> (Integer -> SEval sym (SWord sym))
-> SEval sym (SInteger sym)
-> (Integer -> SEval sym (SInteger sym))
-> SEval sym (SRational sym)
-> (Integer -> Integer -> SEval sym (SFloat sym))
-> TValue
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (Integer -> SEval sym (SWord sym))
-> SEval sym (SInteger sym)
-> (Integer -> SEval sym (SInteger sym))
-> SEval sym (SRational sym)
-> (Integer -> Integer -> SEval sym (SFloat sym))
-> TValue
-> SEval sym (GenValue sym)
ringNullary sym
sym
    (\Integer
w -> sym -> Integer -> SInteger sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SWord sym)
wordFromInt sym
sym Integer
w SInteger sym
i)
    (SInteger sym -> SEval sym (SInteger sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SInteger sym
i)
    (\Integer
m -> sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
intToZn sym
sym Integer
m SInteger sym
i)
    (sym -> SInteger sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SEval sym (SRational sym)
intToRational sym
sym SInteger sym
i)
    (\Integer
e Integer
p -> sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SFloat sym)) -> SEval sym (SFloat sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> sym
-> Integer
-> Integer
-> SWord sym
-> SInteger sym
-> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym
-> Integer
-> Integer
-> SWord sym
-> SInteger sym
-> SEval sym (SFloat sym)
fpFromInteger sym
sym Integer
e Integer
p SWord sym
r SInteger sym
i)

{-# SPECIALIZE ratioV :: Concrete -> Prim Concrete #-}
ratioV :: Backend sym => sym -> Prim sym
ratioV :: forall sym. Backend sym => sym -> Prim sym
ratioV sym
sym =
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun   \SEval sym (GenValue sym)
x ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun   \SEval sym (GenValue sym)
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do SInteger sym
x' <- GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SInteger sym)
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
x
       SInteger sym
y' <- GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SInteger sym)
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
y
       SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SInteger sym -> SInteger sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SRational sym)
ratio sym
sym SInteger sym
x' SInteger sym
y'

{-# SPECIALIZE ecFractionV :: Concrete -> Prim Concrete
  #-}
ecFractionV :: Backend sym => sym -> Prim sym
ecFractionV :: forall sym. Backend sym => sym -> Prim sym
ecFractionV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
n  ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
d  ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_r ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    case TValue
ty of
      TVFloat Integer
e Integer
p -> SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
fpLit sym
sym Integer
e Integer
p (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
d)
      TValue
TVRational ->
        do SInteger sym
x <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
n
           SInteger sym
y <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
d
           SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SInteger sym -> SInteger sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SRational sym)
ratio sym
sym SInteger sym
x SInteger sym
y

      TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ecFractionV"
            [ String
"Unexpected `FLiteral` type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TValue -> String
forall a. Show a => a -> String
show TValue
ty ]



{-# SPECIALIZE fromZV :: Concrete -> Prim Concrete #-}
fromZV :: Backend sym => sym -> Prim sym
fromZV :: forall sym. Backend sym => sym -> Prim sym
fromZV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
n ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
v ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    (SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
znToInt sym
sym Integer
n (SInteger sym -> SEval sym (SInteger sym))
-> (GenValue sym -> SInteger sym)
-> GenValue sym
-> SEval sym (SInteger sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SEval sym (SInteger sym))
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
v))

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


type Binary sym = TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)

{-# SPECIALIZE binary :: Binary Concrete -> Prim Concrete
  #-}
binary :: Backend sym => Binary sym -> Prim sym
binary :: forall sym. Backend sym => Binary sym -> Prim sym
binary Binary sym
f = (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ty ->
           (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
a  ->
           (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
b  ->
           SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$
             do GenValue sym
x <- SEval sym (GenValue sym)
a
                GenValue sym
y <- SEval sym (GenValue sym)
b
                Binary sym
f TValue
ty GenValue sym
x GenValue sym
y

type Unary sym = TValue -> GenValue sym -> SEval sym (GenValue sym)

{-# SPECIALIZE unary :: Unary Concrete -> Prim Concrete
  #-}
unary :: Backend sym => Unary sym -> Prim sym
unary :: forall sym. Backend sym => Unary sym -> Prim sym
unary Unary sym
f = (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ty ->
          (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
a  ->
          SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (Unary sym
f TValue
ty (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
a)

type BinWord sym = Integer -> SWord sym -> SWord sym -> SEval sym (SWord sym)

{-# SPECIALIZE ringBinary :: Concrete -> BinWord Concrete ->
      (SInteger Concrete -> SInteger Concrete -> SEval Concrete (SInteger Concrete)) ->
      (Integer -> SInteger Concrete -> SInteger Concrete -> SEval Concrete (SInteger Concrete)) ->
      (SRational Concrete -> SRational Concrete -> SEval Concrete (SRational Concrete)) ->
      (SFloat Concrete -> SFloat Concrete -> SEval Concrete (SFloat Concrete)) ->
      Binary Concrete
  #-}

ringBinary :: forall sym.
  Backend sym =>
  sym ->
  BinWord sym ->
  (SInteger sym -> SInteger sym -> SEval sym (SInteger sym)) ->
  (Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)) ->
  (SRational sym -> SRational sym -> SEval sym (SRational sym)) ->
  (SFloat sym -> SFloat sym -> SEval sym (SFloat sym)) ->
  Binary sym
ringBinary :: forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> Binary sym
ringBinary sym
sym BinWord sym
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp = TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop
  where
  loop' :: TValue
        -> SEval sym (GenValue sym)
        -> SEval sym (GenValue sym)
        -> SEval sym (GenValue sym)
  loop' :: TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' TValue
ty SEval sym (GenValue sym)
l SEval sym (GenValue sym)
r = SEval sym (SEval sym (GenValue sym)) -> SEval sym (GenValue sym)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty (GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
l SEval sym (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall a b. SEval sym (a -> b) -> SEval sym a -> SEval sym b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SEval sym (GenValue sym)
r)

  loop :: TValue
       -> GenValue sym
       -> GenValue sym
       -> SEval sym (GenValue sym)
  loop :: TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty GenValue sym
l GenValue sym
r = case TValue
ty of
    TValue
TVBit ->
      String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ringBinary" [String
"Bit not in class Ring"]

    TValue
TVInteger ->
      SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
l) (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
r)

    TVIntMod Integer
n ->
      SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz Integer
n (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
l) (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
r)

    TVFloat {} ->
      SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp (GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat GenValue sym
l) (GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat GenValue sym
r)

    TValue
TVRational ->
      SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SRational sym -> SRational sym -> SEval sym (SRational sym)
opq (GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational GenValue sym
l) (GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational GenValue sym
r)

    TVArray{} ->
      String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"arithBinary" [String
"Array not in class Ring"]

    TVSeq Integer
w TValue
a
      -- words and finite sequences
      | TValue -> Bool
isTBit TValue
a -> do
                  SWord sym
lw <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"ringLeft" GenValue sym
l
                  SWord sym
rw <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"ringRight" GenValue sym
r
                  CallStack
stk <- sym -> SEval sym CallStack
forall sym. Backend sym => sym -> SEval sym CallStack
sGetCallStack sym
sym
                  WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> CallStack -> SEval sym (SWord sym) -> SEval sym (SWord sym)
forall a. sym -> CallStack -> SEval sym a -> SEval sym a
forall sym a.
Backend sym =>
sym -> CallStack -> SEval sym a -> SEval sym a
sWithCallStack sym
sym CallStack
stk (BinWord sym
opw Integer
w SWord sym
lw SWord sym
rw))
      | Bool
otherwise -> do
        SeqMap sym (GenValue sym)
vals <- (SEval sym (SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (sym
-> (GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
zipSeqMap sym
sym (TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
a) (Integer -> Nat'
Nat Integer
w) (SeqMap sym (GenValue sym)
 -> SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval
     sym
     (SeqMap sym (GenValue sym)
      -> SEval sym (SeqMap sym (GenValue sym)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ringBinary left" GenValue sym
l) SEval
  sym
  (SeqMap sym (GenValue sym)
   -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall a b. SEval sym (a -> b) -> SEval sym a -> SEval sym b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                  (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ringBinary right" GenValue sym
r)))
        sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
a SeqMap sym (GenValue sym)
vals

    TVStream TValue
a ->
      -- streams
      SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SEval sym (SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (sym
-> (GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
zipSeqMap sym
sym (TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
a) Nat'
Inf (SeqMap sym (GenValue sym)
 -> SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval
     sym
     (SeqMap sym (GenValue sym)
      -> SEval sym (SeqMap sym (GenValue sym)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ringBinary left" GenValue sym
l) SEval
  sym
  (SeqMap sym (GenValue sym)
   -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall a b. SEval sym (a -> b) -> SEval sym a -> SEval sym b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                             (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ringBinary right" GenValue sym
r)))

    -- functions
    TVFun TValue
_ TValue
ety ->
      sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
lam sym
sym ((SEval sym (GenValue sym) -> SEval sym (GenValue sym))
 -> SEval sym (GenValue sym))
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \ SEval sym (GenValue sym)
x -> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' TValue
ety (sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym GenValue sym
l SEval sym (GenValue sym)
x) (sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym GenValue sym
r SEval sym (GenValue sym)
x)

    -- tuples
    TVTuple [TValue]
tys ->
      do [SEval sym (GenValue sym)]
ls <- (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym (GenValue sym)]
-> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
l)
         [SEval sym (GenValue sym)]
rs <- (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym (GenValue sym)]
-> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
r)
         GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ [SEval sym (GenValue sym)] -> GenValue sym
forall sym. [SEval sym (GenValue sym)] -> GenValue sym
VTuple ((TValue
 -> SEval sym (GenValue sym)
 -> SEval sym (GenValue sym)
 -> SEval sym (GenValue sym))
-> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' [TValue]
tys [SEval sym (GenValue sym)]
ls [SEval sym (GenValue sym)]
rs)

    -- records
    TVRec RecordMap Ident TValue
fs ->
      do RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
forall sym.
RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
VRecord (RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym)
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (Ident -> TValue -> SEval sym (SEval sym (GenValue sym)))
-> RecordMap Ident TValue
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap
              (\Ident
f TValue
fty -> sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' TValue
fty (Ident -> GenValue sym -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
Ident -> GenValue sym -> SEval sym (GenValue sym)
lookupRecord Ident
f GenValue sym
l) (Ident -> GenValue sym -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
Ident -> GenValue sym -> SEval sym (GenValue sym)
lookupRecord Ident
f GenValue sym
r)))
              RecordMap Ident TValue
fs

    TVNominal {} ->
      String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ringBinary" [String
"Nominal type not in `Ring`"]

type UnaryWord sym = Integer -> SWord sym -> SEval sym (SWord sym)


{-# SPECIALIZE ringUnary ::
  Concrete ->
  UnaryWord Concrete ->
  (SInteger Concrete -> SEval Concrete (SInteger Concrete)) ->
  (Integer -> SInteger Concrete -> SEval Concrete (SInteger Concrete)) ->
  (SRational Concrete -> SEval Concrete (SRational Concrete)) ->
  (SFloat Concrete -> SEval Concrete (SFloat Concrete)) ->
  Unary Concrete
  #-}
ringUnary :: forall sym.
  Backend sym =>
  sym ->
  UnaryWord sym ->
  (SInteger sym -> SEval sym (SInteger sym)) ->
  (Integer -> SInteger sym -> SEval sym (SInteger sym)) ->
  (SRational sym -> SEval sym (SRational sym)) ->
  (SFloat sym -> SEval sym (SFloat sym)) ->
  Unary sym
ringUnary :: forall sym.
Backend sym =>
sym
-> UnaryWord sym
-> (SInteger sym -> SEval sym (SInteger sym))
-> (Integer -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SEval sym (SFloat sym))
-> Unary sym
ringUnary sym
sym UnaryWord sym
opw SInteger sym -> SEval sym (SInteger sym)
opi Integer -> SInteger sym -> SEval sym (SInteger sym)
opz SRational sym -> SEval sym (SRational sym)
opq SFloat sym -> SEval sym (SFloat sym)
opfp = TValue -> GenValue sym -> SEval sym (GenValue sym)
loop
  where
  loop' :: TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
  loop' :: TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' TValue
ty SEval sym (GenValue sym)
v = TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
v

  loop :: TValue -> GenValue sym -> SEval sym (GenValue sym)
  loop :: TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty GenValue sym
v = case TValue
ty of

    TValue
TVBit ->
      String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ringUnary" [String
"Bit not in class Ring"]

    TValue
TVInteger ->
      SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SInteger sym -> SEval sym (SInteger sym)
opi (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
v)

    TVIntMod Integer
n ->
      SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> SInteger sym -> SEval sym (SInteger sym)
opz Integer
n (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
v)

    TVFloat {} ->
      SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SFloat sym -> SEval sym (SFloat sym)
opfp (GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat GenValue sym
v)

    TValue
TVRational ->
      SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SRational sym -> SEval sym (SRational sym)
opq (GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational GenValue sym
v)

    TVArray{} ->
      String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"arithUnary" [String
"Array not in class Ring"]

    TVSeq Integer
w TValue
a
      -- words and finite sequences
      | TValue -> Bool
isTBit TValue
a -> do
              SWord sym
wx <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"ringUnary" GenValue sym
v
              CallStack
stk <- sym -> SEval sym CallStack
forall sym. Backend sym => sym -> SEval sym CallStack
sGetCallStack sym
sym
              WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> CallStack -> SEval sym (SWord sym) -> SEval sym (SWord sym)
forall a. sym -> CallStack -> SEval sym a -> SEval sym a
forall sym a.
Backend sym =>
sym -> CallStack -> SEval sym a -> SEval sym a
sWithCallStack sym
sym CallStack
stk (UnaryWord sym
opw Integer
w SWord sym
wx)
      | Bool
otherwise -> do
              SeqMap sym (GenValue sym)
vals <- sym
-> (GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
mapSeqMap sym
sym (TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
a) (Integer -> Nat'
Nat Integer
w) (SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ringUnary" GenValue sym
v
              sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
a SeqMap sym (GenValue sym)
vals

    TVStream TValue
a ->
      SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym
-> (GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
mapSeqMap sym
sym (TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
a) Nat'
Inf (SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ringUnary" GenValue sym
v)

    -- functions
    TVFun TValue
_ TValue
ety ->
      sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
lam sym
sym ((SEval sym (GenValue sym) -> SEval sym (GenValue sym))
 -> SEval sym (GenValue sym))
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \ SEval sym (GenValue sym)
y -> TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' TValue
ety (sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym GenValue sym
v SEval sym (GenValue sym)
y)

    -- tuples
    TVTuple [TValue]
tys ->
      do [SEval sym (GenValue sym)]
as <- (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym (GenValue sym)]
-> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
v)
         GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ [SEval sym (GenValue sym)] -> GenValue sym
forall sym. [SEval sym (GenValue sym)] -> GenValue sym
VTuple ((TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' [TValue]
tys [SEval sym (GenValue sym)]
as)

    -- records
    TVRec RecordMap Ident TValue
fs ->
      RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
forall sym.
RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
VRecord (RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym)
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Ident -> TValue -> SEval sym (SEval sym (GenValue sym)))
-> RecordMap Ident TValue
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap
          (\Ident
f TValue
fty -> sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' TValue
fty (Ident -> GenValue sym -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
Ident -> GenValue sym -> SEval sym (GenValue sym)
lookupRecord Ident
f GenValue sym
v)))
          RecordMap Ident TValue
fs

    TVNominal {} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ringUnary" [String
"Nominal type not in `Ring`"]


{-# SPECIALIZE ringNullary ::
  Concrete ->
  (Integer -> SEval Concrete (SWord Concrete)) ->
  SEval Concrete (SInteger Concrete) ->
  (Integer -> SEval Concrete (SInteger Concrete)) ->
  SEval Concrete (SRational Concrete) ->
  (Integer -> Integer -> SEval Concrete (SFloat Concrete)) ->
  TValue ->
  SEval Concrete (GenValue Concrete)
  #-}

ringNullary :: forall sym.
  Backend sym =>
  sym ->
  (Integer -> SEval sym (SWord sym)) ->
  SEval sym (SInteger sym) ->
  (Integer -> SEval sym (SInteger sym)) ->
  SEval sym (SRational sym) ->
  (Integer -> Integer -> SEval sym (SFloat sym)) ->
  TValue ->
  SEval sym (GenValue sym)
ringNullary :: forall sym.
Backend sym =>
sym
-> (Integer -> SEval sym (SWord sym))
-> SEval sym (SInteger sym)
-> (Integer -> SEval sym (SInteger sym))
-> SEval sym (SRational sym)
-> (Integer -> Integer -> SEval sym (SFloat sym))
-> TValue
-> SEval sym (GenValue sym)
ringNullary sym
sym Integer -> SEval sym (SWord sym)
opw SEval sym (SInteger sym)
opi Integer -> SEval sym (SInteger sym)
opz SEval sym (SRational sym)
opq Integer -> Integer -> SEval sym (SFloat sym)
opfp = TValue -> SEval sym (GenValue sym)
loop
  where
    loop :: TValue -> SEval sym (GenValue sym)
    loop :: TValue -> SEval sym (GenValue sym)
loop TValue
ty =
      case TValue
ty of
        TValue
TVBit -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ringNullary" [String
"Bit not in class Ring"]

        TValue
TVInteger -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (SInteger sym)
opi

        TVIntMod Integer
n -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> SEval sym (SInteger sym)
opz Integer
n

        TVFloat Integer
e Integer
p -> SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> SEval sym (SFloat sym)
opfp Integer
e Integer
p

        TValue
TVRational -> SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (SRational sym)
opq

        TVArray{} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"arithNullary" [String
"Array not in class Ring"]

        TVSeq Integer
w TValue
a
          -- words and finite sequences
          | TValue -> Bool
isTBit TValue
a ->
             do CallStack
stk <- sym -> SEval sym CallStack
forall sym. Backend sym => sym -> SEval sym CallStack
sGetCallStack sym
sym
                WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> CallStack -> SEval sym (SWord sym) -> SEval sym (SWord sym)
forall a. sym -> CallStack -> SEval sym a -> SEval sym a
forall sym a.
Backend sym =>
sym -> CallStack -> SEval sym a -> SEval sym a
sWithCallStack sym
sym CallStack
stk (Integer -> SEval sym (SWord sym)
opw Integer
w)
          | Bool
otherwise ->
             do SEval sym (GenValue sym)
v <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue -> SEval sym (GenValue sym)
loop TValue
a)
                sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
a (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap \Integer
_i -> SEval sym (GenValue sym)
v

        TVStream TValue
a ->
             do SEval sym (GenValue sym)
v <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue -> SEval sym (GenValue sym)
loop TValue
a)
                GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap \Integer
_i -> SEval sym (GenValue sym)
v

        TVFun TValue
_ TValue
b ->
             do SEval sym (GenValue sym)
v <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue -> SEval sym (GenValue sym)
loop TValue
b)
                sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
lam sym
sym (SEval sym (GenValue sym)
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. a -> b -> a
const SEval sym (GenValue sym)
v)

        TVTuple [TValue]
tys ->
             do [SEval sym (GenValue sym)]
xs <- (TValue -> SEval sym (SEval sym (GenValue sym)))
-> [TValue] -> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> (TValue -> SEval sym (GenValue sym))
-> TValue
-> SEval sym (SEval sym (GenValue sym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TValue -> SEval sym (GenValue sym)
loop) [TValue]
tys
                GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ [SEval sym (GenValue sym)] -> GenValue sym
forall sym. [SEval sym (GenValue sym)] -> GenValue sym
VTuple [SEval sym (GenValue sym)]
xs

        TVRec RecordMap Ident TValue
fs ->
             do RecordMap Ident (SEval sym (GenValue sym))
xs <- (TValue -> SEval sym (SEval sym (GenValue sym)))
-> RecordMap Ident TValue
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordMap Ident a -> f (RecordMap Ident b)
traverse (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> (TValue -> SEval sym (GenValue sym))
-> TValue
-> SEval sym (SEval sym (GenValue sym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TValue -> SEval sym (GenValue sym)
loop) RecordMap Ident TValue
fs
                GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
forall sym.
RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
VRecord RecordMap Ident (SEval sym (GenValue sym))
xs

        TVNominal {} ->
          String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"ringNullary" [String
"Nominal type not in `Ring`"]

{-# SPECIALIZE integralBinary :: Concrete -> BinWord Concrete ->
      (SInteger Concrete -> SInteger Concrete -> SEval Concrete (SInteger Concrete)) ->
      Binary Concrete
  #-}

integralBinary :: forall sym.
  Backend sym =>
  sym ->
  BinWord sym ->
  (SInteger sym -> SInteger sym -> SEval sym (SInteger sym)) ->
  Binary sym
integralBinary :: forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> Binary sym
integralBinary sym
sym BinWord sym
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi TValue
ty GenValue sym
l GenValue sym
r = case TValue
ty of
    TValue
TVInteger ->
      SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
l) (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
r)

    -- bitvectors
    TVSeq Integer
w TValue
a
      | TValue -> Bool
isTBit TValue
a ->
          do SWord sym
wl <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"integralBinary left" GenValue sym
l
             SWord sym
wr <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"integralBinary right" GenValue sym
r
             CallStack
stk <- sym -> SEval sym CallStack
forall sym. Backend sym => sym -> SEval sym CallStack
sGetCallStack sym
sym
             WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> CallStack -> SEval sym (SWord sym) -> SEval sym (SWord sym)
forall a. sym -> CallStack -> SEval sym a -> SEval sym a
forall sym a.
Backend sym =>
sym -> CallStack -> SEval sym a -> SEval sym a
sWithCallStack sym
sym CallStack
stk (BinWord sym
opw Integer
w SWord sym
wl SWord sym
wr)

    TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"integralBinary" [TValue -> String
forall a. Show a => a -> String
show TValue
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not int class `Integral`"]


---------------------------------------------------------------------------
-- Ring

{-# SPECIALIZE fromIntegerV :: Concrete -> Prim Concrete
  #-}
-- | Convert an unbounded integer to a value in Ring
fromIntegerV :: Backend sym => sym -> Prim sym
fromIntegerV :: forall sym. Backend sym => sym -> Prim sym
fromIntegerV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
a ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
v ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do SInteger sym
i <- GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SInteger sym)
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
v
       sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV sym
sym SInteger sym
i TValue
a

{-# INLINE addV #-}
addV :: Backend sym => sym -> Binary sym
addV :: forall sym. Backend sym => sym -> Binary sym
addV sym
sym = sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> Binary sym
ringBinary sym
sym BinWord sym
forall {p}. p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp
  where
    opw :: p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw p
_w SWord sym
x SWord sym
y = sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordPlus sym
sym SWord sym
x SWord sym
y
    opi :: SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi SInteger sym
x SInteger sym
y = sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
intPlus sym
sym SInteger sym
x SInteger sym
y
    opz :: Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz Integer
m SInteger sym
x SInteger sym
y = sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
znPlus sym
sym Integer
m SInteger sym
x SInteger sym
y
    opq :: SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SRational sym
x SRational sym
y = sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
rationalAdd sym
sym SRational sym
x SRational sym
y
    opfp :: SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp SFloat sym
x SFloat sym
y = sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SFloat sym)) -> SEval sym (SFloat sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpPlus sym
sym SWord sym
r SFloat sym
x SFloat sym
y

{-# INLINE subV #-}
subV :: Backend sym => sym -> Binary sym
subV :: forall sym. Backend sym => sym -> Binary sym
subV sym
sym = sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> Binary sym
ringBinary sym
sym BinWord sym
forall {p}. p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp
  where
    opw :: p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw p
_w SWord sym
x SWord sym
y = sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordMinus sym
sym SWord sym
x SWord sym
y
    opi :: SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi SInteger sym
x SInteger sym
y = sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
intMinus sym
sym SInteger sym
x SInteger sym
y
    opz :: Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz Integer
m SInteger sym
x SInteger sym
y = sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
znMinus sym
sym Integer
m SInteger sym
x SInteger sym
y
    opq :: SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SRational sym
x SRational sym
y = sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
rationalSub sym
sym SRational sym
x SRational sym
y
    opfp :: SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp SFloat sym
x SFloat sym
y = sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SFloat sym)) -> SEval sym (SFloat sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpMinus sym
sym SWord sym
r SFloat sym
x SFloat sym
y

{-# INLINE negateV #-}
negateV :: Backend sym => sym -> Unary sym
negateV :: forall sym. Backend sym => sym -> Unary sym
negateV sym
sym = sym
-> UnaryWord sym
-> (SInteger sym -> SEval sym (SInteger sym))
-> (Integer -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SEval sym (SFloat sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> UnaryWord sym
-> (SInteger sym -> SEval sym (SInteger sym))
-> (Integer -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SEval sym (SFloat sym))
-> Unary sym
ringUnary sym
sym UnaryWord sym
forall {p}. p -> SWord sym -> SEval sym (SWord sym)
opw SInteger sym -> SEval sym (SInteger sym)
opi Integer -> SInteger sym -> SEval sym (SInteger sym)
opz SRational sym -> SEval sym (SRational sym)
opq SFloat sym -> SEval sym (SFloat sym)
opfp
  where
    opw :: p -> SWord sym -> SEval sym (SWord sym)
opw p
_w SWord sym
x = sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SEval sym (SWord sym)
wordNegate sym
sym SWord sym
x
    opi :: SInteger sym -> SEval sym (SInteger sym)
opi SInteger sym
x = sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SEval sym (SInteger sym)
intNegate sym
sym SInteger sym
x
    opz :: Integer -> SInteger sym -> SEval sym (SInteger sym)
opz Integer
m SInteger sym
x = sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
znNegate sym
sym Integer
m SInteger sym
x
    opq :: SRational sym -> SEval sym (SRational sym)
opq SRational sym
x = sym -> SRational sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SRational sym)
rationalNegate sym
sym SRational sym
x
    opfp :: SFloat sym -> SEval sym (SFloat sym)
opfp SFloat sym
x = sym -> SFloat sym -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SFloat sym)
fpNeg sym
sym SFloat sym
x

{-# INLINE mulV #-}
mulV :: Backend sym => sym -> Binary sym
mulV :: forall sym. Backend sym => sym -> Binary sym
mulV sym
sym = sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> (SRational sym -> SRational sym -> SEval sym (SRational sym))
-> (SFloat sym -> SFloat sym -> SEval sym (SFloat sym))
-> Binary sym
ringBinary sym
sym BinWord sym
forall {p}. p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp
  where
    opw :: p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw p
_w SWord sym
x SWord sym
y = sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordMult sym
sym SWord sym
x SWord sym
y
    opi :: SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi SInteger sym
x SInteger sym
y = sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
intMult sym
sym SInteger sym
x SInteger sym
y
    opz :: Integer -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opz Integer
m SInteger sym
x SInteger sym
y = sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
znMult sym
sym Integer
m SInteger sym
x SInteger sym
y
    opq :: SRational sym -> SRational sym -> SEval sym (SRational sym)
opq SRational sym
x SRational sym
y = sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
rationalMul sym
sym SRational sym
x SRational sym
y
    opfp :: SFloat sym -> SFloat sym -> SEval sym (SFloat sym)
opfp SFloat sym
x SFloat sym
y = sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SFloat sym)) -> SEval sym (SFloat sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpMult sym
sym SWord sym
r SFloat sym
x SFloat sym
y

--------------------------------------------------
-- Integral

{-# INLINE divV #-}
divV :: Backend sym => sym -> Binary sym
divV :: forall sym. Backend sym => sym -> Binary sym
divV sym
sym = sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> Binary sym
integralBinary sym
sym BinWord sym
forall {p}. p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi
  where
    opw :: p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw p
_w SWord sym
x SWord sym
y = sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordDiv sym
sym SWord sym
x SWord sym
y
    opi :: SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi SInteger sym
x SInteger sym
y = sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
intDiv sym
sym SInteger sym
x SInteger sym
y

{-# SPECIALIZE expV :: Concrete -> Prim Concrete #-}
expV :: Backend sym => sym -> Prim sym
expV :: forall sym. Backend sym => sym -> Prim sym
expV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
aty ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ety ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
am ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
em ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
     do GenValue sym
a <- SEval sym (GenValue sym)
am
        GenValue sym
e <- SEval sym (GenValue sym)
em
        case TValue
ety of
          TValue
TVInteger ->
            let ei :: SInteger sym
ei = GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
e in
            case sym -> SInteger sym -> Maybe Integer
forall sym. Backend sym => sym -> SInteger sym -> Maybe Integer
integerAsLit sym
sym SInteger sym
ei of
              Just Integer
n
                | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 ->
                   do SInteger sym
onei <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
1
                      sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV sym
sym SInteger sym
onei TValue
aty

                | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 ->
                    do (Integer
_,[SBit sym]
ebits) <- sym -> Integer -> SInteger sym -> SEval sym (Integer, [SBit sym])
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (Integer, [SBit sym])
enumerateIntBits' sym
sym Integer
n SInteger sym
ei
                       sym
-> TValue -> GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> TValue -> GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
computeExponent sym
sym TValue
aty GenValue sym
a [SBit sym]
ebits

                | Bool
otherwise -> sym -> EvalError -> SEval sym (GenValue sym)
forall a. sym -> EvalError -> SEval sym a
forall sym a. Backend sym => sym -> EvalError -> SEval sym a
raiseError sym
sym EvalError
NegativeExponent

              Maybe Integer
Nothing -> IO (GenValue sym) -> SEval sym (GenValue sym)
forall a. IO a -> SEval sym a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Unsupported -> IO (GenValue sym)
forall a e. Exception e => e -> a
X.throw (String -> Unsupported
UnsupportedSymbolicOp String
"integer exponentiation"))

          TVSeq Integer
_w TValue
el | TValue -> Bool
isTBit TValue
el ->
            do [SBit sym]
ebits <- sym -> WordValue sym -> SEval sym [SBit sym]
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym [SBit sym]
enumerateWordValue sym
sym (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"(^^)" GenValue sym
e)
               sym
-> TValue -> GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> TValue -> GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
computeExponent sym
sym TValue
aty GenValue sym
a [SBit sym]
ebits

          TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"expV" [TValue -> String
forall a. Show a => a -> String
show TValue
ety String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not int class `Integral`"]


{-# SPECIALIZE computeExponent ::
      Concrete -> TValue -> GenValue Concrete -> [SBit Concrete] -> SEval Concrete (GenValue Concrete)
  #-}
computeExponent :: Backend sym =>
  sym -> TValue -> GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
computeExponent :: forall sym.
Backend sym =>
sym
-> TValue -> GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
computeExponent sym
sym TValue
aty GenValue sym
a [SBit sym]
bs0 =
  do SInteger sym
onei <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
1
     GenValue sym
one <- sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV sym
sym SInteger sym
onei TValue
aty
     GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
loop GenValue sym
one ([SBit sym] -> [SBit sym]
dropLeadingZeros [SBit sym]
bs0)

 where
 dropLeadingZeros :: [SBit sym] -> [SBit sym]
dropLeadingZeros [] = []
 dropLeadingZeros (SBit sym
b:[SBit sym]
bs)
   | Just Bool
False <- sym -> SBit sym -> Maybe Bool
forall sym. Backend sym => sym -> SBit sym -> Maybe Bool
bitAsLit sym
sym SBit sym
b = [SBit sym] -> [SBit sym]
dropLeadingZeros [SBit sym]
bs
   | Bool
otherwise = (SBit sym
bSBit sym -> [SBit sym] -> [SBit sym]
forall a. a -> [a] -> [a]
:[SBit sym]
bs)

 loop :: GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
loop GenValue sym
acc [] = GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return GenValue sym
acc
 loop GenValue sym
acc (SBit sym
b:[SBit sym]
bs) =
   do GenValue sym
sq <- sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
mulV sym
sym TValue
aty GenValue sym
acc GenValue sym
acc
      GenValue sym
acc' <- sym
-> SBit sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
iteValue sym
sym SBit sym
b
                (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
mulV sym
sym TValue
aty GenValue sym
a GenValue sym
sq)
                (GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenValue sym
sq)
      GenValue sym -> [SBit sym] -> SEval sym (GenValue sym)
loop GenValue sym
acc' [SBit sym]
bs

{-# INLINE modV #-}
modV :: Backend sym => sym -> Binary sym
modV :: forall sym. Backend sym => sym -> Binary sym
modV sym
sym = sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> BinWord sym
-> (SInteger sym -> SInteger sym -> SEval sym (SInteger sym))
-> Binary sym
integralBinary sym
sym BinWord sym
forall {p}. p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi
  where
    opw :: p -> SWord sym -> SWord sym -> SEval sym (SWord sym)
opw p
_w SWord sym
x SWord sym
y = sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordMod sym
sym SWord sym
x SWord sym
y
    opi :: SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
opi SInteger sym
x SInteger sym
y = sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
intMod sym
sym SInteger sym
x SInteger sym
y

{-# SPECIALIZE toIntegerV :: Concrete -> Prim Concrete #-}
-- | Convert a word to a non-negative integer.
toIntegerV :: Backend sym => sym -> Prim sym
toIntegerV :: forall sym. Backend sym => sym -> Prim sym
toIntegerV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
a ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
v ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    case TValue
a of
      TVSeq Integer
_w TValue
el | TValue -> Bool
isTBit TValue
el ->
        SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> SWord sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SEval sym (SInteger sym)
wordToInt sym
sym (SWord sym -> SEval sym (SInteger sym))
-> SEval sym (SWord sym) -> SEval sym (SInteger sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"toInteger" (GenValue sym -> SEval sym (SWord sym))
-> SEval sym (GenValue sym) -> SEval sym (SWord sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
v))
      TValue
TVInteger -> SEval sym (GenValue sym)
v
      TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"toInteger" [TValue -> String
forall a. Show a => a -> String
show TValue
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not in class `Integral`"]

-----------------------------------------------------------------------------
-- Field

{-# SPECIALIZE recipV :: Concrete -> Prim Concrete #-}
recipV :: Backend sym => sym -> Prim sym
recipV :: forall sym. Backend sym => sym -> Prim sym
recipV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
a ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
x ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    case TValue
a of
      TValue
TVRational -> SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> SRational sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SRational sym)
rationalRecip sym
sym (SRational sym -> SEval sym (SRational sym))
-> (GenValue sym -> SRational sym)
-> GenValue sym
-> SEval sym (SRational sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational (GenValue sym -> SEval sym (SRational sym))
-> SEval sym (GenValue sym) -> SEval sym (SRational sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
x)
      TVFloat Integer
e Integer
p ->
        do SFloat sym
one <- sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
fpLit sym
sym Integer
e Integer
p Rational
1
           SWord sym
r   <- sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode sym
sym
           SFloat sym
xv  <- GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat (GenValue sym -> SFloat sym)
-> SEval sym (GenValue sym) -> SEval sym (SFloat sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
x
           SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpDiv sym
sym SWord sym
r SFloat sym
one SFloat sym
xv
      TVIntMod Integer
m -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
znRecip sym
sym Integer
m (SInteger sym -> SEval sym (SInteger sym))
-> (GenValue sym -> SInteger sym)
-> GenValue sym
-> SEval sym (SInteger sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SEval sym (SInteger sym))
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
x)
      TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"recip"  [TValue -> String
forall a. Show a => a -> String
show TValue
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"is not a Field"]

{-# SPECIALIZE fieldDivideV :: Concrete -> Prim Concrete #-}
fieldDivideV :: Backend sym => sym -> Prim sym
fieldDivideV :: forall sym. Backend sym => sym -> Prim sym
fieldDivideV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
a ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
x ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    case TValue
a of
      TValue
TVRational ->
        do SRational sym
x' <- GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational (GenValue sym -> SRational sym)
-> SEval sym (GenValue sym) -> SEval sym (SRational sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
x
           SRational sym
y' <- GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational (GenValue sym -> SRational sym)
-> SEval sym (GenValue sym) -> SEval sym (SRational sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
y
           SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SRational sym)
rationalDivide sym
sym SRational sym
x' SRational sym
y'
      TVFloat Integer
_e Integer
_p ->
        do SFloat sym
xv <- GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat (GenValue sym -> SFloat sym)
-> SEval sym (GenValue sym) -> SEval sym (SFloat sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
x
           SFloat sym
yv <- GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat (GenValue sym -> SFloat sym)
-> SEval sym (GenValue sym) -> SEval sym (SFloat sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
y
           SWord sym
r  <- sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode sym
sym
           SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpDiv sym
sym SWord sym
r SFloat sym
xv SFloat sym
yv
      TVIntMod Integer
m ->
        do SInteger sym
x' <- GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SInteger sym)
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
x
           SInteger sym
y' <- GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger (GenValue sym -> SInteger sym)
-> SEval sym (GenValue sym) -> SEval sym (SInteger sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
y
           SInteger sym
yinv <- sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SInteger sym)
znRecip sym
sym Integer
m SInteger sym
y'
           SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
znMult sym
sym Integer
m SInteger sym
x' SInteger sym
yinv

      TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"recip"  [TValue -> String
forall a. Show a => a -> String
show TValue
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"is not a Field"]

--------------------------------------------------------------
-- Round

{-# SPECIALIZE roundOp ::
  Concrete ->
  String ->
  (SRational Concrete -> SEval Concrete (SInteger Concrete)) ->
  (SFloat Concrete -> SEval Concrete (SInteger Concrete)) ->
  Unary Concrete #-}

roundOp ::
  Backend sym =>
  sym ->
  String ->
  (SRational sym -> SEval sym (SInteger sym)) ->
  (SFloat sym -> SEval sym (SInteger sym)) ->
  Unary sym
roundOp :: forall sym.
Backend sym =>
sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> Unary sym
roundOp sym
_sym String
nm SRational sym -> SEval sym (SInteger sym)
qop SFloat sym -> SEval sym (SInteger sym)
opfp TValue
ty GenValue sym
v =
  case TValue
ty of
    TValue
TVRational  -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SRational sym -> SEval sym (SInteger sym)
qop (GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational GenValue sym
v))
    TVFloat Integer
_ Integer
_ -> SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SFloat sym -> SEval sym (SInteger sym)
opfp (GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat GenValue sym
v)
    TValue
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
nm [TValue -> String
forall a. Show a => a -> String
show TValue
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a Field"]

{-# INLINE floorV #-}
floorV :: Backend sym => sym -> Unary sym
floorV :: forall sym. Backend sym => sym -> Unary sym
floorV sym
sym = sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> Unary sym
roundOp sym
sym String
"floor" SRational sym -> SEval sym (SInteger sym)
opq SFloat sym -> SEval sym (SInteger sym)
opfp
  where
  opq :: SRational sym -> SEval sym (SInteger sym)
opq = sym -> SRational sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SInteger sym)
rationalFloor sym
sym
  opfp :: SFloat sym -> SEval sym (SInteger sym)
opfp = \SFloat sym
x -> sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRTN sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
fpToInteger sym
sym String
"floor" SWord sym
r SFloat sym
x

{-# INLINE ceilingV #-}
ceilingV :: Backend sym => sym -> Unary sym
ceilingV :: forall sym. Backend sym => sym -> Unary sym
ceilingV sym
sym = sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> Unary sym
roundOp sym
sym String
"ceiling" SRational sym -> SEval sym (SInteger sym)
opq SFloat sym -> SEval sym (SInteger sym)
opfp
  where
  opq :: SRational sym -> SEval sym (SInteger sym)
opq = sym -> SRational sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SInteger sym)
rationalCeiling sym
sym
  opfp :: SFloat sym -> SEval sym (SInteger sym)
opfp = \SFloat sym
x -> sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRTP sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
fpToInteger sym
sym String
"ceiling" SWord sym
r SFloat sym
x

{-# INLINE truncV #-}
truncV :: Backend sym => sym -> Unary sym
truncV :: forall sym. Backend sym => sym -> Unary sym
truncV sym
sym = sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> Unary sym
roundOp sym
sym String
"trunc" SRational sym -> SEval sym (SInteger sym)
opq SFloat sym -> SEval sym (SInteger sym)
opfp
  where
  opq :: SRational sym -> SEval sym (SInteger sym)
opq = sym -> SRational sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SInteger sym)
rationalTrunc sym
sym
  opfp :: SFloat sym -> SEval sym (SInteger sym)
opfp = \SFloat sym
x -> sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRTZ sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
fpToInteger sym
sym String
"trunc" SWord sym
r SFloat sym
x

{-# INLINE roundAwayV #-}
roundAwayV :: Backend sym => sym -> Unary sym
roundAwayV :: forall sym. Backend sym => sym -> Unary sym
roundAwayV sym
sym = sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> Unary sym
roundOp sym
sym String
"roundAway" SRational sym -> SEval sym (SInteger sym)
opq SFloat sym -> SEval sym (SInteger sym)
opfp
  where
  opq :: SRational sym -> SEval sym (SInteger sym)
opq = sym -> SRational sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SInteger sym)
rationalRoundAway sym
sym
  opfp :: SFloat sym -> SEval sym (SInteger sym)
opfp = \SFloat sym
x -> sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRNA sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
fpToInteger sym
sym String
"roundAway" SWord sym
r SFloat sym
x

{-# INLINE roundToEvenV #-}
roundToEvenV :: Backend sym => sym -> Unary sym
roundToEvenV :: forall sym. Backend sym => sym -> Unary sym
roundToEvenV sym
sym = sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SRational sym -> SEval sym (SInteger sym))
-> (SFloat sym -> SEval sym (SInteger sym))
-> Unary sym
roundOp sym
sym String
"roundToEven" SRational sym -> SEval sym (SInteger sym)
opq SFloat sym -> SEval sym (SInteger sym)
opfp
  where
  opq :: SRational sym -> SEval sym (SInteger sym)
opq = sym -> SRational sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SEval sym (SInteger sym)
rationalRoundToEven sym
sym
  opfp :: SFloat sym -> SEval sym (SInteger sym)
opfp = \SFloat sym
x -> sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRNE sym
sym SEval sym (SWord sym)
-> (SWord sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym)
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SWord sym
r -> sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> String -> SWord sym -> SFloat sym -> SEval sym (SInteger sym)
fpToInteger sym
sym String
"roundToEven" SWord sym
r SFloat sym
x

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

{-# INLINE andV #-}
andV :: Backend sym => sym -> Binary sym
andV :: forall sym. Backend sym => sym -> Binary sym
andV sym
sym = sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> Binary sym
logicBinary sym
sym (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitAnd sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordAnd sym
sym)

{-# INLINE orV #-}
orV :: Backend sym => sym -> Binary sym
orV :: forall sym. Backend sym => sym -> Binary sym
orV sym
sym = sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> Binary sym
logicBinary sym
sym (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitOr sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordOr sym
sym)

{-# INLINE xorV #-}
xorV :: Backend sym => sym -> Binary sym
xorV :: forall sym. Backend sym => sym -> Binary sym
xorV sym
sym = sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> Binary sym
logicBinary sym
sym (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitXor sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordXor sym
sym)

{-# INLINE complementV #-}
complementV :: Backend sym => sym -> Unary sym
complementV :: forall sym. Backend sym => sym -> Unary sym
complementV sym
sym = sym
-> (SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SEval sym (SWord sym))
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SEval sym (SWord sym))
-> Unary sym
logicUnary sym
sym (sym -> SBit sym -> SEval sym (SBit sym)
forall sym. Backend sym => sym -> SBit sym -> SEval sym (SBit sym)
bitComplement sym
sym) (sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SEval sym (SWord sym)
wordComplement sym
sym)

-- Bitvector signed div and modulus

{-# INLINE lg2V #-}
lg2V :: Backend sym => sym -> Prim sym
lg2V :: forall sym. Backend sym => sym -> Prim sym
lg2V sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_w ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
x ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SEval sym (SWord sym)
wordLg2 sym
sym SWord sym
x)

{-# SPECIALIZE sdivV :: Concrete -> Prim Concrete #-}
sdivV :: Backend sym => sym -> Prim sym
sdivV :: forall sym. Backend sym => sym -> Prim sym
sdivV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_w ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
x ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordSignedDiv sym
sym SWord sym
x SWord sym
y)

{-# SPECIALIZE smodV :: Concrete -> Prim Concrete #-}
smodV :: Backend sym => sym -> Prim sym
smodV :: forall sym. Backend sym => sym -> Prim sym
smodV sym
sym  =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_w ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
x ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordSignedMod sym
sym SWord sym
x SWord sym
y)

{-# SPECIALIZE toSignedIntegerV :: Concrete -> Prim Concrete #-}
toSignedIntegerV :: Backend sym => sym -> Prim sym
toSignedIntegerV :: forall sym. Backend sym => sym -> Prim sym
toSignedIntegerV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_w ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
x ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SEval sym (SInteger sym)
wordToSignedInt sym
sym SWord sym
x)

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

{-# SPECIALIZE cmpValue ::
  Concrete ->
  (SBit Concrete -> SBit Concrete -> SEval Concrete a -> SEval Concrete a) ->
  (SWord Concrete -> SWord Concrete -> SEval Concrete a -> SEval Concrete a) ->
  (SInteger Concrete -> SInteger Concrete -> SEval Concrete a -> SEval Concrete a) ->
  (Integer -> SInteger Concrete -> SInteger Concrete -> SEval Concrete a -> SEval Concrete a) ->
  (SRational Concrete -> SRational Concrete -> SEval Concrete a -> SEval Concrete a) ->
  (SFloat Concrete -> SFloat Concrete -> SEval Concrete a -> SEval Concrete a) ->
  (TValue -> GenValue Concrete -> GenValue Concrete -> SEval Concrete a -> SEval Concrete a)
  #-}

cmpValue ::
  Backend sym =>
  sym ->
  (SBit sym -> SBit sym -> SEval sym a -> SEval sym a) ->
  (SWord sym -> SWord sym -> SEval sym a -> SEval sym a) ->
  (SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a) ->
  (Integer -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a) ->
  (SRational sym -> SRational sym -> SEval sym a -> SEval sym a) ->
  (SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a) ->
  (TValue -> GenValue sym -> GenValue sym -> SEval sym a -> SEval sym a)
cmpValue :: forall sym a.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym a -> SEval sym a)
-> (SWord sym -> SWord sym -> SEval sym a -> SEval sym a)
-> (SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (SRational sym -> SRational sym -> SEval sym a -> SEval sym a)
-> (SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a)
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym a
-> SEval sym a
cmpValue sym
sym SBit sym -> SBit sym -> SEval sym a -> SEval sym a
fb SWord sym -> SWord sym -> SEval sym a -> SEval sym a
fw SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a
fi Integer
-> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a
fz SRational sym -> SRational sym -> SEval sym a -> SEval sym a
fq SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a
ff = TValue
-> GenValue sym -> GenValue sym -> SEval sym a -> SEval sym a
cmp
  where
    cmp :: TValue
-> GenValue sym -> GenValue sym -> SEval sym a -> SEval sym a
cmp TValue
ty GenValue sym
v1 GenValue sym
v2 SEval sym a
k =
      case TValue
ty of
        TValue
TVBit         -> SBit sym -> SBit sym -> SEval sym a -> SEval sym a
fb (GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit GenValue sym
v1) (GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit GenValue sym
v2) SEval sym a
k
        TValue
TVInteger     -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a
fi (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
v1) (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
v2) SEval sym a
k
        TVFloat Integer
_ Integer
_   -> SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a
ff (GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat GenValue sym
v1) (GenValue sym -> SFloat sym
forall sym. Backend sym => GenValue sym -> SFloat sym
fromVFloat GenValue sym
v2) SEval sym a
k
        TVIntMod Integer
n    -> Integer
-> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a
fz Integer
n (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
v1) (GenValue sym -> SInteger sym
forall sym. Backend sym => GenValue sym -> SInteger sym
fromVInteger GenValue sym
v2) SEval sym a
k
        TValue
TVRational    -> SRational sym -> SRational sym -> SEval sym a -> SEval sym a
fq (GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational GenValue sym
v1) (GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational GenValue sym
v2) SEval sym a
k
        TVArray{}     -> String -> [String] -> SEval sym a
forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Prims.Value.cmpValue"
                               [ String
"Arrays are not comparable" ]
        TVSeq Integer
n TValue
t
          | TValue -> Bool
isTBit TValue
t  -> do SWord sym
w1 <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"cmpValue" GenValue sym
v1
                            SWord sym
w2 <- sym -> String -> GenValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> String -> GenValue sym -> SEval sym (SWord sym)
fromVWord sym
sym String
"cmpValue" GenValue sym
v2
                            SWord sym -> SWord sym -> SEval sym a -> SEval sym a
fw SWord sym
w1 SWord sym
w2 SEval sym a
k
          | Bool
otherwise -> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
-> SEval sym a
-> SEval sym a
cmpValues (TValue -> [TValue]
forall a. a -> [a]
repeat TValue
t)
                           (Integer -> SeqMap sym (GenValue sym) -> [SEval sym (GenValue sym)]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n (GenValue sym -> SeqMap sym (GenValue sym)
forall sym.
Backend sym =>
GenValue sym -> SeqMap sym (GenValue sym)
fromVSeq GenValue sym
v1))
                           (Integer -> SeqMap sym (GenValue sym) -> [SEval sym (GenValue sym)]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n (GenValue sym -> SeqMap sym (GenValue sym)
forall sym.
Backend sym =>
GenValue sym -> SeqMap sym (GenValue sym)
fromVSeq GenValue sym
v2))
                           SEval sym a
k
        TVStream TValue
_    -> String -> [String] -> SEval sym a
forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Prims.Value.cmpValue"
                                [ String
"Infinite streams are not comparable" ]
        TVFun TValue
_ TValue
_     -> String -> [String] -> SEval sym a
forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Prims.Value.cmpValue"
                               [ String
"Functions are not comparable" ]
        TVTuple [TValue]
tys   -> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
-> SEval sym a
-> SEval sym a
cmpValues [TValue]
tys (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
v1) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
v2) SEval sym a
k
        TVRec RecordMap Ident TValue
fields  -> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
-> SEval sym a
-> SEval sym a
cmpValues
                            (RecordMap Ident TValue -> [TValue]
forall a b. RecordMap a b -> [b]
recordElements RecordMap Ident TValue
fields)
                            (RecordMap Ident (SEval sym (GenValue sym))
-> [SEval sym (GenValue sym)]
forall a b. RecordMap a b -> [b]
recordElements (GenValue sym -> RecordMap Ident (SEval sym (GenValue sym))
forall sym.
Backend sym =>
GenValue sym -> RecordMap Ident (SEval sym (GenValue sym))
fromVRecord GenValue sym
v1))
                            (RecordMap Ident (SEval sym (GenValue sym))
-> [SEval sym (GenValue sym)]
forall a b. RecordMap a b -> [b]
recordElements (GenValue sym -> RecordMap Ident (SEval sym (GenValue sym))
forall sym.
Backend sym =>
GenValue sym -> RecordMap Ident (SEval sym (GenValue sym))
fromVRecord GenValue sym
v2))
                            SEval sym a
k

        TVNominal {} -> String -> [String] -> SEval sym a
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"cmpValue"
                          [ String
"Nominal type not in `Cmp`" ]

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


{-# INLINE bitLessThan #-}
bitLessThan :: Backend sym => sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitLessThan :: forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitLessThan sym
sym SBit sym
x SBit sym
y =
  do SBit sym
xnot <- sym -> SBit sym -> SEval sym (SBit sym)
forall sym. Backend sym => sym -> SBit sym -> SEval sym (SBit sym)
bitComplement sym
sym SBit sym
x
     sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitAnd sym
sym SBit sym
xnot SBit sym
y

{-# INLINE bitGreaterThan #-}
bitGreaterThan :: Backend sym => sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitGreaterThan :: forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitGreaterThan sym
sym SBit sym
x SBit sym
y = sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitLessThan sym
sym SBit sym
y SBit sym
x

{-# INLINE valEq #-}
valEq :: Backend sym => sym -> TValue -> GenValue sym -> GenValue sym -> SEval sym (SBit sym)
valEq :: forall sym.
Backend sym =>
sym
-> TValue -> GenValue sym -> GenValue sym -> SEval sym (SBit sym)
valEq sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = sym
-> (SBit sym
    -> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SWord sym
    -> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SInteger sym
    -> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (Integer
    -> SInteger sym
    -> SInteger sym
    -> SEval sym (SBit sym)
    -> SEval sym (SBit sym))
-> (SRational sym
    -> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SFloat sym
    -> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym a.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym a -> SEval sym a)
-> (SWord sym -> SWord sym -> SEval sym a -> SEval sym a)
-> (SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (SRational sym -> SRational sym -> SEval sym a -> SEval sym a)
-> (SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a)
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym a
-> SEval sym a
cmpValue sym
sym SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fb SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fi Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
fz SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fq SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
ff TValue
ty GenValue sym
v1 GenValue sym
v2 (SBit sym -> SEval sym (SBit sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBit sym -> SEval sym (SBit sym))
-> SBit sym -> SEval sym (SBit sym)
forall a b. (a -> b) -> a -> b
$ sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
True)
  where
  fb :: SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fb SBit sym
x SBit sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitEq  sym
sym SBit sym
x SBit sym
y) SEval sym (SBit sym)
k
  fw :: SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SWord sym
x SWord sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordEq sym
sym SWord sym
x SWord sym
y) SEval sym (SBit sym)
k
  fi :: SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fi SInteger sym
x SInteger sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym (sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intEq  sym
sym SInteger sym
x SInteger sym
y) SEval sym (SBit sym)
k
  fz :: Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
fz Integer
m SInteger sym
x SInteger sym
y SEval sym (SBit sym)
k = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym (sym
-> Integer -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> Integer -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
znEq sym
sym Integer
m SInteger sym
x SInteger sym
y) SEval sym (SBit sym)
k
  fq :: SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fq SRational sym
x SRational sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym (sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
rationalEq sym
sym SRational sym
x SRational sym
y) SEval sym (SBit sym)
k
  ff :: SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
ff SFloat sym
x SFloat sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym (sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
fpEq sym
sym SFloat sym
x SFloat sym
y) SEval sym (SBit sym)
k

{-# INLINE valLt #-}
valLt :: Backend sym =>
  sym -> TValue -> GenValue sym -> GenValue sym -> SBit sym -> SEval sym (SBit sym)
valLt :: forall sym.
Backend sym =>
sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
valLt sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 SBit sym
final = sym
-> (SBit sym
    -> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SWord sym
    -> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SInteger sym
    -> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (Integer
    -> SInteger sym
    -> SInteger sym
    -> SEval sym (SBit sym)
    -> SEval sym (SBit sym))
-> (SRational sym
    -> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SFloat sym
    -> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym a.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym a -> SEval sym a)
-> (SWord sym -> SWord sym -> SEval sym a -> SEval sym a)
-> (SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (SRational sym -> SRational sym -> SEval sym a -> SEval sym a)
-> (SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a)
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym a
-> SEval sym a
cmpValue sym
sym SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fb SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fi Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall {p} {p} {p} {p} {a}. p -> p -> p -> p -> a
fz SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fq SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
ff TValue
ty GenValue sym
v1 GenValue sym
v2 (SBit sym -> SEval sym (SBit sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SBit sym
final)
  where
  fb :: SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fb SBit sym
x SBit sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitLessThan  sym
sym SBit sym
x SBit sym
y) (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitEq  sym
sym SBit sym
x SBit sym
y) SEval sym (SBit sym)
k
  fw :: SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SWord sym
x SWord sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordLessThan sym
sym SWord sym
x SWord sym
y) (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordEq sym
sym SWord sym
x SWord sym
y) SEval sym (SBit sym)
k
  fi :: SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fi SInteger sym
x SInteger sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan  sym
sym SInteger sym
x SInteger sym
y) (sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intEq  sym
sym SInteger sym
x SInteger sym
y) SEval sym (SBit sym)
k
  fz :: p -> p -> p -> p -> a
fz p
_ p
_ p
_ p
_ = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"valLt" [String
"Z_n is not in `Cmp`"]
  fq :: SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fq SRational sym
x SRational sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
rationalLessThan sym
sym SRational sym
x SRational sym
y) (sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
rationalEq sym
sym SRational sym
x SRational sym
y) SEval sym (SBit sym)
k
  ff :: SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
ff SFloat sym
x SFloat sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
fpLessThan   sym
sym SFloat sym
x SFloat sym
y) (sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
fpEq   sym
sym SFloat sym
x SFloat sym
y) SEval sym (SBit sym)
k

{-# INLINE valGt #-}
valGt :: Backend sym =>
  sym -> TValue -> GenValue sym -> GenValue sym -> SBit sym -> SEval sym (SBit sym)
valGt :: forall sym.
Backend sym =>
sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
valGt sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 SBit sym
final = sym
-> (SBit sym
    -> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SWord sym
    -> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SInteger sym
    -> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (Integer
    -> SInteger sym
    -> SInteger sym
    -> SEval sym (SBit sym)
    -> SEval sym (SBit sym))
-> (SRational sym
    -> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SFloat sym
    -> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym a.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym a -> SEval sym a)
-> (SWord sym -> SWord sym -> SEval sym a -> SEval sym a)
-> (SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (SRational sym -> SRational sym -> SEval sym a -> SEval sym a)
-> (SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a)
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym a
-> SEval sym a
cmpValue sym
sym SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fb SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fi Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall {p} {p} {p} {p} {a}. p -> p -> p -> p -> a
fz SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fq SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
ff TValue
ty GenValue sym
v1 GenValue sym
v2 (SBit sym -> SEval sym (SBit sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SBit sym
final)
  where
  fb :: SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fb SBit sym
x SBit sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitGreaterThan  sym
sym SBit sym
x SBit sym
y) (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitEq  sym
sym SBit sym
x SBit sym
y) SEval sym (SBit sym)
k
  fw :: SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SWord sym
x SWord sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordGreaterThan sym
sym SWord sym
x SWord sym
y) (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordEq sym
sym SWord sym
x SWord sym
y) SEval sym (SBit sym)
k
  fi :: SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fi SInteger sym
x SInteger sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intGreaterThan  sym
sym SInteger sym
x SInteger sym
y) (sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intEq  sym
sym SInteger sym
x SInteger sym
y) SEval sym (SBit sym)
k
  fz :: p -> p -> p -> p -> a
fz p
_ p
_ p
_ p
_ = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"valGt" [String
"Z_n is not in `Cmp`"]
  fq :: SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fq SRational sym
x SRational sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
rationalGreaterThan sym
sym SRational sym
x SRational sym
y) (sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SRational sym -> SRational sym -> SEval sym (SBit sym)
rationalEq sym
sym SRational sym
x SRational sym
y) SEval sym (SBit sym)
k
  ff :: SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
ff SFloat sym
x SFloat sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
fpGreaterThan   sym
sym SFloat sym
x SFloat sym
y) (sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
fpEq   sym
sym SFloat sym
x SFloat sym
y) SEval sym (SBit sym)
k

{-# INLINE eqCombine #-}
eqCombine :: Backend sym =>
  sym ->
  SEval sym (SBit sym) ->
  SEval sym (SBit sym) ->
  SEval sym (SBit sym)
eqCombine :: forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
eqCombine sym
sym SEval sym (SBit sym)
eq SEval sym (SBit sym)
k = SEval sym (SEval sym (SBit sym)) -> SEval sym (SBit sym)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitAnd sym
sym (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym)
-> SEval sym (SBit sym -> SEval sym (SBit sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (SBit sym)
eq SEval sym (SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym) -> SEval sym (SEval sym (SBit sym))
forall a b. SEval sym (a -> b) -> SEval sym a -> SEval sym b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SEval sym (SBit sym)
k)

{-# INLINE lexCombine #-}
lexCombine :: Backend sym =>
  sym ->
  SEval sym (SBit sym) ->
  SEval sym (SBit sym) ->
  SEval sym (SBit sym) ->
  SEval sym (SBit sym)
lexCombine :: forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym SEval sym (SBit sym)
cmp SEval sym (SBit sym)
eq SEval sym (SBit sym)
k =
  do SBit sym
c <- SEval sym (SBit sym)
cmp
     SBit sym
e <- SEval sym (SBit sym)
eq
     sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitOr sym
sym SBit sym
c (SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitAnd sym
sym SBit sym
e (SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (SBit sym)
k

{-# INLINE eqV #-}
eqV :: Backend sym => sym -> Binary sym
eqV :: forall sym. Backend sym => sym -> Binary sym
eqV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> TValue -> GenValue sym -> GenValue sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> TValue -> GenValue sym -> GenValue sym -> SEval sym (SBit sym)
valEq sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2

{-# INLINE distinctV #-}
distinctV :: Backend sym => sym -> Binary sym
distinctV :: forall sym. Backend sym => sym -> Binary sym
distinctV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> SBit sym -> SEval sym (SBit sym)
forall sym. Backend sym => sym -> SBit sym -> SEval sym (SBit sym)
bitComplement sym
sym (SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym
-> TValue -> GenValue sym -> GenValue sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> TValue -> GenValue sym -> GenValue sym -> SEval sym (SBit sym)
valEq sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2)

{-# INLINE lessThanV #-}
lessThanV :: Backend sym => sym -> Binary sym
lessThanV :: forall sym. Backend sym => sym -> Binary sym
lessThanV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
valLt sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
False)

{-# INLINE lessThanEqV #-}
lessThanEqV :: Backend sym => sym -> Binary sym
lessThanEqV :: forall sym. Backend sym => sym -> Binary sym
lessThanEqV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
valLt sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
True)

{-# INLINE greaterThanV #-}
greaterThanV :: Backend sym => sym -> Binary sym
greaterThanV :: forall sym. Backend sym => sym -> Binary sym
greaterThanV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
valGt sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
False)

{-# INLINE greaterThanEqV #-}
greaterThanEqV :: Backend sym => sym -> Binary sym
greaterThanEqV :: forall sym. Backend sym => sym -> Binary sym
greaterThanEqV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> TValue
-> GenValue sym
-> GenValue sym
-> SBit sym
-> SEval sym (SBit sym)
valGt sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
True)

{-# INLINE signedLessThanV #-}
signedLessThanV :: Backend sym => sym -> Binary sym
signedLessThanV :: forall sym. Backend sym => sym -> Binary sym
signedLessThanV sym
sym TValue
ty GenValue sym
v1 GenValue sym
v2 = SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> (SBit sym
    -> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SWord sym
    -> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SInteger sym
    -> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (Integer
    -> SInteger sym
    -> SInteger sym
    -> SEval sym (SBit sym)
    -> SEval sym (SBit sym))
-> (SRational sym
    -> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> (SFloat sym
    -> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym))
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym a.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym a -> SEval sym a)
-> (SWord sym -> SWord sym -> SEval sym a -> SEval sym a)
-> (SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (Integer
    -> SInteger sym -> SInteger sym -> SEval sym a -> SEval sym a)
-> (SRational sym -> SRational sym -> SEval sym a -> SEval sym a)
-> (SFloat sym -> SFloat sym -> SEval sym a -> SEval sym a)
-> TValue
-> GenValue sym
-> GenValue sym
-> SEval sym a
-> SEval sym a
cmpValue sym
sym SBit sym
-> SBit sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall {p} {p} {p} {a}. p -> p -> p -> a
fb SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SInteger sym
-> SInteger sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall {p} {p} {p} {a}. p -> p -> p -> a
fi Integer
-> SInteger sym
-> SInteger sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall {a} {p} {p} {p} {a}. Show a => a -> p -> p -> p -> a
fz SRational sym
-> SRational sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall {p} {p} {p} {a}. p -> p -> p -> a
fq SFloat sym
-> SFloat sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall {p} {p} {p} {a}. p -> p -> p -> a
ff TValue
ty GenValue sym
v1 GenValue sym
v2 (SBit sym -> SEval sym (SBit sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBit sym -> SEval sym (SBit sym))
-> SBit sym -> SEval sym (SBit sym)
forall a b. (a -> b) -> a -> b
$ sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
False)
  where
  fb :: p -> p -> p -> a
fb p
_ p
_ p
_   = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"signedLessThan" [String
"Attempted to perform signed comparison on bit type"]
  fw :: SWord sym
-> SWord sym -> SEval sym (SBit sym) -> SEval sym (SBit sym)
fw SWord sym
x SWord sym
y SEval sym (SBit sym)
k   = sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
-> SEval sym (SBit sym)
lexCombine sym
sym (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordSignedLessThan sym
sym SWord sym
x SWord sym
y) (sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SBit sym)
wordEq sym
sym SWord sym
x SWord sym
y) SEval sym (SBit sym)
k
  fi :: p -> p -> p -> a
fi p
_ p
_ p
_   = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"signedLessThan" [String
"Attempted to perform signed comparison on Integer type"]
  fz :: a -> p -> p -> p -> a
fz a
m p
_ p
_ p
_ = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"signedLessThan" [String
"Attempted to perform signed comparison on Z_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" type"]
  fq :: p -> p -> p -> a
fq p
_ p
_ p
_   = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"signedLessThan" [String
"Attempted to perform signed comparison on Rational type"]
  ff :: p -> p -> p -> a
ff p
_ p
_ p
_   = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"signedLessThan" [String
"Attempted to perform signed comparison on Float"]



{-# SPECIALIZE zeroV ::
  Concrete ->
  TValue ->
  SEval Concrete (GenValue Concrete)
  #-}
zeroV :: forall sym.
  Backend sym =>
  sym ->
  TValue ->
  SEval sym (GenValue sym)
zeroV :: forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
ty = case TValue
ty of

  -- bits
  TValue
TVBit ->
    GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
False))

  -- integers
  TValue
TVInteger ->
    SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0

  -- integers mod n
  TVIntMod Integer
_ ->
    SInteger sym -> GenValue sym
forall sym. SInteger sym -> GenValue sym
VInteger (SInteger sym -> GenValue sym)
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0

  TValue
TVRational ->
    SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym -> SInteger sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SEval sym (SRational sym)
intToRational sym
sym (SInteger sym -> SEval sym (SRational sym))
-> SEval sym (SInteger sym) -> SEval sym (SRational sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0)

  TVArray{} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"zeroV" [String
"Array not in class Zero"]

  -- floating point
  TVFloat Integer
e Integer
p ->
    SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> Rational -> SEval sym (SFloat sym)
fpLit sym
sym Integer
e Integer
p Rational
0

  -- sequences
  TVSeq Integer
w TValue
ety
      | TValue -> Bool
isTBit TValue
ety -> sym -> Integer -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (GenValue sym)
word sym
sym Integer
w Integer
0
      | Bool
otherwise  ->
           do SEval sym (GenValue sym)
z <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
ety)
              sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
ety ((Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap \Integer
_i -> SEval sym (GenValue sym)
z)

  TVStream TValue
ety ->
     do SEval sym (GenValue sym)
z <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
ety)
        GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream ((Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap \Integer
_i -> SEval sym (GenValue sym)
z)

  -- functions
  TVFun TValue
_ TValue
bty ->
     do SEval sym (GenValue sym)
z <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
bty)
        sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
lam sym
sym (SEval sym (GenValue sym)
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. a -> b -> a
const SEval sym (GenValue sym)
z)

  -- tuples
  TVTuple [TValue]
tys ->
      do [SEval sym (GenValue sym)]
xs <- (TValue -> SEval sym (SEval sym (GenValue sym)))
-> [TValue] -> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> (TValue -> SEval sym (GenValue sym))
-> TValue
-> SEval sym (SEval sym (GenValue sym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym) [TValue]
tys
         GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ [SEval sym (GenValue sym)] -> GenValue sym
forall sym. [SEval sym (GenValue sym)] -> GenValue sym
VTuple [SEval sym (GenValue sym)]
xs

  -- records
  TVRec RecordMap Ident TValue
fields ->
      do RecordMap Ident (SEval sym (GenValue sym))
xs <- (TValue -> SEval sym (SEval sym (GenValue sym)))
-> RecordMap Ident TValue
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordMap Ident a -> f (RecordMap Ident b)
traverse (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> (TValue -> SEval sym (GenValue sym))
-> TValue
-> SEval sym (SEval sym (GenValue sym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym) RecordMap Ident TValue
fields
         GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
forall sym.
RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
VRecord RecordMap Ident (SEval sym (GenValue sym))
xs

  TVNominal {} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"zeroV" [ String
"Nominal type not in `Zero`" ]


{-# SPECIALIZE joinSeq ::
  Concrete ->
  Nat' ->
  Integer ->
  TValue ->
  SEval Concrete (SeqMap Concrete (GenValue Concrete)) ->
  SEval Concrete (GenValue Concrete)
  #-}
joinSeq ::
  Backend sym =>
  sym ->
  Nat' ->
  Integer ->
  TValue ->
  SEval sym (SeqMap sym (GenValue sym)) ->
  SEval sym (GenValue sym)

-- Special case for 0 length inner sequences.
joinSeq :: forall sym.
Backend sym =>
sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
joinSeq sym
sym Nat'
_parts Integer
0 TValue
a SEval sym (SeqMap sym (GenValue sym))
_val
  = sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym (Integer -> TValue -> TValue
TVSeq Integer
0 TValue
a)

-- finite sequence of words
joinSeq sym
sym (Nat Integer
parts) Integer
each TValue
TVBit SEval sym (SeqMap sym (GenValue sym))
val
  = do WordValue sym
w <- sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym (Integer
partsInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
each)
              (sym
-> Integer
-> Integer
-> SeqMap sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> Integer
-> SeqMap sym (WordValue sym)
-> SEval sym (WordValue sym)
joinWords sym
sym Integer
parts Integer
each (SeqMap sym (WordValue sym) -> SEval sym (WordValue sym))
-> (SeqMap sym (GenValue sym) -> SeqMap sym (WordValue sym))
-> SeqMap sym (GenValue sym)
-> SEval sym (WordValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenValue sym -> WordValue sym)
-> SeqMap sym (GenValue sym) -> SeqMap sym (WordValue sym)
forall a b. (a -> b) -> SeqMap sym a -> SeqMap sym b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"joinV") (SeqMap sym (GenValue sym) -> SEval sym (WordValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (WordValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (SeqMap sym (GenValue sym))
val)
       GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord WordValue sym
w)

-- infinite sequence of words
joinSeq sym
sym Nat'
Inf Integer
each TValue
TVBit SEval sym (SeqMap sym (GenValue sym))
val
  = GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
      do let (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
each
         SeqMap sym (GenValue sym)
xs <- SEval sym (SeqMap sym (GenValue sym))
val
         WordValue sym
ys <- String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"join seq" (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs Integer
q
         SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> WordValue sym -> Integer -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> Integer -> SEval sym (SBit sym)
indexWordValue sym
sym WordValue sym
ys Integer
r

-- finite or infinite sequence of non-words
joinSeq sym
sym Nat'
parts Integer
each TValue
a SEval sym (SeqMap sym (GenValue sym))
val
  = sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym Nat'
len TValue
a (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
      let (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
each
      SeqMap sym (GenValue sym)
xs <- SEval sym (SeqMap sym (GenValue sym))
val
      SeqMap sym (GenValue sym)
ys <- String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"join seq" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs Integer
q
      SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
ys Integer
r
  where
  len :: Nat'
len = Nat'
parts Nat' -> Nat' -> Nat'
`nMul` (Integer -> Nat'
Nat Integer
each)

{-# INLINE joinV #-}

-- | Join a sequence of sequences into a single sequence.
joinV ::
  Backend sym =>
  sym ->
  Nat' ->
  Integer ->
  TValue ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym)
joinV :: forall sym.
Backend sym =>
sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
joinV sym
sym Nat'
parts Integer
each TValue
a SEval sym (GenValue sym)
val =
  do SEval sym (SeqMap sym (GenValue sym))
xs <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"joinV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val)
     sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
joinSeq sym
sym Nat'
parts Integer
each TValue
a SEval sym (SeqMap sym (GenValue sym))
xs

{-# INLINE takeV #-}
takeV ::
  Backend sym =>
  sym ->
  Nat' ->
  Nat' ->
  TValue ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym)
takeV :: forall sym.
Backend sym =>
sym
-> Nat'
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
takeV sym
sym Nat'
front Nat'
back TValue
a SEval sym (GenValue sym)
val =
  case Nat'
front of
    Nat'
Inf -> SEval sym (GenValue sym)
val
    Nat Integer
front' ->
      case Nat'
back of
        Nat Integer
back' | TValue -> Bool
isTBit TValue
a ->
          do WordValue sym
w <- sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
front' (sym
-> Integer -> Integer -> WordValue sym -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer -> Integer -> WordValue sym -> SEval sym (WordValue sym)
takeWordVal sym
sym Integer
front' Integer
back' (WordValue sym -> SEval sym (WordValue sym))
-> SEval sym (WordValue sym) -> SEval sym (WordValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"takeV" (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
val))
             GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord WordValue sym
w)

        Nat'
Inf | TValue -> Bool
isTBit TValue
a ->
          do WordValue sym
w <- sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
front' (sym
-> Integer -> SeqMap sym (SBit sym) -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer -> SeqMap sym (SBit sym) -> SEval sym (WordValue sym)
bitmapWordVal sym
sym Integer
front' (SeqMap sym (SBit sym) -> SEval sym (WordValue sym))
-> (SeqMap sym (GenValue sym) -> SeqMap sym (SBit sym))
-> SeqMap sym (GenValue sym)
-> SEval sym (WordValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenValue sym -> SBit sym)
-> SeqMap sym (GenValue sym) -> SeqMap sym (SBit sym)
forall a b. (a -> b) -> SeqMap sym a -> SeqMap sym b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit (SeqMap sym (GenValue sym) -> SEval sym (WordValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (WordValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"takeV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val))
             GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord WordValue sym
w)

        Nat'
_ ->
          do SeqMap sym (GenValue sym)
xs <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym (SeqMap sym a) -> SEval sym (SeqMap sym a)
delaySeqMap sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"takeV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val)
             sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
front') TValue
a SeqMap sym (GenValue sym)
xs

{-# INLINE dropV #-}
dropV ::
  Backend sym =>
  sym ->
  Integer ->
  Nat' ->
  TValue ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym)
dropV :: forall sym.
Backend sym =>
sym
-> Integer
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
dropV sym
sym Integer
front Nat'
back TValue
a SEval sym (GenValue sym)
val =
  case Nat'
back of
    Nat Integer
back' | TValue -> Bool
isTBit TValue
a ->
      do WordValue sym
w <- sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
back' (sym
-> Integer -> Integer -> WordValue sym -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer -> Integer -> WordValue sym -> SEval sym (WordValue sym)
dropWordVal sym
sym Integer
front Integer
back' (WordValue sym -> SEval sym (WordValue sym))
-> SEval sym (WordValue sym) -> SEval sym (WordValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"dropV" (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
val))
         GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord WordValue sym
w)

    Nat'
_ ->
      do SeqMap sym (GenValue sym)
xs <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym (SeqMap sym a) -> SEval sym (SeqMap sym a)
delaySeqMap sym
sym (Integer -> SeqMap sym (GenValue sym) -> SeqMap sym (GenValue sym)
forall sym a.
Backend sym =>
Integer -> SeqMap sym a -> SeqMap sym a
dropSeqMap Integer
front (SeqMap sym (GenValue sym) -> SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"dropV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val))
         sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym Nat'
back TValue
a SeqMap sym (GenValue sym)
xs


{-# INLINE splitV #-}

-- | Split implementation.
splitV :: Backend sym =>
  sym ->
  Nat' ->
  Integer ->
  TValue ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym)
splitV :: forall sym.
Backend sym =>
sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
splitV sym
sym Nat'
parts Integer
each TValue
a SEval sym (GenValue sym)
val =
  case Nat'
parts of
    Nat Integer
p
     | TValue -> Bool
isTBit TValue
a ->
       do SEval sym (WordValue sym)
val' <- sym
-> SEval sym (WordValue sym)
-> SEval sym (SEval sym (WordValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"splitV" (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
val)
          sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
p) TValue
tyv (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
            WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym
-> Integer -> Integer -> WordValue sym -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer -> Integer -> WordValue sym -> SEval sym (WordValue sym)
extractWordVal sym
sym Integer
each ((Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
each) (WordValue sym -> SEval sym (WordValue sym))
-> SEval sym (WordValue sym) -> SEval sym (WordValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (WordValue sym)
val')
     | Bool
otherwise ->
       do SEval sym (SeqMap sym (GenValue sym))
val' <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"splitV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val)
          sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
p) TValue
tyv (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
            sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
each) TValue
a (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
j -> do
              SeqMap sym (GenValue sym)
xs <- SEval sym (SeqMap sym (GenValue sym))
val'
              SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs (Integer
each Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j)

    Nat'
Inf
      -- The return type is [inf][each], (where each is non-zero) and `val` is
      -- of type [inf * each], or [inf]. Therefore, `val` is a stream.
      | TValue -> Bool
isTBit TValue
a, Integer
each Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 ->
        do SEval sym (SeqMap sym (GenValue sym))
val' <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"splitV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val)
           GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
             WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer -> SeqMap sym (SBit sym) -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer -> SeqMap sym (SBit sym) -> SEval sym (WordValue sym)
bitmapWordVal sym
sym Integer
each ((Integer -> SEval sym (SBit sym)) -> SeqMap sym (SBit sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (SBit sym)) -> SeqMap sym (SBit sym))
-> (Integer -> SEval sym (SBit sym)) -> SeqMap sym (SBit sym)
forall a b. (a -> b) -> a -> b
$ \Integer
j ->
               let idx :: Integer
idx = Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
each Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
j
                in Integer
idx Integer -> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall a b. a -> b -> b
`seq` do
                       SeqMap sym (GenValue sym)
xs <- SEval sym (SeqMap sym (GenValue sym))
val'
                       GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit (GenValue sym -> SBit sym)
-> SEval sym (GenValue sym) -> SEval sym (SBit sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs Integer
idx)
      -- The return type is [inf][0], and `val` is of type [inf * 0], or [0].
      -- Therefore, `val` is a word. We need to special-case this, because the
      -- case directly above this one will panic if `val` is not a stream due to
      -- the use of `fromSeq` (#1749).
      --
      -- Because `val` is an empty sequence, there is no need to split it apart.
      -- Instead, we can just return a stream with infinite copies of `val`.
      | TValue -> Bool
isTBit TValue
a, Integer
each Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 ->
        GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
_i -> SEval sym (GenValue sym)
val
      -- If `a` is not `Bit`, then `val` must be a sequence or a stream (and not
      -- a word).
      | Bool
otherwise ->
        do SEval sym (SeqMap sym (GenValue sym))
val' <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"splitV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val)
           GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
             sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
each) TValue
a (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
j -> do
               SeqMap sym (GenValue sym)
xs <- SEval sym (SeqMap sym (GenValue sym))
val'
               SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs (Integer
each Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j)
  where
    tyv :: TValue
tyv = Integer -> TValue -> TValue
TVSeq Integer
each TValue
TVBit

{-# INLINE reverseV #-}

reverseV :: forall sym.
  Backend sym =>
  sym ->
  Integer ->
  TValue ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym)

reverseV :: forall sym.
Backend sym =>
sym
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
reverseV sym
sym Integer
n TValue
TVBit SEval sym (GenValue sym)
val =
  do WordValue sym
w <- sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
n (sym -> WordValue sym -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym (WordValue sym)
reverseWordVal sym
sym (WordValue sym -> SEval sym (WordValue sym))
-> (GenValue sym -> WordValue sym)
-> GenValue sym
-> SEval sym (WordValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"reverseV" (GenValue sym -> SEval sym (WordValue sym))
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val)
     GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord WordValue sym
w)

reverseV sym
sym Integer
n TValue
a SEval sym (GenValue sym)
val =
  do SeqMap sym (GenValue sym)
xs <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym (SeqMap sym a) -> SEval sym (SeqMap sym a)
delaySeqMap sym
sym (Integer -> SeqMap sym (GenValue sym) -> SeqMap sym (GenValue sym)
forall sym a.
Backend sym =>
Integer -> SeqMap sym a -> SeqMap sym a
reverseSeqMap Integer
n (SeqMap sym (GenValue sym) -> SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"reverseV" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val))
     sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
n) TValue
a SeqMap sym (GenValue sym)
xs


{-# INLINE transposeV #-}

transposeV ::
  Backend sym =>
  sym ->
  Nat' ->
  Nat' ->
  TValue ->
  GenValue sym ->
  SEval sym (GenValue sym)
transposeV :: forall sym.
Backend sym =>
sym
-> Nat'
-> Nat'
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
transposeV sym
sym Nat'
a Nat'
b TValue
c GenValue sym
xs
  | TValue -> Bool
isTBit TValue
c, Nat Integer
na <- Nat'
a = -- Fin a => [a][b]Bit -> [b][a]Bit
      SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
bseq (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
bi ->
        WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer -> SeqMap sym (SBit sym) -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer -> SeqMap sym (SBit sym) -> SEval sym (WordValue sym)
bitmapWordVal sym
sym Integer
na ((Integer -> SEval sym (SBit sym)) -> SeqMap sym (SBit sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (SBit sym)) -> SeqMap sym (SBit sym))
-> (Integer -> SEval sym (SBit sym)) -> SeqMap sym (SBit sym)
forall a b. (a -> b) -> a -> b
$ \Integer
ai ->
         do SeqMap sym (GenValue sym)
xs' <- String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"transposeV" GenValue sym
xs
            GenValue sym
ys <- SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs' Integer
ai
            case GenValue sym
ys of
              VStream SeqMap sym (GenValue sym)
ys' -> GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit (GenValue sym -> SBit sym)
-> SEval sym (GenValue sym) -> SEval sym (SBit sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
ys' Integer
bi
              VWord WordValue sym
wv    -> sym -> WordValue sym -> Integer -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> Integer -> SEval sym (SBit sym)
indexWordValue sym
sym WordValue sym
wv Integer
bi
              GenValue sym
_ -> String -> [String] -> SEval sym (SBit sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"transpose" [String
"expected sequence of bits"])

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

  | Bool
otherwise = -- [a][b]c -> [b][a]c
      SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
bseq (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
bi ->
        SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
aseq (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
ai -> do
          SeqMap sym (GenValue sym)
xs' <- String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"transposeV 1" GenValue sym
xs
          SeqMap sym (GenValue sym)
ys  <- String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"transposeV 2" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
xs' Integer
ai
          GenValue sym
z   <- SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
ys Integer
bi
          GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return GenValue sym
z

 where
  bseq :: SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
bseq = case Nat'
b of
    Nat Integer
n -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym Nat'
b (Integer -> TValue -> TValue
TVSeq Integer
n TValue
c)
    Nat'
Inf -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym Nat'
b (TValue -> TValue
TVStream TValue
c)
  aseq :: SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
aseq = sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym Nat'
a TValue
c


{-# INLINE ccatV #-}

ccatV ::
  Backend sym =>
  sym ->
  Integer ->
  Nat' ->
  TValue ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym) ->
  SEval sym (GenValue sym)

-- Finite bitvectors
ccatV :: forall sym.
Backend sym =>
sym
-> Integer
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
ccatV sym
sym Integer
front (Nat Integer
back) TValue
TVBit SEval sym (GenValue sym)
l SEval sym (GenValue sym)
r =
  do Maybe (GenValue sym)
ml <- sym -> SEval sym (GenValue sym) -> SEval sym (Maybe (GenValue sym))
forall a. sym -> SEval sym a -> SEval sym (Maybe a)
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (Maybe a)
isReady sym
sym SEval sym (GenValue sym)
l
     Maybe (GenValue sym)
mr <- sym -> SEval sym (GenValue sym) -> SEval sym (Maybe (GenValue sym))
forall a. sym -> SEval sym a -> SEval sym (Maybe a)
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (Maybe a)
isReady sym
sym SEval sym (GenValue sym)
r
     case (Maybe (GenValue sym)
ml, Maybe (GenValue sym)
mr) of
       (Just GenValue sym
l', Just GenValue sym
r') ->
         WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           sym -> WordValue sym -> WordValue sym -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> WordValue sym -> SEval sym (WordValue sym)
joinWordVal sym
sym (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"ccatV left" GenValue sym
l') (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"ccatV right" GenValue sym
r')
       (Maybe (GenValue sym), Maybe (GenValue sym))
_ ->
         WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym (Integer
frontInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
back)
                (do WordValue sym
l' <- String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"ccatV left"  (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
l
                    WordValue sym
r' <- String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"ccatV right" (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
r
                    sym -> WordValue sym -> WordValue sym -> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> WordValue sym -> SEval sym (WordValue sym)
joinWordVal sym
sym WordValue sym
l' WordValue sym
r')

-- Infinite bitstream
ccatV sym
sym Integer
front Nat'
Inf TValue
TVBit SEval sym (GenValue sym)
l SEval sym (GenValue sym)
r =
  do SEval sym (SeqMap sym (SBit sym))
l'' <- sym
-> SEval sym (SeqMap sym (SBit sym))
-> SEval sym (SEval sym (SeqMap sym (SBit sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (sym -> WordValue sym -> SeqMap sym (SBit sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> SeqMap sym (SBit sym)
asBitsMap sym
sym  (WordValue sym -> SeqMap sym (SBit sym))
-> (GenValue sym -> WordValue sym)
-> GenValue sym
-> SeqMap sym (SBit sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"ccatV left" (GenValue sym -> SeqMap sym (SBit sym))
-> SEval sym (GenValue sym) -> SEval sym (SeqMap sym (SBit sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
l)
     SEval sym (SeqMap sym (GenValue sym))
r'' <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ccatV right" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
r)
     GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
      if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
front then do
        SeqMap sym (SBit sym)
ls <- SEval sym (SeqMap sym (SBit sym))
l''
        SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqMap sym (SBit sym) -> Integer -> SEval sym (SBit sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (SBit sym)
ls Integer
i
      else do
        SeqMap sym (GenValue sym)
rs <- SEval sym (SeqMap sym (GenValue sym))
r''
        SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
rs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
front)

-- streams/sequences of nonbits
ccatV sym
sym Integer
front Nat'
back TValue
elty SEval sym (GenValue sym)
l SEval sym (GenValue sym)
r =
  do SEval sym (SeqMap sym (GenValue sym))
l'' <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ccatV left" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
l)
     SEval sym (SeqMap sym (GenValue sym))
r'' <- sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"ccatV right" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
r)
     sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (TFun -> [Nat'] -> Nat'
evalTF TFun
TCAdd [Integer -> Nat'
Nat Integer
front,Nat'
back]) TValue
elty (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
      if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
front then do
        SeqMap sym (GenValue sym)
ls <- SEval sym (SeqMap sym (GenValue sym))
l''
        SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
ls Integer
i
      else do
        SeqMap sym (GenValue sym)
rs <- SEval sym (SeqMap sym (GenValue sym))
r''
        SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
rs (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
front)


{-# SPECIALIZE logicBinary ::
  Concrete ->
  (SBit Concrete -> SBit Concrete -> SEval Concrete (SBit Concrete)) ->
  (SWord Concrete -> SWord Concrete -> SEval Concrete (SWord Concrete)) ->
  Binary Concrete
  #-}

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

  loop :: TValue
        -> GenValue sym
        -> GenValue sym
        -> SEval sym (GenValue sym)

  loop :: TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty GenValue sym
l GenValue sym
r = case TValue
ty of
    TValue
TVBit -> SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBit sym -> SBit sym -> SEval sym (SBit sym)
opb (GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit GenValue sym
l) (GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit GenValue sym
r))
    TValue
TVInteger -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary" [String
"Integer not in class Logic"]
    TVIntMod Integer
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary" [String
"Z not in class Logic"]
    TValue
TVRational -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary" [String
"Rational not in class Logic"]
    TVArray{} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary" [String
"Array not in class Logic"]

    TVFloat {}  -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary" [String
"Float not in class Logic"]
    TVSeq Integer
w TValue
aty
         -- words
         | TValue -> Bool
isTBit TValue
aty
              -> WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
w
                               (sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> WordValue sym
-> WordValue sym
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> (SBit sym -> SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> WordValue sym
-> WordValue sym
-> SEval sym (WordValue sym)
wordValLogicOp sym
sym SBit sym -> SBit sym -> SEval sym (SBit sym)
opb SWord sym -> SWord sym -> SEval sym (SWord sym)
opw
                                    (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"logicBinary l" GenValue sym
l)
                                    (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"logicBinary r" GenValue sym
r))

         -- finite sequences
         | Bool
otherwise -> do
            SeqMap sym (GenValue sym)
vals <- SEval sym (SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (sym
-> (GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
zipSeqMap sym
sym (TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
aty) (Integer -> Nat'
Nat Integer
w) (SeqMap sym (GenValue sym)
 -> SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval
     sym
     (SeqMap sym (GenValue sym)
      -> SEval sym (SeqMap sym (GenValue sym)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"logicBinary left" GenValue sym
l)
                              SEval
  sym
  (SeqMap sym (GenValue sym)
   -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall a b. SEval sym (a -> b) -> SEval sym a -> SEval sym b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"logicBinary right" GenValue sym
r))
            sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
aty SeqMap sym (GenValue sym)
vals


    TVStream TValue
aty ->
        SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SEval sym (SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (sym
-> (GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
zipSeqMap sym
sym (TValue -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
aty) Nat'
Inf (SeqMap sym (GenValue sym)
 -> SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval
     sym
     (SeqMap sym (GenValue sym)
      -> SEval sym (SeqMap sym (GenValue sym)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"logicBinary left" GenValue sym
l) SEval
  sym
  (SeqMap sym (GenValue sym)
   -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SEval sym (SeqMap sym (GenValue sym)))
forall a b. SEval sym (a -> b) -> SEval sym a -> SEval sym b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                          (String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"logicBinary right" GenValue sym
r)))

    TVTuple [TValue]
etys -> do
        [SEval sym (GenValue sym)]
ls <- (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym (GenValue sym)]
-> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
l)
        [SEval sym (GenValue sym)]
rs <- (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym (GenValue sym)]
-> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
r)
        GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ [SEval sym (GenValue sym)] -> GenValue sym
forall sym. [SEval sym (GenValue sym)] -> GenValue sym
VTuple ([SEval sym (GenValue sym)] -> GenValue sym)
-> [SEval sym (GenValue sym)] -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (TValue
 -> SEval sym (GenValue sym)
 -> SEval sym (GenValue sym)
 -> SEval sym (GenValue sym))
-> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' [TValue]
etys [SEval sym (GenValue sym)]
ls [SEval sym (GenValue sym)]
rs

    TVFun TValue
_ TValue
bty ->
        sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
lam sym
sym ((SEval sym (GenValue sym) -> SEval sym (GenValue sym))
 -> SEval sym (GenValue sym))
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \ SEval sym (GenValue sym)
a -> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' TValue
bty (sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym GenValue sym
l SEval sym (GenValue sym)
a) (sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym GenValue sym
r SEval sym (GenValue sym)
a)

    TVRec RecordMap Ident TValue
fields ->
      RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
forall sym.
RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
VRecord (RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym)
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Ident -> TValue -> SEval sym (SEval sym (GenValue sym)))
-> RecordMap Ident TValue
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap
          (\Ident
f TValue
fty -> sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
loop' TValue
fty (Ident -> GenValue sym -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
Ident -> GenValue sym -> SEval sym (GenValue sym)
lookupRecord Ident
f GenValue sym
l) (Ident -> GenValue sym -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
Ident -> GenValue sym -> SEval sym (GenValue sym)
lookupRecord Ident
f GenValue sym
r)))
          RecordMap Ident TValue
fields

    TVNominal {} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary"
                        [ String
"Nominal type not in `Logic`" ]

{-# SPECIALIZE logicUnary ::
  Concrete ->
  (SBit Concrete -> SEval Concrete (SBit Concrete)) ->
  (SWord Concrete -> SEval Concrete (SWord Concrete)) ->
  Unary Concrete
  #-}

logicUnary :: forall sym.
  Backend sym =>
  sym ->
  (SBit sym -> SEval sym (SBit sym)) ->
  (SWord sym -> SEval sym (SWord sym)) ->
  Unary sym
logicUnary :: forall sym.
Backend sym =>
sym
-> (SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SEval sym (SWord sym))
-> Unary sym
logicUnary sym
sym SBit sym -> SEval sym (SBit sym)
opb SWord sym -> SEval sym (SWord sym)
opw = TValue -> GenValue sym -> SEval sym (GenValue sym)
loop
  where
  loop' :: TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
  loop' :: TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' TValue
ty SEval sym (GenValue sym)
val = TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
val

  loop :: TValue -> GenValue sym -> SEval sym (GenValue sym)
  loop :: TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ty GenValue sym
val = case TValue
ty of
    TValue
TVBit -> SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBit sym -> SEval sym (SBit sym)
opb (GenValue sym -> SBit sym
forall sym. Backend sym => GenValue sym -> SBit sym
fromVBit GenValue sym
val))

    TValue
TVInteger -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicUnary" [String
"Integer not in class Logic"]
    TVIntMod Integer
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicUnary" [String
"Z not in class Logic"]
    TVFloat {} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicUnary" [String
"Float not in class Logic"]
    TValue
TVRational -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicBinary" [String
"Rational not in class Logic"]
    TVArray{} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicUnary" [String
"Array not in class Logic"]

    TVSeq Integer
w TValue
ety
         -- words
         | TValue -> Bool
isTBit TValue
ety
              -> WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
w (sym
-> (SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SEval sym (SWord sym))
-> WordValue sym
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> (SBit sym -> SEval sym (SBit sym))
-> (SWord sym -> SEval sym (SWord sym))
-> WordValue sym
-> SEval sym (WordValue sym)
wordValUnaryOp sym
sym SBit sym -> SEval sym (SBit sym)
opb SWord sym -> SEval sym (SWord sym)
opw (String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"logicUnary" GenValue sym
val))

         -- finite sequences
         | Bool
otherwise
              -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
ety (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (sym
-> (GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
mapSeqMap sym
sym (TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ety) (Integer -> Nat'
Nat Integer
w) (SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"logicUnary" GenValue sym
val)

         -- streams
    TVStream TValue
ety ->
         SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (sym
-> (GenValue sym -> SEval sym (GenValue sym))
-> Nat'
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (a -> SEval sym a)
-> Nat'
-> SeqMap sym a
-> SEval sym (SeqMap sym a)
mapSeqMap sym
sym (TValue -> GenValue sym -> SEval sym (GenValue sym)
loop TValue
ety) Nat'
Inf (SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"logicUnary" GenValue sym
val)

    TVTuple [TValue]
etys ->
      do [SEval sym (GenValue sym)]
as <- (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym (GenValue sym)]
-> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym) (GenValue sym -> [SEval sym (GenValue sym)]
forall sym.
Backend sym =>
GenValue sym -> [SEval sym (GenValue sym)]
fromVTuple GenValue sym
val)
         GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ [SEval sym (GenValue sym)] -> GenValue sym
forall sym. [SEval sym (GenValue sym)] -> GenValue sym
VTuple ((TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> [TValue]
-> [SEval sym (GenValue sym)]
-> [SEval sym (GenValue sym)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' [TValue]
etys [SEval sym (GenValue sym)]
as)

    TVFun TValue
_ TValue
bty ->
      sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
lam sym
sym ((SEval sym (GenValue sym) -> SEval sym (GenValue sym))
 -> SEval sym (GenValue sym))
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \ SEval sym (GenValue sym)
a -> TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' TValue
bty (sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym GenValue sym
val SEval sym (GenValue sym)
a)

    TVRec RecordMap Ident TValue
fields ->
      RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
forall sym.
RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym
VRecord (RecordMap Ident (SEval sym (GenValue sym)) -> GenValue sym)
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Ident -> TValue -> SEval sym (SEval sym (GenValue sym)))
-> RecordMap Ident TValue
-> SEval sym (RecordMap Ident (SEval sym (GenValue sym)))
forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap
          (\Ident
f TValue
fty -> sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (TValue -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
loop' TValue
fty (Ident -> GenValue sym -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
Ident -> GenValue sym -> SEval sym (GenValue sym)
lookupRecord Ident
f GenValue sym
val)))
          RecordMap Ident TValue
fields

    TVNominal {} -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"logicUnary" [ String
"Nominal type not in `Logic`" ]


{-# INLINE assertIndexInBounds #-}
assertIndexInBounds ::
  Backend sym =>
  sym ->
  Nat' {- ^ Sequence size bounds -} ->
  Either (SInteger sym) (WordValue sym) {- ^ Index value -} ->
  SEval sym ()

-- All nonnegative integers are in bounds for an infinite sequence
assertIndexInBounds :: forall sym.
Backend sym =>
sym
-> Nat' -> Either (SInteger sym) (WordValue sym) -> SEval sym ()
assertIndexInBounds sym
sym Nat'
Inf (Left SInteger sym
idx) =
  do SBit sym
ppos <- sym -> SBit sym -> SEval sym (SBit sym)
forall sym. Backend sym => sym -> SBit sym -> SEval sym (SBit sym)
bitComplement sym
sym (SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan sym
sym SInteger sym
idx (SInteger sym -> SEval sym (SBit sym))
-> SEval sym (SInteger sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0
     sym -> SBit sym -> EvalError -> SEval sym ()
forall sym.
Backend sym =>
sym -> SBit sym -> EvalError -> SEval sym ()
assertSideCondition sym
sym SBit sym
ppos (Maybe Integer -> EvalError
InvalidIndex (sym -> SInteger sym -> Maybe Integer
forall sym. Backend sym => sym -> SInteger sym -> Maybe Integer
integerAsLit sym
sym SInteger sym
idx))

-- If the index is an integer, test that it
-- is nonnegative and less than the concrete value of n.
assertIndexInBounds sym
sym (Nat Integer
n) (Left SInteger sym
idx) =
  do SInteger sym
n' <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
n
     SBit sym
ppos <- sym -> SBit sym -> SEval sym (SBit sym)
forall sym. Backend sym => sym -> SBit sym -> SEval sym (SBit sym)
bitComplement sym
sym (SBit sym -> SEval sym (SBit sym))
-> SEval sym (SBit sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan sym
sym SInteger sym
idx (SInteger sym -> SEval sym (SBit sym))
-> SEval sym (SInteger sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0
     SBit sym
pn <- sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan sym
sym SInteger sym
idx SInteger sym
n'
     SBit sym
p <- sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SBit sym -> SBit sym -> SEval sym (SBit sym)
bitAnd sym
sym SBit sym
ppos SBit sym
pn
     sym -> SBit sym -> EvalError -> SEval sym ()
forall sym.
Backend sym =>
sym -> SBit sym -> EvalError -> SEval sym ()
assertSideCondition sym
sym SBit sym
p (Maybe Integer -> EvalError
InvalidIndex (sym -> SInteger sym -> Maybe Integer
forall sym. Backend sym => sym -> SInteger sym -> Maybe Integer
integerAsLit sym
sym SInteger sym
idx))

-- Bitvectors can't index out of bounds for an infinite sequence
assertIndexInBounds sym
_sym Nat'
Inf (Right WordValue sym
_) = () -> SEval sym ()
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Can't index out of bounds for a sequence that is
-- longer than the expressible index values
assertIndexInBounds sym
sym (Nat Integer
n) (Right WordValue sym
idx) =
  sym -> Integer -> WordValue sym -> SEval sym ()
forall sym.
Backend sym =>
sym -> Integer -> WordValue sym -> SEval sym ()
assertWordValueInBounds sym
sym Integer
n WordValue sym
idx

-- | Indexing operations.

{-# INLINE indexPrim #-}
indexPrim ::
  Backend sym =>
  sym ->
  IndexDirection ->
  (Nat' -> TValue -> SeqMap sym (GenValue sym) -> TValue -> SInteger sym -> SEval sym (GenValue sym)) ->
  (Nat' -> TValue -> SeqMap sym (GenValue sym) -> TValue -> Integer -> [IndexSegment sym] -> SEval sym (GenValue sym)) ->
  Prim sym
indexPrim :: forall sym.
Backend sym =>
sym
-> IndexDirection
-> (Nat'
    -> TValue
    -> SeqMap sym (GenValue sym)
    -> TValue
    -> SInteger sym
    -> SEval sym (GenValue sym))
-> (Nat'
    -> TValue
    -> SeqMap sym (GenValue sym)
    -> TValue
    -> Integer
    -> [IndexSegment sym]
    -> SEval sym (GenValue sym))
-> Prim sym
indexPrim sym
sym IndexDirection
dir Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> TValue
-> SInteger sym
-> SEval sym (GenValue sym)
int_op Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> TValue
-> Integer
-> [IndexSegment sym]
-> SEval sym (GenValue sym)
word_op =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
len ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
eltTy ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ix ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
idx ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
   do SeqMap sym (GenValue sym)
vs <- SEval sym (GenValue sym)
xs SEval sym (GenValue sym)
-> (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (SeqMap sym (GenValue sym))
forall a b. SEval sym a -> (a -> SEval sym b) -> SEval sym b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               VWord WordValue sym
w    -> SeqMap sym (GenValue sym) -> SEval sym (SeqMap sym (GenValue sym))
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap (\Integer
i -> SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> WordValue sym -> Integer -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> Integer -> SEval sym (SBit sym)
indexWordValue sym
sym WordValue sym
w Integer
i)
               VSeq Integer
_ SeqMap sym (GenValue sym)
vs  -> SeqMap sym (GenValue sym) -> SEval sym (SeqMap sym (GenValue sym))
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return SeqMap sym (GenValue sym)
vs
               VStream SeqMap sym (GenValue sym)
vs -> SeqMap sym (GenValue sym) -> SEval sym (SeqMap sym (GenValue sym))
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return SeqMap sym (GenValue sym)
vs
               GenValue sym
_ -> String -> [String] -> SEval sym (SeqMap sym (GenValue sym))
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"Expected sequence value" [String
"indexPrim"]
      let vs' :: SeqMap sym (GenValue sym)
vs' = case (Nat'
len, IndexDirection
dir) of
                  (Nat'
_    , IndexDirection
IndexForward)  -> SeqMap sym (GenValue sym)
vs
                  (Nat Integer
n, IndexDirection
IndexBackward) -> Integer -> SeqMap sym (GenValue sym) -> SeqMap sym (GenValue sym)
forall sym a.
Backend sym =>
Integer -> SeqMap sym a -> SeqMap sym a
reverseSeqMap Integer
n SeqMap sym (GenValue sym)
vs
                  (Nat'
Inf  , IndexDirection
IndexBackward) -> String -> [String] -> SeqMap sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"Expected finite sequence" [String
"!"]
      Either (SInteger sym) (WordValue sym)
idx' <- sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
forall sym.
Backend sym =>
sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
asIndex sym
sym String
"index" TValue
ix (GenValue sym -> Either (SInteger sym) (WordValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (Either (SInteger sym) (WordValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
idx
      sym
-> Nat' -> Either (SInteger sym) (WordValue sym) -> SEval sym ()
forall sym.
Backend sym =>
sym
-> Nat' -> Either (SInteger sym) (WordValue sym) -> SEval sym ()
assertIndexInBounds sym
sym Nat'
len Either (SInteger sym) (WordValue sym)
idx'
      case Either (SInteger sym) (WordValue sym)
idx' of
        Left SInteger sym
i  -> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> TValue
-> SInteger sym
-> SEval sym (GenValue sym)
int_op  Nat'
len TValue
eltTy SeqMap sym (GenValue sym)
vs' TValue
ix SInteger sym
i
        Right WordValue sym
w -> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> TValue
-> Integer
-> [IndexSegment sym]
-> SEval sym (GenValue sym)
word_op Nat'
len TValue
eltTy SeqMap sym (GenValue sym)
vs' TValue
ix (sym -> WordValue sym -> Integer
forall sym. Backend sym => sym -> WordValue sym -> Integer
wordValueSize sym
sym WordValue sym
w) ([IndexSegment sym] -> SEval sym (GenValue sym))
-> SEval sym [IndexSegment sym] -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> WordValue sym -> SEval sym [IndexSegment sym]
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym [IndexSegment sym]
enumerateIndexSegments sym
sym WordValue sym
w

{-# INLINE updatePrim #-}

updatePrim ::
  Backend sym =>
  sym ->
  (Nat' -> TValue -> WordValue sym -> Either (SInteger sym) (WordValue sym) -> SEval sym (GenValue sym) -> SEval sym (WordValue sym)) ->
  (Nat' -> TValue -> SeqMap sym (GenValue sym) -> Either (SInteger sym) (WordValue sym) -> SEval sym (GenValue sym) -> SEval sym (SeqMap sym (GenValue sym))) ->
  Prim sym
updatePrim :: forall sym.
Backend sym =>
sym
-> (Nat'
    -> TValue
    -> WordValue sym
    -> Either (SInteger sym) (WordValue sym)
    -> SEval sym (GenValue sym)
    -> SEval sym (WordValue sym))
-> (Nat'
    -> TValue
    -> SeqMap sym (GenValue sym)
    -> Either (SInteger sym) (WordValue sym)
    -> SEval sym (GenValue sym)
    -> SEval sym (SeqMap sym (GenValue sym)))
-> Prim sym
updatePrim sym
sym Nat'
-> TValue
-> WordValue sym
-> Either (SInteger sym) (WordValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (WordValue sym)
updateWord Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> Either (SInteger sym) (WordValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
updateSeq =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
len ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
eltTy ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ix ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
idx ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
val ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
   do Either (SInteger sym) (WordValue sym)
idx' <- sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
forall sym.
Backend sym =>
sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
asIndex sym
sym String
"update" TValue
ix (GenValue sym -> Either (SInteger sym) (WordValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (Either (SInteger sym) (WordValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
idx
      sym
-> Nat' -> Either (SInteger sym) (WordValue sym) -> SEval sym ()
forall sym.
Backend sym =>
sym
-> Nat' -> Either (SInteger sym) (WordValue sym) -> SEval sym ()
assertIndexInBounds sym
sym Nat'
len Either (SInteger sym) (WordValue sym)
idx'
      case (Nat'
len, TValue
eltTy) of
        (Nat Integer
n, TValue
TVBit) -> WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
delayWordValue sym
sym Integer
n
                             (do WordValue sym
w <- String -> GenValue sym -> WordValue sym
forall sym. Backend sym => String -> GenValue sym -> WordValue sym
fromWordVal String
"updatePrim" (GenValue sym -> WordValue sym)
-> SEval sym (GenValue sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
xs; Nat'
-> TValue
-> WordValue sym
-> Either (SInteger sym) (WordValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (WordValue sym)
updateWord Nat'
len TValue
eltTy WordValue sym
w Either (SInteger sym) (WordValue sym)
idx' SEval sym (GenValue sym)
val)
        (Nat Integer
n, TValue
_    ) -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
n) TValue
eltTy (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym (SeqMap sym a) -> SEval sym (SeqMap sym a)
delaySeqMap sym
sym
                             (do SeqMap sym (GenValue sym)
vs <- String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"updatePrim" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
xs; Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> Either (SInteger sym) (WordValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
updateSeq Nat'
len TValue
eltTy SeqMap sym (GenValue sym)
vs Either (SInteger sym) (WordValue sym)
idx' SEval sym (GenValue sym)
val)
        (Nat'
Inf  , TValue
_    ) -> SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym (SeqMap sym a) -> SEval sym (SeqMap sym a)
delaySeqMap sym
sym
                             (do SeqMap sym (GenValue sym)
vs <- String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
forall sym.
Backend sym =>
String -> GenValue sym -> SEval sym (SeqMap sym (GenValue sym))
fromSeq String
"updatePrim" (GenValue sym -> SEval sym (SeqMap sym (GenValue sym)))
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
xs; Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> Either (SInteger sym) (WordValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
updateSeq Nat'
len TValue
eltTy SeqMap sym (GenValue sym)
vs Either (SInteger sym) (WordValue sym)
idx' SEval sym (GenValue sym)
val)

{-# INLINE fromToV #-}
-- @[ 0 .. 10 ]@
fromToV :: Backend sym => sym -> Prim sym
fromToV :: forall sym. Backend sym => sym -> Prim sym
fromToV sym
sym =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
first ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
lst ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty in
    case (Nat'
first, Nat'
lst) of
      (Nat Integer
first', Nat Integer
lst') ->
        let len :: Integer
len = Integer
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 sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
len) TValue
ty (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
f (Integer
first' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)
      (Nat', Nat')
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"fromToV" [String
"invalid arguments"]

{-# INLINE fromThenToV #-}
-- @[ 0, 1 .. 10 ]@
fromThenToV :: Backend sym => sym -> Prim sym
fromThenToV :: forall sym. Backend sym => sym -> Prim sym
fromThenToV sym
sym =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
first ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
next  ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
lst   ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty    ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
len   ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty in
    case (Nat'
first, Nat'
next, Nat'
lst, Nat'
len) of
      (Nat Integer
first', Nat Integer
next', Nat Integer
_lst', Nat Integer
len') ->
        let diff :: Integer
diff = Integer
next' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
first'
        in sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
len') TValue
ty (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
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)
      (Nat', Nat', Nat', Nat')
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"fromThenToV" [String
"invalid arguments"]

{-# INLINE fromToLessThanV #-}
-- @[ 0 .. <10 ]@
fromToLessThanV :: Backend sym => sym -> Prim sym
fromToLessThanV :: forall sym. Backend sym => sym -> Prim sym
fromToLessThanV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
first ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
bound ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty
        ss :: SeqMap sym (GenValue sym)
ss = (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
f (Integer
first Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)
    in case Nat'
bound of
         Nat'
Inf        -> GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream SeqMap sym (GenValue sym)
ss
         Nat Integer
bound' -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat (Integer
bound' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
first)) TValue
ty SeqMap sym (GenValue sym)
ss

{-# INLINE fromToByV #-}
-- @[ 0 .. 10 by 2 ]@
fromToByV :: Backend sym => sym -> Prim sym
fromToByV :: forall sym. Backend sym => sym -> Prim sym
fromToByV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
first ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
lst ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
stride ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty
        ss :: SeqMap sym (GenValue sym)
ss = (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
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
stride)
     in sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat (Integer
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) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
stride))) TValue
ty SeqMap sym (GenValue sym)
ss

{-# INLINE fromToByLessThanV #-}
-- @[ 0 .. <10 by 2 ]@
fromToByLessThanV :: Backend sym => sym -> Prim sym
fromToByLessThanV :: forall sym. Backend sym => sym -> Prim sym
fromToByLessThanV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
first ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
bound ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
stride ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty
        ss :: SeqMap sym (GenValue sym)
ss = (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
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
stride)
     in case Nat'
bound of
          Nat'
Inf -> GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream SeqMap sym (GenValue sym)
ss
          Nat Integer
bound' -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat ((Integer
bound' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
first Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
stride Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
stride)) TValue
ty SeqMap sym (GenValue sym)
ss


{-# INLINE fromToDownByV #-}
-- @[ 10 .. 0 down by 2 ]@
fromToDownByV :: Backend sym => sym -> Prim sym
fromToDownByV :: forall sym. Backend sym => sym -> Prim sym
fromToDownByV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
first ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
lst ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
stride ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty
        ss :: SeqMap sym (GenValue sym)
ss = (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
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
stride)
     in sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ((Integer
first Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lst) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
stride))) TValue
ty SeqMap sym (GenValue sym)
ss

{-# INLINE fromToDownByGreaterThanV #-}
-- @[ 10 .. >0 down by 2 ]@
fromToDownByGreaterThanV :: Backend sym => sym -> Prim sym
fromToDownByGreaterThanV :: forall sym. Backend sym => sym -> Prim sym
fromToDownByGreaterThanV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
first ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
bound ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
stride ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ty ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    let !f :: Integer -> SEval sym (GenValue sym)
f = sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
mkLit sym
sym TValue
ty
        ss :: SeqMap sym (GenValue sym)
ss = (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> Integer -> SEval sym (GenValue sym)
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
stride)
     in sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat ((Integer
first Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
bound Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
stride Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
stride)) TValue
ty SeqMap sym (GenValue sym)
ss

{-# INLINE infFromV #-}
infFromV :: Backend sym => sym -> Prim sym
infFromV :: forall sym. Backend sym => sym -> Prim sym
infFromV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ty ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
x ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do SEval sym (GenValue sym)
mx <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym SEval sym (GenValue sym)
x
       GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
         do GenValue sym
x' <- SEval sym (GenValue sym)
mx
            SInteger sym
i' <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
i
            sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
addV sym
sym TValue
ty GenValue sym
x' (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV sym
sym SInteger sym
i' TValue
ty

{-# INLINE infFromThenV #-}
infFromThenV :: Backend sym => sym -> Prim sym
infFromThenV :: forall sym. Backend sym => sym -> Prim sym
infFromThenV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ty ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
first ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun    \SEval sym (GenValue sym)
next ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do SEval sym (GenValue sym, GenValue sym)
mxd <- sym
-> SEval sym (GenValue sym, GenValue sym)
-> SEval sym (SEval sym (GenValue sym, GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym
               (do GenValue sym
x <- SEval sym (GenValue sym)
first
                   GenValue sym
y <- SEval sym (GenValue sym)
next
                   GenValue sym
d <- sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
subV sym
sym TValue
ty GenValue sym
y GenValue sym
x
                   (GenValue sym, GenValue sym)
-> SEval sym (GenValue sym, GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym
x,GenValue sym
d))
       GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenValue sym -> SEval sym (GenValue sym))
-> GenValue sym -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SeqMap sym (GenValue sym) -> GenValue sym
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
         (GenValue sym
x,GenValue sym
d) <- SEval sym (GenValue sym, GenValue sym)
mxd
         SInteger sym
i' <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
i
         sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
addV sym
sym TValue
ty GenValue sym
x (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
mulV sym
sym TValue
ty GenValue sym
d (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> TValue -> SEval sym (GenValue sym)
intV sym
sym SInteger sym
i' TValue
ty

-- Shifting ---------------------------------------------------


{-# INLINE shiftLeftReindex #-}
shiftLeftReindex :: Nat' -> Integer -> Integer -> Maybe Integer
shiftLeftReindex :: Nat' -> Integer -> Integer -> Maybe Integer
shiftLeftReindex Nat'
sz Integer
i Integer
shft =
   case Nat'
sz of
     Nat Integer
n | Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
shft Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
n -> Maybe Integer
forall a. Maybe a
Nothing
     Nat'
_                   -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
shft)

{-# INLINE shiftRightReindex #-}
shiftRightReindex :: Nat' -> Integer -> Integer -> Maybe Integer
shiftRightReindex :: Nat' -> Integer -> Integer -> Maybe Integer
shiftRightReindex Nat'
_sz Integer
i Integer
shft =
   if Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
shft Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Maybe Integer
forall a. Maybe a
Nothing else Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
shft)

{-# INLINE rotateLeftReindex #-}
rotateLeftReindex :: Nat' -> Integer -> Integer -> Maybe Integer
rotateLeftReindex :: Nat' -> Integer -> Integer -> Maybe Integer
rotateLeftReindex Nat'
sz Integer
i Integer
shft =
   case Nat'
sz of
     Nat'
Inf -> String -> [String] -> Maybe Integer
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"cannot rotate infinite sequence" []
     Nat Integer
n -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just ((Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
shft) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n)

{-# INLINE rotateRightReindex #-}
rotateRightReindex :: Nat' -> Integer -> Integer -> Maybe Integer
rotateRightReindex :: Nat' -> Integer -> Integer -> Maybe Integer
rotateRightReindex Nat'
sz Integer
i Integer
shft =
   case Nat'
sz of
     Nat'
Inf -> String -> [String] -> Maybe Integer
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"cannot rotate infinite sequence" []
     Nat Integer
n -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just ((Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
shft) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n)


{-# INLINE logicShift #-}
-- | Generic implementation of shifting.
--   Uses the provided word-level operation to perform the shift, when
--   possible.  Otherwise falls back on a barrel shifter that uses
--   the provided reindexing operation to implement the concrete
--   shifting operations.  The reindex operation is given the size
--   of the sequence, the requested index value for the new output sequence,
--   and the amount to shift.  The return value is an index into the original
--   sequence if in bounds, and Nothing otherwise.
logicShift :: Backend sym =>
  sym ->
  String ->
  (sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
     {- ^ operation for range reduction on integers -} ->
  (SWord sym -> SWord sym -> SEval sym (SWord sym))
     {- ^ word shift operation for positive indices -} ->
  (SWord sym -> SWord sym -> SEval sym (SWord sym))
     {- ^ word shift operation for negative indices -} ->
  (Nat' -> Integer -> Integer -> Maybe Integer)
     {- ^ reindexing operation for positive indices (sequence size, starting index, shift amount -} ->
  (Nat' -> Integer -> Integer -> Maybe Integer)
     {- ^ reindexing operation for negative indices (sequence size, starting index, shift amount -} ->
  Prim sym
logicShift :: forall sym.
Backend sym =>
sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
logicShift sym
sym String
nm sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shrinkRange SWord sym -> SWord sym -> SEval sym (SWord sym)
wopPos SWord sym -> SWord sym -> SEval sym (SWord sym)
wopNeg Nat' -> Integer -> Integer -> Maybe Integer
reindexPos Nat' -> Integer -> Integer -> Maybe Integer
reindexNeg =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
m ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ix ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do GenValue sym
xs' <- SEval sym (GenValue sym)
xs
       Either (SInteger sym) (WordValue sym)
y' <- sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
forall sym.
Backend sym =>
sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
asIndex sym
sym String
"shift" TValue
ix (GenValue sym -> Either (SInteger sym) (WordValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (Either (SInteger sym) (WordValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
y
       case Either (SInteger sym) (WordValue sym)
y' of
         Left SInteger sym
int_idx ->
           do SBit sym
pneg <- sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan sym
sym SInteger sym
int_idx (SInteger sym -> SEval sym (SBit sym))
-> SEval sym (SInteger sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0
              sym
-> SBit sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
iteValue sym
sym SBit sym
pneg
                (sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> SInteger sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> SInteger sym
-> SEval sym (GenValue sym)
intShifter sym
sym String
nm SWord sym -> SWord sym -> SEval sym (SWord sym)
wopNeg Nat' -> Integer -> Integer -> Maybe Integer
reindexNeg Nat'
m TValue
a GenValue sym
xs' (SInteger sym -> SEval sym (GenValue sym))
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shrinkRange sym
sym Nat'
m TValue
ix (SInteger sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym) -> SEval sym (SInteger sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SEval sym (SInteger sym)
intNegate sym
sym SInteger sym
int_idx)
                (sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> SInteger sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> SInteger sym
-> SEval sym (GenValue sym)
intShifter sym
sym String
nm SWord sym -> SWord sym -> SEval sym (SWord sym)
wopPos Nat' -> Integer -> Integer -> Maybe Integer
reindexPos Nat'
m TValue
a GenValue sym
xs' (SInteger sym -> SEval sym (GenValue sym))
-> SEval sym (SInteger sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shrinkRange sym
sym Nat'
m TValue
ix SInteger sym
int_idx)
         Right WordValue sym
idx ->
           sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> WordValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> WordValue sym
-> SEval sym (GenValue sym)
wordShifter sym
sym String
nm SWord sym -> SWord sym -> SEval sym (SWord sym)
wopPos Nat' -> Integer -> Integer -> Maybe Integer
reindexPos Nat'
m TValue
a GenValue sym
xs' WordValue sym
idx



{-# INLINE intShifter #-}
intShifter :: Backend sym =>
   sym ->
   String ->
   (SWord sym -> SWord sym -> SEval sym (SWord sym)) ->
   (Nat' -> Integer -> Integer -> Maybe Integer) ->
   Nat' ->
   TValue ->
   GenValue sym ->
   SInteger sym ->
   SEval sym (GenValue sym)
intShifter :: forall sym.
Backend sym =>
sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> SInteger sym
-> SEval sym (GenValue sym)
intShifter sym
sym String
nm SWord sym -> SWord sym -> SEval sym (SWord sym)
wop Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m TValue
a GenValue sym
xs SInteger sym
idx =
  case GenValue sym
xs of
    VWord WordValue sym
x    -> WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord   (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Integer -> Integer -> Maybe Integer)
-> WordValue sym
-> SInteger sym
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Integer -> Integer -> Maybe Integer)
-> WordValue sym
-> SInteger sym
-> SEval sym (WordValue sym)
shiftWordByInteger sym
sym SWord sym -> SWord sym -> SEval sym (SWord sym)
wop (Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m) WordValue sym
x SInteger sym
idx
    VSeq Integer
w SeqMap sym (GenValue sym)
vs  -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
a (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym
-> (SBit sym
    -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym (GenValue sym)
-> Nat'
-> SeqMap sym (GenValue sym)
-> SInteger sym
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (SBit sym -> a -> a -> SEval sym a)
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym a
-> Nat'
-> SeqMap sym a
-> SInteger sym
-> SEval sym (SeqMap sym a)
shiftSeqByInteger sym
sym (sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
mergeValue sym
sym) (Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m) (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
a) Nat'
m SeqMap sym (GenValue sym)
vs SInteger sym
idx
    VStream SeqMap sym (GenValue sym)
vs -> SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> (SBit sym
    -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym (GenValue sym)
-> Nat'
-> SeqMap sym (GenValue sym)
-> SInteger sym
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (SBit sym -> a -> a -> SEval sym a)
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym a
-> Nat'
-> SeqMap sym a
-> SInteger sym
-> SEval sym (SeqMap sym a)
shiftSeqByInteger sym
sym (sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
mergeValue sym
sym) (Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m) (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
a) Nat'
m SeqMap sym (GenValue sym)
vs SInteger sym
idx
    GenValue sym
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"expected sequence value in shift operation" [String
nm]


{-# INLINE wordShifter #-}
wordShifter :: Backend sym =>
   sym ->
   String ->
   (SWord sym -> SWord sym -> SEval sym (SWord sym)) ->
   (Nat' -> Integer -> Integer -> Maybe Integer) ->
   Nat' ->
   TValue ->
   GenValue sym ->
   WordValue sym ->
   SEval sym (GenValue sym)
wordShifter :: forall sym.
Backend sym =>
sym
-> String
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Nat'
-> TValue
-> GenValue sym
-> WordValue sym
-> SEval sym (GenValue sym)
wordShifter sym
sym String
nm SWord sym -> SWord sym -> SEval sym (SWord sym)
wop Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m TValue
a GenValue sym
xs WordValue sym
idx =
  case GenValue sym
xs of
    VWord WordValue sym
x    -> WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord   (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Integer -> Integer -> Maybe Integer)
-> WordValue sym
-> WordValue sym
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Integer -> Integer -> Maybe Integer)
-> WordValue sym
-> WordValue sym
-> SEval sym (WordValue sym)
shiftWordByWord sym
sym SWord sym -> SWord sym -> SEval sym (SWord sym)
wop (Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m) WordValue sym
x WordValue sym
idx
    VSeq Integer
w SeqMap sym (GenValue sym)
vs  -> sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
w) TValue
a (SeqMap sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym
-> (SBit sym
    -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym (GenValue sym)
-> Nat'
-> SeqMap sym (GenValue sym)
-> WordValue sym
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (SBit sym -> a -> a -> SEval sym a)
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym a
-> Nat'
-> SeqMap sym a
-> WordValue sym
-> SEval sym (SeqMap sym a)
shiftSeqByWord sym
sym (sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
mergeValue sym
sym) (Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m) (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
a) (Integer -> Nat'
Nat Integer
w) SeqMap sym (GenValue sym)
vs WordValue sym
idx
    VStream SeqMap sym (GenValue sym)
vs -> SeqMap sym (GenValue sym) -> GenValue sym
forall sym. SeqMap sym (GenValue sym) -> GenValue sym
VStream (SeqMap sym (GenValue sym) -> GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
-> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> (SBit sym
    -> GenValue sym -> GenValue sym -> SEval sym (GenValue sym))
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym (GenValue sym)
-> Nat'
-> SeqMap sym (GenValue sym)
-> WordValue sym
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (SBit sym -> a -> a -> SEval sym a)
-> (Integer -> Integer -> Maybe Integer)
-> SEval sym a
-> Nat'
-> SeqMap sym a
-> WordValue sym
-> SEval sym (SeqMap sym a)
shiftSeqByWord sym
sym (sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> GenValue sym
-> GenValue sym
-> SEval sym (GenValue sym)
mergeValue sym
sym) (Nat' -> Integer -> Integer -> Maybe Integer
reindex Nat'
m) (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
a) Nat'
Inf     SeqMap sym (GenValue sym)
vs WordValue sym
idx
    GenValue sym
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"expected sequence value in shift operation" [String
nm]



{-# INLINE shiftShrink #-}
shiftShrink :: Backend sym => sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shiftShrink :: forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shiftShrink sym
_sym Nat'
Inf TValue
_ SInteger sym
x = SInteger sym -> SEval sym (SInteger sym)
forall a. a -> SEval sym a
forall (m :: * -> *) a. Monad m => a -> m a
return SInteger sym
x
shiftShrink sym
sym (Nat Integer
w) TValue
_ SInteger sym
x =
  do SInteger sym
w' <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
w
     SBit sym
p  <- sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan sym
sym SInteger sym
w' SInteger sym
x
     sym
-> SBit sym
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> SInteger sym
-> SInteger sym
-> SEval sym (SInteger sym)
iteInteger sym
sym SBit sym
p SInteger sym
w' SInteger sym
x

{-# INLINE rotateShrink #-}
rotateShrink :: Backend sym => sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
rotateShrink :: forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
rotateShrink sym
_sym Nat'
Inf TValue
_ SInteger sym
_ = String -> [String] -> SEval sym (SInteger sym)
forall a. HasCallStack => String -> [String] -> a
panic String
"rotateShrink" [String
"expected finite sequence in rotate"]
rotateShrink sym
sym (Nat Integer
0) TValue
_ SInteger sym
_ = sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0
rotateShrink sym
sym (Nat Integer
w) TValue
_ SInteger sym
x =
  do SInteger sym
w' <- sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
w
     sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SInteger sym)
intMod sym
sym SInteger sym
x SInteger sym
w'

{-# INLINE sshrV #-}
sshrV :: Backend sym => sym -> Prim sym
sshrV :: forall sym. Backend sym => sym -> Prim sym
sshrV sym
sym =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
n ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
ix ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
x ->
  (GenValue sym -> Prim sym) -> Prim sym
forall sym. (GenValue sym -> Prim sym) -> Prim sym
PStrict  \GenValue sym
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$
    case sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
forall sym.
Backend sym =>
sym
-> String
-> TValue
-> GenValue sym
-> Either (SInteger sym) (WordValue sym)
asIndex sym
sym String
">>$" TValue
ix GenValue sym
y of
       Left SInteger sym
i ->
         do SBit sym
pneg <- sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SInteger sym -> SEval sym (SBit sym)
intLessThan sym
sym SInteger sym
i (SInteger sym -> SEval sym (SBit sym))
-> SEval sym (SInteger sym) -> SEval sym (SBit sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> Integer -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Integer -> SEval sym (SInteger sym)
integerLit sym
sym Integer
0
            WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> SEval sym (WordValue sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> SBit sym
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
forall sym.
Backend sym =>
sym
-> SBit sym
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
-> SEval sym (WordValue sym)
mergeWord' sym
sym
              SBit sym
pneg
              (do SInteger sym
i' <- sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shiftShrink sym
sym (Integer -> Nat'
Nat Integer
n) TValue
ix (SInteger sym -> SEval sym (SInteger sym))
-> SEval sym (SInteger sym) -> SEval sym (SInteger sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> SInteger sym -> SEval sym (SInteger sym)
intNegate sym
sym SInteger sym
i
                  SWord sym
amt <- sym -> Integer -> SInteger sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SWord sym)
wordFromInt sym
sym Integer
n SInteger sym
i'
                  SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> WordValue sym)
-> SEval sym (SWord sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordShiftLeft sym
sym SWord sym
x SWord sym
amt)
              (do SInteger sym
i' <- sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shiftShrink sym
sym (Integer -> Nat'
Nat Integer
n) TValue
ix SInteger sym
i
                  SWord sym
amt <- sym -> Integer -> SInteger sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> SInteger sym -> SEval sym (SWord sym)
wordFromInt sym
sym Integer
n SInteger sym
i'
                  SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> WordValue sym)
-> SEval sym (SWord sym) -> SEval sym (WordValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordSignedShiftRight sym
sym SWord sym
x SWord sym
amt)

       Right WordValue sym
wv ->
         do SWord sym
amt <- sym -> WordValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym (SWord sym)
asWordVal sym
sym WordValue sym
wv
            WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordSignedShiftRight sym
sym SWord sym
x SWord sym
amt

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

{-# SPECIALIZE errorV ::
  Concrete ->
  TValue ->
  String ->
  SEval Concrete (GenValue Concrete)
  #-}
errorV :: forall sym.
  Backend sym =>
  sym ->
  TValue ->
  String ->
  SEval sym (GenValue sym)
errorV :: forall sym.
Backend sym =>
sym -> TValue -> String -> SEval sym (GenValue sym)
errorV sym
sym TValue
_ty String
msg =
  do CallStack
stk <- sym -> SEval sym CallStack
forall sym. Backend sym => sym -> SEval sym CallStack
sGetCallStack sym
sym
     sym
-> CallStack
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall a. sym -> CallStack -> SEval sym a -> SEval sym a
forall sym a.
Backend sym =>
sym -> CallStack -> SEval sym a -> SEval sym a
sWithCallStack sym
sym CallStack
stk (sym -> String -> SEval sym (GenValue sym)
forall sym a. Backend sym => sym -> String -> SEval sym a
cryUserError sym
sym String
msg)

{-# INLINE valueToChar #-}

-- | Expect a word value.  Mask it to an 8-bits ASCII value
--   and return the associated character, if it is concrete.
--   Otherwise, return a '?' character
valueToChar :: Backend sym => sym -> GenValue sym -> SEval sym Char
valueToChar :: forall sym. Backend sym => sym -> GenValue sym -> SEval sym Char
valueToChar sym
sym (VWord WordValue sym
wval) | WordValue sym -> Integer
forall sym. Backend sym => WordValue sym -> Integer
wordValWidth WordValue sym
wval Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
8 =
  do SWord sym
w <- sym -> WordValue sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym (SWord sym)
asWordVal sym
sym WordValue sym
wval
     Char -> SEval sym Char
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> SEval sym Char) -> Char -> SEval sym Char
forall a b. (a -> b) -> a -> b
$! Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
'?' (sym -> SWord sym -> Maybe Char
forall sym. Backend sym => sym -> SWord sym -> Maybe Char
wordAsChar sym
sym SWord sym
w)
valueToChar sym
_ GenValue sym
_ = String -> [String] -> SEval sym Char
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"valueToChar" [String
"Not an 8-bit bitvector"]

{-# INLINE valueToString #-}

valueToString :: Backend sym => sym -> GenValue sym -> SEval sym String
valueToString :: forall sym. Backend sym => sym -> GenValue sym -> SEval sym String
valueToString sym
sym (VSeq Integer
n SeqMap sym (GenValue sym)
vals) = (SEval sym (GenValue sym) -> SEval sym Char)
-> [SEval sym (GenValue sym)] -> SEval sym String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (sym -> GenValue sym -> SEval sym Char
forall sym. Backend sym => sym -> GenValue sym -> SEval sym Char
valueToChar sym
sym (GenValue sym -> SEval sym Char)
-> SEval sym (GenValue sym) -> SEval sym Char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Integer -> SeqMap sym (GenValue sym) -> [SEval sym (GenValue sym)]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n SeqMap sym (GenValue sym)
vals)
valueToString sym
_ GenValue sym
_ = String -> [String] -> SEval sym String
forall a. HasCallStack => String -> [String] -> a
evalPanic String
"valueToString" [String
"Not a finite sequence"]


foldlV :: Backend sym => sym -> Prim sym
foldlV :: forall sym. Backend sym => sym -> Prim sym
foldlV sym
sym =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
_n ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_a ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_b ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
f ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
z ->
  (GenValue sym -> Prim sym) -> Prim sym
forall sym. (GenValue sym -> Prim sym) -> Prim sym
PStrict  \GenValue sym
v ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    case GenValue sym
v of
      VSeq Integer
n SeqMap sym (GenValue sym)
m  -> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go0 SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z (Integer -> SeqMap sym (GenValue sym) -> [SEval sym (GenValue sym)]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n SeqMap sym (GenValue sym)
m)
      VWord  WordValue sym
wv -> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go0 SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z ([SEval sym (GenValue sym)] -> SEval sym (GenValue sym))
-> ([SBit sym] -> [SEval sym (GenValue sym)])
-> [SBit sym]
-> SEval sym (GenValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SBit sym -> SEval sym (GenValue sym))
-> [SBit sym] -> [SEval sym (GenValue sym)]
forall a b. (a -> b) -> [a] -> [b]
map (GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> (SBit sym -> GenValue sym)
-> SBit sym
-> SEval sym (GenValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit) ([SBit sym] -> SEval sym (GenValue sym))
-> SEval sym [SBit sym] -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (sym -> WordValue sym -> SEval sym [SBit sym]
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym [SBit sym]
enumerateWordValue sym
sym WordValue sym
wv)
      GenValue sym
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Eval.Generic.foldlV" [String
"Expected finite sequence"]
  where
  go0 :: SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go0 SEval sym (GenValue sym)
_f SEval sym (GenValue sym)
a [] = SEval sym (GenValue sym)
a
  go0 SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a [SEval sym (GenValue sym)]
bs =
    do SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
f
       (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' SEval sym (GenValue sym)
a [SEval sym (GenValue sym)]
bs

  go1 :: (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
_f SEval sym (GenValue sym)
a [] = SEval sym (GenValue sym)
a
  go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a (SEval sym (GenValue sym)
b:[SEval sym (GenValue sym)]
bs) =
    do SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a)
       (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f (SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' SEval sym (GenValue sym)
b) [SEval sym (GenValue sym)]
bs

foldl'V :: Backend sym => sym -> Prim sym
foldl'V :: forall sym. Backend sym => sym -> Prim sym
foldl'V sym
sym =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
_n ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_a ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_b ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
f ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
z ->
  (GenValue sym -> Prim sym) -> Prim sym
forall sym. (GenValue sym -> Prim sym) -> Prim sym
PStrict  \GenValue sym
v ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    case GenValue sym
v of
      VSeq Integer
n SeqMap sym (GenValue sym)
m    -> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go0 SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z (Integer -> SeqMap sym (GenValue sym) -> [SEval sym (GenValue sym)]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n SeqMap sym (GenValue sym)
m)
      VWord WordValue sym
wv    -> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go0 SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z ([SEval sym (GenValue sym)] -> SEval sym (GenValue sym))
-> ([SBit sym] -> [SEval sym (GenValue sym)])
-> [SBit sym]
-> SEval sym (GenValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SBit sym -> SEval sym (GenValue sym))
-> [SBit sym] -> [SEval sym (GenValue sym)]
forall a b. (a -> b) -> [a] -> [b]
map (GenValue sym -> SEval sym (GenValue sym)
forall a. a -> SEval sym a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenValue sym -> SEval sym (GenValue sym))
-> (SBit sym -> GenValue sym)
-> SBit sym
-> SEval sym (GenValue sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit) ([SBit sym] -> SEval sym (GenValue sym))
-> SEval sym [SBit sym] -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (sym -> WordValue sym -> SEval sym [SBit sym]
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym [SBit sym]
enumerateWordValue sym
sym WordValue sym
wv)
      GenValue sym
_ -> String -> [String] -> SEval sym (GenValue sym)
forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Eval.Generic.foldlV" [String
"Expected finite sequence"]
  where
  go0 :: SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go0 SEval sym (GenValue sym)
_f SEval sym (GenValue sym)
a [] = SEval sym (GenValue sym)
a
  go0 SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a [SEval sym (GenValue sym)]
bs =
    do SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
f
       SEval sym (GenValue sym)
a' <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym SEval sym (GenValue sym)
a
       GenValue sym -> SEval sym ()
forall sym. Backend sym => GenValue sym -> SEval sym ()
forceValue (GenValue sym -> SEval sym ())
-> SEval sym (GenValue sym) -> SEval sym ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
a'
       (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' SEval sym (GenValue sym)
a' [SEval sym (GenValue sym)]
bs

  go1 :: (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
_f SEval sym (GenValue sym)
a [] = SEval sym (GenValue sym)
a
  go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a (SEval sym (GenValue sym)
b:[SEval sym (GenValue sym)]
bs) =
    do SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a)
       SEval sym (GenValue sym)
a' <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' SEval sym (GenValue sym)
b)
       GenValue sym -> SEval sym ()
forall sym. Backend sym => GenValue sym -> SEval sym ()
forceValue (GenValue sym -> SEval sym ())
-> SEval sym (GenValue sym) -> SEval sym ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
a'
       (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> [SEval sym (GenValue sym)]
-> SEval sym (GenValue sym)
go1 SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f SEval sym (GenValue sym)
a' [SEval sym (GenValue sym)]
bs


-- scanl : {n, a, b}  (a -> b -> a) -> a -> [n]b -> [1+n]a
scanlV :: forall sym. Backend sym => sym -> Prim sym
scanlV :: forall sym. Backend sym => sym -> Prim sym
scanlV sym
sym =
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
n ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_b ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
f ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
z ->
  (GenValue sym -> Prim sym) -> Prim sym
forall sym. (GenValue sym -> Prim sym) -> Prim sym
PStrict  \GenValue sym
v ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do SeqMap sym (GenValue sym)
sm <- case GenValue sym
v of
            VSeq Integer
_ SeqMap sym (GenValue sym)
m   -> Nat'
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
scan Nat'
n SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z SeqMap sym (GenValue sym)
m
            VWord WordValue sym
wv   -> Nat'
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
scan Nat'
n SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SeqMap sym (SBit sym) -> SeqMap sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> WordValue sym -> SeqMap sym (SBit sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> SeqMap sym (SBit sym)
asBitsMap sym
sym WordValue sym
wv)
            VStream SeqMap sym (GenValue sym)
m  -> Nat'
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
scan Nat'
n SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z SeqMap sym (GenValue sym)
m
            GenValue sym
_ -> String -> [String] -> SEval sym (SeqMap sym (GenValue sym))
forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Eval.Generic.scanlV" [String
"Expected sequence"]
       sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Nat' -> Nat' -> Nat'
nAdd (Integer -> Nat'
Nat Integer
1) Nat'
n) TValue
a SeqMap sym (GenValue sym)
sm

 where
  scan :: Nat' ->
          SEval sym (GenValue sym) ->
          SEval sym (GenValue sym) ->
          (SeqMap sym (GenValue sym)) ->
          SEval sym (SeqMap sym (GenValue sym))
  scan :: Nat'
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
scan Nat'
n SEval sym (GenValue sym)
f SEval sym (GenValue sym)
z SeqMap sym (GenValue sym)
m =
    do (SEval sym (SeqMap sym (GenValue sym))
result, SEval sym (SeqMap sym (GenValue sym)) -> SEval sym ()
fill) <- sym
-> String
-> SEval
     sym
     (SEval sym (SeqMap sym (GenValue sym)),
      SEval sym (SeqMap sym (GenValue sym)) -> SEval sym ())
forall a.
sym
-> String -> SEval sym (SEval sym a, SEval sym a -> SEval sym ())
forall sym a.
Backend sym =>
sym
-> String -> SEval sym (SEval sym a, SEval sym a -> SEval sym ())
sDeclareHole sym
sym String
"scanl"
       SEval sym (SeqMap sym (GenValue sym)) -> SEval sym ()
fill (SEval sym (SeqMap sym (GenValue sym)) -> SEval sym ())
-> SEval sym (SeqMap sym (GenValue sym)) -> SEval sym ()
forall a b. (a -> b) -> a -> b
$ sym
-> Nat'
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> Nat' -> SeqMap sym a -> SEval sym (SeqMap sym a)
memoMap sym
sym (Nat' -> Nat' -> Nat'
nAdd (Integer -> Nat'
Nat Integer
1) Nat'
n) (SeqMap sym (GenValue sym)
 -> SEval sym (SeqMap sym (GenValue sym)))
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall a b. (a -> b) -> a -> b
$ (Integer -> SEval sym (GenValue sym)) -> SeqMap sym (GenValue sym)
forall sym a. (Integer -> SEval sym a) -> SeqMap sym a
indexSeqMap ((Integer -> SEval sym (GenValue sym))
 -> SeqMap sym (GenValue sym))
-> (Integer -> SEval sym (GenValue sym))
-> SeqMap sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ \Integer
i ->
         if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then SEval sym (GenValue sym)
z
         else
           do SeqMap sym (GenValue sym)
r <- SEval sym (SeqMap sym (GenValue sym))
result
              SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f'  <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
f
              SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f'' <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' (SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
r (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1))
              SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f'' (SeqMap sym (GenValue sym) -> Integer -> SEval sym (GenValue sym)
forall sym a. Backend sym => SeqMap sym a -> Integer -> SEval sym a
lookupSeqMap SeqMap sym (GenValue sym)
m (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1))
       SEval sym (SeqMap sym (GenValue sym))
result

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

{-# SPECIALIZE randomV ::
  Concrete -> TValue -> Integer -> SEval Concrete (GenValue Concrete)
  #-}
-- | 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 :: Backend sym => sym -> TValue -> Integer -> SEval sym (GenValue sym)
randomV :: forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
randomV sym
sym TValue
ty Integer
seed =
  case sym -> TValue -> Maybe (Gen TFGen sym)
forall sym g.
(Backend sym, RandomGen g) =>
sym -> TValue -> Maybe (Gen g sym)
randomValue sym
sym TValue
ty of
    Maybe (Gen TFGen sym)
Nothing -> sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
ty
    Just Gen TFGen sym
gen ->
      -- unpack the seed into four Word64s
      let mask64 :: Integer
mask64 = Integer
0xFFFFFFFFFFFFFFFF
          unpack :: Integer -> [a]
unpack 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` Int
64)
          (Word64
a, Word64
b, Word64
c, Word64
d) = case Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
4 (Integer -> [Word64]
forall {a}. Num a => Integer -> [a]
unpack Integer
seed) of
                           [Word64
a', Word64
b', Word64
c', Word64
d'] -> (Word64
a', Word64
b', Word64
c', Word64
d')
                           [Word64]
_ -> String -> (Word64, Word64, Word64, Word64)
forall a. HasCallStack => String -> a
error String
"randomV: impossible (infinite seed is finite)"
      in (SEval sym (GenValue sym), TFGen) -> SEval sym (GenValue sym)
forall a b. (a, b) -> a
fst ((SEval sym (GenValue sym), TFGen) -> SEval sym (GenValue sym))
-> (SEval sym (GenValue sym), TFGen) -> SEval sym (GenValue sym)
forall a b. (a -> b) -> a -> b
$ Gen TFGen sym
gen Integer
100 (TFGen -> (SEval sym (GenValue sym), TFGen))
-> TFGen -> (SEval sym (GenValue sym), TFGen)
forall a b. (a -> b) -> a -> b
$ (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen (Word64
a, Word64
b, Word64
c, Word64
d)

--------------------------------------------------------------------------------
-- Experimental parallel primitives

parmapV :: Backend sym => sym -> Prim sym
parmapV :: forall sym. Backend sym => sym -> Prim sym
parmapV sym
sym =
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
_a ->
  (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
b ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
n ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
f ->
  (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
xs ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
    do SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' <- sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> GenValue sym
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
fromVFun sym
sym (GenValue sym
 -> SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym)
-> SEval sym (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
f
       GenValue sym
xs' <- SEval sym (GenValue sym)
xs
       SeqMap sym (GenValue sym)
m <-
         case GenValue sym
xs' of
           VWord WordValue sym
w ->
             let m :: SeqMap sym (SBit sym)
m = sym -> WordValue sym -> SeqMap sym (SBit sym)
forall sym.
Backend sym =>
sym -> WordValue sym -> SeqMap sym (SBit sym)
asBitsMap sym
sym WordValue sym
w in
             sym
-> (SEval sym (SBit sym) -> SEval sym (GenValue sym))
-> Integer
-> SeqMap sym (SBit sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (SEval sym a -> SEval sym (GenValue sym))
-> Integer
-> SeqMap sym a
-> SEval sym (SeqMap sym (GenValue sym))
sparkParMap sym
sym (\SEval sym (SBit sym)
x -> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (SBit sym)
x)) Integer
n SeqMap sym (SBit sym)
m
           VSeq Integer
_n SeqMap sym (GenValue sym)
m ->
             sym
-> (SEval sym (GenValue sym) -> SEval sym (GenValue sym))
-> Integer
-> SeqMap sym (GenValue sym)
-> SEval sym (SeqMap sym (GenValue sym))
forall sym a.
Backend sym =>
sym
-> (SEval sym a -> SEval sym (GenValue sym))
-> Integer
-> SeqMap sym a
-> SEval sym (SeqMap sym (GenValue sym))
sparkParMap sym
sym SEval sym (GenValue sym) -> SEval sym (GenValue sym)
f' Integer
n SeqMap sym (GenValue sym)
m

           GenValue sym
_ -> String -> [String] -> SEval sym (SeqMap sym (GenValue sym))
forall a. HasCallStack => String -> [String] -> a
panic String
"parmapV" [String
"expected finite sequence!"]
       sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> TValue
-> SeqMap sym (GenValue sym)
-> SEval sym (GenValue sym)
mkSeq sym
sym (Integer -> Nat'
Nat Integer
n) TValue
b SeqMap sym (GenValue sym)
m


sparkParMap ::
  Backend sym =>
  sym ->
  (SEval sym a -> SEval sym (GenValue sym)) ->
  Integer ->
  SeqMap sym a ->
  SEval sym (SeqMap sym (GenValue sym))
sparkParMap :: forall sym a.
Backend sym =>
sym
-> (SEval sym a -> SEval sym (GenValue sym))
-> Integer
-> SeqMap sym a
-> SEval sym (SeqMap sym (GenValue sym))
sparkParMap sym
sym SEval sym a -> SEval sym (GenValue sym)
f Integer
n SeqMap sym a
m =
  sym -> [SEval sym (GenValue sym)] -> SeqMap sym (GenValue sym)
forall sym a. Backend sym => sym -> [SEval sym a] -> SeqMap sym a
finiteSeqMap sym
sym ([SEval sym (GenValue sym)] -> SeqMap sym (GenValue sym))
-> SEval sym [SEval sym (GenValue sym)]
-> SEval sym (SeqMap sym (GenValue sym))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SEval sym a -> SEval sym (SEval sym (GenValue sym)))
-> [SEval sym a] -> SEval sym [SEval sym (GenValue sym)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall a. sym -> SEval sym a -> SEval sym (SEval sym a)
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sSpark sym
sym (SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym)))
-> (SEval sym a -> SEval sym (GenValue sym))
-> SEval sym a
-> SEval sym (SEval sym (GenValue sym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEval sym a -> SEval sym (GenValue sym)
g) (Integer -> SeqMap sym a -> [SEval sym a]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n SeqMap sym a
m)
 where
 g :: SEval sym a -> SEval sym (GenValue sym)
g SEval sym a
x =
   do SEval sym (GenValue sym)
z <- sym
-> SEval sym (GenValue sym) -> SEval sym (SEval sym (GenValue sym))
forall sym a.
Backend sym =>
sym -> SEval sym a -> SEval sym (SEval sym a)
sDelay sym
sym (SEval sym a -> SEval sym (GenValue sym)
f SEval sym a
x)
      GenValue sym -> SEval sym ()
forall sym. Backend sym => GenValue sym -> SEval sym ()
forceValue (GenValue sym -> SEval sym ())
-> SEval sym (GenValue sym) -> SEval sym ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
z
      SEval sym (GenValue sym)
z

--------------------------------------------------------------------------------
-- Floating Point Operations

-- | A helper for definitng floating point constants.
fpConst ::
  Backend sym =>
  (Integer -> Integer -> SEval sym (SFloat sym)) ->
  Prim sym
fpConst :: forall sym.
Backend sym =>
(Integer -> Integer -> SEval sym (SFloat sym)) -> Prim sym
fpConst Integer -> Integer -> SEval sym (SFloat sym)
mk =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
e ->
  (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \ ~(Nat Integer
p) ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> SEval sym (SFloat sym)
mk Integer
e Integer
p)

-- | Make a Cryptol value for a binary arithmetic function.
fpBinArithV :: Backend sym => sym -> FPArith2 sym -> Prim sym
fpBinArithV :: forall sym. Backend sym => sym -> FPArith2 sym -> Prim sym
fpBinArithV sym
sym FPArith2 sym
fun =
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly  \Integer
_e ->
  (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly  \Integer
_p ->
  (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun  \SWord sym
r ->
  (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
  (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
y ->
  SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FPArith2 sym
fun sym
sym SWord sym
r SFloat sym
x SFloat sym
y)

-- | Rounding mode used in FP operations that do not specify it explicitly.
fpRndMode, fpRndRNE, fpRndRNA, fpRndRTP, fpRndRTN, fpRndRTZ ::
   Backend sym => sym -> SEval sym (SWord sym)
fpRndMode :: forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndMode    = sym -> SEval sym (SWord sym)
forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRNE
fpRndRNE :: forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRNE sym
sym = sym -> Integer -> Integer -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SWord sym)
wordLit sym
sym Integer
3 Integer
0 {- to nearest, ties to even -}
fpRndRNA :: forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRNA sym
sym = sym -> Integer -> Integer -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SWord sym)
wordLit sym
sym Integer
3 Integer
1 {- to nearest, ties to away from 0 -}
fpRndRTP :: forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRTP sym
sym = sym -> Integer -> Integer -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SWord sym)
wordLit sym
sym Integer
3 Integer
2 {- to +inf -}
fpRndRTN :: forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRTN sym
sym = sym -> Integer -> Integer -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SWord sym)
wordLit sym
sym Integer
3 Integer
3 {- to -inf -}
fpRndRTZ :: forall sym. Backend sym => sym -> SEval sym (SWord sym)
fpRndRTZ sym
sym = sym -> Integer -> Integer -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SWord sym)
wordLit sym
sym Integer
3 Integer
4 {- to 0    -}


{-# SPECIALIZE genericFloatTable :: Concrete -> Map PrimIdent (Prim Concrete) #-}

genericFloatTable :: Backend sym => sym -> Map PrimIdent (Prim sym)
genericFloatTable :: forall sym. Backend sym => sym -> Map PrimIdent (Prim sym)
genericFloatTable sym
sym =
  let ~> :: a -> b -> (a, b)
(~>) = (,) in
  [(PrimIdent, Prim sym)] -> Map PrimIdent (Prim sym)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PrimIdent, Prim sym)] -> Map PrimIdent (Prim sym))
-> [(PrimIdent, Prim sym)] -> Map PrimIdent (Prim sym)
forall a b. (a -> b) -> a -> b
$ ((Text, Prim sym) -> (PrimIdent, Prim sym))
-> [(Text, Prim sym)] -> [(PrimIdent, Prim sym)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
n, Prim sym
v) -> (Text -> PrimIdent
floatPrim Text
n, Prim sym
v))
    [ Text
"fpNaN"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Integer -> SEval sym (SFloat sym)) -> Prim sym
forall sym.
Backend sym =>
(Integer -> Integer -> SEval sym (SFloat sym)) -> Prim sym
fpConst (sym -> Integer -> Integer -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SFloat sym)
fpNaN sym
sym)
    , Text
"fpPosInf"    Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Integer -> SEval sym (SFloat sym)) -> Prim sym
forall sym.
Backend sym =>
(Integer -> Integer -> SEval sym (SFloat sym)) -> Prim sym
fpConst (sym -> Integer -> Integer -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SEval sym (SFloat sym)
fpPosInf sym
sym)
    , Text
"fpFromBits"  Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
e -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
p -> (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
w ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> Integer -> Integer -> SWord sym -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> Integer -> Integer -> SWord sym -> SEval sym (SFloat sym)
fpFromBits sym
sym Integer
e Integer
p SWord sym
w)
    , Text
"fpToBits"    Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_e -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_p -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x -> SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
                            (WordValue sym -> GenValue sym
forall sym. WordValue sym -> GenValue sym
VWord (WordValue sym -> GenValue sym)
-> (SWord sym -> WordValue sym) -> SWord sym -> GenValue sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord sym -> WordValue sym
forall sym. SWord sym -> WordValue sym
wordVal (SWord sym -> GenValue sym)
-> SEval sym (SWord sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SWord sym)
fpToBits sym
sym SFloat sym
x)
    , Text
"=.="         Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
y ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SFloat sym -> SEval sym (SBit sym)
fpLogicalEq sym
sym SFloat sym
x SFloat sym
y)

    , Text
"fpIsNaN"     Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SBit sym)
fpIsNaN sym
sym SFloat sym
x)
    , Text
"fpIsInf"     Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SBit sym)
fpIsInf sym
sym SFloat sym
x)
    , Text
"fpIsZero"    Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SBit sym)
fpIsZero sym
sym SFloat sym
x)
    , Text
"fpIsNeg"     Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SBit sym)
fpIsNeg sym
sym SFloat sym
x)
    , Text
"fpIsNormal"  Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SBit sym)
fpIsNorm sym
sym SFloat sym
x)
    , Text
"fpIsSubnormal" Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                         SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (SBit sym -> GenValue sym)
-> SEval sym (SBit sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SBit sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SBit sym)
fpIsSubnorm sym
sym SFloat sym
x)

    , Text
"fpAdd"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> sym -> FPArith2 sym -> Prim sym
forall sym. Backend sym => sym -> FPArith2 sym -> Prim sym
fpBinArithV sym
sym FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpPlus
    , Text
"fpSub"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> sym -> FPArith2 sym -> Prim sym
forall sym. Backend sym => sym -> FPArith2 sym -> Prim sym
fpBinArithV sym
sym FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpMinus
    , Text
"fpMul"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> sym -> FPArith2 sym -> Prim sym
forall sym. Backend sym => sym -> FPArith2 sym -> Prim sym
fpBinArithV sym
sym FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpMult
    , Text
"fpDiv"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> sym -> FPArith2 sym -> Prim sym
forall sym. Backend sym => sym -> FPArith2 sym -> Prim sym
fpBinArithV sym
sym FPArith2 sym
forall sym. Backend sym => FPArith2 sym
fpDiv
    , Text
"fpFMA"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
r ->
                       (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
y -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
z ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> SWord sym
-> SFloat sym
-> SFloat sym
-> SFloat sym
-> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym
-> SWord sym
-> SFloat sym
-> SFloat sym
-> SFloat sym
-> SEval sym (SFloat sym)
fpFMA sym
sym SWord sym
r SFloat sym
x SFloat sym
y SFloat sym
z)

    , Text
"fpAbs"       Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ ->
                       (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SFloat sym)
fpAbs sym
sym SFloat sym
x)

    , Text
"fpSqrt"      Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ ->
                       (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
r -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
                       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SWord sym -> SFloat sym -> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SFloat sym -> SEval sym (SFloat sym)
fpSqrt sym
sym SWord sym
r SFloat sym
x)

    , Text
"fpToRational" Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~>
       (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_e -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_p -> (SFloat sym -> Prim sym) -> Prim sym
forall sym. (SFloat sym -> Prim sym) -> Prim sym
PFloatFun \SFloat sym
x ->
       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SRational sym -> GenValue sym
forall sym. SRational sym -> GenValue sym
VRational (SRational sym -> GenValue sym)
-> SEval sym (SRational sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym -> SFloat sym -> SEval sym (SRational sym)
forall sym.
Backend sym =>
sym -> SFloat sym -> SEval sym (SRational sym)
fpToRational sym
sym SFloat sym
x)

    , Text
"fpFromRational" Text -> Prim sym -> (Text, Prim sym)
forall a b. a -> b -> (a, b)
~>
       (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
e -> (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
p -> (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
r -> (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
x ->
       SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
         do SRational sym
rat <- GenValue sym -> SRational sym
forall sym. Backend sym => GenValue sym -> SRational sym
fromVRational (GenValue sym -> SRational sym)
-> SEval sym (GenValue sym) -> SEval sym (SRational sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEval sym (GenValue sym)
x
            SFloat sym -> GenValue sym
forall sym. SFloat sym -> GenValue sym
VFloat (SFloat sym -> GenValue sym)
-> SEval sym (SFloat sym) -> SEval sym (GenValue sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sym
-> Integer
-> Integer
-> SWord sym
-> SRational sym
-> SEval sym (SFloat sym)
forall sym.
Backend sym =>
sym
-> Integer
-> Integer
-> SWord sym
-> SRational sym
-> SEval sym (SFloat sym)
fpFromRational sym
sym Integer
e Integer
p SWord sym
r SRational sym
rat

    ]


{-# SPECIALIZE genericPrimTable :: Concrete -> IO EvalOpts -> Map PrimIdent (Prim Concrete) #-}

genericPrimTable :: Backend sym => sym -> IO EvalOpts -> Map PrimIdent (Prim sym)
genericPrimTable :: forall sym.
Backend sym =>
sym -> IO EvalOpts -> Map PrimIdent (Prim sym)
genericPrimTable sym
sym IO EvalOpts
getEOpts =
  [(PrimIdent, Prim sym)] -> Map PrimIdent (Prim sym)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PrimIdent, Prim sym)] -> Map PrimIdent (Prim sym))
-> [(PrimIdent, Prim sym)] -> Map PrimIdent (Prim sym)
forall a b. (a -> b) -> a -> b
$ ((Text, Prim sym) -> (PrimIdent, Prim sym))
-> [(Text, Prim sym)] -> [(PrimIdent, Prim sym)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
n, Prim sym
v) -> (Text -> PrimIdent
prelPrim Text
n, Prim sym
v))

  [ -- Literals
    (Text
"True"       , GenValue sym -> Prim sym
forall sym. GenValue sym -> Prim sym
PVal (GenValue sym -> Prim sym) -> GenValue sym -> Prim sym
forall a b. (a -> b) -> a -> b
$ SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
True))
  , (Text
"False"      , GenValue sym -> Prim sym
forall sym. GenValue sym -> Prim sym
PVal (GenValue sym -> Prim sym) -> GenValue sym -> Prim sym
forall a b. (a -> b) -> a -> b
$ SBit sym -> GenValue sym
forall sym. SBit sym -> GenValue sym
VBit (sym -> Bool -> SBit sym
forall sym. Backend sym => sym -> Bool -> SBit sym
bitLit sym
sym Bool
False))
  , (Text
"number"     , {-# SCC "Prelude::number" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
ecNumberV sym
sym)
  , (Text
"ratio"      , {-# SCC "Prelude::ratio" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
ratioV sym
sym)
  , (Text
"fraction"   , sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
ecFractionV sym
sym)

    -- Zero
  , (Text
"zero"       , {-# SCC "Prelude::zero" #-}
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
ty ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (sym -> TValue -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> SEval sym (GenValue sym)
zeroV sym
sym TValue
ty))

    -- Logic
  , (Text
"&&"         , {-# SCC "Prelude::(&&)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
andV sym
sym))
  , (Text
"||"         , {-# SCC "Prelude::(||)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
orV sym
sym))
  , (Text
"^"          , {-# SCC "Prelude::(^)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
xorV sym
sym))
  , (Text
"complement" , {-# SCC "Prelude::complement" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary  (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
complementV sym
sym))

    -- Ring
  , (Text
"fromInteger", {-# SCC "Prelude::fromInteger" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromIntegerV sym
sym)
  , (Text
"+"          , {-# SCC "Prelude::(+)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
addV sym
sym))
  , (Text
"-"          , {-# SCC "Prelude::(-)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
subV sym
sym))
  , (Text
"*"          , {-# SCC "Prelude::(*)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
mulV sym
sym))
  , (Text
"negate"     , {-# SCC "Prelude::negate" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
negateV sym
sym))

    -- Integral
  , (Text
"toInteger"  , {-# SCC "Prelude::toInteger" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
toIntegerV sym
sym)
  , (Text
"/"          , {-# SCC "Prelude::(/)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
divV sym
sym))
  , (Text
"%"          , {-# SCC "Prelude::(%)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
modV sym
sym))
  , (Text
"^^"         , {-# SCC "Prelude::(^^)" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
expV sym
sym)
  , (Text
"infFrom"    , {-# SCC "Prelude::infFrom" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
infFromV sym
sym)
  , (Text
"infFromThen", {-# SCC "Prelude::infFromThen" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
infFromThenV sym
sym)

    -- Field
  , (Text
"recip"      , {-# SCC "Prelude::recip" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
recipV sym
sym)
  , (Text
"/."         , {-# SCC "Prelude::(/.)" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fieldDivideV sym
sym)

    -- Round
  , (Text
"floor"      , {-# SCC "Prelude::floor" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
floorV sym
sym))
  , (Text
"ceiling"    , {-# SCC "Prelude::ceiling" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
ceilingV sym
sym))
  , (Text
"trunc"      , {-# SCC "Prelude::trunc" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
truncV sym
sym))
  , (Text
"roundAway"  , {-# SCC "Prelude::roundAway" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
roundAwayV sym
sym))
  , (Text
"roundToEven", {-# SCC "Prelude::roundToEven" #-}
                    Unary sym -> Prim sym
forall sym. Backend sym => Unary sym -> Prim sym
unary (sym -> Unary sym
forall sym. Backend sym => sym -> Unary sym
roundToEvenV sym
sym))

    -- Bitvector specific operations
  , (Text
"toSignedInteger"
                  , {-# SCC "Prelude::toSignedInteger" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
toSignedIntegerV sym
sym)
  , (Text
"/$"         , {-# SCC "Prelude::(/$)" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
sdivV sym
sym)
  , (Text
"%$"         , {-# SCC "Prelude::(%$)" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
smodV sym
sym)
  , (Text
"lg2"        , {-# SCC "Prelude::lg2" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
lg2V sym
sym)

    -- Cmp
  , (Text
"<"          , {-# SCC "Prelude::(<)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
lessThanV sym
sym))
  , (Text
">"          , {-# SCC "Prelude::(>)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
greaterThanV sym
sym))
  , (Text
"<="         , {-# SCC "Prelude::(<=)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
lessThanEqV sym
sym))
  , (Text
">="         , {-# SCC "Prelude::(>=)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
greaterThanEqV sym
sym))
  , (Text
"=="         , {-# SCC "Prelude::(==)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
eqV sym
sym))
  , (Text
"!="         , {-# SCC "Prelude::(!=)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
distinctV sym
sym))

    -- SignedCmp
  , (Text
"<$"         , {-# SCC "Prelude::(<$)" #-}
                    Binary sym -> Prim sym
forall sym. Backend sym => Binary sym -> Prim sym
binary (sym -> Binary sym
forall sym. Backend sym => sym -> Binary sym
signedLessThanV sym
sym))

    -- Finite enumerations
  , (Text
"fromTo"     , {-# SCC "Prelude::fromTo" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromToV sym
sym)

  , (Text
"fromThenTo" , {-# SCC "Prelude::fromThenTo" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromThenToV sym
sym)

  , (Text
"fromToLessThan"
                  , {-# SCC "Prelude::fromToLessThan" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromToLessThanV sym
sym)

  , (Text
"fromToBy"   , {-# SCC "Prelude::fromToBy" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromToByV sym
sym)

  , (Text
"fromToByLessThan",
                    {-# SCC "Prelude::fromToByLessThan" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromToByLessThanV sym
sym)

  , (Text
"fromToDownBy", {-# SCC "Prelude::fromToDownBy" #-}
                     sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromToDownByV sym
sym)

  , (Text
"fromToDownByGreaterThan"
                  , {-# SCC "Prelude::fromToDownByGreaterThan" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromToDownByGreaterThanV sym
sym)

    -- Sequence manipulations
  , (Text
"#"          , {-# SCC "Prelude::(#)" #-}
                    (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
front ->
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
back  ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
elty  ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
l ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
r ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym
-> Integer
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
ccatV sym
sym Integer
front Nat'
back TValue
elty SEval sym (GenValue sym)
l SEval sym (GenValue sym)
r)

  , (Text
"join"       , {-# SCC "Prelude::join" #-}
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
parts ->
                    (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
each  ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a     ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
x   ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
joinV sym
sym Nat'
parts Integer
each TValue
a SEval sym (GenValue sym)
x)

  , (Text
"split"      , {-# SCC "Prelude::split" #-}
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
parts ->
                    (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
each ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
val ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
splitV sym
sym Nat'
parts Integer
each TValue
a SEval sym (GenValue sym)
val)

  , (Text
"take"       , {-# SCC "Preldue::take" #-}
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
front ->
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
back ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym
-> Nat'
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Nat'
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
takeV sym
sym Nat'
front Nat'
back TValue
a SEval sym (GenValue sym)
xs)

  , (Text
"drop"       , {-# SCC "Preldue::drop" #-}
                    (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
front ->
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
back ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym
-> Integer
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> Nat'
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
dropV sym
sym Integer
front Nat'
back TValue
a SEval sym (GenValue sym)
xs)

  , (Text
"reverse"    , {-# SCC "Prelude::reverse" #-}
                    (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
a ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
b ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym
-> Integer
-> TValue
-> SEval sym (GenValue sym)
-> SEval sym (GenValue sym)
reverseV sym
sym Integer
a TValue
b SEval sym (GenValue sym)
xs)

  , (Text
"transpose"  , {-# SCC "Prelude::transpose" #-}
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
a ->
                    (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
b ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
c ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
xs ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (SEval sym (GenValue sym) -> Prim sym)
-> SEval sym (GenValue sym) -> Prim sym
forall a b. (a -> b) -> a -> b
$ sym -> Nat' -> Nat' -> Unary sym
forall sym.
Backend sym =>
sym
-> Nat'
-> Nat'
-> TValue
-> GenValue sym
-> SEval sym (GenValue sym)
transposeV sym
sym Nat'
a Nat'
b TValue
c (GenValue sym -> SEval sym (GenValue sym))
-> SEval sym (GenValue sym) -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
xs)

    -- Shifts and rotates
  , (Text
"<<"         , {-# SCC "Prelude::(<<)" #-}
                    sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
forall sym.
Backend sym =>
sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
logicShift sym
sym String
"<<" sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shiftShrink
                      (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordShiftLeft sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordShiftRight sym
sym)
                      Nat' -> Integer -> Integer -> Maybe Integer
shiftLeftReindex Nat' -> Integer -> Integer -> Maybe Integer
shiftRightReindex)
  , (Text
">>"         , {-# SCC "Prelude::(>>)" #-}
                    sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
forall sym.
Backend sym =>
sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
logicShift sym
sym String
">>"  sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
shiftShrink
                      (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordShiftRight sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordShiftLeft sym
sym)
                      Nat' -> Integer -> Integer -> Maybe Integer
shiftRightReindex Nat' -> Integer -> Integer -> Maybe Integer
shiftLeftReindex)
  , (Text
"<<<"        , {-# SCC "Prelude::(<<<)" #-}
                    sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
forall sym.
Backend sym =>
sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
logicShift sym
sym String
"<<<" sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
rotateShrink
                      (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordRotateLeft sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordRotateRight sym
sym)
                      Nat' -> Integer -> Integer -> Maybe Integer
rotateLeftReindex Nat' -> Integer -> Integer -> Maybe Integer
rotateRightReindex)
  , (Text
">>>"        , {-# SCC "Prelude::(>>>)" #-}
                    sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
forall sym.
Backend sym =>
sym
-> String
-> (sym
    -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (SWord sym -> SWord sym -> SEval sym (SWord sym))
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> (Nat' -> Integer -> Integer -> Maybe Integer)
-> Prim sym
logicShift sym
sym String
">>>" sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
forall sym.
Backend sym =>
sym -> Nat' -> TValue -> SInteger sym -> SEval sym (SInteger sym)
rotateShrink
                      (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordRotateRight sym
sym) (sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
forall sym.
Backend sym =>
sym -> SWord sym -> SWord sym -> SEval sym (SWord sym)
wordRotateLeft sym
sym)
                      Nat' -> Integer -> Integer -> Maybe Integer
rotateRightReindex Nat' -> Integer -> Integer -> Maybe Integer
rotateLeftReindex)

  , (Text
">>$"        , {-# SCC "Prelude::(>>$)" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
sshrV sym
sym)

    -- Misc

    -- {at,len} (fin len) => [len][8] -> at
  , (Text
"error"      , {-# SCC "Prelude::error" #-}
                     (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
                     (Integer -> Prim sym) -> Prim sym
forall sym. (Integer -> Prim sym) -> Prim sym
PFinPoly \Integer
_ ->
                     (GenValue sym -> Prim sym) -> Prim sym
forall sym. (GenValue sym -> Prim sym) -> Prim sym
PStrict  \GenValue sym
s ->
                     SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim (sym -> TValue -> String -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> String -> SEval sym (GenValue sym)
errorV sym
sym TValue
a (String -> SEval sym (GenValue sym))
-> SEval sym String -> SEval sym (GenValue sym)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< sym -> GenValue sym -> SEval sym String
forall sym. Backend sym => sym -> GenValue sym -> SEval sym String
valueToString sym
sym GenValue sym
s))

  , (Text
"trace"       , {-# SCC "Prelude::trace" #-}
                     (Nat' -> Prim sym) -> Prim sym
forall sym. (Nat' -> Prim sym) -> Prim sym
PNumPoly \Nat'
_n ->
                     (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_a ->
                     (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
_b ->
                     (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
s ->
                     (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
x ->
                     (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun     \SEval sym (GenValue sym)
y ->
                     SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
                      do String
msg <- sym -> GenValue sym -> SEval sym String
forall sym. Backend sym => sym -> GenValue sym -> SEval sym String
valueToString sym
sym (GenValue sym -> SEval sym String)
-> SEval sym (GenValue sym) -> SEval sym String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
s
                         EvalOpts { PPOpts
evalPPOpts :: PPOpts
evalPPOpts :: EvalOpts -> PPOpts
evalPPOpts, Logger
evalLogger :: Logger
evalLogger :: EvalOpts -> Logger
evalLogger } <- IO EvalOpts -> SEval sym EvalOpts
forall a. IO a -> SEval sym a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO EvalOpts
getEOpts
                         Doc
doc <- sym -> PPOpts -> GenValue sym -> SEval sym Doc
forall sym.
Backend sym =>
sym -> PPOpts -> GenValue sym -> SEval sym Doc
ppValue sym
sym PPOpts
evalPPOpts (GenValue sym -> SEval sym Doc)
-> SEval sym (GenValue sym) -> SEval sym Doc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
x
                         IO () -> SEval sym ()
forall a. IO a -> SEval sym a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SEval sym ()) -> IO () -> SEval sym ()
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 a. [a] -> 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
                         SEval sym (GenValue sym)
y)

  , (Text
"random"      , {-# SCC "Prelude::random" #-}
                     (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly  \TValue
a ->
                     (SWord sym -> Prim sym) -> Prim sym
forall sym. (SWord sym -> Prim sym) -> Prim sym
PWordFun \SWord sym
x ->
                     SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim
                       case sym -> SWord sym -> Maybe (Integer, Integer)
forall sym.
Backend sym =>
sym -> SWord sym -> Maybe (Integer, Integer)
wordAsLit sym
sym SWord sym
x of
                         Just (Integer
_,Integer
i)  -> sym -> TValue -> Integer -> SEval sym (GenValue sym)
forall sym.
Backend sym =>
sym -> TValue -> Integer -> SEval sym (GenValue sym)
randomV sym
sym TValue
a Integer
i
                         Maybe (Integer, Integer)
Nothing -> IO (GenValue sym) -> SEval sym (GenValue sym)
forall a. IO a -> SEval sym a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Unsupported -> IO (GenValue sym)
forall a e. Exception e => e -> a
X.throw (String -> Unsupported
UnsupportedSymbolicOp String
"random")))

  , (Text
"foldl"      , {-# SCC "Prelude::foldl" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
foldlV sym
sym)

  , (Text
"foldl'"     , {-# SCC "Prelude::foldl'" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
foldl'V sym
sym)

  , (Text
"scanl"      , {-# SCC "Prelude::scanl" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
scanlV sym
sym)

  , (Text
"deepseq"    , {-# SCC "Prelude::deepseq" #-}
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
_a ->
                    (TValue -> Prim sym) -> Prim sym
forall sym. (TValue -> Prim sym) -> Prim sym
PTyPoly \TValue
_b ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
x ->
                    (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
forall sym. (SEval sym (GenValue sym) -> Prim sym) -> Prim sym
PFun \SEval sym (GenValue sym)
y ->
                    SEval sym (GenValue sym) -> Prim sym
forall sym. SEval sym (GenValue sym) -> Prim sym
PPrim do ()
_ <- GenValue sym -> SEval sym ()
forall sym. Backend sym => GenValue sym -> SEval sym ()
forceValue (GenValue sym -> SEval sym ())
-> SEval sym (GenValue sym) -> SEval sym ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SEval sym (GenValue sym)
x
                             SEval sym (GenValue sym)
y)

  , (Text
"parmap"     , {-# SCC "Prelude::parmap" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
parmapV sym
sym)

  , (Text
"fromZ"      , {-# SCC "Prelude::fromZ" #-}
                    sym -> Prim sym
forall sym. Backend sym => sym -> Prim sym
fromZV sym
sym)

  ]