feat: interpreting

src/Control/Monad/Dataflow/Infer/InferExpression.purs

@@ -101,13 +101,6 @@ infer expression =
         t <- infer value
         inner <- if shouldGeneralize then generalize t else pure $ Forall [] t
         createClosure name inner (infer body)
-      If _ condition onTrue onFalse -> do
-        conditionType <- infer condition
-        trueType <- infer onTrue
-        falseType <- infer onFalse
-        createConstraint conditionType typeBool
-        createConstraint trueType falseType
-        pure trueType
       FixPoint _ body -> do
         t <- infer body
         tv <- fresh

src/Control/Monad/Dataflow/Interpreter.purs

@@ -1,8 +1,9 @@
 module Lunarbox.Control.Monad.Dataflow.Interpreter
   ( Interpreter(..)
   , InterpreterContext(..)
-  , _location
   , runInterpreter
+  , _location
+  , _termEnv
   ) where
 
 import Prelude
@@ -20,14 +21,18 @@ import Lunarbox.Data.Lens (newtypeIso)
 newtype InterpreterContext v l
   = InterpreterContext
   { location :: l
-  , typeEnv :: TermEnvironment v
+  , termEnv :: TermEnvironment v
   }
 
 derive instance newtypeInterpreterContent :: Newtype (InterpreterContext v l) _
 
+-- Lenses
 _location :: forall v l. Lens' (InterpreterContext v l) l
 _location = newtypeIso <<< prop (SProxy :: _ "location")
 
+_termEnv :: forall v l. Lens' (InterpreterContext v l) (TermEnvironment v)
+_termEnv = newtypeIso <<< prop (SProxy :: _ "termEnv")
+
 -- Monad used to Interpret expressions
 newtype Interpreter v l a
   = Interpreter (WriterT (ValueMap v l) (Reader (InterpreterContext v l)) a)

src/Control/Monad/Dataflow/Interpreter/Interpret.purs

@@ -0,0 +1,56 @@
+module Lunarbox.Control.Monad.Dataflow.Interpreter.Interpret
+  ( interpret
+  ) where
+
+import Prelude
+import Control.Monad.Reader (asks, local)
+import Data.Int (toNumber)
+import Data.Lens (over, set, view)
+import Data.List as List
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Lunarbox.Control.Monad.Dataflow.Interpreter (Interpreter, _termEnv)
+import Lunarbox.Data.Dataflow.Expression (Expression(..), Literal(..), NativeExpression(..))
+import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..), lookup)
+import Lunarbox.Data.Lens (newtypeIso)
+
+-- Interpreter for Expressions
+type ExpressionInterpreter l
+  = Interpreter (Expression l) l
+
+-- Gets a value from the current environment
+getVariable :: forall l. Ord l => String -> ExpressionInterpreter l (RuntimeValue (Expression l))
+getVariable name = do
+  env <- asks $ view _termEnv
+  pure $ lookup name env
+
+-- Perform an action in an environment with an extra variable
+withTerm :: forall l. Ord l => String -> RuntimeValue (Expression l) -> ExpressionInterpreter l ~> ExpressionInterpreter l
+withTerm name value = local $ over (_termEnv <<< newtypeIso) $ Map.insert (show name) value
+
+-- Interpret an expression into a runtimeValue
+interpret :: forall l. Ord l => Expression l -> ExpressionInterpreter l (RuntimeValue (Expression l))
+interpret = case _ of
+  Literal _ (LInt value) -> pure $ Number $ toNumber value
+  Literal _ (LBool value) -> pure $ Bool value
+  Literal _ LNull -> pure Null
+  Variable _ name -> getVariable $ show name
+  Lambda _ argument body -> asks $ view _termEnv <#> Closure (show argument) body
+  Chain _ expressions -> case List.last expressions of
+    Just expression -> interpret expression
+    Nothing -> pure Null
+  Let _ _ name value body -> do
+    runtimeValue <- interpret value
+    local (over (_termEnv <<< newtypeIso) $ Map.insert (show name) runtimeValue) $ interpret body
+  FixPoint location function -> interpret $ FunctionCall location function $ FixPoint location function
+  Native _ (NativeExpression _ call) -> pure call
+  FunctionCall _ argument function -> do
+    runtimeArgument <- interpret argument
+    runtimeFunction <- interpret function
+    case runtimeFunction of
+      Function call -> pure $ call runtimeArgument
+      Closure name expression environment ->
+        withTerm name runtimeArgument
+          $ local (set _termEnv environment)
+          $ interpret expression
+      _ -> pure Null

src/Data/Dataflow/Expression.purs

@@ -54,21 +54,22 @@ instance showLiteral :: Show Literal where
   show (LBool b) = show b
   show LNull = "null"
 
-data NativeExpression
-  = NativeExpression Scheme RuntimeValue
+data NativeExpression l
+  = NativeExpression Scheme (RuntimeValue (Expression l))
 
-derive instance eqNativeExpression :: Eq NativeExpression
+derive instance eqNativeExpression :: Eq l => Eq (NativeExpression l)
 
 data Expression l
   = Variable l VarName
   | FunctionCall l (Expression l) (Expression l)
   | Lambda l VarName (Expression l)
   | Literal l Literal
   | Let l Boolean VarName (Expression l) (Expression l)
-  | If l (Expression l) (Expression l) (Expression l)
   | FixPoint l (Expression l)
   | Chain l (List (Expression l))
-  | Native l NativeExpression
+  | Native l (NativeExpression l)
+
+derive instance eqExpression :: Eq l => Eq (Expression l)
 
 -- Takes a list of argument names and a body and creates the body of a function
 functionDeclaration :: forall l. l -> Expression l -> List VarName -> Expression l
@@ -82,7 +83,6 @@ getLocation = case _ of
   Lambda l _ _ -> l
   Literal l _ -> l
   Let l _ _ _ _ -> l
-  If l _ _ _ -> l
   FixPoint l _ -> l
   Native l _ -> l
   Chain l _ -> l
@@ -95,7 +95,6 @@ toMap expression =
         FunctionCall _ calee input -> toMap calee <> toMap input
         Lambda _ _ body -> toMap body
         Let _ _ _ value body -> toMap value <> toMap body
-        If _ condition then' else' -> toMap condition <> toMap then' <> toMap else'
         Chain _ expressions -> foldr (\expression' -> (<>) $ toMap expression') mempty expressions
         FixPoint _ body -> toMap body
         _ -> mempty
@@ -122,10 +121,6 @@ inputs :: forall l. Expression l -> Int
 inputs = inputs' 0
 
 -- Typecalss instances
-derive instance expressinEq :: Eq l => Eq (Expression l)
-
-derive instance functorExpression :: Functor Expression
-
 instance showExpression :: Show l => Show (Expression l) where
   show expr = "(" <> show (getLocation expr) <> ": " <> printRawExpression show expr <> ")"
 
@@ -170,13 +165,6 @@ printRawExpression print expression = case expression of
   Literal _ literal -> show literal
   Let _ _ _ _ _ -> printLet true (printRawExpression print) expression
   FixPoint _ e -> "fixpoint( " <> print e <> " )"
-  If _ cond then' else' ->
-    "if\n"
-      <> indent 2 (print cond)
-      <> "\nthen\n"
-      <> indent 2 (print then')
-      <> "\nelse\n"
-      <> indent 2 (print else')
   Native _ (NativeExpression t _) -> "native :: " <> show t
   Chain l (e : Nil) -> printRawExpression print e
   Chain l (e : es) -> "{" <> printRawExpression print e <> "," <> (printRawExpression print $ Chain l es) <> "}"
@@ -219,8 +207,6 @@ optimize (FunctionCall location calee argument) = FunctionCall location (optimiz
 
 optimize (Lambda location argument body) = Lambda location argument $ optimize body
 
-optimize (If location condition then' else') = If location (optimize condition) (optimize then') $ optimize else'
-
 optimize (FixPoint location body) = FixPoint location $ optimize body
 
 optimize (Chain location expressions) = Chain location $ optimize <$> expressions

src/Data/Dataflow/Runtime.purs

@@ -2,6 +2,7 @@ module Lunarbox.Data.Dataflow.Runtime
   ( RuntimeValue(..)
   , TermEnvironment(..)
   , binaryFunction
+  , lookup
   , _Number
   , _String
   , _Function
@@ -10,8 +11,8 @@ module Lunarbox.Data.Dataflow.Runtime
 import Prelude
 import Data.Lens (Prism', prism')
 import Data.Map as Map
-import Data.Maybe (Maybe(..))
-import Data.Newtype (class Newtype)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Newtype (class Newtype, unwrap)
 
 -- Structure used to store the value of different variables
 newtype TermEnvironment c
@@ -21,6 +22,10 @@ derive instance eqTermEnvironment :: Eq c => Eq (TermEnvironment c)
 
 derive instance newtypeTermEnvironment :: Newtype (TermEnvironment c) _
 
+-- Same as Map.lookup but returns Null in case the value cannot be found
+lookup :: forall c. String -> TermEnvironment c -> RuntimeValue c
+lookup key = fromMaybe Null <<< Map.lookup key <<< unwrap
+
 -- Representations of all possible runtime values
 data RuntimeValue c
   = Number Number