{-# LANGUAGE Safe #-}
{-# LANGUAGE GADTs, BangPatterns, DeriveDataTypeable #-}
module Copilot.Core.Interpret.Eval
(
Env
, Output
, ExecTrace (..)
, eval
) where
import Copilot.Core
import Copilot.Core.Type.Show (showWithType, ShowType)
import Prelude hiding (id)
import qualified Prelude as P
import Data.List (transpose)
import Data.Maybe (fromJust)
import Data.Bits
import Control.Exception (Exception, throw)
import Data.Dynamic (Dynamic, fromDynamic, toDyn)
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
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
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
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