{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Safe #-}
module Copilot.Interpret.Eval
( Env
, Output
, ExecTrace (..)
, eval
, ShowType (..)
) where
import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..),
Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..),
Trigger (..), Type (..), UExpr (..), arrayelems,
specObservers, specStreams, specTriggers)
import Copilot.Interpret.Error (badUsage)
import Prelude hiding (id)
import qualified Prelude as P
import Control.Exception (Exception, throw)
import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.))
import Data.Dynamic (Dynamic, fromDynamic, toDyn)
import Data.List (transpose)
import Data.Maybe (fromJust)
import Data.Typeable (Typeable)
data InterpException
= ArrayWrongSize Name Int
| ArrayIdxOutofBounds Name Int Int
| DivideByZero
| NotEnoughValues Name Int
| NoExtsInterp Name
deriving Typeable
instance Show InterpException where
show :: InterpException -> String
show (ArrayWrongSize String
name Int
expectedSize) =
forall a. String -> a
badUsage forall a b. (a -> b) -> a -> b
$ String
"in the environment for external array " forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
", we expect a list of length " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
expectedSize
forall a. [a] -> [a] -> [a]
++ String
", but the length of the array you supplied is of a different length."
show (ArrayIdxOutofBounds String
name Int
index Int
size) =
forall a. String -> a
badUsage forall a b. (a -> b) -> a -> b
$ String
"in the environment for external array " forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
", you gave an index of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index
forall a. [a] -> [a] -> [a]
++ String
" where the size of the array is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
size forall a. [a] -> [a] -> [a]
++ String
"; the size must "
forall a. [a] -> [a] -> [a]
++ String
" be strictly greater than the index."
show InterpException
DivideByZero =
forall a. String -> a
badUsage String
"divide by zero."
show (NotEnoughValues String
name Int
k) =
forall a. String -> a
badUsage forall a b. (a -> b) -> a -> b
$ String
"on the " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
k forall a. [a] -> [a] -> [a]
++ String
"th iteration, we ran out of "
forall a. [a] -> [a] -> [a]
++ String
"values for simulating the external element " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"."
show (NoExtsInterp String
name) =
forall a. String -> a
badUsage forall a b. (a -> b) -> a -> b
$ String
"in a call of external symbol " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
", you did not "
forall a. [a] -> [a] -> [a]
++ String
"provide an expression for interpretation. In your external "
forall a. [a] -> [a] -> [a]
++ String
"declaration, you need to provide a 'Just strm', where 'strm' is "
forall a. [a] -> [a] -> [a]
++ String
"some stream with which to simulate the function."
instance Exception InterpException
type Env nm = [(nm, Dynamic)]
type Output = String
data ExecTrace = ExecTrace
{ ExecTrace -> [(String, [Maybe [String]])]
interpTriggers :: [(String, [Maybe [Output]])]
, ExecTrace -> [(String, [String])]
interpObservers :: [(String, [Output])]
}
deriving Int -> ExecTrace -> ShowS
[ExecTrace] -> ShowS
ExecTrace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecTrace] -> ShowS
$cshowList :: [ExecTrace] -> ShowS
show :: ExecTrace -> String
$cshow :: ExecTrace -> String
showsPrec :: Int -> ExecTrace -> ShowS
$cshowsPrec :: Int -> ExecTrace -> ShowS
Show
eval :: ShowType
-> Int
-> Spec
-> ExecTrace
eval :: ShowType -> Int -> Spec -> ExecTrace
eval ShowType
showType Int
k Spec
spec =
let initStrms :: [(Int, Dynamic)]
initStrms = forall a b. (a -> b) -> [a] -> [b]
map Stream -> (Int, Dynamic)
initStrm (Spec -> [Stream]
specStreams Spec
spec) in
let strms :: [(Int, Dynamic)]
strms = Int -> [Stream] -> [(Int, Dynamic)] -> [(Int, Dynamic)]
evalStreams Int
k (Spec -> [Stream]
specStreams Spec
spec) [(Int, Dynamic)]
initStrms in
let trigs :: [[Maybe [String]]]
trigs = forall a b. (a -> b) -> [a] -> [b]
map (ShowType -> Int -> [(Int, Dynamic)] -> Trigger -> [Maybe [String]]
evalTrigger ShowType
showType Int
k [(Int, Dynamic)]
strms)
(Spec -> [Trigger]
specTriggers Spec
spec) in
let obsvs :: [[String]]
obsvs = forall a b. (a -> b) -> [a] -> [b]
map (ShowType -> Int -> [(Int, Dynamic)] -> Observer -> [String]
evalObserver ShowType
showType Int
k [(Int, Dynamic)]
strms)
(Spec -> [Observer]
specObservers Spec
spec) in
[(Int, Dynamic)]
strms seq :: forall a b. a -> b -> b
`seq` ExecTrace
{ interpTriggers :: [(String, [Maybe [String]])]
interpTriggers =
forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Trigger -> String
triggerName (Spec -> [Trigger]
specTriggers Spec
spec)) [[Maybe [String]]]
trigs
, interpObservers :: [(String, [String])]
interpObservers =
forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Observer -> String
observerName (Spec -> [Observer]
specObservers Spec
spec)) [[String]]
obsvs
}
type LocalEnv = [(Name, Dynamic)]
evalExpr_ :: Typeable a => Int -> Expr a -> LocalEnv -> Env Id -> a
evalExpr_ :: forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e0 LocalEnv
locs [(Int, Dynamic)]
strms = case Expr a
e0 of
Const Type a
_ a
x -> a
x
Drop Type a
t DropIdx
i Int
id ->
let Just [a]
buff = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
id [(Int, Dynamic)]
strms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => Dynamic -> Maybe a
fromDynamic in
forall a. [a] -> [a]
reverse [a]
buff forall a. [a] -> Int -> a
!! (forall a b. (Integral a, Num b) => a -> b
fromIntegral DropIdx
i forall a. Num a => a -> a -> a
+ Int
k)
Local Type a1
t1 Type a
_ String
name Expr a1
e1 Expr a
e2 ->
let x :: a1
x = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a1
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let locs' :: LocalEnv
locs' = (String
name, forall a. Typeable a => a -> Dynamic
toDyn a1
x) forall a. a -> [a] -> [a]
: LocalEnv
locs in
a1
x seq :: forall a b. a -> b -> b
`seq` LocalEnv
locs' seq :: forall a b. a -> b -> b
`seq` forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e2 LocalEnv
locs' [(Int, Dynamic)]
strms
Var Type a
t String
name -> forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name LocalEnv
locs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
ExternVar Type a
_ String
name Maybe [a]
xs -> forall a. Int -> String -> Maybe [a] -> a
evalExternVar Int
k String
name Maybe [a]
xs
Op1 Op1 a1 a
op Expr a1
e1 ->
let ev1 :: a1
ev1 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a1
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let op1 :: a1 -> a
op1 = forall a b. Op1 a b -> a -> b
evalOp1 Op1 a1 a
op in
a1
ev1 seq :: forall a b. a -> b -> b
`seq` a1 -> a
op1 seq :: forall a b. a -> b -> b
`seq` a1 -> a
op1 a1
ev1
Op2 Op2 a1 b a
op Expr a1
e1 Expr b
e2 ->
let ev1 :: a1
ev1 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a1
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let ev2 :: b
ev2 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr b
e2 LocalEnv
locs [(Int, Dynamic)]
strms in
let op2 :: a1 -> b -> a
op2 = forall a b c. Op2 a b c -> a -> b -> c
evalOp2 Op2 a1 b a
op in
a1
ev1 seq :: forall a b. a -> b -> b
`seq` b
ev2 seq :: forall a b. a -> b -> b
`seq` a1 -> b -> a
op2 seq :: forall a b. a -> b -> b
`seq` a1 -> b -> a
op2 a1
ev1 b
ev2
Op3 Op3 a1 b c a
op Expr a1
e1 Expr b
e2 Expr c
e3 ->
let ev1 :: a1
ev1 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a1
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let ev2 :: b
ev2 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr b
e2 LocalEnv
locs [(Int, Dynamic)]
strms in
let ev3 :: c
ev3 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr c
e3 LocalEnv
locs [(Int, Dynamic)]
strms in
let op3 :: a1 -> b -> c -> a
op3 = forall a b c d. Op3 a b c d -> a -> b -> c -> d
evalOp3 Op3 a1 b c a
op in
a1
ev1 seq :: forall a b. a -> b -> b
`seq` b
ev2 seq :: forall a b. a -> b -> b
`seq` c
ev3 seq :: forall a b. a -> b -> b
`seq` a1 -> b -> c -> a
op3 seq :: forall a b. a -> b -> b
`seq` a1 -> b -> c -> a
op3 a1
ev1 b
ev2 c
ev3
Label Type a
_ String
_ Expr a
e1 ->
let ev1 :: a
ev1 = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
a
ev1
evalExternVar :: Int -> Name -> Maybe [a] -> a
evalExternVar :: forall a. Int -> String -> Maybe [a] -> a
evalExternVar Int
k String
name Maybe [a]
exts =
case Maybe [a]
exts of
Maybe [a]
Nothing -> forall a e. Exception e => e -> a
throw (String -> InterpException
NoExtsInterp String
name)
Just [a]
xs ->
case forall a. Int -> [a] -> Maybe a
safeIndex Int
k [a]
xs of
Maybe a
Nothing -> forall a e. Exception e => e -> a
throw (String -> Int -> InterpException
NotEnoughValues String
name Int
k)
Just a
x -> a
x
evalOp1 :: Op1 a b -> (a -> b)
evalOp1 :: forall a b. Op1 a b -> a -> b
evalOp1 Op1 a b
op = case Op1 a b
op of
Op1 a b
Not -> Bool -> Bool
P.not
Abs Type a
_ -> forall a. Num a => a -> a
P.abs
Sign Type a
_ -> forall a. Num a => a -> a
P.signum
Recip Type a
_ -> forall a. Fractional a => a -> a
P.recip
Exp Type a
_ -> forall a. Floating a => a -> a
P.exp
Sqrt Type a
_ -> forall a. Floating a => a -> a
P.sqrt
Log Type a
_ -> forall a. Floating a => a -> a
P.log
Sin Type a
_ -> forall a. Floating a => a -> a
P.sin
Tan Type a
_ -> forall a. Floating a => a -> a
P.tan
Cos Type a
_ -> forall a. Floating a => a -> a
P.cos
Asin Type a
_ -> forall a. Floating a => a -> a
P.asin
Atan Type a
_ -> forall a. Floating a => a -> a
P.atan
Acos Type a
_ -> forall a. Floating a => a -> a
P.acos
Sinh Type a
_ -> forall a. Floating a => a -> a
P.sinh
Tanh Type a
_ -> forall a. Floating a => a -> a
P.tanh
Cosh Type a
_ -> forall a. Floating a => a -> a
P.cosh
Asinh Type a
_ -> forall a. Floating a => a -> a
P.asinh
Atanh Type a
_ -> forall a. Floating a => a -> a
P.atanh
Acosh Type a
_ -> forall a. Floating a => a -> a
P.acosh
Ceiling Type a
_ -> forall a b. (Integral a, Num b) => a -> b
P.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
idI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling
Floor Type a
_ -> forall a b. (Integral a, Num b) => a -> b
P.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
idI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
P.floor
BwNot Type a
_ -> forall a. Bits a => a -> a
complement
Cast Type a
_ Type b
_ -> forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
GetField (Struct a
_) Type b
_ a -> Field s b
f -> forall {s :: Symbol} {t}. Field s t -> t
unfield forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Field s b
f
where
idI :: Integer -> Integer
idI :: Integer -> Integer
idI = forall a. a -> a
P.id
unfield :: Field s t -> t
unfield (Field t
v) = t
v
evalOp2 :: Op2 a b c -> (a -> b -> c)
evalOp2 :: forall a b c. Op2 a b c -> a -> b -> c
evalOp2 Op2 a b c
op = case Op2 a b c
op of
Op2 a b c
And -> Bool -> Bool -> Bool
(&&)
Op2 a b c
Or -> Bool -> Bool -> Bool
(||)
Add Type a
_ -> forall a. Num a => a -> a -> a
(+)
Sub Type a
_ -> (-)
Mul Type a
_ -> forall a. Num a => a -> a -> a
(*)
Mod Type a
_ -> (forall a. Integral a => (a -> a -> a) -> a -> a -> a
catchZero forall a. Integral a => a -> a -> a
P.mod)
Div Type a
_ -> (forall a. Integral a => (a -> a -> a) -> a -> a -> a
catchZero forall a. Integral a => a -> a -> a
P.quot)
Fdiv Type a
_ -> forall a. Fractional a => a -> a -> a
(P./)
Pow Type a
_ -> forall a. Floating a => a -> a -> a
(P.**)
Logb Type a
_ -> forall a. Floating a => a -> a -> a
P.logBase
Atan2 Type a
_ -> forall a. RealFloat a => a -> a -> a
P.atan2
Eq Type a
_ -> forall a. Eq a => a -> a -> Bool
(==)
Ne Type a
_ -> forall a. Eq a => a -> a -> Bool
(/=)
Le Type a
_ -> forall a. Ord a => a -> a -> Bool
(<=)
Ge Type a
_ -> forall a. Ord a => a -> a -> Bool
(>=)
Lt Type a
_ -> forall a. Ord a => a -> a -> Bool
(<)
Gt Type a
_ -> forall a. Ord a => a -> a -> Bool
(>)
BwAnd Type a
_ -> forall a. Bits a => a -> a -> a
(.&.)
BwOr Type a
_ -> forall a. Bits a => a -> a -> a
(.|.)
BwXor Type a
_ -> (forall a. Bits a => a -> a -> a
xor)
BwShiftL Type a
_ Type b
_ -> ( \ !a
a !b
b -> forall a. Bits a => a -> Int -> a
shiftL a
a forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral b
b )
BwShiftR Type a
_ Type b
_ -> ( \ !a
a !b
b -> forall a. Bits a => a -> Int -> a
shiftR a
a forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral b
b )
Index Type (Array n c)
_ -> \a
xs b
n -> (forall (n :: Nat) a. Array n a -> [a]
arrayelems a
xs) forall a. [a] -> Int -> a
!! (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n)
catchZero :: Integral a => (a -> a -> a) -> (a -> a -> a)
catchZero :: forall a. Integral a => (a -> a -> a) -> a -> a -> a
catchZero a -> a -> a
_ a
_ a
0 = forall a e. Exception e => e -> a
throw InterpException
DivideByZero
catchZero a -> a -> a
f a
x a
y = a -> a -> a
f a
x a
y
evalOp3 :: Op3 a b c d -> (a -> b -> c -> d)
evalOp3 :: forall a b c d. Op3 a b c d -> a -> b -> c -> d
evalOp3 (Mux Type b
_) = \ !a
v !b
x !c
y -> if a
v then b
x else c
y
initStrm :: Stream -> (Id, Dynamic)
initStrm :: Stream -> (Int, Dynamic)
initStrm Stream { streamId :: Stream -> Int
streamId = Int
id
, streamBuffer :: ()
streamBuffer = [a]
buffer
, streamExprType :: ()
streamExprType = Type a
t } =
(Int
id, forall a. Typeable a => a -> Dynamic
toDyn (forall a. [a] -> [a]
reverse [a]
buffer))
evalStreams :: Int -> [Stream] -> Env Id -> Env Id
evalStreams :: Int -> [Stream] -> [(Int, Dynamic)] -> [(Int, Dynamic)]
evalStreams Int
top [Stream]
specStrms [(Int, Dynamic)]
initStrms =
Int -> [(Int, Dynamic)] -> [(Int, Dynamic)]
evalStreams_ Int
0 [(Int, Dynamic)]
initStrms
where
evalStreams_ :: Int -> Env Id -> Env Id
evalStreams_ :: Int -> [(Int, Dynamic)] -> [(Int, Dynamic)]
evalStreams_ Int
k [(Int, Dynamic)]
strms | Int
k forall a. Eq a => a -> a -> Bool
== Int
top = [(Int, Dynamic)]
strms
evalStreams_ Int
k [(Int, Dynamic)]
strms | Bool
otherwise =
Int -> [(Int, Dynamic)] -> [(Int, Dynamic)]
evalStreams_ (Int
kforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$! [(Int, Dynamic)]
strms_
where
strms_ :: [(Int, Dynamic)]
strms_ = forall a b. (a -> b) -> [a] -> [b]
map Stream -> (Int, Dynamic)
evalStream [Stream]
specStrms
evalStream :: Stream -> (Int, Dynamic)
evalStream Stream { streamId :: Stream -> Int
streamId = Int
id
, streamExpr :: ()
streamExpr = Expr a
e
, streamExprType :: ()
streamExprType = Type a
t } =
let xs :: [a]
xs = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
id [(Int, Dynamic)]
strms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => Dynamic -> Maybe a
fromDynamic in
let x :: a
x = forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e [] [(Int, Dynamic)]
strms in
let ls :: [a]
ls = a
x seq :: forall a b. a -> b -> b
`seq` (a
xforall a. a -> [a] -> [a]
:[a]
xs) in
(Int
id, forall a. Typeable a => a -> Dynamic
toDyn [a]
ls)
evalTrigger :: ShowType
-> Int
-> Env Id
-> Trigger
-> [Maybe [Output]]
evalTrigger :: ShowType -> Int -> [(Int, Dynamic)] -> Trigger -> [Maybe [String]]
evalTrigger ShowType
showType Int
k [(Int, Dynamic)]
strms
Trigger
{ triggerGuard :: Trigger -> Expr Bool
triggerGuard = Expr Bool
e
, triggerArgs :: Trigger -> [UExpr]
triggerArgs = [UExpr]
args
} = forall a b. (a -> b) -> [a] -> [b]
map forall a. (Bool, a) -> Maybe a
tag (forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
bs [[String]]
vs)
where
tag :: (Bool, a) -> Maybe a
tag :: forall a. (Bool, a) -> Maybe a
tag (Bool
True, a
x) = forall a. a -> Maybe a
Just a
x
tag (Bool
False, a
_) = forall a. Maybe a
Nothing
bs :: [Bool]
bs :: [Bool]
bs = forall a. Typeable a => Int -> Expr a -> [(Int, Dynamic)] -> [a]
evalExprs_ Int
k Expr Bool
e [(Int, Dynamic)]
strms
vs :: [[Output]]
vs :: [[String]]
vs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UExpr]
args then forall a. Int -> a -> [a]
replicate Int
k []
else forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map UExpr -> [String]
evalUExpr [UExpr]
args
evalUExpr :: UExpr -> [Output]
evalUExpr :: UExpr -> [String]
evalUExpr (UExpr Type a
t Expr a
e1) =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. ShowType -> Type a -> a -> String
showWithType ShowType
showType Type a
t) (forall a. Typeable a => Int -> Expr a -> [(Int, Dynamic)] -> [a]
evalExprs_ Int
k Expr a
e1 [(Int, Dynamic)]
strms)
evalObserver :: ShowType
-> Int
-> Env Id
-> Observer
-> [Output]
evalObserver :: ShowType -> Int -> [(Int, Dynamic)] -> Observer -> [String]
evalObserver ShowType
showType Int
k [(Int, Dynamic)]
strms
Observer
{ observerExpr :: ()
observerExpr = Expr a
e
, observerExprType :: ()
observerExprType = Type a
t }
= forall a b. (a -> b) -> [a] -> [b]
map (forall a. ShowType -> Type a -> a -> String
showWithType ShowType
showType Type a
t) (forall a. Typeable a => Int -> Expr a -> [(Int, Dynamic)] -> [a]
evalExprs_ Int
k Expr a
e [(Int, Dynamic)]
strms)
evalExprs_ :: Typeable a => Int -> Expr a -> Env Id -> [a]
evalExprs_ :: forall a. Typeable a => Int -> Expr a -> [(Int, Dynamic)] -> [a]
evalExprs_ Int
k Expr a
e [(Int, Dynamic)]
strms =
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
i Expr a
e [] [(Int, Dynamic)]
strms) [Int
0..(Int
kforall a. Num a => a -> a -> a
-Int
1)]
safeIndex :: Int -> [a] -> Maybe a
safeIndex :: forall a. Int -> [a] -> Maybe a
safeIndex Int
i [a]
ls =
let ls' :: [a]
ls' = forall a. Int -> [a] -> [a]
take (Int
iforall a. Num a => a -> a -> a
+Int
1) [a]
ls in
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls' forall a. Ord a => a -> a -> Bool
> Int
i then forall a. a -> Maybe a
Just ([a]
ls' forall a. [a] -> Int -> a
!! Int
i)
else forall a. Maybe a
Nothing
data ShowType = C | Haskell
showWithType :: ShowType -> Type a -> a -> String
showWithType :: forall a. ShowType -> Type a -> a -> String
showWithType ShowType
showT Type a
t a
x =
case ShowType
showT of
ShowType
C -> case Type a
t of
Type a
Bool -> if a
x then String
"1" else String
"0"
Type a
_ -> String
sw
ShowType
Haskell -> case Type a
t of
Type a
Bool -> if a
x then String
"true" else String
"false"
Type a
_ -> String
sw
where
sw :: String
sw = case forall a. Type a -> ShowWit a
showWit Type a
t of
ShowWit a
ShowWit -> forall a. Show a => a -> String
show a
x
data ShowWit a = Show a => ShowWit
showWit :: Type a -> ShowWit a
showWit :: forall a. Type a -> ShowWit a
showWit Type a
t =
case Type a
t of
Type a
Bool -> forall a. Show a => ShowWit a
ShowWit
Type a
Int8 -> forall a. Show a => ShowWit a
ShowWit
Type a
Int16 -> forall a. Show a => ShowWit a
ShowWit
Type a
Int32 -> forall a. Show a => ShowWit a
ShowWit
Type a
Int64 -> forall a. Show a => ShowWit a
ShowWit
Type a
Word8 -> forall a. Show a => ShowWit a
ShowWit
Type a
Word16 -> forall a. Show a => ShowWit a
ShowWit
Type a
Word32 -> forall a. Show a => ShowWit a
ShowWit
Type a
Word64 -> forall a. Show a => ShowWit a
ShowWit
Type a
Float -> forall a. Show a => ShowWit a
ShowWit
Type a
Double -> forall a. Show a => ShowWit a
ShowWit
Array Type t
t -> forall a. Show a => ShowWit a
ShowWit
Struct a
t -> forall a. Show a => ShowWit a
ShowWit