exploring-interpreters (empty) → 0.2.0.0

raw patch · 8 files changed

+671/−0 lines, 8 filesdep +basedep +containersdep +fglsetup-changed

Dependencies added: base, containers, fgl, mtl, transformers

Files

CHANGELOG.md +4/−0
LICENSE +30/−0
Language/Explorer/Basic.hs +97/−0
Language/Explorer/Monadic.hs +182/−0
Language/Explorer/Pure.hs +82/−0
Setup.hs +2/−0
examples/Whilelang.hs +237/−0
exploring-interpreters.cabal +37/−0

+ CHANGELOG.md view

@@ -0,0 +1,4 @@+# Revision history for exploring-interpreters ++## 0.2.0.0 -- 2021-03-15+* First official version.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2021, Damian Frolich++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Damian Frolich nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Language/Explorer/Basic.hs view

@@ -0,0 +1,97 @@+module Language.Explorer.Basic+    ( Explorer+    , execute+    , executeAll+    , revert+    , dynamicRevert +    , ExplorerM.toTree+    , mkExplorerStack+    , mkExplorerTree+    , mkExplorerGraph+    , mkExplorerGSS+    , config+    , currRef+    , Ref+    , deref+    , getTrace+    , getTraces+    , getPathsFromTo+    , getPathFromTo+    , executionGraph+    ) where++import qualified Language.Explorer.Monadic as ExplorerM+import Control.Monad.Identity++import qualified Data.IntMap as IntMap+import Data.List+import Data.Functor+import Data.Foldable+import Data.Monoid ()+import Data.Graph.Inductive.Graph (emap)++-- We shadow instead of exporting directly to make the user interaction+-- the same.+type Ref = ExplorerM.Ref+type Explorer a b = ExplorerM.Explorer a Identity b ()++currRef :: Explorer a b -> Ref+currRef = ExplorerM.currRef++config :: Explorer a b -> b+config = ExplorerM.config++deref :: Explorer p c -> Ref -> Maybe c+deref = ExplorerM.deref++-- This should be able with func composition.+wrap :: Monad m => (a -> b -> b) -> a -> b -> m (b, ())+wrap def p e = return $ (def p e, ())++-- Constructor for a exploring interpreter.+mkExplorerStack:: (Show a, Eq a, Eq b) => (a -> b -> b) -> b -> Explorer a b+mkExplorerStack definterp conf = ExplorerM.mkExplorerStack (wrap definterp) conf++mkExplorerTree:: (Show a, Eq a, Eq b) => (a -> b -> b) -> b -> Explorer a b+mkExplorerTree definterp conf = ExplorerM.mkExplorerTree (wrap definterp) conf++mkExplorerGraph :: (Show a, Eq a, Eq b) => (a -> b -> b) -> b -> Explorer a b+mkExplorerGraph definterp conf = ExplorerM.mkExplorerGraph (wrap definterp) conf++mkExplorerGSS :: (Show a, Eq a, Eq b) => (a -> b -> b) -> b -> Explorer a b+mkExplorerGSS definterp conf = ExplorerM.mkExplorerGSS (wrap definterp) conf++execute :: (Eq c, Eq p) =>  p -> Explorer p c -> Explorer p c+execute p e = fst $ runIdentity $ ExplorerM.execute p e++executeAll :: (Eq c, Eq p) => [p] -> Explorer p c -> Explorer p c+executeAll p e = fst $ runIdentity $ ExplorerM.executeAll p e++dynamicRevert :: Bool -> Ref -> Explorer p c -> Maybe (Explorer p c)+dynamicRevert = ExplorerM.dynamicRevert++revert :: ExplorerM.Ref -> Explorer p c -> Maybe (Explorer p c)+revert = ExplorerM.revert++removeOutput :: ((Ref, c), (p, o), (Ref, c)) -> ((Ref, c), p, (Ref, c))+removeOutput (s, (p, _), t) = (s, p, t)++incomingEdges :: Ref -> Explorer p c -> [((Ref, c), p, (Ref, c))]+incomingEdges r e = map removeOutput $ ExplorerM.incomingEdges r e++getTrace :: Explorer p c -> [((Ref, c), p, (Ref, c))]+getTrace e = map removeOutput $ ExplorerM.getTrace e++getTraces :: Explorer p c -> [[((Ref, c), p, (Ref, c))]]+getTraces e = map (map removeOutput) $ ExplorerM.getTraces e++getPathsFromTo :: Explorer p c -> Ref -> Ref -> [[((Ref, c), p, (Ref, c))]]+getPathsFromTo e s t = map (map removeOutput) $ ExplorerM.getPathsFromTo e s t++getPathFromTo :: Explorer p c -> Ref -> Ref -> [((Ref, c), p, (Ref, c))]+getPathFromTo e s t = map removeOutput $ ExplorerM.getPathFromTo e s t++executionGraph :: Explorer p c -> (Ref, [Ref], [((Ref, c), p, (Ref, c))])+executionGraph e = (curr, nodes, map removeOutput graph)+  where+    (curr, nodes, graph) = ExplorerM.executionGraph e

+ Language/Explorer/Monadic.hs view

@@ -0,0 +1,182 @@+{-# LANGUAGE GADTs #-}++module Language.Explorer.Monadic+    ( Explorer+    , execute+    , executeAll+    , revert+    , dynamicRevert +    , toTree+    , incomingEdges+    , mkExplorerStack+    , mkExplorerTree+    , mkExplorerGraph+    , mkExplorerGSS+    , config+    , execEnv+    , currRef+    , Ref+    , deref+    , getTrace+    , getTraces+    , getPathsFromTo+    , getPathFromTo+    , executionGraph+    ) where++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.PatriciaTree+import Data.Graph.Inductive.Query+import Data.Graph.Inductive.Query.SP+import Data.Tree (Tree(..))++import qualified Data.IntMap as IntMap+import Data.List+import Data.Foldable+import Data.Maybe++type Ref = Int++data Explorer programs m configs output where+    Explorer :: (Show programs, Eq programs, Eq configs, Monad m, Monoid output) =>+        { sharing :: Bool+        , backTracking :: Bool+        , defInterp :: programs -> configs -> m (configs, output)+        , config :: configs -- Cache the config+        , currRef :: Ref+        , genRef :: Ref+        , cmap :: IntMap.IntMap configs+        , execEnv :: Gr Ref (programs, output)+        } -> Explorer programs m configs output++mkExplorer :: (Show a, Eq a, Eq b, Monad m, Monoid o) =>+  Bool -> Bool -> (a -> b -> m (b,o)) -> b -> Explorer a m b o+mkExplorer share backtrack definterp conf = Explorer+    { defInterp = definterp+    , config = conf+    , genRef = 1 -- Currently generate references by increasing a counter.+    , currRef = initialRef+    , cmap = IntMap.fromList [(initialRef, conf)]+    , execEnv = mkGraph [(initialRef, initialRef)] []+    , sharing = share+    , backTracking = backtrack+}++initialRef :: Int+initialRef = 1++mkExplorerStack, mkExplorerTree, mkExplorerGraph, mkExplorerGSS :: (Show a, Eq a, Eq b, Monad m, Monoid o) => (a -> b -> m (b,o)) -> b -> Explorer a m b o+mkExplorerStack = mkExplorer False True+mkExplorerTree  = mkExplorer False False+mkExplorerGraph = mkExplorer True False+mkExplorerGSS   = mkExplorer True True++deref :: Explorer p m c o -> Ref -> Maybe c+deref e r = IntMap.lookup r (cmap e)++findRef :: Eq c => Explorer p m c o -> c -> Maybe (Ref, c)+findRef e c = find (\(r, c') -> c' == c) (IntMap.toList (cmap e))++addNewPath :: Explorer p m c o -> p -> o -> c -> Explorer p m c o+addNewPath e p o c = e { config = c, currRef = newref, genRef = newref, cmap = IntMap.insert newref c (cmap e),+     execEnv = insNode (newref, newref) $ insEdge (currRef e, newref, (p,o)) (execEnv e)}+     where newref = genRef e + 1++updateConf :: (Eq c, Eq p, Eq o) => Explorer p m c o -> (p, c, o) -> Explorer p m c o+updateConf e (p, newconf, output) =+    if sharing e+        then case findRef e newconf of+            Just (r, c) ->+                if hasLEdge (execEnv e) (currRef e, r, (p,output))+                    then e  { config = newconf, currRef = r }+                    else e  { config = newconf, currRef = r+                            , execEnv = insEdge (currRef e, r, (p,output)) (execEnv e) }+            Nothing -> addNewPath e p output newconf+        else addNewPath e p output newconf++execute :: (Eq c, Eq p, Eq o, Monad m, Monoid o) =>  p -> Explorer p m c o -> m (Explorer p m c o, o)+execute p e = do+    (newconf,out) <- defInterp e p (config e)+    return $ (updateConf e (p, newconf, out), out)++++executeAll :: (Eq c, Eq p, Eq o, Monad m, Monoid o) => [p] -> Explorer p m c o -> m (Explorer p m c o, o)+executeAll ps exp = foldlM executeCollect (exp, mempty) ps+  where executeCollect (exp, out) p = do (res, out') <- execute p exp+                                         return (res, out `mappend` out')++deleteMap :: [Ref] -> IntMap.IntMap a -> IntMap.IntMap a+deleteMap xs m = foldl (flip IntMap.delete) m xs++dynamicRevert :: Bool -> Ref -> Explorer p m c o -> Maybe (Explorer p m c o)+dynamicRevert backtrack r e =+  case IntMap.lookup r (cmap e) of+    Just c | backtrack -> Just e { execEnv = execEnv', currRef = r, config = c, cmap = cmap'}+           | otherwise -> Just e { currRef = r, config = c }+    Nothing            -> Nothing+    where nodesToDel = reachable r (execEnv e) \\ [r]+          edgesToDel = filter (\(s, t) -> s `elem` nodesToDel || t `elem` nodesToDel) (edges (execEnv e))+          execEnv'   = (delEdges edgesToDel . delNodes nodesToDel) (execEnv e)+          cmap'      = deleteMap nodesToDel (cmap e)+++revert :: Ref -> Explorer p m c o -> Maybe (Explorer p m c o)+revert r e = dynamicRevert (backTracking e) r e++  +toTree :: Explorer p m c o -> Tree (Ref, c)+toTree exp = mkTree initialRef+  where graph = execEnv exp+        target (_, r, _) = r+        mkTree r = Node (r, cmap exp IntMap.! r) (map (mkTree . target) (out graph r))+++incomingEdges :: Ref -> Explorer p m c o -> [((Ref, c), (p, o), (Ref, c))]+incomingEdges ref e = foldr (\(s, t, l) acc ->  [((s, unpack s), l, (t, unpack t))] ++ acc) [] (filter (\(_, t, _) -> t == ref) (labEdges (execEnv e)))+  where+    unpack ref = fromJust $ deref e ref+++transformToRealGraph :: Gr Ref p -> Gr Ref Int+transformToRealGraph g = mkGraph (labNodes g) (map (\(s, t) -> (s, t, 1)) (edges g))++transformToPairs :: [Ref] -> [(Ref, Ref)]+transformToPairs (s:t:xs) = (s, t) : transformToPairs (t:xs)+transformToPairs _ = []++getTrace :: Explorer p m c o -> [((Ref, c), (p, o), (Ref, c))]+getTrace e = getPathFromTo e initialRef (currRef e)++getTraces :: Explorer p m c o -> [[((Ref, c), (p, o), (Ref, c))]]+getTraces e = getPathsFromTo e initialRef (currRef e)+++mapOut :: Explorer p m c o -> Gr Ref (p, o) -> [Ref] -> Ref -> (Ref, Ref, (p,o)) -> Maybe [[((Ref, c), (p, o), (Ref, c))]]+mapOut exp gr visited goal (s, t, (l, o))+  | goal == t = Just $ [[((s, unpack s), (l, o), (t, unpack t))]] ++ explore+  | otherwise = case t `elem` visited of+                  True -> Nothing+                  False -> Just explore+  where+    explore = map ((:)((s, unpack s), (l, o), (t, unpack t))) (concat $ catMaybes $ map (mapOut exp gr (t : visited) goal) (out gr t))+    unpack ref = fromJust $ deref exp ref+++getPathsFromTo :: Explorer p m c o -> Ref -> Ref -> [[((Ref, c), (p, o), (Ref, c))]]+getPathsFromTo exp from to = concat $ catMaybes $ map (mapOut exp (execEnv exp) [from] to) (out (execEnv exp) from)++getPathFromTo :: Explorer p m c o -> Ref -> Ref -> [((Ref, c), (p, o), (Ref, c))]+getPathFromTo exp from to =+  case getPathsFromTo exp from to of+    [] -> []+    (x:_) -> x+++executionGraph :: Explorer p m c o -> (Ref, [Ref], [((Ref, c), (p, o), (Ref, c))])+executionGraph exp =+  (curr, nodes, edges)+  where+    curr = currRef exp+    nodes = map fst (labNodes (execEnv exp))+    edges = map (\(s, t, p) -> ((s, fromJust $ deref exp s), p, (t, fromJust $ deref exp t)) ) (labEdges (execEnv exp))

+ Language/Explorer/Pure.hs view

@@ -0,0 +1,82 @@+module Language.Explorer.Pure+    ( Explorer+    , execute+    , executeAll+    , revert+    , dynamicRevert +    , ExplorerM.toTree+    , incomingEdges+    , mkExplorerStack+    , mkExplorerTree+    , mkExplorerGraph+    , mkExplorerGSS+    , config+    , currRef+    , Ref+    , deref+    , getTrace+    , getTraces+    , getPathsFromTo+    , getPathFromTo+    , executionGraph+    ) where++import qualified Language.Explorer.Monadic as ExplorerM+import Control.Monad.Identity++import qualified Data.IntMap as IntMap+import Data.List+import Data.Foldable++-- We shadow instead of exporting directly to make the user interaction+-- the same.+type Ref = ExplorerM.Ref+type Explorer a b o = ExplorerM.Explorer a Identity b o++currRef :: Explorer a b o -> Ref+currRef = ExplorerM.currRef++config :: Explorer a b o -> b+config = ExplorerM.config++deref :: Explorer p c o -> Ref -> Maybe c+deref = ExplorerM.deref++wrap :: (Monad m, Monoid o) => (a -> b -> (b,o)) -> a -> b -> m (b, o)+wrap def p e = return $ def p e++mkExplorerStack, mkExplorerTree, mkExplorerGraph, mkExplorerGSS:: (Show a, Eq a, Eq b, Monoid o) => (a -> b -> (b,o)) -> b -> Explorer a b o+mkExplorerStack definterp conf = ExplorerM.mkExplorerStack (wrap definterp) conf+mkExplorerTree definterp conf = ExplorerM.mkExplorerTree (wrap definterp) conf+mkExplorerGraph definterp conf = ExplorerM.mkExplorerGraph (wrap definterp) conf+mkExplorerGSS definterp conf = ExplorerM.mkExplorerGSS (wrap definterp) conf++execute :: (Eq c, Eq p, Eq o, Monoid o) =>  p -> Explorer p c o -> (Explorer p c o, o)+execute p e = runIdentity $ ExplorerM.execute p e++executeAll :: (Eq c, Eq p, Eq o, Monoid o) => [p] -> Explorer p c o -> (Explorer p c o, o)+executeAll p e = runIdentity $ ExplorerM.executeAll p e++dynamicRevert :: Bool -> Ref -> Explorer p c o -> Maybe (Explorer p c o)+dynamicRevert = ExplorerM.dynamicRevert++revert :: ExplorerM.Ref -> Explorer p c o -> Maybe (Explorer p c o)+revert = ExplorerM.revert++incomingEdges :: Ref -> Explorer p c o -> [((Ref, c), (p, o), (Ref, c))]+incomingEdges = ExplorerM.incomingEdges++getTrace :: Explorer p c o -> [((Ref, c), (p, o), (Ref, c))]+getTrace = ExplorerM.getTrace++getTraces :: Explorer p c o -> [[((Ref, c), (p, o), (Ref, c))]]+getTraces = ExplorerM.getTraces++getPathsFromTo :: Explorer p c o -> Ref -> Ref -> [[((Ref, c), (p, o), (Ref, c))]]+getPathsFromTo = ExplorerM.getPathsFromTo++getPathFromTo :: Explorer p c o -> Ref -> Ref -> [((Ref, c), (p, o), (Ref, c))]+getPathFromTo = ExplorerM.getPathFromTo++executionGraph :: Explorer p c o -> (Ref, [Ref], [((Ref, c), (p, o), (Ref, c))])+executionGraph = ExplorerM.executionGraph

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ examples/Whilelang.hs view

@@ -0,0 +1,237 @@+module Whilelang where++import qualified Data.Map as Map+import Data.List+import Data.Graph.Inductive (emap)+import Control.Monad.Trans.Writer.Lazy+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Class+import Control.Monad.Identity+import qualified Language.Explorer.Basic as E+import qualified Language.Explorer.Pure as EP+import qualified Language.Explorer.Monadic as EM+++data Literal = LitBool Bool | LitInt Integer deriving (Eq)+instance Show Literal where+    show (LitBool b) = show b+    show (LitInt i) = show i++data Expr = Leq Expr Expr | Plus Expr Expr | LitExpr Literal | Id String deriving (Eq)+instance Show Expr where+    show (Leq e1 e2) = show e1 ++ "<=" ++ show e2+    show (Plus e1 e2) = show e1 ++ "+" ++ show e2+    show (LitExpr lit) = show lit+    show (Id s) = s++data Command = Seq Command Command | Assign String Expr | Print Expr | While Expr Expr Command | Done deriving (Eq)+instance Show Command where+    show (Print e1) = "print(" ++ show e1 ++ ")"+    show Done = "Done"+    show (Assign s e) = s ++ " = " ++ show e+    show (Seq c1 c2) = show c1 ++ "\n" ++ show c2+    show (While e1 e2 c) = "while(" ++ show e2 ++ ") do\n" ++ show c ++ "\nod"++type Store = Map.Map String Literal+type StoreM = State Store+type Output = [String]+data Config = Config { cfgStore :: Store, cfgOutput :: Output } deriving (Show, Eq)++type WhileExplorer = E.Explorer Command Config+type WhileExplorerM = EM.Explorer Command IO Config ()+type WhileExplorerO = EP.Explorer Command Config [String]++evalPlus :: Expr -> Expr -> StoreM Expr+evalPlus (LitExpr (LitInt l1)) (LitExpr (LitInt l2)) = return $ LitExpr $ LitInt (l1 + l2)+evalPlus (LitExpr l1) l2 = do+    l2' <- evalExpr l2+    return (Plus (LitExpr l1) l2')+evalPlus l1 l2 = do+    l1' <- evalExpr l1+    return (Plus l1' l2)++evalLeq :: Expr -> Expr -> StoreM Expr+evalLeq (LitExpr (LitInt l1)) (LitExpr (LitInt l2)) = return $ LitExpr $ LitBool (l1 <= l2)+evalLeq (LitExpr l1) e2 = do+    e2' <- evalExpr e2+    return (Leq (LitExpr l1) e2')+evalLeq e1 e2 = do+    e1' <- evalExpr e1+    return (Leq e1' e2)++evalExpr :: Expr -> StoreM Expr+evalExpr (LitExpr e) = return $ LitExpr e+evalExpr (Plus e1 e2) = evalPlus e1 e2+evalExpr (Leq e1 e2) = evalLeq e1 e2+evalExpr (Id s) = do+    m <- get+    let l = Map.lookup s m+    case l of+        Just lit -> return $ LitExpr lit+        Nothing -> error $ "Invalid Id: " ++ s++evalExpr' :: Expr -> StoreM Expr+evalExpr' (LitExpr e) = return $ LitExpr e+evalExpr' e = do+    e' <- evalExpr e+    evalExpr' e'++store :: String -> Expr -> StoreM Command+store s (LitExpr l) = do+    lut <- get+    put $ Map.insert s l lut+    return Done++evalCommand :: Command -> WriterT [String] StoreM Command+evalCommand (Print e) = do+    x <- (lift . evalExpr') e+    tell [show x]+    return Done+evalCommand (Assign id e) = do+    lit <- (lift . evalExpr') e+    lift $ store id lit+evalCommand (Seq Done c2) = return c2+evalCommand (Seq c1 c2) = do+    c1' <- evalCommand c1+    return $ Seq c1' c2+evalCommand (While (LitExpr (LitBool False)) e2 c) = return Done+evalCommand (While (LitExpr (LitBool True)) e2 c) = return $ Seq c (While e2 e2 c)+evalCommand (While e1 e2 c) = do+    e1' <- (lift . evalExpr') e1+    return $ While e1' e2 c+++evalCommand' :: Command -> WriterT [String] StoreM Command+evalCommand' Done = return Done+evalCommand' c = do+    c' <- evalCommand c+    evalCommand' c'++-- Initial configuration in the while language)+initialConfig :: Config+initialConfig = Config {cfgStore = Map.empty, cfgOutput = []}++-- Definitial interpreter for the while language.+definterp :: Command -> Config -> Config+definterp c cfg = cfg {cfgStore = newstore, cfgOutput = cfgOutput cfg ++ newout}+    where ((_, newout), newstore) = runState (runWriterT (evalCommand' c)) (cfgStore cfg)+++definterpO :: Command -> Config -> (Config, [String])+definterpO c cfg = (cfg {cfgStore = newstore}, newout)+    where ((_, newout), newstore) = runState (runWriterT (evalCommand' c)) (cfgStore cfg)+++-- Simulate doing IO in the definitional interpreter.+definterpM :: Command -> Config -> IO Config+definterpM c cfg = do+    mapM putStrLn newout+    return cfg {cfgStore = newstore, cfgOutput = []}+    where ((_, newout), newstore) = runState (runWriterT (evalCommand' c)) (cfgStore cfg)+++-- whileLang = (Command, Config, initialConfig, definterp)+--+do_ :: Command -> WhileExplorer -> IO WhileExplorer+do_ (Seq c1 c2) e = do_ c1 e >>= do_ c2+do_ p e = do+    let e' = E.execute p e +    putStr $ unlines $ cfgOutput (E.config e') \\ cfgOutput (E.config e)+    return e'++do_2 :: Command -> WhileExplorerM -> IO WhileExplorerM+do_2 (Seq c1 c2) e = do_2 c1 e >>= do_2 c2 +do_2 p e = fst <$> EM.execute p e++do_3 :: Command -> (WhileExplorerO, [String]) -> (WhileExplorerO, [String])+do_3 (Seq c1 c2) e = do_3 c2 $ do_3 c1 e +do_3 p (e, o) = (e', o ++ o')+  where (e', o') = EP.execute p e++start :: IO WhileExplorer+start = return whileGraph++startM :: IO WhileExplorerM+startM = return whileGraphM++startO :: WhileExplorerO+startO = whileGraphO++session1 :: IO WhileExplorer+session1 = start >>=+  do_ (assign "x" (intToExpr 1)) >>= +  do_ (assign "y" (Id "x")) >>= +  do_ (Print (Id "y"))+++-- When using sharing, this results in 3 configurations and not 4,+-- since the IO effect is hidden in the monad and not part of the+-- configurations anymore.+session2 :: IO WhileExplorerM+session2 = startM >>=+  do_2 (assign "x" (intToExpr 1)) >>= +  do_2 (assign "y" (Id "x")) >>= +  do_2 (Print (Id "y"))+++session3 :: (WhileExplorerO, [String])+session3 =+  do_3 (Print (Id "y")) $ do_3 (assign "y" (Id "x")) $ do_3 (assign "x" (intToExpr 1)) (startO, [])++-- Below are some helpers to create a Command and fully evaluate it.+-- Example:+-- ghci> let x = wprint (intToExpr 10) `wseq` (wprint (intToExpr 100) `wseq` wprint (intToExpr 200))+-- ghci> runCommand' x+-- ["10","100","200"]+-- ghci>+runCommand :: Command -> IO()+runCommand c = do+    let ((_, output), _) = runState (runWriterT (evalCommand' c)) Map.empty+    print output+++intToExpr :: Integer -> Expr+intToExpr = LitExpr . LitInt++boolToExpr :: Bool -> Expr+boolToExpr = LitExpr . LitBool++while ::  Expr -> Command -> Command+while e = While e e++leq :: Expr -> Expr -> Expr+leq = Leq++wprint :: Expr -> Command+wprint = Print++plus :: Expr -> Expr -> Expr+plus = Plus++assign :: String -> Expr -> Command+assign = Assign++wseq :: Command -> Command -> Command+wseq = Seq++whileGraph :: WhileExplorer+whileGraph = E.mkExplorerGraph definterp initialConfig++whileGraphM :: WhileExplorerM+whileGraphM = EM.mkExplorerGraph (\p c -> (\c -> (c,())) <$> definterpM p c) initialConfig++whileGraphO :: WhileExplorerO+whileGraphO = EP.mkExplorerGraph definterpO initialConfig++whileTree :: WhileExplorer+whileTree = E.mkExplorerTree definterp initialConfig++whileStack :: WhileExplorer +whileStack = E.mkExplorerStack definterp initialConfig++whileExample = Seq (Assign "x" (intToExpr 0)) (while (Leq (Id "x") (intToExpr 10)) (Seq (Assign "x" (Plus (Id "x") (intToExpr 1))) (Print (Id "x"))))++zero = intToExpr 0++getRef :: WhileExplorer -> E.Ref+getRef = E.currRef

+ exploring-interpreters.cabal view

@@ -0,0 +1,37 @@+cabal-version:       >=1.10++name:                exploring-interpreters+version:             0.2.0.0+synopsis:            A generic exploring interpreter for exploratory programming+-- synopsis:+-- description:+-- bug-reports:+license:             BSD3+license-file:        LICENSE+author:              Damian Frolich+maintainer:          leegbestand@gmail.com+-- copyright:+category:            Compilers/Interpreters+build-type:          Simple+extra-source-files:  CHANGELOG.md examples/Whilelang.hs++source-repository head+    type:         git+    location:     https://github.com/leegbestand/exploring_interpreters++library+  exposed-modules:+      Language.Explorer.Monadic,+      Language.Explorer.Pure+  other-modules:+      Language.Explorer.Basic+  -- other-extensions:+  build-depends:+      base >=4.9 && <5,+      containers >=0.5 && <0.7,+      fgl >= 5.7.0 && < 5.8,+      transformers >= 0.5.2 && < 0.6,+      mtl          >= 2.2.1 && < 2.3++  -- hs-source-dirs:+  default-language:    Haskell2010