diff --git a/src/Control/Monad/Dataflow/Interpreter.purs b/src/Control/Monad/Dataflow/Interpreter.purs new file mode 100644 index 0000000..7ea8d43 --- /dev/null +++ b/src/Control/Monad/Dataflow/Interpreter.purs @@ -0,0 +1,58 @@ +module Lunarbox.Control.Monad.Dataflow.Interpreter + ( Interpreter(..) + , InterpreterContext(..) + , _location + , runInterpreter + ) where + +import Prelude +import Control.Monad.Reader (class MonadAsk, class MonadReader, Reader, runReader) +import Control.Monad.Writer (class MonadTell, class MonadWriter, WriterT, runWriterT) +import Data.Lens (Lens') +import Data.Lens.Record (prop) +import Data.Newtype (class Newtype) +import Data.Symbol (SProxy(..)) +import Lunarbox.Data.Dataflow.Runtime.TermEnvironment (TermEnvironment) +import Lunarbox.Data.Dataflow.Runtime.ValueMap (ValueMap) +import Lunarbox.Data.Lens (newtypeIso) + +-- The Interpreter context is the env all interpreting occurs in. +newtype InterpreterContext l + = InterpreterContext + { location :: l + , typeEnv :: TermEnvironment + } + +derive instance newtypeInterpreterContent :: Newtype (InterpreterContext l) _ + +_location :: forall l. Lens' (InterpreterContext l) l +_location = newtypeIso <<< prop (SProxy :: _ "location") + +-- Monad used to Interpret expressions +newtype Interpreter l a + = Interpreter (WriterT (ValueMap l) (Reader (InterpreterContext l)) a) + +-- Takes a Interpreter monad and runs it +runInterpreter :: forall l a. Ord l => Interpreter l a -> ValueMap l +runInterpreter (Interpreter m) = runReader mempty $ runWriterT m + +-- Typeclasses +derive instance newtypeInterpreter :: Newtype (Interpreter l a) _ + +derive newtype instance functorInterpreter :: Ord l => Functor (Interpreter l) + +derive newtype instance applyInterpreter :: Ord l => Apply (Interpreter l) + +derive newtype instance applicativeInterpreter :: Ord l => Applicative (Interpreter l) + +derive newtype instance bindInterpreter :: Ord l => Bind (Interpreter l) + +derive newtype instance monadInterpreter :: Ord l => Monad (Interpreter l) + +derive newtype instance monadAskInterpreter :: Ord l => MonadAsk (InterpreterContext l) (Interpreter l) + +derive newtype instance monadReaderInterpreter :: Ord l => MonadReader (InterpreterContext l) (Interpreter l) + +derive newtype instance monadTellInterpreter :: Ord l => MonadTell (ValueMap l) (Interpreter l) + +derive newtype instance monadWriterInterpreter :: Ord l => MonadWriter (ValueMap l) (Interpreter l) diff --git a/src/Data/Dataflow/Runtime/TermEnvironment.purs b/src/Data/Dataflow/Runtime/TermEnvironment.purs new file mode 100644 index 0000000..3be8acc --- /dev/null +++ b/src/Data/Dataflow/Runtime/TermEnvironment.purs @@ -0,0 +1,15 @@ +module Lunarbox.Data.Dataflow.Runtime.TermEnvironment + ( TermEnvironment(..) + ) where + +import Prelude +import Data.Map as Map +import Data.Newtype (class Newtype) +import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) + +newtype TermEnvironment + = TermEnvironment (Map.Map String RuntimeValue) + +derive instance eqTermEnvironment :: Eq TermEnvironment + +derive instance newtypeTermEnvironment :: Newtype TermEnvironment _ diff --git a/src/Data/Dataflow/Runtime/ValueMap.purs b/src/Data/Dataflow/Runtime/ValueMap.purs new file mode 100644 index 0000000..7c1680e --- /dev/null +++ b/src/Data/Dataflow/Runtime/ValueMap.purs @@ -0,0 +1,20 @@ +module Lunarbox.Data.Dataflow.Runtime.ValueMap + ( ValueMap(..) + ) where + +import Prelude +import Data.Map as Map +import Data.Newtype (class Newtype) +import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) + +-- A map holding the runtime values of different locations +newtype ValueMap l + = ValueMap (Map.Map l RuntimeValue) + +derive instance eqValueMap :: Eq l => Eq (ValueMap l) + +derive instance newtypeValueMap :: Newtype (ValueMap l) _ + +derive newtype instance semigroupValueMap :: Ord l => Semigroup (ValueMap l) + +derive newtype instance monoidValueMap :: Ord l => Monoid (ValueMap l)