{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Safe #-}
module Copilot.Core.Interpret.Eval
( Env
, Output
, ExecTrace (..)
, eval
, ShowType (..)
) where
import Copilot.Core (Expr (..), Field (..), Id, Name,
Observer (..), Op1 (..), Op2 (..),
Op3 (..), Spec, Stream (..),
Trigger (..), Type (Struct), UExpr (..),
arrayelems, specObservers, specStreams,
specTriggers)
import Copilot.Core.Error (badUsage)
import Copilot.Core.Type.ShowInternal (ShowType (..), showWithType)
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) =
ShowS
forall a. String -> a
badUsage ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"in the environment for external array " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", we expect a list of length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
expectedSize
String -> ShowS
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) =
ShowS
forall a. String -> a
badUsage ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"in the environment for external array " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", you gave an index of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" where the size of the array is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; the size must "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" be strictly greater than the index."
show InterpException
DivideByZero =
ShowS
forall a. String -> a
badUsage String
"divide by zero."
show (NotEnoughValues String
name Int
k) =
ShowS
forall a. String -> a
badUsage ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"on the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"th iteration, we ran out of "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"values for simulating the external element " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
show (NoExtsInterp String
name) =
ShowS
forall a. String -> a
badUsage ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"in a call of external symbol " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", you did not "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"provide an expression for interpretation. In your external "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"declaration, you need to provide a 'Just strm', where 'strm' is "
String -> ShowS
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
(Int -> ExecTrace -> ShowS)
-> (ExecTrace -> String)
-> ([ExecTrace] -> ShowS)
-> Show ExecTrace
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 = (Stream -> (Int, Dynamic)) -> [Stream] -> [(Int, Dynamic)]
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 = (Trigger -> [Maybe [String]]) -> [Trigger] -> [[Maybe [String]]]
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 = (Observer -> [String]) -> [Observer] -> [[String]]
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 [(Int, Dynamic)] -> ExecTrace -> ExecTrace
`seq` ExecTrace :: [(String, [Maybe [String]])] -> [(String, [String])] -> ExecTrace
ExecTrace
{ interpTriggers :: [(String, [Maybe [String]])]
interpTriggers =
[String] -> [[Maybe [String]]] -> [(String, [Maybe [String]])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Trigger -> String) -> [Trigger] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Trigger -> String
triggerName (Spec -> [Trigger]
specTriggers Spec
spec)) [[Maybe [String]]]
trigs
, interpObservers :: [(String, [String])]
interpObservers =
[String] -> [[String]] -> [(String, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Observer -> String) -> [Observer] -> [String]
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_ :: 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 = Int -> [(Int, Dynamic)] -> Maybe Dynamic
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
id [(Int, Dynamic)]
strms Maybe Dynamic -> (Dynamic -> Maybe [a]) -> Maybe [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe [a]
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic in
[a] -> [a]
forall a. [a] -> [a]
reverse [a]
buff [a] -> Int -> a
forall a. [a] -> Int -> a
!! (DropIdx -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DropIdx
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k)
Local Type a
t1 Type a
_ String
name Expr a
e1 Expr a
e2 ->
let x :: a
x = Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let locs' :: LocalEnv
locs' = (String
name, a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
x) (String, Dynamic) -> LocalEnv -> LocalEnv
forall a. a -> [a] -> [a]
: LocalEnv
locs in
a
x a -> a -> a
`seq` LocalEnv
locs' LocalEnv -> a -> a
`seq` Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
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 -> Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ String -> LocalEnv -> Maybe Dynamic
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name LocalEnv
locs Maybe Dynamic -> (Dynamic -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
ExternVar Type a
_ String
name Maybe [a]
xs -> Int -> String -> Maybe [a] -> a
forall a. Int -> String -> Maybe [a] -> a
evalExternVar Int
k String
name Maybe [a]
xs
Op1 Op1 a a
op Expr a
e1 ->
let ev1 :: a
ev1 = Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let op1 :: a -> a
op1 = Op1 a a -> a -> a
forall a b. Op1 a b -> a -> b
evalOp1 Op1 a a
op in
a
ev1 a -> a -> a
`seq` a -> a
op1 (a -> a) -> a -> a
`seq` a -> a
op1 a
ev1
Op2 Op2 a b a
op Expr a
e1 Expr b
e2 ->
let ev1 :: a
ev1 = Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let ev2 :: b
ev2 = Int -> Expr b -> LocalEnv -> [(Int, Dynamic)] -> b
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 :: a -> b -> a
op2 = Op2 a b a -> a -> b -> a
forall a b c. Op2 a b c -> a -> b -> c
evalOp2 Op2 a b a
op in
a
ev1 a -> a -> a
`seq` b
ev2 b -> a -> a
`seq` a -> b -> a
op2 (a -> b -> a) -> a -> a
`seq` a -> b -> a
op2 a
ev1 b
ev2
Op3 Op3 a b c a
op Expr a
e1 Expr b
e2 Expr c
e3 ->
let ev1 :: a
ev1 = Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
k Expr a
e1 LocalEnv
locs [(Int, Dynamic)]
strms in
let ev2 :: b
ev2 = Int -> Expr b -> LocalEnv -> [(Int, Dynamic)] -> b
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 = Int -> Expr c -> LocalEnv -> [(Int, Dynamic)] -> c
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 :: a -> b -> c -> a
op3 = Op3 a b c a -> a -> b -> c -> a
forall a b c d. Op3 a b c d -> a -> b -> c -> d
evalOp3 Op3 a b c a
op in
a
ev1 a -> a -> a
`seq` b
ev2 b -> a -> a
`seq` c
ev3 c -> a -> a
`seq` a -> b -> c -> a
op3 (a -> b -> c -> a) -> a -> a
`seq` a -> b -> c -> a
op3 a
ev1 b
ev2 c
ev3
Label Type a
_ String
_ Expr a
e1 ->
let ev1 :: a
ev1 = Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
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 :: Int -> String -> Maybe [a] -> a
evalExternVar Int
k String
name Maybe [a]
exts =
case Maybe [a]
exts of
Maybe [a]
Nothing -> InterpException -> a
forall a e. Exception e => e -> a
throw (String -> InterpException
NoExtsInterp String
name)
Just [a]
xs ->
case Int -> [a] -> Maybe a
forall a. Int -> [a] -> Maybe a
safeIndex Int
k [a]
xs of
Maybe a
Nothing -> InterpException -> a
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 :: Op1 a b -> a -> b
evalOp1 Op1 a b
op = case Op1 a b
op of
Op1 a b
Not -> a -> b
Bool -> Bool
P.not
Abs Type a
_ -> a -> b
forall a. Num a => a -> a
P.abs
Sign Type a
_ -> a -> b
forall a. Num a => a -> a
P.signum
Recip Type a
_ -> a -> b
forall a. Fractional a => a -> a
P.recip
Exp Type a
_ -> a -> b
forall a. Floating a => a -> a
P.exp
Sqrt Type a
_ -> a -> b
forall a. Floating a => a -> a
P.sqrt
Log Type a
_ -> a -> b
forall a. Floating a => a -> a
P.log
Sin Type a
_ -> a -> b
forall a. Floating a => a -> a
P.sin
Tan Type a
_ -> a -> b
forall a. Floating a => a -> a
P.tan
Cos Type a
_ -> a -> b
forall a. Floating a => a -> a
P.cos
Asin Type a
_ -> a -> b
forall a. Floating a => a -> a
P.asin
Atan Type a
_ -> a -> b
forall a. Floating a => a -> a
P.atan
Acos Type a
_ -> a -> b
forall a. Floating a => a -> a
P.acos
Sinh Type a
_ -> a -> b
forall a. Floating a => a -> a
P.sinh
Tanh Type a
_ -> a -> b
forall a. Floating a => a -> a
P.tanh
Cosh Type a
_ -> a -> b
forall a. Floating a => a -> a
P.cosh
Asinh Type a
_ -> a -> b
forall a. Floating a => a -> a
P.asinh
Atanh Type a
_ -> a -> b
forall a. Floating a => a -> a
P.atanh
Acosh Type a
_ -> a -> b
forall a. Floating a => a -> a
P.acosh
Ceiling Type a
_ -> Integer -> b
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
idI (Integer -> Integer) -> (a -> Integer) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling
Floor Type a
_ -> Integer -> b
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
idI (Integer -> Integer) -> (a -> Integer) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor
BwNot Type a
_ -> a -> b
forall a. Bits a => a -> a
complement
Cast Type a
_ Type b
_ -> a -> b
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral
GetField (Struct a
_) Type b
_ a -> Field s b
f -> Field s b -> b
forall (s :: Symbol) t. Field s t -> t
unfield (Field s b -> b) -> (a -> Field s b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Field s b
f
where
idI :: Integer -> Integer
idI :: Integer -> Integer
idI = Integer -> Integer
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 :: 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 -> a -> b -> c
Bool -> Bool -> Bool
(&&)
Op2 a b c
Or -> a -> b -> c
Bool -> Bool -> Bool
(||)
Add Type a
_ -> a -> b -> c
forall a. Num a => a -> a -> a
(+)
Sub Type a
_ -> (-)
Mul Type a
_ -> a -> b -> c
forall a. Num a => a -> a -> a
(*)
Mod Type a
_ -> ((c -> c -> c) -> c -> c -> c
forall a. Integral a => (a -> a -> a) -> a -> a -> a
catchZero c -> c -> c
forall a. Integral a => a -> a -> a
P.mod)
Div Type a
_ -> ((c -> c -> c) -> c -> c -> c
forall a. Integral a => (a -> a -> a) -> a -> a -> a
catchZero c -> c -> c
forall a. Integral a => a -> a -> a
P.quot)
Fdiv Type a
_ -> a -> b -> c
forall a. Fractional a => a -> a -> a
(P./)
Pow Type a
_ -> a -> b -> c
forall a. Floating a => a -> a -> a
(P.**)
Logb Type a
_ -> a -> b -> c
forall a. Floating a => a -> a -> a
P.logBase
Atan2 Type a
_ -> a -> b -> c
forall a. RealFloat a => a -> a -> a
P.atan2
Eq Type a
_ -> a -> b -> c
forall a. Eq a => a -> a -> Bool
(==)
Ne Type a
_ -> a -> b -> c
forall a. Eq a => a -> a -> Bool
(/=)
Le Type a
_ -> a -> b -> c
forall a. Ord a => a -> a -> Bool
(<=)
Ge Type a
_ -> a -> b -> c
forall a. Ord a => a -> a -> Bool
(>=)
Lt Type a
_ -> a -> b -> c
forall a. Ord a => a -> a -> Bool
(<)
Gt Type a
_ -> a -> b -> c
forall a. Ord a => a -> a -> Bool
(>)
BwAnd Type a
_ -> a -> b -> c
forall a. Bits a => a -> a -> a
(.&.)
BwOr Type a
_ -> a -> b -> c
forall a. Bits a => a -> a -> a
(.|.)
BwXor Type a
_ -> (a -> b -> c
forall a. Bits a => a -> a -> a
xor)
BwShiftL Type a
_ Type b
_ -> ( \ !a
a !b
b -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
a (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$! b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
b )
BwShiftR Type a
_ Type b
_ -> ( \ !a
a !b
b -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
a (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$! b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
b )
Index Type (Array n c)
_ -> \a
xs b
n -> (Array n c -> [c]
forall (n :: Nat) a. Array n a -> [a]
arrayelems a
Array n c
xs) [c] -> Int -> c
forall a. [a] -> Int -> a
!! (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n)
catchZero :: Integral a => (a -> a -> a) -> (a -> a -> a)
catchZero :: (a -> a -> a) -> a -> a -> a
catchZero a -> a -> a
_ a
_ a
0 = InterpException -> a
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 :: Op3 a b c d -> a -> b -> c -> d
evalOp3 (Mux Type b
_) = \ !a
v !b
x !c
y -> if a
Bool
v then b
d
x else c
d
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, [a] -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ([a] -> [a]
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 Int -> Int -> Bool
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
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([(Int, Dynamic)] -> [(Int, Dynamic)])
-> [(Int, Dynamic)] -> [(Int, Dynamic)]
forall a b. (a -> b) -> a -> b
$! [(Int, Dynamic)]
strms_
where
strms_ :: [(Int, Dynamic)]
strms_ = (Stream -> (Int, Dynamic)) -> [Stream] -> [(Int, Dynamic)]
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 = Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Dynamic)] -> Maybe Dynamic
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
id [(Int, Dynamic)]
strms Maybe Dynamic -> (Dynamic -> Maybe [a]) -> Maybe [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe [a]
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic in
let x :: a
x = Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
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 a -> [a] -> [a]
`seq` (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) in
(Int
id, [a] -> Dynamic
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
} = ((Bool, [String]) -> Maybe [String])
-> [(Bool, [String])] -> [Maybe [String]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, [String]) -> Maybe [String]
forall a. (Bool, a) -> Maybe a
tag ([Bool] -> [[String]] -> [(Bool, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
bs [[String]]
vs)
where
tag :: (Bool, a) -> Maybe a
tag :: (Bool, a) -> Maybe a
tag (Bool
True, a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
tag (Bool
False, a
_) = Maybe a
forall a. Maybe a
Nothing
bs :: [Bool]
bs :: [Bool]
bs = Int -> Expr Bool -> [(Int, Dynamic)] -> [Bool]
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 [UExpr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UExpr]
args then Int -> [String] -> [[String]]
forall a. Int -> a -> [a]
replicate Int
k []
else [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (UExpr -> [String]) -> [UExpr] -> [[String]]
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) =
(a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowType -> Type a -> a -> String
forall a. ShowType -> Type a -> a -> String
showWithType ShowType
showType Type a
t) (Int -> Expr a -> [(Int, Dynamic)] -> [a]
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 }
= (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowType -> Type a -> a -> String
forall a. ShowType -> Type a -> a -> String
showWithType ShowType
showType Type a
t) (Int -> Expr a -> [(Int, Dynamic)] -> [a]
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_ :: Int -> Expr a -> [(Int, Dynamic)] -> [a]
evalExprs_ Int
k Expr a
e [(Int, Dynamic)]
strms =
(Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
forall a.
Typeable a =>
Int -> Expr a -> LocalEnv -> [(Int, Dynamic)] -> a
evalExpr_ Int
i Expr a
e [] [(Int, Dynamic)]
strms) [Int
0..(Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
safeIndex :: Int -> [a] -> Maybe a
safeIndex :: Int -> [a] -> Maybe a
safeIndex Int
i [a]
ls =
let ls' :: [a]
ls' = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
ls in
if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i then a -> Maybe a
forall a. a -> Maybe a
Just ([a]
ls' [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i)
else Maybe a
forall a. Maybe a
Nothing