From f853836c0cf9a0572fc0fa1b7dc597c424d47ef4 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sun, 19 Apr 2020 11:44:21 -0300 Subject: [PATCH 1/2] Adding Repl module --- mulang.cabal | 1 + spec/ReplSpec.hs | 15 ++++++++++ src/Language/Mulang/Interpreter/Repl.hs | 37 +++++++++++++++++++++++++ 3 files changed, 53 insertions(+) create mode 100644 spec/ReplSpec.hs create mode 100644 src/Language/Mulang/Interpreter/Repl.hs diff --git a/mulang.cabal b/mulang.cabal index 3c408688c..49d8e7bab 100644 --- a/mulang.cabal +++ b/mulang.cabal @@ -108,6 +108,7 @@ library Language.Mulang.Edl.Parser Language.Mulang.Interpreter Language.Mulang.Interpreter.Internals + Language.Mulang.Interpreter.Repl Language.Mulang.Interpreter.Runner Language.Mulang.Transform.Normalizer Language.Mulang.Transform.Renamer diff --git a/spec/ReplSpec.hs b/spec/ReplSpec.hs new file mode 100644 index 000000000..45b489cb4 --- /dev/null +++ b/spec/ReplSpec.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} + +module ReplSpec (spec) where + +import Test.Hspec +import Language.Mulang.Interpreter.Repl + +spec :: Spec +spec = do + describe "evalNext" $ do + let session = newSession js + it "evals and returns" $ do + let (_, r1) = evalNext newSession "1" + r1 `shouldBe` (MuNumber 1) + diff --git a/src/Language/Mulang/Interpreter/Repl.hs b/src/Language/Mulang/Interpreter/Repl.hs new file mode 100644 index 000000000..2e8651231 --- /dev/null +++ b/src/Language/Mulang/Interpreter/Repl.hs @@ -0,0 +1,37 @@ +module Language.Mulang.Interpreter.Repl ( + repl, + newSession) where + +import Data.Map ((!)) +import Language.Mulang.Interpreter (Reference, ExecutionContext (..), globalObjects, defaultContext, eval) + +type SessionState = ([(Int, Value)], [Int]) +type SessionLanguage = (String -> Expression) + +data Session = Session { language :: Language, context :: ExecutionContext } + +newSession :: Language -> Session +newSession language = Session language defaultContext + +repl :: Session -> String -> IO (Session, Value) +repl session line = do + (ref, newContext) <- eval (context session) (language . session $ line) + return (globalObjects newContext ! ref, newContext) + +dump :: Session -> SessionState +dump (Session _ (ExecutationContext globals scopes _ _ _ )) = (dumpGlobals globals, dumpScopes scopes) + where + dumpGlobals = Map.toList . Map.mapKeys asInt + dumpScopes = map asInt + +load :: SessionLanguage -> SessionState -> Session +load language (globalsState, scopesState) = Session language (defaultContext { globalObjects = loadGlobals state, scopes = loadScopes state } ) + where + loadGlobals = Map.fromList . map fromInt + loadScopes = map fromInt + +fromInt :: Int -> Reference +fromInt = Reference + +toInt :: Reference -> Int +toInt (Reference i) = i From 581df1aa05b64d26fabaaae53e323d57e69965be Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sun, 19 Apr 2020 13:04:09 -0300 Subject: [PATCH 2/2] Fixing tests --- spec/ReplSpec.hs | 28 ++++++++++++++---- src/Language/Mulang/Interpreter/Repl.hs | 39 ++++++++++++++++--------- 2 files changed, 48 insertions(+), 19 deletions(-) diff --git a/spec/ReplSpec.hs b/spec/ReplSpec.hs index 45b489cb4..c0fa7bc36 100644 --- a/spec/ReplSpec.hs +++ b/spec/ReplSpec.hs @@ -1,15 +1,33 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} - module ReplSpec (spec) where import Test.Hspec +import Language.Mulang.Parsers.JavaScript import Language.Mulang.Interpreter.Repl +import Language.Mulang.Interpreter.Internals (Value (..)) spec :: Spec spec = do - describe "evalNext" $ do - let session = newSession js + describe "repl" $ do + let s0 = newSession js it "evals and returns" $ do - let (_, r1) = evalNext newSession "1" + (r1, _) <- repl "1" s0 + r1 `shouldBe` (MuNumber 1) + + it "can eval multiple statements and return" $ do + (r1, s1) <- repl "var x = 1" s0 r1 `shouldBe` (MuNumber 1) + (r2, s2) <- repl "x + 3" s1 + r2 `shouldBe` (MuNumber 4) + + (_, s3) <- repl "function double(x) { return x * 2 }" s2 + (r4, _) <- repl "double(x)" s3 + r4 `shouldBe` (MuNumber 2) + + it "can save state" $ do + (_, s1) <- repl "function succ(x) { return x + 1 }" s0 + (_, s2) <- repl "function pred(x) { return x - 1 }" s1 + + (r, _) <- repl "succ(succ(pred(10)))" (reload s2) + r `shouldBe` (MuNumber 11) + diff --git a/src/Language/Mulang/Interpreter/Repl.hs b/src/Language/Mulang/Interpreter/Repl.hs index 2e8651231..7a845e2a4 100644 --- a/src/Language/Mulang/Interpreter/Repl.hs +++ b/src/Language/Mulang/Interpreter/Repl.hs @@ -1,37 +1,48 @@ module Language.Mulang.Interpreter.Repl ( + Session (..), + newSession, repl, - newSession) where + dump, + load, + reload) where -import Data.Map ((!)) -import Language.Mulang.Interpreter (Reference, ExecutionContext (..), globalObjects, defaultContext, eval) +import Language.Mulang.Ast (Expression) +import Language.Mulang.Interpreter (eval) +import Language.Mulang.Interpreter.Internals (Value, Reference (..), ExecutionContext (..), defaultContext) + +import qualified Data.Map as Map +import Data.Map ((!)) type SessionState = ([(Int, Value)], [Int]) -type SessionLanguage = (String -> Expression) +type Language = (String -> Expression) data Session = Session { language :: Language, context :: ExecutionContext } newSession :: Language -> Session newSession language = Session language defaultContext -repl :: Session -> String -> IO (Session, Value) -repl session line = do - (ref, newContext) <- eval (context session) (language . session $ line) - return (globalObjects newContext ! ref, newContext) +repl :: String -> Session -> IO (Value, Session) +repl line session = do + (ref, newContext) <- eval (context session) (language session line) + return (globalObjects newContext ! ref, session { context = newContext } ) dump :: Session -> SessionState -dump (Session _ (ExecutationContext globals scopes _ _ _ )) = (dumpGlobals globals, dumpScopes scopes) +dump (Session _ (ExecutionContext globals scopes _ _ _ )) = (dumpGlobals globals, dumpScopes scopes) where dumpGlobals = Map.toList . Map.mapKeys asInt dumpScopes = map asInt -load :: SessionLanguage -> SessionState -> Session -load language (globalsState, scopesState) = Session language (defaultContext { globalObjects = loadGlobals state, scopes = loadScopes state } ) +load :: Language -> SessionState -> Session +load language (globalsState, scopesState) = Session language (defaultContext { globalObjects = loadGlobals globalsState, scopes = loadScopes scopesState } ) where - loadGlobals = Map.fromList . map fromInt + loadGlobals = Map.mapKeys fromInt . Map.fromList loadScopes = map fromInt +reload :: Session -> Session +reload s@(Session l _) = load l (dump s) + fromInt :: Int -> Reference fromInt = Reference -toInt :: Reference -> Int -toInt (Reference i) = i +asInt :: Reference -> Int +asInt (Reference i) = i