{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Interpreter for L1
module Gibbon.L1.Interp ( interpProg, interp, applyPrim ) where

import           Data.ByteString.Builder ( toLazyByteString, string8)
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.Char ( ord )
import           Control.DeepSeq
import           Control.Monad
import           Control.Monad.State
import           Control.Monad.Writer
import qualified Data.List as L
import qualified Data.Map as M
import           System.Clock
import           System.IO.Unsafe
import           System.Random
import           Text.PrettyPrint.GenericPretty

import           Gibbon.Common
import           Gibbon.L1.Syntax as L1


interpChatter :: Int
interpChatter :: Int
interpChatter = Int
7

------------------------------------------------------------

instance InterpExt () Exp1 (E1Ext () Ty1) where
  gInterpExt :: RunConfig
-> ValEnv Exp1
-> DDefs (TyOf Exp1)
-> FunDefs Exp1
-> E1Ext () Ty1
-> InterpM () Exp1 (Value Exp1)
gInterpExt RunConfig
rc ValEnv Exp1
valenv DDefs (TyOf Exp1)
ddefs FunDefs Exp1
fundefs E1Ext () Ty1
ex =
      case E1Ext () Ty1
ex of
          BenchE Var
fn [()]
locs [Exp1]
args Bool
_b -> RunConfig
-> ValEnv Exp1
-> DDefs (TyOf Exp1)
-> FunDefs Exp1
-> Exp1
-> InterpM () Exp1 (Value Exp1)
forall (e :: * -> * -> *) l d s.
(Show l, Ord l, NFData l, Out l, Show d, NFData d, Out d, Ord d,
 Ord (e l d), NFData (e l d), InterpExt s (PreExp e l d) (e l d)) =>
RunConfig
-> ValEnv (PreExp e l d)
-> DDefs (TyOf (PreExp e l d))
-> FunDefs (PreExp e l d)
-> PreExp e l d
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
interp RunConfig
rc ValEnv Exp1
valenv DDefs (TyOf Exp1)
ddefs FunDefs Exp1
fundefs (Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [()]
locs [Exp1]
args)
          AddFixed{}   -> [Char] -> InterpM () Exp1 (Value Exp1)
forall a. HasCallStack => [Char] -> a
error [Char]
"L1.Interp: AddFixed not handled."
          StartOfPkdCursor{} -> [Char] -> InterpM () Exp1 (Value Exp1)
forall a. HasCallStack => [Char] -> a
error [Char]
"L1.Interp: StartOfPkdCursor not handled."

instance Interp () Exp1 where
  gInterpExp :: RunConfig
-> ValEnv Exp1
-> DDefs (TyOf Exp1)
-> FunDefs Exp1
-> Exp1
-> InterpM () Exp1 (Value Exp1)
gInterpExp = RunConfig
-> ValEnv Exp1
-> DDefs (TyOf Exp1)
-> FunDefs Exp1
-> Exp1
-> InterpM () Exp1 (Value Exp1)
forall (e :: * -> * -> *) l d s.
(Show l, Ord l, NFData l, Out l, Show d, NFData d, Out d, Ord d,
 Ord (e l d), NFData (e l d), InterpExt s (PreExp e l d) (e l d)) =>
RunConfig
-> ValEnv (PreExp e l d)
-> DDefs (TyOf (PreExp e l d))
-> FunDefs (PreExp e l d)
-> PreExp e l d
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
interp

instance InterpProg () Exp1 where
  gInterpProg :: () -> RunConfig -> Prog Exp1 -> IO ((), Value Exp1, ByteString)
gInterpProg ()
_s = RunConfig -> Prog Exp1 -> IO ((), Value Exp1, ByteString)
forall e.
Interp () e =>
RunConfig -> Prog e -> IO ((), Value e, ByteString)
interpProg

-- | Interpret a program, including printing timings to the screen.
--   The returned bytestring contains that printed timing info.
interpProg :: Interp () e => RunConfig -> Prog e -> IO ((), Value e, B.ByteString)
interpProg :: forall e.
Interp () e =>
RunConfig -> Prog e -> IO ((), Value e, ByteString)
interpProg RunConfig
rc Prog{DDefs (TyOf e)
ddefs :: DDefs (TyOf e)
ddefs :: forall ex. Prog ex -> DDefs (TyOf ex)
ddefs,FunDefs e
fundefs :: FunDefs e
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs,Maybe (e, TyOf e)
mainExp :: Maybe (e, TyOf e)
mainExp :: forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp} =
  case Maybe (e, TyOf e)
mainExp of
    -- Print nothing, return "void"
    Maybe (e, TyOf e)
Nothing -> ((), Value e, ByteString) -> IO ((), Value e, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), [Value e] -> Value e
forall e. [Value e] -> Value e
VProd [], ByteString
B.empty)
    Just (e
e,TyOf e
_) -> do
      let fenv :: FunDefs e
fenv = [(Var, FunDef e)] -> FunDefs e
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (FunDef e -> Var
forall ex. FunDef ex -> Var
funName FunDef e
f , FunDef e
f) | FunDef e
f <- FunDefs e -> [FunDef e]
forall k a. Map k a -> [a]
M.elems FunDefs e
fundefs]
      (Value e
v,InterpLog
logs,()
_) <- InterpM () e (Value e) -> () -> IO (Value e, InterpLog, ())
forall s e a. InterpM s e a -> s -> IO (a, InterpLog, s)
runInterpM (RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> e
-> InterpM () e (Value e)
forall s e.
Interp s e =>
RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> e
-> InterpM s e (Value e)
gInterpExp RunConfig
rc ValEnv e
forall k a. Map k a
M.empty DDefs (TyOf e)
ddefs FunDefs e
fenv e
e) ()
      ((), Value e, ByteString) -> IO ((), Value e, ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), Value e
v, InterpLog -> ByteString
toLazyByteString InterpLog
logs)

interp :: forall e l d s.
          (Show l, Ord l, NFData l, Out l,
           Show d, NFData d, Out d, Ord d,
           Ord (e l d), NFData (e l d),
           InterpExt s (PreExp e l d) (e l d))
       => RunConfig
       -> ValEnv (PreExp e l d)
       -> DDefs (TyOf (PreExp e l d))
       -> FunDefs (PreExp e l d)
       -> (PreExp e l d)
       -> InterpM s (PreExp e l d) (Value (PreExp e l d))
interp :: forall (e :: * -> * -> *) l d s.
(Show l, Ord l, NFData l, Out l, Show d, NFData d, Out d, Ord d,
 Ord (e l d), NFData (e l d), InterpExt s (PreExp e l d) (e l d)) =>
RunConfig
-> ValEnv (PreExp e l d)
-> DDefs (TyOf (PreExp e l d))
-> FunDefs (PreExp e l d)
-> PreExp e l d
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
interp RunConfig
rc ValEnv (PreExp e l d)
valenv DDefs (TyOf (PreExp e l d))
ddefs FunDefs (PreExp e l d)
fenv = ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
valenv
  where
    {-# NOINLINE goWrapper #-}
    goWrapper :: ValEnv (PreExp e l d)
-> Word64
-> PreExp e l d
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
goWrapper ValEnv (PreExp e l d)
env !Word64
_ix PreExp e l d
ex = ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
ex

    go :: ValEnv (PreExp e l d) -> (PreExp e l d) -> InterpM s (PreExp e l d) (Value (PreExp e l d))
    go :: ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
x0 = do
        case PreExp e l d
x0 of
          Ext e l d
ext -> do
              RunConfig
-> ValEnv (PreExp e l d)
-> DDefs (TyOf (PreExp e l d))
-> FunDefs (PreExp e l d)
-> e l d
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall s e ext.
InterpExt s e ext =>
RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> ext
-> InterpM s e (Value e)
gInterpExt RunConfig
rc ValEnv (PreExp e l d)
env DDefs (TyOf (PreExp e l d))
ddefs FunDefs (PreExp e l d)
fenv e l d
ext

          LitE Int
c    -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt Int
c
          CharE Char
c   -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Char -> Value (PreExp e l d)
forall e. Char -> Value e
VChar Char
c
          FloatE Double
c  -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat Double
c
          LitSymE Var
s -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char] -> Value (PreExp e l d)
forall e. [Char] -> Value e
VSym (Var -> [Char]
fromVar Var
s)
          VarE Var
v    -> do
              Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ ValEnv (PreExp e l d)
env ValEnv (PreExp e l d) -> Var -> Value (PreExp e l d)
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v

          -- -- Don't sort for now
          -- PrimAppE (VSortP{}) [ls,VarE fp] -> do
          --   (VList vals) <- go env ls
          --   applySortP env vals fp

          PrimAppE Prim d
p [PreExp e l d]
ls -> do [Value (PreExp e l d)]
args <- (PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [PreExp e l d]
-> InterpM s (PreExp e l d) [Value (PreExp e l d)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env) [PreExp e l d]
ls
                              RunConfig
-> Prim d
-> [Value (PreExp e l d)]
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall ty l d (e :: * -> * -> *) s.
(Show ty, Ord l, Out l, Show l, Show d, Out d, Ord d, Ord (e l d),
 Out (e l d), Show (e l d)) =>
RunConfig
-> Prim ty
-> [Value (PreExp e l d)]
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
applyPrim RunConfig
rc Prim d
p [Value (PreExp e l d)]
args
          ProjE Int
ix PreExp e l d
ex   -> do VProd [Value (PreExp e l d)]
ls <- ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
ex
                              Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)]
ls [Value (PreExp e l d)] -> Int -> Value (PreExp e l d)
forall a. (Out a, HasCallStack) => [a] -> Int -> a
!!! Int
ix

          -- N.B. this AppE is shared by the interpreters for L0 and L1
          AppE Var
f [l]
_ [PreExp e l d]
ls -> do
            [Value (PreExp e l d)]
ls' <- (PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [PreExp e l d]
-> InterpM s (PreExp e l d) [Value (PreExp e l d)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env) [PreExp e l d]
ls
            -- Look in the local environment first
            case Var -> ValEnv (PreExp e l d) -> Maybe (Value (PreExp e l d))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f ValEnv (PreExp e l d)
env of
              Maybe (Value (PreExp e l d))
Nothing ->
                case Var -> FunDefs (PreExp e l d) -> Maybe (FunDef (PreExp e l d))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f FunDefs (PreExp e l d)
fenv of
                  Just FunDef (PreExp e l d)
fn -> do
                      let env' :: ValEnv (PreExp e l d)
env' = ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d) -> ValEnv (PreExp e l d)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Value (PreExp e l d))] -> ValEnv (PreExp e l d)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([Var] -> [Value (PreExp e l d)] -> [(Var, Value (PreExp e l d))]
forall a b. [a] -> [b] -> [(a, b)]
zip (FunDef (PreExp e l d) -> [Var]
forall ex. FunDef ex -> [Var]
funArgs FunDef (PreExp e l d)
fn) [Value (PreExp e l d)]
ls')) ValEnv (PreExp e l d)
env
                      ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env' (FunDef (PreExp e l d) -> PreExp e l d
forall ex. FunDef ex -> ex
funBody FunDef (PreExp e l d)
fn)
                  Maybe (FunDef (PreExp e l d))
Nothing -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"L1.Interp: unbound function in application: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++PreExp e l d -> [Char]
forall a. Out a => a -> [Char]
ndoc PreExp e l d
x0
              Just fn :: Value (PreExp e l d)
fn@(VLam [Var]
args PreExp e l d
bod ValEnv (PreExp e l d)
closed_env) ->
                if [Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Value (PreExp e l d)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value (PreExp e l d)]
ls'
                then [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"L0.Interp: unexpected arguments in application: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Value (PreExp e l d)] -> [Char]
forall a. Out a => a -> [Char]
ndoc [Value (PreExp e l d)]
ls' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value (PreExp e l d) -> [Char]
forall a. Out a => a -> [Char]
ndoc Value (PreExp e l d)
fn
                else do
                  let env' :: ValEnv (PreExp e l d)
env' = [(Var, Value (PreExp e l d))] -> ValEnv (PreExp e l d)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([Var] -> [Value (PreExp e l d)] -> [(Var, Value (PreExp e l d))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args [Value (PreExp e l d)]
ls') ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d) -> ValEnv (PreExp e l d)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ValEnv (PreExp e l d)
closed_env ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d) -> ValEnv (PreExp e l d)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` ValEnv (PreExp e l d)
env
                  ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env' PreExp e l d
bod
              Just Value (PreExp e l d)
oth -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"L0.Interp: expected a lambda in application, got: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value (PreExp e l d) -> [Char]
forall a. Out a => a -> [Char]
ndoc Value (PreExp e l d)
oth [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value (PreExp e l d) -> [Char]
forall a. Out a => a -> [Char]
ndoc Value (PreExp e l d)
oth


          CaseE PreExp e l d
_ [] -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"L1.Interp: CaseE with empty alternatives list: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++PreExp e l d -> [Char]
forall a. Out a => a -> [Char]
ndoc PreExp e l d
x0

          CaseE PreExp e l d
x1 alts :: [([Char], [(Var, l)], PreExp e l d)]
alts@(([Char]
_sometag,[(Var, l)]
_,PreExp e l d
_):[([Char], [(Var, l)], PreExp e l d)]
_) -> do
                 Value (PreExp e l d)
v <- ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
x1
                 case Value (PreExp e l d)
v of
                   VPacked [Char]
k [Value (PreExp e l d)]
ls2 -> do
                       let vs :: [Var]
vs = ((Var, l) -> Var) -> [(Var, l)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (Var, l) -> Var
forall a b. (a, b) -> a
fst [(Var, l)]
prs
                           ([Char]
_,[(Var, l)]
prs,PreExp e l d
rhs) = [Char]
-> [([Char], [(Var, l)], PreExp e l d)]
-> ([Char], [(Var, l)], PreExp e l d)
forall k a b.
(Eq k, Show k, Show a, Show b) =>
k -> [(k, a, b)] -> (k, a, b)
lookup3 [Char]
k [([Char], [(Var, l)], PreExp e l d)]
alts
                           env' :: ValEnv (PreExp e l d)
env' = ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d) -> ValEnv (PreExp e l d)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Value (PreExp e l d))] -> ValEnv (PreExp e l d)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([Var] -> [Value (PreExp e l d)] -> [(Var, Value (PreExp e l d))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vs [Value (PreExp e l d)]
ls2)) ValEnv (PreExp e l d)
env
                       ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env' PreExp e l d
rhs
                   Value (PreExp e l d)
_ -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"L1.Interp: type error, expected data constructor, got: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Value (PreExp e l d) -> [Char]
forall a. Out a => a -> [Char]
ndoc Value (PreExp e l d)
v[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                               [Char]
"\nWhen evaluating scrutinee of case expression: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++PreExp e l d -> [Char]
forall a. Out a => a -> [Char]
ndoc PreExp e l d
x1

          LetE (Var
v,[l]
_,d
_ty,PreExp e l d
rhs) PreExp e l d
bod -> do
            Value (PreExp e l d)
rhs' <- ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
rhs
            let env' :: ValEnv (PreExp e l d)
env' = Var
-> Value (PreExp e l d)
-> ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Value (PreExp e l d)
rhs' ValEnv (PreExp e l d)
env
                env'' :: ValEnv (PreExp e l d)
env'' = case PreExp e l d
rhs of
                          (PrimAppE (InplaceVUpdateP d
_) [VarE Var
x,PreExp e l d
_,PreExp e l d
_]) ->
                            Var
-> Value (PreExp e l d)
-> ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
x Value (PreExp e l d)
rhs' ValEnv (PreExp e l d)
env'
                          PreExp e l d
_ -> ValEnv (PreExp e l d)
env'
            ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env'' PreExp e l d
bod

          MkProdE [PreExp e l d]
ls -> [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd ([Value (PreExp e l d)] -> Value (PreExp e l d))
-> InterpM s (PreExp e l d) [Value (PreExp e l d)]
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [PreExp e l d]
-> InterpM s (PreExp e l d) [Value (PreExp e l d)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env) [PreExp e l d]
ls
          -- TODO: Should check this against the ddefs.
          DataConE l
_ [Char]
k [PreExp e l d]
ls -> do
              [Value (PreExp e l d)]
args <- (PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [PreExp e l d]
-> InterpM s (PreExp e l d) [Value (PreExp e l d)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env) [PreExp e l d]
ls
              Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char] -> [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Char] -> [Value e] -> Value e
VPacked [Char]
k [Value (PreExp e l d)]
args

          TimeIt PreExp e l d
bod d
_ Bool
isIter -> do
              let iters :: Word64
iters = if Bool
isIter then RunConfig -> Word64
rcIters RunConfig
rc else Word64
1
              !ValEnv (PreExp e l d)
_ <- ValEnv (PreExp e l d)
-> InterpM s (PreExp e l d) (ValEnv (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValEnv (PreExp e l d)
 -> InterpM s (PreExp e l d) (ValEnv (PreExp e l d)))
-> ValEnv (PreExp e l d)
-> InterpM s (PreExp e l d) (ValEnv (PreExp e l d))
forall a b. (a -> b) -> a -> b
$! ValEnv (PreExp e l d) -> ValEnv (PreExp e l d)
forall a. NFData a => a -> a
force ValEnv (PreExp e l d)
env
              TimeSpec
st <- IO TimeSpec -> InterpM s (PreExp e l d) TimeSpec
forall a. IO a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> InterpM s (PreExp e l d) TimeSpec)
-> IO TimeSpec -> InterpM s (PreExp e l d) TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
clk
              Value (PreExp e l d)
val <- (Value (PreExp e l d)
 -> Word64 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> [Word64]
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ Value (PreExp e l d)
_ Word64
i -> ValEnv (PreExp e l d)
-> Word64
-> PreExp e l d
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
goWrapper ValEnv (PreExp e l d)
env Word64
i PreExp e l d
bod)
                            ([Char] -> Value (PreExp e l d)
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: this should be unused.")
                         [Word64
1..Word64
iters]
              TimeSpec
en <- IO TimeSpec -> InterpM s (PreExp e l d) TimeSpec
forall a. IO a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> InterpM s (PreExp e l d) TimeSpec)
-> IO TimeSpec -> InterpM s (PreExp e l d) TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
clk
              let tm :: Double
tm = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeSpec -> Integer
toNanoSecs (TimeSpec -> Integer) -> TimeSpec -> Integer
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
en TimeSpec
st)
                        Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10e9 :: Double
              if Bool
isIter
               then do InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell(InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 ([Char] -> InterpLog) -> [Char] -> InterpLog
forall a b. (a -> b) -> a -> b
$ [Char]
"ITERS: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
iters       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"
                       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell(InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 ([Char] -> InterpLog) -> [Char] -> InterpLog
forall a b. (a -> b) -> a -> b
$ [Char]
"SIZE: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show (RunConfig -> Int
rcSize RunConfig
rc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"
                       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell(InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 ([Char] -> InterpLog) -> [Char] -> InterpLog
forall a b. (a -> b) -> a -> b
$ [Char]
"BATCHTIME: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Double -> [Char]
forall a. Show a => a -> [Char]
show Double
tm      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"
               else InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell(InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 ([Char] -> InterpLog) -> [Char] -> InterpLog
forall a b. (a -> b) -> a -> b
$ [Char]
"SELFTIMED: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Double -> [Char]
forall a. Show a => a -> [Char]
show Double
tm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"
              Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$! Value (PreExp e l d)
val

          SpawnE Var
f [l]
locs [PreExp e l d]
args -> ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env (Var -> [l] -> [PreExp e l d] -> PreExp e l d
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [l]
locs [PreExp e l d]
args)
          PreExp e l d
SyncE -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (-Int
1)

          WithArenaE Var
v PreExp e l d
e -> do
              let env' :: ValEnv (PreExp e l d)
env' = Var
-> Value (PreExp e l d)
-> ValEnv (PreExp e l d)
-> ValEnv (PreExp e l d)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt Int
0) ValEnv (PreExp e l d)
env
              ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env' PreExp e l d
e

          IfE PreExp e l d
a PreExp e l d
b PreExp e l d
c -> do Value (PreExp e l d)
v <- ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
a
                          case Value (PreExp e l d)
v of
                           VBool Bool
flg -> if Bool
flg
                                        then ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
b
                                        else ValEnv (PreExp e l d)
-> PreExp e l d -> InterpM s (PreExp e l d) (Value (PreExp e l d))
go ValEnv (PreExp e l d)
env PreExp e l d
c
                           Value (PreExp e l d)
oth -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"interp: expected bool, got: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Value (PreExp e l d) -> [Char]
forall a. Show a => a -> [Char]
show Value (PreExp e l d)
oth

          MapE (Var, d, PreExp e l d)
_ PreExp e l d
_bod    -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error [Char]
"L1.Interp: finish MapE"
          FoldE (Var, d, PreExp e l d)
_ (Var, d, PreExp e l d)
_ PreExp e l d
_bod -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error [Char]
"L1.Interp: finish FoldE"

    -- _applySortP :: ValEnv (PreExp e l d) -> [(Value (PreExp e l d))] -> Var -> WriterT InterpLog IO (Value (PreExp e l d))
    -- _applySortP env ls f = do
    --   let fn  = case M.lookup f fenv of
    --               Just fun -> fun
    --               Nothing -> error $ "L1.Interp: unbound function given to vsort: "++ndoc f
    --       ls' = sortBy
    --             (\a b ->
    --                  let env' = M.union (M.fromList (zip (funArgs fn) [a,b])) env
    --                      (i,_) =
    --                        unsafePerformIO $ (runWriterT (go env' (funBody fn)))
    --                      VInt j = i
    --                  in compare j 0)
    --             ls
    --   pure (VList ls')


applyPrim :: (Show ty, Ord l, Out l, Show l, Show d, Out d, Ord d,  Ord (e l d), Out (e l d), Show (e l d))
          => RunConfig -> Prim ty -> [(Value (PreExp e l d))] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
applyPrim :: forall ty l d (e :: * -> * -> *) s.
(Show ty, Ord l, Out l, Show l, Show d, Out d, Ord d, Ord (e l d),
 Out (e l d), Show (e l d)) =>
RunConfig
-> Prim ty
-> [Value (PreExp e l d)]
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
applyPrim RunConfig
rc Prim ty
p [Value (PreExp e l d)]
args =
 case (Prim ty
p,[Value (PreExp e l d)]
args) of
   (Prim ty
MkTrue,[])             -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool Bool
True
   (Prim ty
MkFalse,[])            -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool Bool
False
   -- FIXME: randomIO does not guarentee unique numbers every time.
   (Prim ty
Gensym, [])            -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char] -> Value (PreExp e l d)
forall e. [Char] -> Value e
VSym ([Char] -> Value (PreExp e l d)) -> [Char] -> Value (PreExp e l d)
forall a b. (a -> b) -> a -> b
$ [Char]
"gensym_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ (IO Int -> Int
forall a. IO a -> a
unsafePerformIO IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1000)
   (Prim ty
AddP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y)
   (Prim ty
SubP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y)
   (Prim ty
MulP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
y)
   (Prim ty
DivP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
y)
   (Prim ty
ModP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
y)
   (Prim ty
ExpP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int
x Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
y)
   (Prim ty
FAddP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y)
   (Prim ty
FSubP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y)
   (Prim ty
FMulP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y)
   (Prim ty
FDivP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
y)
   (Prim ty
FExpP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
y)
   -- Constrained to the value of RAND_MAX (in C) on my laptop: 2147483647 (2^31 − 1)
   (Prim ty
RandP,[]) -> do
       Int
i <- IO Int -> InterpM s (PreExp e l d) Int
forall a. IO a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> InterpM s (PreExp e l d) Int)
-> IO Int -> InterpM s (PreExp e l d) Int
forall a b. (a -> b) -> a -> b
$ IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Int -> Value (PreExp e l d)) -> Int -> Value (PreExp e l d)
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2147483647
   (Prim ty
FRandP,[]) -> do
       Double
i <- IO Double -> InterpM s (PreExp e l d) Double
forall a. IO a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> InterpM s (PreExp e l d) Double)
-> IO Double -> InterpM s (PreExp e l d) Double
forall a b. (a -> b) -> a -> b
$ IO Double
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat Double
i
   (Prim ty
IntToFloatP,[VInt Int
x]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
   (Prim ty
FloatToIntP,[VFloat Double
x]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x)
   (Prim ty
FSqrtP,[VFloat Double
x]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Double -> Value (PreExp e l d)
forall e. Double -> Value e
VFloat (Double -> Double
forall a. Floating a => a -> a
sqrt Double
x)
   (Prim ty
EqSymP,[VSym [Char]
x, VSym [Char]
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool ([Char]
x[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
y)
   (EqBenchProgP [Char]
_str,[]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool Bool
False
   (Prim ty
EqIntP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y)
   (Prim ty
EqFloatP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Double
xDouble -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
y)
   (Prim ty
EqCharP ,[VChar Char
x , VChar Char
y])  -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
y)
   (Prim ty
LtP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y)
   (Prim ty
GtP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y)
   (Prim ty
LtEqP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y)
   (Prim ty
GtEqP,[VInt Int
x, VInt Int
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
y)
   (Prim ty
FLtP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y)
   (Prim ty
FGtP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y)
   (Prim ty
FLtEqP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
y)
   (Prim ty
FGtEqP,[VFloat Double
x, VFloat Double
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y)
   (Prim ty
AndP, [VBool Bool
x, VBool Bool
y]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Bool
x Bool -> Bool -> Bool
&& Bool
y)
   (Prim ty
OrP, [VBool Bool
x, VBool Bool
y])  -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Bool
x Bool -> Bool -> Bool
|| Bool
y)
   ((DictInsertP ty
_ty),[Value (PreExp e l d)
_, VDict Map (Value (PreExp e l d)) (Value (PreExp e l d))
mp, Value (PreExp e l d)
key, Value (PreExp e l d)
val]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Map (Value (PreExp e l d)) (Value (PreExp e l d))
-> Value (PreExp e l d)
forall e. Map (Value e) (Value e) -> Value e
VDict (Value (PreExp e l d)
-> Value (PreExp e l d)
-> Map (Value (PreExp e l d)) (Value (PreExp e l d))
-> Map (Value (PreExp e l d)) (Value (PreExp e l d))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Value (PreExp e l d)
key Value (PreExp e l d)
val Map (Value (PreExp e l d)) (Value (PreExp e l d))
mp)
   ((DictLookupP ty
_),[VDict Map (Value (PreExp e l d)) (Value (PreExp e l d))
mp, Value (PreExp e l d)
key])        -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Map (Value (PreExp e l d)) (Value (PreExp e l d))
mp Map (Value (PreExp e l d)) (Value (PreExp e l d))
-> Value (PreExp e l d) -> Value (PreExp e l d)
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Value (PreExp e l d)
key
   ((DictHasKeyP ty
_),[VDict Map (Value (PreExp e l d)) (Value (PreExp e l d))
mp, Value (PreExp e l d)
key])        -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool (Value (PreExp e l d)
-> Map (Value (PreExp e l d)) (Value (PreExp e l d)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Value (PreExp e l d)
key Map (Value (PreExp e l d)) (Value (PreExp e l d))
mp)
   ((DictEmptyP ty
_),[Value (PreExp e l d)
_])                     -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Map (Value (PreExp e l d)) (Value (PreExp e l d))
-> Value (PreExp e l d)
forall e. Map (Value e) (Value e) -> Value e
VDict Map (Value (PreExp e l d)) (Value (PreExp e l d))
forall k a. Map k a
M.empty
   ((ErrorP [Char]
msg ty
_ty),[]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char] -> Value (PreExp e l d)
forall a. HasCallStack => [Char] -> a
error [Char]
msg
   (Prim ty
SizeParam,[]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt (RunConfig -> Int
rcSize RunConfig
rc)
   (Prim ty
IsBig,[Value (PreExp e l d)
_one,Value (PreExp e l d)
_two]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Bool -> Value (PreExp e l d)
forall e. Bool -> Value e
VBool Bool
False
   (ReadPackedFile Maybe [Char]
file [Char]
_ Maybe Var
_ ty
ty,[]) ->
       [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"L1.Interp: unfinished, need to read a packed file: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Maybe [Char], ty) -> [Char]
forall a. Show a => a -> [Char]
show (Maybe [Char]
file,ty
ty)
   (ReadArrayFile{},[]) -> do
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList [])
   (VAllocP ty
_,[Value (PreExp e l d)]
_n) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList [])
   (VFreeP ty
_,[Value (PreExp e l d)]
_n) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd [])
   (VFree2P ty
_,[Value (PreExp e l d)]
_n) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd [])
   (VLengthP ty
_,[(VList [Value (PreExp e l d)]
ls)]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt ([Value (PreExp e l d)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value (PreExp e l d)]
ls)
   (VNthP ty
_,[(VList [Value (PreExp e l d)]
ls), VInt Int
n]) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)]
ls [Value (PreExp e l d)] -> Int -> Value (PreExp e l d)
forall a. (Out a, HasCallStack) => [a] -> Int -> a
!!! Int
n
   (InplaceVUpdateP ty
_,[(VList [Value (PreExp e l d)]
ls), VInt Int
i, Value (PreExp e l d)
v]) -> do
       let ls' :: Value (PreExp e l d)
ls' = if [Value (PreExp e l d)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value (PreExp e l d)]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i
                 then
                     let need :: Int
need = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- ([Value (PreExp e l d)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value (PreExp e l d)]
ls)
                     in [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList ([Value (PreExp e l d)] -> Value (PreExp e l d))
-> [Value (PreExp e l d)] -> Value (PreExp e l d)
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)]
ls [Value (PreExp e l d)]
-> [Value (PreExp e l d)] -> [Value (PreExp e l d)]
forall a. [a] -> [a] -> [a]
++ (Int -> Value (PreExp e l d) -> [Value (PreExp e l d)]
forall a. Int -> a -> [a]
replicate Int
need Value (PreExp e l d)
v)
                 else [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList (Int
-> Value (PreExp e l d)
-> [Value (PreExp e l d)]
-> [Value (PreExp e l d)]
forall a. Int -> a -> [a] -> [a]
replaceNth Int
i Value (PreExp e l d)
v [Value (PreExp e l d)]
ls)
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value (PreExp e l d)
ls'
   (VSliceP ty
_,[VInt Int
from, VInt Int
len, (VList [Value (PreExp e l d)]
ls)]) -> do
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList (Int -> [Value (PreExp e l d)] -> [Value (PreExp e l d)]
forall a. Int -> [a] -> [a]
L.take Int
len (Int -> [Value (PreExp e l d)] -> [Value (PreExp e l d)]
forall a. Int -> [a] -> [a]
L.drop Int
from [Value (PreExp e l d)]
ls))
   (VConcatP ty
_, [VList [Value (PreExp e l d)]
ls]) -> do
       let concatd :: [Value (PreExp e l d)]
concatd = ([Value (PreExp e l d)]
 -> Value (PreExp e l d) -> [Value (PreExp e l d)])
-> [Value (PreExp e l d)]
-> [Value (PreExp e l d)]
-> [Value (PreExp e l d)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[Value (PreExp e l d)]
acc Value (PreExp e l d)
v ->
                                case Value (PreExp e l d)
v of
                                  VList [Value (PreExp e l d)]
l -> [Value (PreExp e l d)]
acc [Value (PreExp e l d)]
-> [Value (PreExp e l d)] -> [Value (PreExp e l d)]
forall a. [a] -> [a] -> [a]
++ [Value (PreExp e l d)]
l
                                  Value (PreExp e l d)
_ -> [Char] -> [Value (PreExp e l d)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Value (PreExp e l d)])
-> [Char] -> [Value (PreExp e l d)]
forall a b. (a -> b) -> a -> b
$ [Char]
"VConcatP: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value (PreExp e l d) -> [Char]
forall a. Show a => a -> [Char]
show Value (PreExp e l d)
v)
                           []
                           [Value (PreExp e l d)]
ls
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList [Value (PreExp e l d)]
concatd
   (VMergeP ty
_,[VList [Value (PreExp e l d)]
ls1,VList [Value (PreExp e l d)]
ls2]) -> do
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VList ([Value (PreExp e l d)]
ls1 [Value (PreExp e l d)]
-> [Value (PreExp e l d)] -> [Value (PreExp e l d)]
forall a. [a] -> [a] -> [a]
++ [Value (PreExp e l d)]
ls2)
   (Prim ty
GetNumProcessors, []) -> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ Int -> Value (PreExp e l d)
forall e. Int -> Value e
VInt Int
1
   -- Don't sort for now.
   (VSortP ty
_, [Value (PreExp e l d)
ls, Value (PreExp e l d)
_fn]) -> do
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value (PreExp e l d)
ls
   (InplaceVSortP ty
_, [Value (PreExp e l d)
ls, Value (PreExp e l d)
_fn]) -> do
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value (PreExp e l d)
ls
   (Prim ty
PrintInt, [VInt Int
n]) -> do
       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd []
   (Prim ty
PrintFloat, [VFloat Double
n]) -> do
       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 (Double -> [Char]
forall a. Show a => a -> [Char]
show Double
n)
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd []
   (Prim ty
PrintBool, [VBool Bool
n]) -> do
       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 (Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
n)
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd []
   (Prim ty
PrintSym, [VSym [Char]
s]) -> do
       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 [Char]
s
       let v' :: [Char]
v' = case [Char]
s of
                  [Char]
"NEWLINE" -> [Char]
"\n"
                  [Char]
"SPACE"   -> [Char]
" "
                  [Char]
_oth -> [Char]
s
       IO () -> InterpM s (PreExp e l d) ()
forall a. IO a -> InterpM s (PreExp e l d) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InterpM s (PreExp e l d) ())
-> IO () -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
v'
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd []
   (Prim ty
PrintSym, [VInt Int
n]) -> do
       InterpLog -> InterpM s (PreExp e l d) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (InterpLog -> InterpM s (PreExp e l d) ())
-> InterpLog -> InterpM s (PreExp e l d) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InterpLog
string8 (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
       Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. a -> InterpM s (PreExp e l d) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (PreExp e l d)
 -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> Value (PreExp e l d)
-> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Value (PreExp e l d)] -> Value (PreExp e l d)
forall e. [Value e] -> Value e
VProd []
   (Prim ty, [Value (PreExp e l d)])
oth -> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d)))
-> [Char] -> InterpM s (PreExp e l d) (Value (PreExp e l d))
forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled prim or wrong number of arguments: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Prim ty, [Value (PreExp e l d)]) -> [Char]
forall a. Show a => a -> [Char]
show (Prim ty, [Value (PreExp e l d)])
oth

  where
     replaceNth :: Int -> a -> [a] -> [a]
     replaceNth :: forall a. Int -> a -> [a] -> [a]
replaceNth Int
_ a
_ [] = []
     replaceNth Int
n a
newVal (a
x:[a]
xs)
       | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a
newVala -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
       | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
replaceNth (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
newVal [a]
xs


clk :: Clock
clk :: Clock
clk = Clock
Monotonic

strToInt :: String -> Int
strToInt :: [Char] -> Int
strToInt = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Int] -> Int) -> ([Char] -> [Int]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> [Char] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
L.map Char -> Int
ord