exploring-interpreters 1.0.0.0 → 1.2.0.0

raw patch · 6 files changed

+49/−38 lines, 6 filesdep +haskelinedep −readline

Dependencies added: haskeline

Dependencies removed: readline

Files

• CHANGELOG.md +3/−0
• Language/Explorer/Basic.hs +1/−1
• Language/Explorer/Monadic.hs +7/−7
• Language/Explorer/Tools/REPL.hs +23/−23
• examples/Whilelang.hs +13/−5
• exploring-interpreters.cabal +2/−2

@@ -30,3 +30,6 @@ * Add the Tools module. This module includes an implementation of the exploring interpreter protocol and an implementation of an language parametric REPL.++## 1.2.0.0 -- 2022-01-13+* Change the readline dependency to haskeline.

@@ -94,7 +94,7 @@  toExport :: Explorer p c -> (Ref, [(Ref, c)], [(Ref, Ref, p)]) toExport = removeOut . ExplorerM.toExport-  where +  where     removeOut (c, nodes, edges) = (c, nodes, map (\(s, t, (p, _)) -> (s, t, p)) edges)  fromExport :: Explorer p c -> (Ref, [(Ref, c)], [(Ref, Ref, p)]) -> Explorer p c

@@ -158,14 +158,14 @@  data RevertableStatus = ContinueRevert | StopRevert deriving Show -findRevertableNodes gr source target = +findRevertableNodes gr source target =   case findNextNodeInPath gr source target of     (Just node) -> fst $ findRevertableNodes' gr node target     Nothing     -> []-  where -    findNextNodeInPath gr source target = find (\n -> target `elem` (reachable n gr)) (suc gr source) -    findRevertableNodes' gr source target -      | source == target = if outdeg gr source > 1 then ([], StopRevert) else ([source], ContinueRevert) +  where+    findNextNodeInPath gr source target = find (\n -> target `elem` (reachable n gr)) (suc gr source)+    findRevertableNodes' gr source target+      | source == target = if outdeg gr source > 1 then ([], StopRevert) else ([source], ContinueRevert)       | otherwise = case findNextNodeInPath gr source target of         (Just node) -> case findRevertableNodes' gr node target of           (res, StopRevert) -> (res, StopRevert)@@ -256,8 +256,8 @@ fromExport :: Explorer p m c o -> (Ref, [(Ref, c)], [(Ref, Ref, (p, o))]) -> Explorer p m c o fromExport exp (curr, nds, edgs) = exp { genRef = findMax nds,                                          config = findCurrentConf curr nds,-                                         currRef = curr, -                                         cmap = IntMap.fromList nds, +                                         currRef = curr,+                                         cmap = IntMap.fromList nds,                                          execEnv = mkGraph (map (\(x, _) -> (x, x)) nds) edgs }   where findMax l = maximum $ map fst l         findCurrentConf curr nds = case lookup curr nds of

@@ -1,16 +1,16 @@-module Language.Explorer.Tools.REPL where +module Language.Explorer.Tools.REPL where  import Control.Monad.IO.Class (MonadIO(..)) import Language.Explorer.Monadic     (Explorer(config), execute, revert, jump, toTree)-import qualified System.Console.Readline as Rl+import qualified System.Console.Haskeline as Hl import Data.Tree (drawTree) import Data.Maybe (fromJust, isNothing) import Data.Char (isSpace)-import Data.List (find, isPrefixOf) +import Data.List (find, isPrefixOf) import Text.Read (readMaybe) import Control.Arrow (Arrow(first))-+import Control.Monad.Trans   type MetaTable p m c o = [(String, String -> Explorer p m c o -> m (Explorer p m c o))]@@ -51,22 +51,22 @@ constructMetaTable :: MonadIO m => String -> [(String, String -> Explorer p m c o -> m (Explorer p m c o))] constructMetaTable prefix = map (first (prefix ++ )) metaTable -repl :: (Eq p, Eq o, Monoid o, MonadIO m) => Repl p m c o-repl prompt parser metaPrefix metaTable metaHandler outputHandler ex = do-  minput <- liftIO . Rl.readline . prompt $ ex-  case minput of-    (Just input) -> do-      liftIO $ Rl.addHistory input-      if metaPrefix `isPrefixOf` input then runMeta input else runExec input-    Nothing -> return ()-  where-    repl' = repl prompt parser metaPrefix metaTable metaHandler outputHandler-    runMeta input =-      let (pcmd, args) = break isSpace input in-        case find (\(cmd, _) -> (metaPrefix ++ cmd) == pcmd) metaTable of-          Just (_, f) -> f args ex >>= repl'-          Nothing -> metaHandler input ex >>= repl'-    runExec input =-      case parser input (config ex) of-        (Just program) -> execute program ex >>= \(newEx, out) -> (outputHandler out >> repl' newEx)-        Nothing -> repl' ex+repl :: (Eq p, Eq o, Monoid o, MonadIO m, Hl.MonadException m) => Repl p m c o+repl prompt parser metaPrefix metaTable metaHandler outputHandler ex =+  Hl.runInputT Hl.defaultSettings (loop ex)+    where+    loop ex = do+      minput <- Hl.getInputLine . prompt $ ex+      case minput of+        (Just input) -> lift (if metaPrefix `isPrefixOf` input then runMeta input else runExec input) >>= loop+        Nothing -> return ()+      where+        runMeta input =+          let (pcmd, args) = break isSpace input in+            case find (\(cmd, _) -> (metaPrefix ++ cmd) == pcmd) metaTable of+              Just (_, f) -> f args ex+              Nothing -> metaHandler input ex+        runExec input =+          case parser input (config ex) of+            (Just program) -> execute program ex >>= \(newEx, out) -> outputHandler out >> return newEx+            Nothing -> return ex

@@ -11,21 +11,24 @@ import qualified Language.Explorer.Basic as E import qualified Language.Explorer.Pure as EP import qualified Language.Explorer.Monadic as EM+import qualified Language.Explorer.Tools.REPL as R+import Language.Explorer.Basic (mkExplorerNoSharing)  -data Literal = LitBool Bool | LitInt Integer deriving (Eq)++data Literal = LitBool Bool | LitInt Integer deriving (Eq, Read) 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)+data Expr = Leq Expr Expr | Plus Expr Expr | LitExpr Literal | Id String deriving (Eq, Read) 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)+data Command = Seq Command Command | Assign String Expr | Print Expr | While Expr Expr Command | Done deriving (Eq, Read) instance Show Command where     show (Print e1) = "print(" ++ show e1 ++ ")"     show Done = "Done"@@ -124,12 +127,17 @@   -- Simulate doing IO in the definitional interpreter.-definterpM :: Command -> Config -> IO Config+definterpM :: Command -> Config -> IO (Maybe Config, ()) definterpM c cfg = do     mapM putStrLn newout-    return cfg {cfgStore = newstore, cfgOutput = []}+    return (Just $ cfg {cfgStore = newstore, cfgOutput = []}, ())     where ((_, newout), newstore) = runState (runWriterT (evalCommand' c)) (cfgStore cfg) ++parser :: String -> c -> Maybe Command+parser s _ = Just (read s :: Command)++repl = R.repl (const "While> ") parser ":" R.metaTable  (\_ ex -> return ex) (\_ -> return ()) (EM.mkExplorerNoSharing definterpM initialConfig)  -- whileLang = (Command, Config, initialConfig, definterp) --

@@ -1,7 +1,7 @@ cabal-version:       >=1.10  name:                exploring-interpreters-version:             1.0.0.0+version:             1.2.0.0 synopsis:            A generic exploring interpreter for exploratory programming -- synopsis: -- description:@@ -41,7 +41,7 @@       text                  >= 1.2.4 && < 1.3,       http-types            >= 0.12.3 && < 0.13,       network               >= 3.1.2 && < 3.2,-      readline              >= 1.0.3 && < 1.1+      haskeline    -- hs-source-dirs:   default-language:    Haskell2010