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

-- | Interpreter for the source language (L0)
module Gibbon.L0.Interp where

import qualified Data.Map.Lazy as M

import           Gibbon.Common
import           Gibbon.L0.Syntax
import qualified Gibbon.L1.Interp as L1

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

instance InterpExt () Exp0 (E0Ext Ty0 Ty0) where
  gInterpExt :: RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> E0Ext Ty0 Ty0
-> InterpM () Exp0 (Value Exp0)
gInterpExt RunConfig
rc ValEnv Exp0
valenv DDefs (TyOf Exp0)
ddefs FunDefs Exp0
fundefs E0Ext Ty0 Ty0
ex =
      case E0Ext Ty0 Ty0
ex of
        LambdaE [(Var, Ty0)]
args Exp0
bod -> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a. a -> InterpM () Exp0 a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Var] -> Exp0 -> ValEnv Exp0 -> Value Exp0
forall e. [Var] -> e -> ValEnv e -> Value e
VLam (((Var, Ty0) -> Var) -> [(Var, Ty0)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, Ty0) -> Var
forall a b. (a, b) -> a
fst [(Var, Ty0)]
args) Exp0
bod ValEnv Exp0
valenv)
        FunRefE [Ty0]
_tyapps Var
f ->
          case Var -> ValEnv Exp0 -> Maybe (Value Exp0)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f ValEnv Exp0
valenv of
            Just Value Exp0
lam -> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a. a -> InterpM () Exp0 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value Exp0
lam
            Maybe (Value Exp0)
Nothing  ->
              case Var -> FunDefs Exp0 -> Maybe (FunDef Exp0)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f FunDefs Exp0
fundefs of
                Maybe (FunDef Exp0)
Nothing -> [Char] -> InterpM () Exp0 (Value Exp0)
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM () Exp0 (Value Exp0))
-> [Char] -> InterpM () Exp0 (Value Exp0)
forall a b. (a -> b) -> a -> b
$ [Char]
"L0.Interp: Unbound function reference: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
f
                Just FunDef Exp0
fn -> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a. a -> InterpM () Exp0 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp0 -> InterpM () Exp0 (Value Exp0))
-> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a b. (a -> b) -> a -> b
$ [Var] -> Exp0 -> ValEnv Exp0 -> Value Exp0
forall e. [Var] -> e -> ValEnv e -> Value e
VLam (FunDef Exp0 -> [Var]
forall ex. FunDef ex -> [Var]
funArgs FunDef Exp0
fn) (FunDef Exp0 -> Exp0
forall ex. FunDef ex -> ex
funBody FunDef Exp0
fn) ValEnv Exp0
forall k a. Map k a
M.empty
        BenchE Var
fn [Ty0]
locs [Exp0]
args Bool
_b ->
          RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> Exp0
-> InterpM () Exp0 (Value Exp0)
forall s e.
Interp s e =>
RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> e
-> InterpM s e (Value e)
gInterpExp RunConfig
rc ValEnv Exp0
valenv DDefs (TyOf Exp0)
ddefs FunDefs Exp0
fundefs (Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [Ty0]
locs [Exp0]
args)
        ParE0 [Exp0]
ls -> RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> Exp0
-> InterpM () Exp0 (Value Exp0)
forall s e.
Interp s e =>
RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> e
-> InterpM s e (Value e)
gInterpExp RunConfig
rc ValEnv Exp0
valenv DDefs (TyOf Exp0)
ddefs FunDefs Exp0
fundefs ([Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp0]
ls)
        PrintPacked Ty0
_ty Exp0
_arg -> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a. a -> InterpM () Exp0 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp0 -> InterpM () Exp0 (Value Exp0))
-> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a b. (a -> b) -> a -> b
$ [Value Exp0] -> Value Exp0
forall e. [Value e] -> Value e
VProd []
        CopyPacked Ty0
_ty Exp0
arg -> RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> Exp0
-> InterpM () Exp0 (Value Exp0)
forall s e.
Interp s e =>
RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> e
-> InterpM s e (Value e)
gInterpExp RunConfig
rc ValEnv Exp0
valenv DDefs (TyOf Exp0)
ddefs FunDefs Exp0
fundefs Exp0
arg
        TravPacked Ty0
_ty Exp0
_arg -> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a. a -> InterpM () Exp0 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp0 -> InterpM () Exp0 (Value Exp0))
-> Value Exp0 -> InterpM () Exp0 (Value Exp0)
forall a b. (a -> b) -> a -> b
$ [Value Exp0] -> Value Exp0
forall e. [Value e] -> Value e
VProd []
        L Loc
_ Exp0
e -> RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> Exp0
-> InterpM () Exp0 (Value Exp0)
forall s e.
Interp s e =>
RunConfig
-> ValEnv e
-> DDefs (TyOf e)
-> FunDefs e
-> e
-> InterpM s e (Value e)
gInterpExp RunConfig
rc ValEnv Exp0
valenv DDefs (TyOf Exp0)
ddefs FunDefs Exp0
fundefs Exp0
e
        PolyAppE{} -> [Char] -> InterpM () Exp0 (Value Exp0)
forall a. HasCallStack => [Char] -> a
error [Char]
"L0.Interp: PolyAppE not handled."
        LinearExt{} -> [Char] -> InterpM () Exp0 (Value Exp0)
forall a. HasCallStack => [Char] -> a
error ([Char] -> InterpM () Exp0 (Value Exp0))
-> [Char] -> InterpM () Exp0 (Value Exp0)
forall a b. (a -> b) -> a -> b
$ [Char]
"L0.Interp: a linear types extension wasn't desugared: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ E0Ext Ty0 Ty0 -> [Char]
forall a. Out a => a -> [Char]
sdoc E0Ext Ty0 Ty0
ex

instance Interp () Exp0 where
  gInterpExp :: RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> Exp0
-> InterpM () Exp0 (Value Exp0)
gInterpExp  = RunConfig
-> ValEnv Exp0
-> DDefs (TyOf Exp0)
-> FunDefs Exp0
-> Exp0
-> InterpM () Exp0 (Value Exp0)
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))
L1.interp

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