{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.Analysis.Hash
-- Copyright   : [2017..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Analysis.Hash (

  -- hashing expressions
  Hash,
  HashOptions(..), defaultHashOptions,
  hashPreOpenAcc, hashPreOpenAccWith,
  hashOpenFun, hashOpenExp,

  -- auxiliary
  EncodeAcc,
  encodePreOpenAcc,
  encodeOpenExp,
  encodeOpenFun,
  encodeArraysType,
  hashQ,

) where

import Data.Array.Accelerate.AST
import Data.Array.Accelerate.AST.Idx
import Data.Array.Accelerate.AST.LeftHandSide
import Data.Array.Accelerate.AST.Var
import Data.Array.Accelerate.Analysis.Hash.TH
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Slice
import Data.Array.Accelerate.Representation.Stencil
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Type
import Data.Primitive.Vec

import Crypto.Hash
import Data.ByteString.Builder
import Data.ByteString.Builder.Extra
import Data.ByteString.Short.Internal                               ( ShortByteString(..) )
import Data.Monoid
import System.IO.Unsafe                                             ( unsafePerformIO )
import System.Mem.StableName                                        ( hashStableName, makeStableName )
import Prelude                                                      hiding ( exp )


-- Hashing
-- -------

type Hash = Digest SHA3_256

data HashOptions = HashOptions
  { HashOptions -> Bool
perfect :: Bool
    -- ^ Should the hash function include _all_ substructure, recursively?
    --
    -- Set to true (the default) if you want a truly unique fingerprint for
    -- the entire expression:
    --
    -- Example:
    --
    -- xs, ys :: Acc (Vector Float)
    -- xs = fill (constant (Z:.10)) 1.0
    -- ys = fill (constant (Z:.20)) 1.0
    --
    -- with perfect=True:
    --
    --   hash xs = 2e1f91aca4c476d13b36f22462e73c15bbdd9fcacb0d4996280f6004058e9732
    --   hash ys = 2fce5c849b6c652192b09aaeafdc8029e57b9f006c1ecd79ccf9114f349aaf9e
    --
    -- However, for a code generating backend the object code used to
    -- evaluate both of these expressions is likely to be identical.
    --
    -- Setting perfect=False results in:
    --
    --   hash xs = hash ys = f97944b0ec64ab8aa989fd60c8b50e7ec3eff759d22d2b340039d837d74dfc3c
    --
    -- Note that to be useful the provided 'EncodeAcc' function must also
    -- understand this option, and the consumer of the hash value must be
    -- agnostic to the elided details.
  }
  deriving Int -> HashOptions -> ShowS
[HashOptions] -> ShowS
HashOptions -> String
(Int -> HashOptions -> ShowS)
-> (HashOptions -> String)
-> ([HashOptions] -> ShowS)
-> Show HashOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashOptions] -> ShowS
$cshowList :: [HashOptions] -> ShowS
show :: HashOptions -> String
$cshow :: HashOptions -> String
showsPrec :: Int -> HashOptions -> ShowS
$cshowsPrec :: Int -> HashOptions -> ShowS
Show

defaultHashOptions :: HashOptions
defaultHashOptions :: HashOptions
defaultHashOptions = Bool -> HashOptions
HashOptions Bool
True


{-# INLINEABLE hashPreOpenAcc #-}
hashPreOpenAcc :: HasArraysR acc => EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
hashPreOpenAcc :: EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
hashPreOpenAcc = HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
forall (acc :: * -> * -> *) aenv a.
HasArraysR acc =>
HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
hashPreOpenAccWith HashOptions
defaultHashOptions

{-# INLINEABLE hashPreOpenAccWith #-}
hashPreOpenAccWith :: HasArraysR acc => HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
hashPreOpenAccWith :: HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
hashPreOpenAccWith HashOptions
options EncodeAcc acc
encodeAcc
  = ByteString -> Hash
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy
  (ByteString -> Hash)
-> (PreOpenAcc acc aenv a -> ByteString)
-> PreOpenAcc acc aenv a
-> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
  (Builder -> ByteString)
-> (PreOpenAcc acc aenv a -> Builder)
-> PreOpenAcc acc aenv a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv a -> Builder
forall (acc :: * -> * -> *) aenv arrs.
HasArraysR acc =>
HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv arrs -> Builder
encodePreOpenAcc HashOptions
options EncodeAcc acc
encodeAcc

{-# INLINEABLE hashOpenFun #-}
hashOpenFun :: OpenFun env aenv f -> Hash
hashOpenFun :: OpenFun env aenv f -> Hash
hashOpenFun
  = ByteString -> Hash
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy
  (ByteString -> Hash)
-> (OpenFun env aenv f -> ByteString) -> OpenFun env aenv f -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
  (Builder -> ByteString)
-> (OpenFun env aenv f -> Builder)
-> OpenFun env aenv f
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenFun env aenv f -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
encodeOpenFun

{-# INLINEABLE hashOpenExp #-}
hashOpenExp :: OpenExp env aenv t -> Hash
hashOpenExp :: OpenExp env aenv t -> Hash
hashOpenExp
  = ByteString -> Hash
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy
  (ByteString -> Hash)
-> (OpenExp env aenv t -> ByteString) -> OpenExp env aenv t -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
  (Builder -> ByteString)
-> (OpenExp env aenv t -> Builder)
-> OpenExp env aenv t
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenExp env aenv t -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
encodeOpenExp


-- Array computations
-- ------------------

type EncodeAcc acc = forall aenv a. HashOptions -> acc aenv a -> Builder

{-# INLINEABLE encodePreOpenAcc #-}
encodePreOpenAcc
    :: forall acc aenv arrs. HasArraysR acc
    => HashOptions
    -> EncodeAcc acc
    -> PreOpenAcc acc aenv arrs
    -> Builder
encodePreOpenAcc :: HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv arrs -> Builder
encodePreOpenAcc HashOptions
options EncodeAcc acc
encodeAcc PreOpenAcc acc aenv arrs
pacc =
  let
      travA :: forall aenv' a. acc aenv' a -> Builder
      travA :: acc aenv' a -> Builder
travA = HashOptions -> acc aenv' a -> Builder
EncodeAcc acc
encodeAcc HashOptions
options

      travAF :: PreOpenAfun acc aenv' f -> Builder
      travAF :: PreOpenAfun acc aenv' f -> Builder
travAF = HashOptions -> EncodeAcc acc -> PreOpenAfun acc aenv' f -> Builder
forall (acc :: * -> * -> *) aenv f.
HashOptions -> EncodeAcc acc -> PreOpenAfun acc aenv f -> Builder
encodePreOpenAfun HashOptions
options EncodeAcc acc
encodeAcc

      travE :: OpenExp env' aenv' e -> Builder
      travE :: OpenExp env' aenv' e -> Builder
travE = OpenExp env' aenv' e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
encodeOpenExp

      travF :: OpenFun env' aenv' f -> Builder
      travF :: OpenFun env' aenv' f -> Builder
travF = OpenFun env' aenv' f -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
encodeOpenFun

      travD :: Direction -> Builder
      travD :: Direction -> Builder
travD Direction
LeftToRight = Int -> Builder
intHost $(hashQ "L")
      travD Direction
RightToLeft = Int -> Builder
intHost $(hashQ "R")

      deep :: Builder -> Builder
      deep :: Builder -> Builder
deep | HashOptions -> Bool
perfect HashOptions
options = Builder -> Builder
forall a. a -> a
id
           | Bool
otherwise       = Builder -> Builder -> Builder
forall a b. a -> b -> a
const Builder
forall a. Monoid a => a
mempty

      deepE :: forall env' aenv' e. OpenExp env' aenv' e -> Builder
      deepE :: OpenExp env' aenv' e -> Builder
deepE OpenExp env' aenv' e
e
        | HashOptions -> Bool
perfect HashOptions
options = OpenExp env' aenv' e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env' aenv' e
e
        | Bool
otherwise       = TypeR e -> Builder
forall t. TypeR t -> Builder
encodeTypeR (TypeR e -> Builder) -> TypeR e -> Builder
forall a b. (a -> b) -> a -> b
$ OpenExp env' aenv' e -> TypeR e
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp env' aenv' e
e
  in
  case PreOpenAcc acc aenv arrs
pacc of
    Alet ALeftHandSide bndArrs aenv aenv'
lhs acc aenv bndArrs
bnd acc aenv' arrs
body            -> Int -> Builder
intHost $(hashQ "Alet")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. ArrayR b -> Builder)
-> ALeftHandSide bndArrs aenv aenv' -> Builder
forall (s :: * -> *) a env env'.
(forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. ArrayR b -> Builder
encodeArrayType ALeftHandSide bndArrs aenv aenv'
lhs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv bndArrs -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv bndArrs
bnd Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv' arrs -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv' arrs
body
    Avar (Var ArrayR (Array sh e)
repr Idx aenv (Array sh e)
v)            -> Int -> Builder
intHost $(hashQ "Avar")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ArrayR (Array sh e) -> Builder
forall b. ArrayR b -> Builder
encodeArrayType ArrayR (Array sh e)
repr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
deep (Idx aenv (Array sh e) -> Builder
forall env t. Idx env t -> Builder
encodeIdx Idx aenv (Array sh e)
v)
    Apair acc aenv as
a1 acc aenv bs
a2                  -> Int -> Builder
intHost $(hashQ "Apair")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv as -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv as
a1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv bs -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv bs
a2
    PreOpenAcc acc aenv arrs
Anil                         -> Int -> Builder
intHost $(hashQ "Anil")
    Apply ArraysR arrs
_ PreOpenAfun acc aenv (arrs1 -> arrs)
f acc aenv arrs1
a                  -> Int -> Builder
intHost $(hashQ "Apply")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PreOpenAfun acc aenv (arrs1 -> arrs) -> Builder
forall aenv' f. PreOpenAfun acc aenv' f -> Builder
travAF PreOpenAfun acc aenv (arrs1 -> arrs)
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv arrs1 -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv arrs1
a
    Aforeign ArraysR arrs
_ asm (as -> arrs)
_ PreAfun acc (as -> arrs)
f acc aenv as
a             -> Int -> Builder
intHost $(hashQ "Aforeign")    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PreAfun acc (as -> arrs) -> Builder
forall aenv' f. PreOpenAfun acc aenv' f -> Builder
travAF PreAfun acc (as -> arrs)
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv as -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv as
a
    Use ArrayR (Array sh e)
repr Array sh e
a                   -> Int -> Builder
intHost $(hashQ "Use")         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ArrayR (Array sh e) -> Builder
forall b. ArrayR b -> Builder
encodeArrayType ArrayR (Array sh e)
repr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
deep (Array sh e -> Builder
forall sh e. Array sh e -> Builder
encodeArray Array sh e
a)
    Awhile PreOpenAfun acc aenv (arrs -> Scalar PrimBool)
p PreOpenAfun acc aenv (arrs -> arrs)
f acc aenv arrs
a                 -> Int -> Builder
intHost $(hashQ "Awhile")      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PreOpenAfun acc aenv (arrs -> arrs) -> Builder
forall aenv' f. PreOpenAfun acc aenv' f -> Builder
travAF PreOpenAfun acc aenv (arrs -> arrs)
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PreOpenAfun acc aenv (arrs -> Scalar PrimBool) -> Builder
forall aenv' f. PreOpenAfun acc aenv' f -> Builder
travAF PreOpenAfun acc aenv (arrs -> Scalar PrimBool)
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv arrs -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv arrs
a
    Unit TypeR e
_ Exp aenv e
e                     -> Int -> Builder
intHost $(hashQ "Unit")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Exp aenv e
e
    Generate ArrayR (Array sh e)
_ Exp aenv sh
e Fun aenv (sh -> e)
f               -> Int -> Builder
intHost $(hashQ "Generate")    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv sh -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
deepE Exp aenv sh
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (sh -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (sh -> e)
f
    -- We don't need to encode the type of 'e' when perfect is False, as 'e' is an expression of type Bool.
    -- We thus use `deep (travE e)` instead of `deepE e`.
    Acond Exp aenv PrimBool
e acc aenv arrs
a1 acc aenv arrs
a2                -> Int -> Builder
intHost $(hashQ "Acond")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
deep (Exp aenv PrimBool -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Exp aenv PrimBool
e) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv arrs -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv arrs
a1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv arrs -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv arrs
a2
    Reshape ShapeR sh
_ Exp aenv sh
sh acc aenv (Array sh' e)
a               -> Int -> Builder
intHost $(hashQ "Reshape")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv sh -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
deepE Exp aenv sh
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh' e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh' e)
a
    Backpermute ShapeR sh'
_ Exp aenv sh'
sh Fun aenv (sh' -> sh)
f acc aenv (Array sh e)
a         -> Int -> Builder
intHost $(hashQ "Backpermute") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv sh' -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
deepE Exp aenv sh'
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (sh' -> sh) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (sh' -> sh)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e)
a
    Transform ArrayR (Array sh' b)
_ Exp aenv sh'
sh Fun aenv (sh' -> sh)
f1 Fun aenv (a -> b)
f2 acc aenv (Array sh a)
a       -> Int -> Builder
intHost $(hashQ "Transform")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv sh' -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
deepE Exp aenv sh'
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (sh' -> sh) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (sh' -> sh)
f1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (a -> b) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (a -> b)
f2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh a) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh a)
a
    Replicate SliceIndex slix sl co sh
spec Exp aenv slix
ix acc aenv (Array sl e)
a          -> Int -> Builder
intHost $(hashQ "Replicate")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv slix -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
deepE Exp aenv slix
ix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sl e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sl e)
a  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SliceIndex slix sl co sh -> Builder
forall slix sl co sh. SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex slix sl co sh
spec
    Slice SliceIndex slix sl co sh
spec acc aenv (Array sh e)
a Exp aenv slix
ix              -> Int -> Builder
intHost $(hashQ "Slice")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv slix -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
deepE Exp aenv slix
ix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e)
a  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SliceIndex slix sl co sh -> Builder
forall slix sl co sh. SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex slix sl co sh
spec
    Map TypeR e'
_ Fun aenv (e -> e')
f acc aenv (Array sh e)
a                    -> Int -> Builder
intHost $(hashQ "Map")         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e -> e') -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e -> e')
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e)
a
    ZipWith TypeR e3
_ Fun aenv (e1 -> e2 -> e3)
f acc aenv (Array sh e1)
a1 acc aenv (Array sh e2)
a2            -> Int -> Builder
intHost $(hashQ "ZipWith")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e1 -> e2 -> e3) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e1 -> e2 -> e3)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e1) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e1)
a1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e2) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e2)
a2
    Fold Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
e acc aenv (Array (sh, Int) e)
a                   -> Int -> Builder
intHost $(hashQ "Fold")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e -> e -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e -> e -> e)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Exp aenv e -> Builder) -> Maybe (Exp aenv e) -> Builder
forall a. (a -> Builder) -> Maybe a -> Builder
encodeMaybe Exp aenv e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Maybe (Exp aenv e)
e  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array (sh, Int) e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array (sh, Int) e)
a
    FoldSeg IntegralType i
_ Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
e acc aenv (Array (sh, Int) e)
a acc aenv (Segments i)
s            -> Int -> Builder
intHost $(hashQ "FoldSeg")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e -> e -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e -> e -> e)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Exp aenv e -> Builder) -> Maybe (Exp aenv e) -> Builder
forall a. (a -> Builder) -> Maybe a -> Builder
encodeMaybe Exp aenv e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Maybe (Exp aenv e)
e  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array (sh, Int) e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array (sh, Int) e)
a  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Segments i) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Segments i)
s
    Scan  Direction
d Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
e acc aenv (Array (sh, Int) e)
a                -> Int -> Builder
intHost $(hashQ "Scan")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Direction -> Builder
travD Direction
d  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e -> e -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e -> e -> e)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Exp aenv e -> Builder) -> Maybe (Exp aenv e) -> Builder
forall a. (a -> Builder) -> Maybe a -> Builder
encodeMaybe Exp aenv e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Maybe (Exp aenv e)
e  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array (sh, Int) e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array (sh, Int) e)
a
    Scan' Direction
d Fun aenv (e -> e -> e)
f Exp aenv e
e acc aenv (Array (sh, Int) e)
a                -> Int -> Builder
intHost $(hashQ "Scan'")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Direction -> Builder
travD Direction
d  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e -> e -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e -> e -> e)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>           Exp aenv e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Exp aenv e
e  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array (sh, Int) e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array (sh, Int) e)
a
    Permute Fun aenv (e -> e -> e)
f1 acc aenv (Array sh' e)
a1 Fun aenv (sh -> PrimMaybe sh')
f2 acc aenv (Array sh e)
a2          -> Int -> Builder
intHost $(hashQ "Permute")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (e -> e -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (e -> e -> e)
f1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh' e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh' e)
a1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (sh -> PrimMaybe sh') -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (sh -> PrimMaybe sh')
f2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e)
a2
    Stencil StencilR sh e stencil
s TypeR e'
_ Fun aenv (stencil -> e')
f Boundary aenv (Array sh e)
b acc aenv (Array sh e)
a            -> Int -> Builder
intHost $(hashQ "Stencil")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (stencil -> e') -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (stencil -> e')
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TypeR e -> Boundary aenv (Array sh e) -> Builder
forall e aenv sh. TypeR e -> Boundary aenv (Array sh e) -> Builder
encodeBoundary (StencilR sh e stencil -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e stencil
s) Boundary aenv (Array sh e)
b  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh e) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh e)
a
    Stencil2 StencilR sh a stencil1
s1 StencilR sh b stencil2
s2 TypeR c
_ Fun aenv (stencil1 -> stencil2 -> c)
f Boundary aenv (Array sh a)
b1 acc aenv (Array sh a)
a1 Boundary aenv (Array sh b)
b2 acc aenv (Array sh b)
a2 -> Int -> Builder
intHost $(hashQ "Stencil2")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (stencil1 -> stencil2 -> c) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun aenv (stencil1 -> stencil2 -> c)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TypeR a -> Boundary aenv (Array sh a) -> Builder
forall e aenv sh. TypeR e -> Boundary aenv (Array sh e) -> Builder
encodeBoundary (StencilR sh a stencil1 -> TypeR a
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh a stencil1
s1) Boundary aenv (Array sh a)
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh a) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh a)
a1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TypeR b -> Boundary aenv (Array sh b) -> Builder
forall e aenv sh. TypeR e -> Boundary aenv (Array sh e) -> Builder
encodeBoundary (StencilR sh b stencil2 -> TypeR b
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh b stencil2
s2) Boundary aenv (Array sh b)
b2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> acc aenv (Array sh b) -> Builder
forall aenv' a. acc aenv' a -> Builder
travA acc aenv (Array sh b)
a2

{--
{-# INLINEABLE encodePreOpenSeq #-}
encodePreOpenSeq :: forall acc aenv senv arrs. EncodeAcc acc -> PreOpenSeq acc aenv senv arrs -> Int
encodePreOpenSeq encodeAcc s =
  let
      travA :: acc aenv' a -> Builder
      travA = encodeAcc -- XXX: plus type information?

      travE :: OpenExp env' aenv' e -> Builder
      travE = encodeOpenExp encodeAcc

      travAF :: PreOpenAfun acc aenv' f -> Builder
      travAF = encodePreOpenAfun encodeAcc

      travF :: OpenFun env' aenv' f -> Builder
      travF = encodeOpenFun encodeAcc

      travS :: PreOpenSeq acc aenv senv' arrs' -> Builder
      travS = encodePreOpenSeq encodeAcc

      travV :: forall a. Arrays a => Idx senv' a -> Builder
      travV v = encodeArraysType (arrays @a) <> encodeIdx v

      travP :: Producer acc aenv senv a -> Builder
      travP p =
        case p of
          StreamIn arrs       -> intHost . unsafePerformIO $! hashStableName `fmap` makeStableName arrs
          ToSeq spec _ acc    -> intHost $(hashQ "ToSeq")         <> travA  acc <> stringUtf8 (show spec)
          MapSeq f x          -> intHost $(hashQ "MapSeq")        <> travAF f   <> travV x
          ChunkedMapSeq f x   -> intHost $(hashQ "ChunkedMapSeq") <> travAF f   <> travV x
          ZipWithSeq f x y    -> intHost $(hashQ "ZipWithSeq")    <> travAF f   <> travV x <> travV y
          ScanSeq f e x       -> intHost $(hashQ "ScanSeq")       <> travF  f   <> travE e <> travV x

      travC :: Consumer acc aenv senv' a -> Builder
      travC c =
        case c of
          FoldSeq f e x          -> intHost $(hashQ "FoldSeq")        <> travF  f <> travE e   <> travV x
          FoldSeqFlatten f acc x -> intHost $(hashQ "FoldSeqFlatten") <> travAF f <> travA acc <> travV x
          Stuple t               -> intHost $(hashQ "Stuple")         <> encodeAtuple travC t
  in
  case s of
    Producer p s' -> intHost $(hashQ "Producer")   <> travP p <> travS s'
    Consumer c    -> intHost $(hashQ "Consumer")   <> travC c
    Reify ix      -> intHost $(hashQ "Reify")      <> travV ix
--}

encodeIdx :: Idx env t -> Builder
encodeIdx :: Idx env t -> Builder
encodeIdx = Int -> Builder
intHost (Int -> Builder) -> (Idx env t -> Int) -> Idx env t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idx env t -> Int
forall env t. Idx env t -> Int
idxToInt

encodeArray :: Array sh e -> Builder
encodeArray :: Array sh e -> Builder
encodeArray Array sh e
ad = Int -> Builder
intHost (Int -> Builder) -> (IO Int -> Int) -> IO Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Builder) -> IO Int -> Builder
forall a b. (a -> b) -> a -> b
$! StableName (Array sh e) -> Int
forall a. StableName a -> Int
hashStableName (StableName (Array sh e) -> Int)
-> IO (StableName (Array sh e)) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array sh e -> IO (StableName (Array sh e))
forall a. a -> IO (StableName a)
makeStableName Array sh e
ad

encodeTupR :: (forall b. s b -> Builder) -> TupR s a -> Builder
encodeTupR :: (forall b. s b -> Builder) -> TupR s a -> Builder
encodeTupR forall b. s b -> Builder
_ TupR s a
TupRunit         = Int -> Builder
intHost $(hashQ "TupRunit")
encodeTupR forall b. s b -> Builder
f (TupRpair TupR s a
r1 TupR s b
r2) = Int -> Builder
intHost $(hashQ "TupRpair")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. s b -> Builder) -> TupR s a -> Builder
forall (s :: * -> *) a.
(forall b. s b -> Builder) -> TupR s a -> Builder
encodeTupR forall b. s b -> Builder
f TupR s a
r1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. s b -> Builder) -> TupR s b -> Builder
forall (s :: * -> *) a.
(forall b. s b -> Builder) -> TupR s a -> Builder
encodeTupR forall b. s b -> Builder
f TupR s b
r2
encodeTupR forall b. s b -> Builder
f (TupRsingle s a
s)   = Int -> Builder
intHost $(hashQ "TupRsingle") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> s a -> Builder
forall b. s b -> Builder
f s a
s

encodeLeftHandSide :: (forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide :: (forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. s b -> Builder
f (LeftHandSideWildcard TupR s a
r) = Int -> Builder
intHost $(hashQ "LeftHandSideWildcard") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. s b -> Builder) -> TupR s a -> Builder
forall (s :: * -> *) a.
(forall b. s b -> Builder) -> TupR s a -> Builder
encodeTupR forall b. s b -> Builder
f TupR s a
r
encodeLeftHandSide forall b. s b -> Builder
f (LeftHandSidePair LeftHandSide s v1 env env'
r1 LeftHandSide s v2 env' env'
r2) = Int -> Builder
intHost $(hashQ "LeftHandSidePair")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. s b -> Builder) -> LeftHandSide s v1 env env' -> Builder
forall (s :: * -> *) a env env'.
(forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. s b -> Builder
f LeftHandSide s v1 env env'
r1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. s b -> Builder)
-> LeftHandSide s v2 env' env' -> Builder
forall (s :: * -> *) a env env'.
(forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. s b -> Builder
f LeftHandSide s v2 env' env'
r2
encodeLeftHandSide forall b. s b -> Builder
f (LeftHandSideSingle s a
s)   = Int -> Builder
intHost $(hashQ "LeftHandSideArray")    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> s a -> Builder
forall b. s b -> Builder
f s a
s

encodeArrayType :: ArrayR a -> Builder
encodeArrayType :: ArrayR a -> Builder
encodeArrayType (ArrayR ShapeR sh
shr TypeR e
tp) = ShapeR sh -> Builder
forall sh. ShapeR sh -> Builder
encodeShapeR ShapeR sh
shr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TypeR e -> Builder
forall t. TypeR t -> Builder
encodeTypeR TypeR e
tp

encodeArraysType :: ArraysR arrs -> Builder
encodeArraysType :: ArraysR arrs -> Builder
encodeArraysType = (forall b. ArrayR b -> Builder) -> ArraysR arrs -> Builder
forall (s :: * -> *) a.
(forall b. s b -> Builder) -> TupR s a -> Builder
encodeTupR forall b. ArrayR b -> Builder
encodeArrayType

encodeShapeR :: ShapeR sh -> Builder
encodeShapeR :: ShapeR sh -> Builder
encodeShapeR = Int -> Builder
intHost (Int -> Builder) -> (ShapeR sh -> Int) -> ShapeR sh -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeR sh -> Int
forall sh. ShapeR sh -> Int
rank

encodePreOpenAfun
    :: forall acc aenv f.
       HashOptions
    -> EncodeAcc acc
    -> PreOpenAfun acc aenv f
    -> Builder
encodePreOpenAfun :: HashOptions -> EncodeAcc acc -> PreOpenAfun acc aenv f -> Builder
encodePreOpenAfun HashOptions
options EncodeAcc acc
travA PreOpenAfun acc aenv f
afun =
  let
      travL :: forall aenv1 aenv2 a b. ALeftHandSide a aenv1 aenv2 -> PreOpenAfun acc aenv2 b -> Builder
      travL :: ALeftHandSide a aenv1 aenv2 -> PreOpenAfun acc aenv2 b -> Builder
travL ALeftHandSide a aenv1 aenv2
lhs PreOpenAfun acc aenv2 b
l = (forall b. ArrayR b -> Builder)
-> ALeftHandSide a aenv1 aenv2 -> Builder
forall (s :: * -> *) a env env'.
(forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. ArrayR b -> Builder
encodeArrayType ALeftHandSide a aenv1 aenv2
lhs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> HashOptions -> EncodeAcc acc -> PreOpenAfun acc aenv2 b -> Builder
forall (acc :: * -> * -> *) aenv f.
HashOptions -> EncodeAcc acc -> PreOpenAfun acc aenv f -> Builder
encodePreOpenAfun HashOptions
options EncodeAcc acc
travA PreOpenAfun acc aenv2 b
l
  in
  case PreOpenAfun acc aenv f
afun of
    Abody acc aenv f
b    -> Int -> Builder
intHost $(hashQ "Abody") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> HashOptions -> acc aenv f -> Builder
EncodeAcc acc
travA HashOptions
options acc aenv f
b
    Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun acc aenv' t
l -> Int -> Builder
intHost $(hashQ "Alam")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ALeftHandSide a aenv aenv' -> PreOpenAfun acc aenv' t -> Builder
forall aenv1 aenv2 a b.
ALeftHandSide a aenv1 aenv2 -> PreOpenAfun acc aenv2 b -> Builder
travL ALeftHandSide a aenv aenv'
lhs  PreOpenAfun acc aenv' t
l


encodeBoundary
    :: TypeR e
    -> Boundary aenv (Array sh e)
    -> Builder
encodeBoundary :: TypeR e -> Boundary aenv (Array sh e) -> Builder
encodeBoundary TypeR e
_  Boundary aenv (Array sh e)
Wrap          = Int -> Builder
intHost $(hashQ "Wrap")
encodeBoundary TypeR e
_  Boundary aenv (Array sh e)
Clamp         = Int -> Builder
intHost $(hashQ "Clamp")
encodeBoundary TypeR e
_  Boundary aenv (Array sh e)
Mirror        = Int -> Builder
intHost $(hashQ "Mirror")
encodeBoundary TypeR e
tp (Constant e
c)  = Int -> Builder
intHost $(hashQ "Constant") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TypeR e -> e -> Builder
forall t. TypeR t -> t -> Builder
encodeConst TypeR e
tp e
e
c
encodeBoundary TypeR e
_  (Function Fun aenv (sh -> e)
f)  = Int -> Builder
intHost $(hashQ "Function") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (sh -> e) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
encodeOpenFun Fun aenv (sh -> e)
f

encodeSliceIndex :: SliceIndex slix sl co sh -> Builder
encodeSliceIndex :: SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex slix sl co sh
SliceNil         = Int -> Builder
intHost $(hashQ "SliceNil")
encodeSliceIndex (SliceAll SliceIndex ix slice co dim
r)     = Int -> Builder
intHost $(hashQ "SliceAll")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SliceIndex ix slice co dim -> Builder
forall slix sl co sh. SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex ix slice co dim
r
encodeSliceIndex (SliceFixed SliceIndex ix sl co dim
r)   = Int -> Builder
intHost $(hashQ "sliceFixed") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SliceIndex ix sl co dim -> Builder
forall slix sl co sh. SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex ix sl co dim
r


-- Scalar expressions
-- ------------------

{-# INLINEABLE encodeOpenExp #-}
encodeOpenExp
    :: forall env aenv exp.
       OpenExp env aenv exp
    -> Builder
encodeOpenExp :: OpenExp env aenv exp -> Builder
encodeOpenExp OpenExp env aenv exp
exp =
  let
      travE :: forall env' aenv' e. OpenExp env' aenv' e -> Builder
      travE :: OpenExp env' aenv' e -> Builder
travE OpenExp env' aenv' e
e = OpenExp env' aenv' e -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
encodeOpenExp OpenExp env' aenv' e
e

      travF :: OpenFun env' aenv' f -> Builder
      travF :: OpenFun env' aenv' f -> Builder
travF = OpenFun env' aenv' f -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
encodeOpenFun
  in
  case OpenExp env aenv exp
exp of
    Let ELeftHandSide bnd_t env env'
lhs OpenExp env aenv bnd_t
bnd OpenExp env' aenv exp
body            -> Int -> Builder
intHost $(hashQ "Let")         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. ScalarType b -> Builder)
-> ELeftHandSide bnd_t env env' -> Builder
forall (s :: * -> *) a env env'.
(forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. ScalarType b -> Builder
encodeScalarType ELeftHandSide bnd_t env env'
lhs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv bnd_t -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv bnd_t
bnd Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env' aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env' aenv exp
body
    Evar (Var ScalarType exp
tp Idx env exp
ix)            -> Int -> Builder
intHost $(hashQ "Evar")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ScalarType exp -> Builder
forall b. ScalarType b -> Builder
encodeScalarType ScalarType exp
tp Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Idx env exp -> Builder
forall env t. Idx env t -> Builder
encodeIdx Idx env exp
ix
    OpenExp env aenv exp
Nil                         -> Int -> Builder
intHost $(hashQ "Nil")
    Pair OpenExp env aenv t1
e1 OpenExp env aenv t2
e2                  -> Int -> Builder
intHost $(hashQ "Pair")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv t1 -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv t1
e1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv t2 -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv t2
e2
    VecPack   VecR n s tup
_ OpenExp env aenv tup
e               -> Int -> Builder
intHost $(hashQ "VecPack")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv tup -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv tup
e
    VecUnpack VecR n s exp
_ OpenExp env aenv (Vec n s)
e               -> Int -> Builder
intHost $(hashQ "VecUnpack")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv (Vec n s) -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv (Vec n s)
e
    Const ScalarType exp
tp exp
c                  -> Int -> Builder
intHost $(hashQ "Const")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ScalarType exp -> exp -> Builder
forall t. ScalarType t -> t -> Builder
encodeScalarConst ScalarType exp
tp exp
c
    Undef ScalarType exp
tp                    -> Int -> Builder
intHost $(hashQ "Undef")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ScalarType exp -> Builder
forall b. ScalarType b -> Builder
encodeScalarType ScalarType exp
tp
    IndexSlice SliceIndex slix exp co sh
spec OpenExp env aenv slix
ix OpenExp env aenv sh
sh       -> Int -> Builder
intHost $(hashQ "IndexSlice")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv slix -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv slix
ix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv sh -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv sh
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SliceIndex slix exp co sh -> Builder
forall slix sl co sh. SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex slix exp co sh
spec
    IndexFull  SliceIndex slix sl co exp
spec OpenExp env aenv slix
ix OpenExp env aenv sl
sl       -> Int -> Builder
intHost $(hashQ "IndexFull")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv slix -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv slix
ix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv sl -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv sl
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SliceIndex slix sl co exp -> Builder
forall slix sl co sh. SliceIndex slix sl co sh -> Builder
encodeSliceIndex SliceIndex slix sl co exp
spec
    ToIndex ShapeR sh
_ OpenExp env aenv sh
sh OpenExp env aenv sh
i              -> Int -> Builder
intHost $(hashQ "ToIndex")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv sh -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv sh
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv sh -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv sh
i
    FromIndex ShapeR exp
_ OpenExp env aenv exp
sh OpenExp env aenv Int
i            -> Int -> Builder
intHost $(hashQ "FromIndex")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv exp
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv Int -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv Int
i
    Case OpenExp env aenv PrimBool
e [(PrimBool, OpenExp env aenv exp)]
rhs Maybe (OpenExp env aenv exp)
def              -> Int -> Builder
intHost $(hashQ "Case")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv PrimBool -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv PrimBool
e  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ PrimBool -> Builder
word8 PrimBool
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv exp
c | (PrimBool
t,OpenExp env aenv exp
c) <- [(PrimBool, OpenExp env aenv exp)]
rhs ] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (OpenExp env aenv exp -> Builder)
-> Maybe (OpenExp env aenv exp) -> Builder
forall a. (a -> Builder) -> Maybe a -> Builder
encodeMaybe OpenExp env aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE Maybe (OpenExp env aenv exp)
def
    Cond OpenExp env aenv PrimBool
c OpenExp env aenv exp
t OpenExp env aenv exp
e                  -> Int -> Builder
intHost $(hashQ "Cond")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv PrimBool -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv PrimBool
c  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv exp
t  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv exp
e
    While OpenFun env aenv (exp -> PrimBool)
p OpenFun env aenv (exp -> exp)
f OpenExp env aenv exp
x                 -> Int -> Builder
intHost $(hashQ "While")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenFun env aenv (exp -> PrimBool) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF OpenFun env aenv (exp -> PrimBool)
p  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenFun env aenv (exp -> exp) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF OpenFun env aenv (exp -> exp)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv exp -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv exp
x
    PrimApp PrimFun (a -> exp)
f OpenExp env aenv a
x                 -> Int -> Builder
intHost $(hashQ "PrimApp")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PrimFun (a -> exp) -> Builder
forall f. PrimFun f -> Builder
encodePrimFun PrimFun (a -> exp)
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv a -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv a
x
    PrimConst PrimConst exp
c                 -> Int -> Builder
intHost $(hashQ "PrimConst")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PrimConst exp -> Builder
forall c. PrimConst c -> Builder
encodePrimConst PrimConst exp
c
    Index ArrayVar aenv (Array dim exp)
a OpenExp env aenv dim
ix                  -> Int -> Builder
intHost $(hashQ "Index")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ArrayVar aenv (Array dim exp) -> Builder
forall aenv a. ArrayVar aenv a -> Builder
encodeArrayVar ArrayVar aenv (Array dim exp)
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv dim -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv dim
ix
    LinearIndex ArrayVar aenv (Array dim exp)
a OpenExp env aenv Int
ix            -> Int -> Builder
intHost $(hashQ "LinearIndex") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ArrayVar aenv (Array dim exp) -> Builder
forall aenv a. ArrayVar aenv a -> Builder
encodeArrayVar ArrayVar aenv (Array dim exp)
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv Int -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv Int
ix
    Shape ArrayVar aenv (Array exp e)
a                     -> Int -> Builder
intHost $(hashQ "Shape")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ArrayVar aenv (Array exp e) -> Builder
forall aenv a. ArrayVar aenv a -> Builder
encodeArrayVar ArrayVar aenv (Array exp e)
a
    ShapeSize ShapeR dim
_ OpenExp env aenv dim
sh              -> Int -> Builder
intHost $(hashQ "ShapeSize")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv dim -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv dim
sh
    Foreign TypeR exp
_ asm (x -> exp)
_ Fun () (x -> exp)
f OpenExp env aenv x
e             -> Int -> Builder
intHost $(hashQ "Foreign")     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun () (x -> exp) -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
travF Fun () (x -> exp)
f  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv x -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv x
e
    Coerce ScalarType a
_ ScalarType exp
tp OpenExp env aenv a
e               -> Int -> Builder
intHost $(hashQ "Coerce")      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ScalarType exp -> Builder
forall b. ScalarType b -> Builder
encodeScalarType ScalarType exp
tp Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv a -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
travE OpenExp env aenv a
e

encodeArrayVar :: ArrayVar aenv a -> Builder
encodeArrayVar :: ArrayVar aenv a -> Builder
encodeArrayVar (Var ArrayR a
repr Idx aenv a
v) = ArrayR a -> Builder
forall b. ArrayR b -> Builder
encodeArrayType ArrayR a
repr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Idx aenv a -> Builder
forall env t. Idx env t -> Builder
encodeIdx Idx aenv a
v

{-# INLINEABLE encodeOpenFun #-}
encodeOpenFun
    :: OpenFun env aenv f
    -> Builder
encodeOpenFun :: OpenFun env aenv f -> Builder
encodeOpenFun (Body OpenExp env aenv f
b)    = Int -> Builder
intHost $(hashQ "Body") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv f -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
encodeOpenExp OpenExp env aenv f
b
encodeOpenFun (Lam ELeftHandSide a env env'
lhs OpenFun env' aenv t
l) = Int -> Builder
intHost $(hashQ "Lam") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (forall b. ScalarType b -> Builder)
-> ELeftHandSide a env env' -> Builder
forall (s :: * -> *) a env env'.
(forall b. s b -> Builder) -> LeftHandSide s a env env' -> Builder
encodeLeftHandSide forall b. ScalarType b -> Builder
encodeScalarType ELeftHandSide a env env'
lhs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OpenFun env' aenv t -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
encodeOpenFun OpenFun env' aenv t
l


encodeConst :: TypeR t -> t -> Builder
encodeConst :: TypeR t -> t -> Builder
encodeConst TypeR t
TupRunit         ()    = Int -> Builder
intHost $(hashQ "nil")
encodeConst (TupRsingle ScalarType t
t)   t
c     = ScalarType t -> t -> Builder
forall t. ScalarType t -> t -> Builder
encodeScalarConst ScalarType t
t t
c
encodeConst (TupRpair TupR ScalarType a
ta TupR ScalarType b
tb) (a,b) = Int -> Builder
intHost $(hashQ "pair") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TupR ScalarType a -> a -> Builder
forall t. TypeR t -> t -> Builder
encodeConst TupR ScalarType a
ta a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TupR ScalarType b -> b -> Builder
forall t. TypeR t -> t -> Builder
encodeConst TupR ScalarType b
tb b
b

encodeScalarConst :: ScalarType t -> t -> Builder
encodeScalarConst :: ScalarType t -> t -> Builder
encodeScalarConst (SingleScalarType SingleType t
t) = SingleType t -> t -> Builder
forall t. SingleType t -> t -> Builder
encodeSingleConst SingleType t
t
encodeScalarConst (VectorScalarType VectorType (Vec n a)
t) = VectorType (Vec n a) -> Vec n a -> Builder
forall (n :: Nat) t. VectorType (Vec n t) -> Vec n t -> Builder
encodeVectorConst VectorType (Vec n a)
t

encodeSingleConst :: SingleType t -> t -> Builder
encodeSingleConst :: SingleType t -> t -> Builder
encodeSingleConst (NumSingleType NumType t
t) = NumType t -> t -> Builder
forall t. NumType t -> t -> Builder
encodeNumConst NumType t
t

encodeVectorConst :: VectorType (Vec n t) -> Vec n t -> Builder
encodeVectorConst :: VectorType (Vec n t) -> Vec n t -> Builder
encodeVectorConst (VectorType Int
n SingleType a
t) (Vec ByteArray#
ba#) = Int -> Builder
intHost $(hashQ "Vec") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intHost Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
shortByteString (ByteArray# -> ShortByteString
SBS ByteArray#
ba#)

encodeNumConst :: NumType t -> t -> Builder
encodeNumConst :: NumType t -> t -> Builder
encodeNumConst (IntegralNumType IntegralType t
t) = IntegralType t -> t -> Builder
forall t. IntegralType t -> t -> Builder
encodeIntegralConst IntegralType t
t
encodeNumConst (FloatingNumType FloatingType t
t) = FloatingType t -> t -> Builder
forall t. FloatingType t -> t -> Builder
encodeFloatingConst FloatingType t
t

encodeIntegralConst :: IntegralType t -> t -> Builder
encodeIntegralConst :: IntegralType t -> t -> Builder
encodeIntegralConst TypeInt{}    t
x = Int -> Builder
intHost $(hashQ "Int")    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intHost t
Int
x
encodeIntegralConst TypeInt8{}   t
x = Int -> Builder
intHost $(hashQ "Int8")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int8 -> Builder
int8 t
Int8
x
encodeIntegralConst TypeInt16{}  t
x = Int -> Builder
intHost $(hashQ "Int16")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int16 -> Builder
int16Host t
Int16
x
encodeIntegralConst TypeInt32{}  t
x = Int -> Builder
intHost $(hashQ "Int32")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
int32Host t
Int32
x
encodeIntegralConst TypeInt64{}  t
x = Int -> Builder
intHost $(hashQ "Int64")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
int64Host t
Int64
x
encodeIntegralConst TypeWord{}   t
x = Int -> Builder
intHost $(hashQ "Word")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordHost t
Word
x
encodeIntegralConst TypeWord8{}  t
x = Int -> Builder
intHost $(hashQ "Word8")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PrimBool -> Builder
word8 t
PrimBool
x
encodeIntegralConst TypeWord16{} t
x = Int -> Builder
intHost $(hashQ "Word16") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16Host t
Word16
x
encodeIntegralConst TypeWord32{} t
x = Int -> Builder
intHost $(hashQ "Word32") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Host t
Word32
x
encodeIntegralConst TypeWord64{} t
x = Int -> Builder
intHost $(hashQ "Word64") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64Host t
Word64
x

encodeFloatingConst :: FloatingType t -> t -> Builder
encodeFloatingConst :: FloatingType t -> t -> Builder
encodeFloatingConst TypeHalf{}    (Half (CUShort x)) = Int -> Builder
intHost $(hashQ "Half")    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16Host Word16
x
encodeFloatingConst TypeFloat{}   t
x                  = Int -> Builder
intHost $(hashQ "Float")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
floatHost t
Float
x
encodeFloatingConst TypeDouble{}  t
x                  = Int -> Builder
intHost $(hashQ "Double")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
doubleHost t
Double
x

encodePrimConst :: PrimConst c -> Builder
encodePrimConst :: PrimConst c -> Builder
encodePrimConst (PrimMinBound BoundedType c
t)  = Int -> Builder
intHost $(hashQ "PrimMinBound") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedType c -> Builder
forall t. BoundedType t -> Builder
encodeBoundedType BoundedType c
t
encodePrimConst (PrimMaxBound BoundedType c
t)  = Int -> Builder
intHost $(hashQ "PrimMaxBound") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedType c -> Builder
forall t. BoundedType t -> Builder
encodeBoundedType BoundedType c
t
encodePrimConst (PrimPi FloatingType c
t)        = Int -> Builder
intHost $(hashQ "PrimPi")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType c -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType c
t

encodePrimFun :: PrimFun f -> Builder
encodePrimFun :: PrimFun f -> Builder
encodePrimFun (PrimAdd NumType a
a)                = Int -> Builder
intHost $(hashQ "PrimAdd")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a
encodePrimFun (PrimSub NumType a
a)                = Int -> Builder
intHost $(hashQ "PrimSub")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a
encodePrimFun (PrimMul NumType a
a)                = Int -> Builder
intHost $(hashQ "PrimMul")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a
encodePrimFun (PrimNeg NumType a
a)                = Int -> Builder
intHost $(hashQ "PrimNeg")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a
encodePrimFun (PrimAbs NumType a
a)                = Int -> Builder
intHost $(hashQ "PrimAbs")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a
encodePrimFun (PrimSig NumType a
a)                = Int -> Builder
intHost $(hashQ "PrimSig")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a
encodePrimFun (PrimQuot IntegralType a
a)               = Int -> Builder
intHost $(hashQ "PrimQuot")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimRem IntegralType a
a)                = Int -> Builder
intHost $(hashQ "PrimRem")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimQuotRem IntegralType a
a)            = Int -> Builder
intHost $(hashQ "PrimQuotRem")            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimIDiv IntegralType a
a)               = Int -> Builder
intHost $(hashQ "PrimIDiv")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimMod IntegralType a
a)                = Int -> Builder
intHost $(hashQ "PrimMod")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimDivMod IntegralType a
a)             = Int -> Builder
intHost $(hashQ "PrimDivMod")             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBAnd IntegralType a
a)               = Int -> Builder
intHost $(hashQ "PrimBAnd")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBOr IntegralType a
a)                = Int -> Builder
intHost $(hashQ "PrimBOr")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBXor IntegralType a
a)               = Int -> Builder
intHost $(hashQ "PrimBXor")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBNot IntegralType a
a)               = Int -> Builder
intHost $(hashQ "PrimBNot")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBShiftL IntegralType a
a)            = Int -> Builder
intHost $(hashQ "PrimBShiftL")            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBShiftR IntegralType a
a)            = Int -> Builder
intHost $(hashQ "PrimBShiftR")            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBRotateL IntegralType a
a)           = Int -> Builder
intHost $(hashQ "PrimBRotateL")           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimBRotateR IntegralType a
a)           = Int -> Builder
intHost $(hashQ "PrimBRotateR")           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimPopCount IntegralType a
a)           = Int -> Builder
intHost $(hashQ "PrimPopCount")           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimCountLeadingZeros IntegralType a
a)  = Int -> Builder
intHost $(hashQ "PrimCountLeadingZeros")  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimCountTrailingZeros IntegralType a
a) = Int -> Builder
intHost $(hashQ "PrimCountTrailingZeros") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a
encodePrimFun (PrimFDiv FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimFDiv")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimRecip FloatingType a
a)              = Int -> Builder
intHost $(hashQ "PrimRecip")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimSin FloatingType a
a)                = Int -> Builder
intHost $(hashQ "PrimSin")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimCos FloatingType a
a)                = Int -> Builder
intHost $(hashQ "PrimCos")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimTan FloatingType a
a)                = Int -> Builder
intHost $(hashQ "PrimTan")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAsin FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimAsin")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAcos FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimAcos")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAtan FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimAtan")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimSinh FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimSinh")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimCosh FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimCosh")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimTanh FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimTanh")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAsinh FloatingType a
a)              = Int -> Builder
intHost $(hashQ "PrimAsinh")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAcosh FloatingType a
a)              = Int -> Builder
intHost $(hashQ "PrimAcosh")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAtanh FloatingType a
a)              = Int -> Builder
intHost $(hashQ "PrimAtanh")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimExpFloating FloatingType a
a)        = Int -> Builder
intHost $(hashQ "PrimExpFloating")        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimSqrt FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimSqrt")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimLog FloatingType a
a)                = Int -> Builder
intHost $(hashQ "PrimLog")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimFPow FloatingType a
a)               = Int -> Builder
intHost $(hashQ "PrimFPow")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimLogBase FloatingType a
a)            = Int -> Builder
intHost $(hashQ "PrimLogBase")            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimAtan2 FloatingType a
a)              = Int -> Builder
intHost $(hashQ "PrimAtan2")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimTruncate FloatingType a
a IntegralType b
b)         = Int -> Builder
intHost $(hashQ "PrimTruncate")           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType b -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType b
b
encodePrimFun (PrimRound FloatingType a
a IntegralType b
b)            = Int -> Builder
intHost $(hashQ "PrimRound")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType b -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType b
b
encodePrimFun (PrimFloor FloatingType a
a IntegralType b
b)            = Int -> Builder
intHost $(hashQ "PrimFloor")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType b -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType b
b
encodePrimFun (PrimCeiling FloatingType a
a IntegralType b
b)          = Int -> Builder
intHost $(hashQ "PrimCeiling")            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType b -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType b
b
encodePrimFun (PrimIsNaN FloatingType a
a)              = Int -> Builder
intHost $(hashQ "PrimIsNaN")              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimIsInfinite FloatingType a
a)         = Int -> Builder
intHost $(hashQ "PrimIsInfinite")         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType a -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType a
a
encodePrimFun (PrimLt SingleType a
a)                 = Int -> Builder
intHost $(hashQ "PrimLt")                 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimGt SingleType a
a)                 = Int -> Builder
intHost $(hashQ "PrimGt")                 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimLtEq SingleType a
a)               = Int -> Builder
intHost $(hashQ "PrimLtEq")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimGtEq SingleType a
a)               = Int -> Builder
intHost $(hashQ "PrimGtEq")               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimEq SingleType a
a)                 = Int -> Builder
intHost $(hashQ "PrimEq")                 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimNEq SingleType a
a)                = Int -> Builder
intHost $(hashQ "PrimNEq")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimMax SingleType a
a)                = Int -> Builder
intHost $(hashQ "PrimMax")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimMin SingleType a
a)                = Int -> Builder
intHost $(hashQ "PrimMin")                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
a
encodePrimFun (PrimFromIntegral IntegralType a
a NumType b
b)     = Int -> Builder
intHost $(hashQ "PrimFromIntegral")       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType a -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType b -> Builder
forall t. NumType t -> Builder
encodeNumType NumType b
b
encodePrimFun (PrimToFloating NumType a
a FloatingType b
b)       = Int -> Builder
intHost $(hashQ "PrimToFloating")         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType a -> Builder
forall t. NumType t -> Builder
encodeNumType NumType a
a      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType b -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType b
b
encodePrimFun PrimFun f
PrimLAnd                   = Int -> Builder
intHost $(hashQ "PrimLAnd")
encodePrimFun PrimFun f
PrimLOr                    = Int -> Builder
intHost $(hashQ "PrimLOr")
encodePrimFun PrimFun f
PrimLNot                   = Int -> Builder
intHost $(hashQ "PrimLNot")


encodeTypeR :: TypeR t -> Builder
encodeTypeR :: TypeR t -> Builder
encodeTypeR TypeR t
TupRunit       = Int -> Builder
intHost $(hashQ "TupRunit")
encodeTypeR (TupRsingle ScalarType t
t) = Int -> Builder
intHost $(hashQ "TupRsingle") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ScalarType t -> Builder
forall b. ScalarType b -> Builder
encodeScalarType ScalarType t
t
encodeTypeR (TupRpair TupR ScalarType a
a TupR ScalarType b
b) = Int -> Builder
intHost $(hashQ "TupRpair")   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TupR ScalarType a -> Builder
forall t. TypeR t -> Builder
encodeTypeR TupR ScalarType a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intHost (TupR ScalarType a -> Int
forall t. TypeR t -> Int
depthTypeR TupR ScalarType a
a)
                                                           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TupR ScalarType b -> Builder
forall t. TypeR t -> Builder
encodeTypeR TupR ScalarType b
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intHost (TupR ScalarType b -> Int
forall t. TypeR t -> Int
depthTypeR TupR ScalarType b
b)

depthTypeR :: TypeR t -> Int
depthTypeR :: TypeR t -> Int
depthTypeR TypeR t
TupRunit       = Int
0
depthTypeR TupRsingle{}   = Int
1
depthTypeR (TupRpair TupR ScalarType a
a TupR ScalarType b
b) = TupR ScalarType a -> Int
forall t. TypeR t -> Int
depthTypeR TupR ScalarType a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TupR ScalarType b -> Int
forall t. TypeR t -> Int
depthTypeR TupR ScalarType b
b

encodeScalarType :: ScalarType t -> Builder
encodeScalarType :: ScalarType t -> Builder
encodeScalarType (SingleScalarType SingleType t
t) = Int -> Builder
intHost $(hashQ "SingleScalarType") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType t -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType t
t
encodeScalarType (VectorScalarType VectorType (Vec n a)
t) = Int -> Builder
intHost $(hashQ "VectorScalarType") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> VectorType (Vec n a) -> Builder
forall (n :: Nat) t. VectorType (Vec n t) -> Builder
encodeVectorType VectorType (Vec n a)
t

encodeSingleType :: SingleType t -> Builder
encodeSingleType :: SingleType t -> Builder
encodeSingleType (NumSingleType NumType t
t) = Int -> Builder
intHost $(hashQ "NumSingleType")    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumType t -> Builder
forall t. NumType t -> Builder
encodeNumType NumType t
t

encodeVectorType :: VectorType (Vec n t) -> Builder
encodeVectorType :: VectorType (Vec n t) -> Builder
encodeVectorType (VectorType Int
n SingleType a
t) = Int -> Builder
intHost $(hashQ "VectorType") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intHost Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SingleType a -> Builder
forall t. SingleType t -> Builder
encodeSingleType SingleType a
t

encodeBoundedType :: BoundedType t -> Builder
encodeBoundedType :: BoundedType t -> Builder
encodeBoundedType (IntegralBoundedType IntegralType t
t) = Int -> Builder
intHost $(hashQ "IntegralBoundedType") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType t -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType t
t

encodeNumType :: NumType t -> Builder
encodeNumType :: NumType t -> Builder
encodeNumType (IntegralNumType IntegralType t
t) = Int -> Builder
intHost $(hashQ "IntegralNumType") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IntegralType t -> Builder
forall t. IntegralType t -> Builder
encodeIntegralType IntegralType t
t
encodeNumType (FloatingNumType FloatingType t
t) = Int -> Builder
intHost $(hashQ "FloatingNumType") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FloatingType t -> Builder
forall t. FloatingType t -> Builder
encodeFloatingType FloatingType t
t

encodeIntegralType :: IntegralType t -> Builder
encodeIntegralType :: IntegralType t -> Builder
encodeIntegralType TypeInt{}    = Int -> Builder
intHost $(hashQ "Int")
encodeIntegralType TypeInt8{}   = Int -> Builder
intHost $(hashQ "Int8")
encodeIntegralType TypeInt16{}  = Int -> Builder
intHost $(hashQ "Int16")
encodeIntegralType TypeInt32{}  = Int -> Builder
intHost $(hashQ "Int32")
encodeIntegralType TypeInt64{}  = Int -> Builder
intHost $(hashQ "Int64")
encodeIntegralType TypeWord{}   = Int -> Builder
intHost $(hashQ "Word")
encodeIntegralType TypeWord8{}  = Int -> Builder
intHost $(hashQ "Word8")
encodeIntegralType TypeWord16{} = Int -> Builder
intHost $(hashQ "Word16")
encodeIntegralType TypeWord32{} = Int -> Builder
intHost $(hashQ "Word32")
encodeIntegralType TypeWord64{} = Int -> Builder
intHost $(hashQ "Word64")

encodeFloatingType :: FloatingType t -> Builder
encodeFloatingType :: FloatingType t -> Builder
encodeFloatingType TypeHalf{}   = Int -> Builder
intHost $(hashQ "Half")
encodeFloatingType TypeFloat{}  = Int -> Builder
intHost $(hashQ "Float")
encodeFloatingType TypeDouble{} = Int -> Builder
intHost $(hashQ "Double")

encodeMaybe :: (a -> Builder) -> Maybe a -> Builder
encodeMaybe :: (a -> Builder) -> Maybe a -> Builder
encodeMaybe a -> Builder
_ Maybe a
Nothing  = Int -> Builder
intHost $(hashQ "Nothing")
encodeMaybe a -> Builder
f (Just a
x) = Int -> Builder
intHost $(hashQ "Just") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
f a
x