exploring-interpreters 0.4.0.0 → 1.0.0.0
raw patch · 8 files changed
+748/−142 lines, 8 filesdep +aesondep +attoparsecdep +bytestring
Dependencies added: aeson, attoparsec, bytestring, http-types, network, readline, scientific, text
Files
- CHANGELOG.md +12/−2
- Language/Explorer/Basic.hs +22/−21
- Language/Explorer/Monadic.hs +124/−61
- Language/Explorer/Pure.hs +15/−19
- Language/Explorer/Tools/Protocol.hs +451/−0
- Language/Explorer/Tools/REPL.hs +72/−0
- examples/Whilelang.hs +39/−36
- exploring-interpreters.cabal +13/−3
CHANGELOG.md view
@@ -15,8 +15,18 @@ This functionality is provided via the 'toExport' and 'fromExport' functions. * Furthermore, this version also exports the initial reference. -## 0.3.2.1 -- 2021-01-10+## 0.3.2.1 -- 2021-10-01 * Add the toExport and fromExport functions to the exported functions in the pure module. -## 0.4.0.0 -- 2021-01-10+## 0.4.0.0 -- 2021-10-01 * fromExport function now correctly determines the referece to use for generation of new nodes.++## 1.0.0.0 -- 2021-10-06+* Change explorer model to the new model where the exploration is always reported+by a tree and sharing is possible via the optional shadow graph.+Furthermore, the *jump* action is introduced to allow jumping to any node in the tree without the +destructive property. In addition, the *revert* action is now always destructive and can only operate +on the current trace.+* Add the Tools module.+This module includes an implementation of the exploring interpreter protocol and an implementation+of an language parametric REPL.
Language/Explorer/Basic.hs view
@@ -1,14 +1,13 @@+{-# LANGUAGE ConstraintKinds #-}+ module Language.Explorer.Basic ( Explorer+ , mkExplorer+ , mkExplorerNoSharing , execute , executeAll , revert- , dynamicRevert , ExplorerM.toTree- , mkExplorerStack- , mkExplorerTree- , mkExplorerGraph- , mkExplorerGSS , config , currRef , Ref@@ -19,7 +18,8 @@ , getPathsFromTo , getPathFromTo , executionGraph- , ExplorerM.initialRef+ , fromExport+ , toExport ) where import qualified Language.Explorer.Monadic as ExplorerM@@ -36,7 +36,14 @@ -- the same. type Ref = ExplorerM.Ref type Explorer a b = ExplorerM.Explorer a Identity b ()+type BasicLanguage p c = Eq p +mkExplorer :: BasicLanguage p c => Bool -> (c -> c -> Bool) -> (p -> c -> Maybe c) -> c -> Explorer p c+mkExplorer shadow eqfunc definterp initialConf = ExplorerM.mkExplorer shadow eqfunc (wrap definterp) initialConf++mkExplorerNoSharing :: BasicLanguage p c => (p -> c -> Maybe c) -> c -> Explorer p c+mkExplorerNoSharing = mkExplorer False (const . const $ False)+ currRef :: Explorer a b -> Ref currRef = ExplorerM.currRef @@ -50,22 +57,12 @@ wrap :: Monad m => (a -> b -> Maybe b) -> a -> b -> m (Maybe b, ()) wrap def p e = return $ (def p e, ()) --- Constructor for a exploring interpreter.-mkExplorerStack, mkExplorerTree, mkExplorerGraph, mkExplorerGSS :: (Show a, Eq a, Eq b) => (a -> b -> Maybe b) -> b -> Explorer a b-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) => p -> Explorer p c -> Explorer p c+execute :: BasicLanguage p c => 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 :: BasicLanguage p c => [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 @@ -87,7 +84,7 @@ 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 :: Explorer p c -> ((Ref, c), [(Ref, c)], [((Ref, c), p, (Ref, c))]) executionGraph e = (curr, nodes, map removeOutput graph) where (curr, nodes, graph) = ExplorerM.executionGraph e@@ -96,7 +93,11 @@ leaves = ExplorerM.leaves toExport :: Explorer p c -> (Ref, [(Ref, c)], [(Ref, Ref, p)])-toExport exp = let (curr, nds, edges) = ExplorerM.toExport exp in (curr, nds, map (\(r1, r2, (p, o)) -> (r1, r2, p)) edges)+toExport = removeOut . ExplorerM.toExport+ 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-fromExport exp (curr, nds, edgs) = ExplorerM.fromExport exp (curr, nds, map (\(r1, r2, p) -> (r1, r2, (p, ()))) edgs)+fromExport e exported = ExplorerM.fromExport e (addOut exported)+ where+ addOut (c, nodes, edges) = (c, nodes, map (\(s, t, p) -> (s, t, (p, ()))) edges)
Language/Explorer/Monadic.hs view
@@ -1,31 +1,34 @@ {-# LANGUAGE GADTs #-}+{-# LANGUAGE ConstraintKinds #-} + module Language.Explorer.Monadic ( Explorer+ , mkExplorer+ , mkExplorerNoSharing , execute , executeAll , revert- , dynamicRevert+ , jump , toTree , incomingEdges- , mkExplorerStack- , mkExplorerTree- , mkExplorerGraph- , mkExplorerGSS , config , execEnv , currRef- , initialRef , leaves , Ref+ , Language , deref , getTrace , getTraces , getPathsFromTo , getPathFromTo , executionGraph- , toExport+ , shadowExecEnv+ , eqClasses+ , initialRef , fromExport+ , toExport ) where import Data.Graph.Inductive.Graph@@ -40,72 +43,93 @@ import Data.Maybe type Ref = Int+type Language p m c o = (Eq p, Eq o, Monad m, Monoid o) data Explorer programs m configs output where- Explorer :: (Show programs, Eq programs, Eq configs, Monad m, Monoid output) =>- { sharing :: Bool- , backTracking :: Bool+ Explorer :: Language programs m configs output =>+ { shadowing :: Bool -- Shadow the exploration tree in a shadow graph. , defInterp :: programs -> configs -> m (Maybe configs, output) , config :: configs -- Cache the config , currRef :: Ref , genRef :: Ref , cmap :: IntMap.IntMap configs , execEnv :: Gr Ref (programs, output)+ , shadowExecEnv :: Gr [Ref] (programs, output)+ , configEq :: configs -> configs -> Bool } -> Explorer programs m configs output -mkExplorer :: (Show a, Eq a, Eq b, Monad m, Monoid o) =>- Bool -> Bool -> (a -> b -> m (Maybe b,o)) -> b -> Explorer a m b o-mkExplorer share backtrack definterp conf = Explorer++mkExplorer :: Language p m c o => Bool -> (c -> c -> Bool) -> (p -> c -> m (Maybe c, o)) -> c -> Explorer p m c o+mkExplorer shadow shadowEq 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+ , shadowExecEnv = mkGraph [(initialRef, [initialRef])] []+ , shadowing = shadow+ , configEq = shadowEq } initialRef :: Int initialRef = 1 -mkExplorerStack, mkExplorerTree, mkExplorerGraph, mkExplorerGSS :: (Show a, Eq a, Eq b, Monad m, Monoid o) => (a -> b -> m (Maybe b,o)) -> b -> Explorer a m b o-mkExplorerStack = mkExplorer False True-mkExplorerTree = mkExplorer False False-mkExplorerGraph = mkExplorer True False-mkExplorerGSS = mkExplorer True True+mkExplorerNoSharing :: Language p m c o => (p -> c -> m (Maybe c, o)) -> c -> Explorer p m c o+mkExplorerNoSharing = mkExplorer False (\_ -> \_ -> False) 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))+findRef :: Explorer p m c o -> c -> (c -> Bool) -> Maybe (Ref, c)+findRef e c eq = find (\(r, c') -> eq 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)+findNodeRef :: Gr [Ref] (p, o) -> Ref -> Ref+findNodeRef g r = fst $ fromJust $ find (\(_, rs) -> r `elem` rs) $ labNodes g+++updateShadowEnv :: Language p m c o => Explorer p m c o -> (p, c, o, Ref, Ref) -> Explorer p m c o+updateShadowEnv e (p, newconf, output, newref, oldref) =+ case findRef e newconf (configEq e newconf) of+ Just (r', _) ->+ if hasLEdge shadowEnv (nref, findNodeRef shadowEnv r', (p, output))+ then e+ else e {+ shadowExecEnv = updateLabel (findNodeRef shadowEnv r', newref, p, output) $ insEdge (nref, findNodeRef shadowEnv r', (p, output)) shadowEnv+ }+ Nothing -> e {+ shadowExecEnv = insNode (newref, [newref]) $ insEdge (nref, newref, (p, output)) $ shadowExecEnv e+ }+ where+ shadowEnv = shadowExecEnv e+ nref = findNodeRef shadowEnv oldref+ updateLabel (target, add_to_label, p, output) gr =+ case match target gr of+ (Just (toadj, node, label, fromadj), decomgr) -> (toadj, node, add_to_label : label, fromadj) & decomgr+ _ -> error "Shadow execution environment is inconsistent."+++updateExecEnvs :: Language p m c o => Explorer p m c o -> (p, c, o) -> Explorer p m c o+updateExecEnvs e (p, newconf, output)+ | shadowing e = addNewPath (updateShadowEnv e (p, newconf, output, (currRef newexplorer), (currRef e))) p output newconf+ | otherwise = newexplorer+ where+ newexplorer = addNewPath e p output newconf++execute :: Language p m c o => p -> Explorer p m c o -> m (Explorer p m c o, o) execute p e = do (mcfg, o) <- defInterp e p (config e) case mcfg of- Just cfg -> return $ (updateConf e (p, cfg, o), o)+ Just cfg -> return (updateExecEnvs e (p, cfg, o), o) Nothing -> return (e, o) -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 :: Language p m c 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')@@ -113,21 +137,57 @@ 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) +deleteFromShadowEnv :: [(Ref, Ref)] -> Gr [Ref] po -> Gr [Ref] po+deleteFromShadowEnv [(l, r)] gr = case match r gr of+ (Just (toadj, node, label, fromadj), decomgr) -> (toadj, node, label \\ [l], fromadj) & decomgr+ _ -> error "Inconsistent shadow env."+deleteFromShadowEnv (x:xs) gr = deleteFromShadowEnv xs (deleteFromShadowEnv [x] gr) +cleanEdges :: [Ref] -> [(Ref, Ref, (p, o))] -> [(Ref, Ref, (p, o))]+cleanEdges ref edg = filter (\(s, t, l) -> not $ t `elem` ref) edg++cleanShadowEnv :: Bool -> [Ref] -> Gr [Ref] (p, o) -> Gr [Ref] (p, o)+cleanShadowEnv False _ g = g+cleanShadowEnv True nds g = shadowEnv''+ where+ shadowEnv' = deleteFromShadowEnv (map (\r -> (r, findNodeRef g r)) nds) g+ nodesToDel' = map fst (filter (\(r, labels) -> labels == []) $ labNodes (shadowEnv'))+ edgesToDel' = filter (\(s, t) -> s `elem` nodesToDel' || t `elem` nodesToDel') (edges shadowEnv')+ shadowEnv'' = (delEdges edgesToDel' . delNodes nodesToDel') shadowEnv'++data RevertableStatus = ContinueRevert | StopRevert deriving Show++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) + | otherwise = case findNextNodeInPath gr source target of+ (Just node) -> case findRevertableNodes' gr node target of+ (res, StopRevert) -> (res, StopRevert)+ (res, ContinueRevert) -> if outdeg gr source > 1 then (res, StopRevert) else (source : res, ContinueRevert)+ Nothing -> ([], ContinueRevert)+ revert :: Ref -> Explorer p m c o -> Maybe (Explorer p m c o)-revert r e = dynamicRevert (backTracking e) r e+revert r e+ | currRef e `elem` reachNodes =+ jump r e >>= \e' -> return $ e' { execEnv = mkGraph (zip remainNodes remainNodes) $ cleanEdges reachNodes (labEdges $ execEnv e')+ , cmap = deleteMap reachNodes (cmap e')+ , shadowExecEnv = cleanShadowEnv (shadowing e') reachNodes (shadowExecEnv e')}+ | otherwise = Nothing+ where+ reachNodes = findRevertableNodes gr r (currRef e)+ remainNodes = nodes gr \\ reachNodes+ gr = execEnv e +jump :: Ref -> Explorer p m c o -> Maybe (Explorer p m c o)+jump r e = case deref e r of+ (Just c) -> return $ e { config = c, currRef = r }+ Nothing -> Nothing toTree :: Explorer p m c o -> Tree (Ref, c) toTree exp = mkTree initialRef@@ -141,14 +201,6 @@ 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) @@ -177,12 +229,13 @@ (x:_) -> x -executionGraph :: Explorer p m c o -> (Ref, [Ref], [((Ref, c), (p, o), (Ref, c))])++executionGraph :: Explorer p m c o -> ((Ref, c), [(Ref, c)], [((Ref, c), (p, o), (Ref, c))]) executionGraph exp = (curr, nodes, edges) where- curr = currRef exp- nodes = map fst (labNodes (execEnv exp))+ curr = (currRef exp, config exp)+ nodes = IntMap.toList $ cmap exp edges = map (\(s, t, p) -> ((s, fromJust $ deref exp s), p, (t, fromJust $ deref exp t)) ) (labEdges (execEnv exp)) {-|@@ -190,16 +243,26 @@ This corresponds to leaves in a tree or nodes without an outbound-edge in a graph. -} leaves :: Explorer p m c o -> [(Ref, c)]-leaves exp = map refToPair leave_nodes+leaves exp = map refToPair leaf_nodes where env = execEnv exp refToPair = \r -> (r, fromJust $ deref exp r)- leave_nodes = nodes $ nfilter (\n -> (==0) $ outdeg env n) env+ leaf_nodes = nodes $ nfilter (\n -> (==0) $ outdeg env n) env toExport :: Explorer p m c o -> (Ref, [(Ref, c)], [(Ref, Ref, (p, o))]) toExport exp = (currRef exp, IntMap.toList $ cmap exp, labEdges $ execEnv exp) 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, currRef = curr, cmap = IntMap.fromList nds, execEnv = mkGraph (map (\(x, _) -> (x, x)) nds) edgs }+fromExport exp (curr, nds, edgs) = exp { genRef = findMax nds,+ config = findCurrentConf curr 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+ Just conf -> conf+ Nothing -> error "no config found"++eqClasses :: Explorer p m c o -> [[Ref]]+eqClasses expl = map snd $ labNodes $ shadowExecEnv expl
Language/Explorer/Pure.hs view
@@ -1,19 +1,17 @@+{-# LANGUAGE ConstraintKinds #-}+ module Language.Explorer.Pure ( Explorer+ , mkExplorer+ , mkExplorerNoSharing , execute , executeAll , revert- , dynamicRevert , ExplorerM.toTree , incomingEdges- , mkExplorerStack- , mkExplorerTree- , mkExplorerGraph- , mkExplorerGSS , config , currRef , Ref- , ExplorerM.initialRef , deref , leaves , getTrace@@ -36,7 +34,14 @@ -- the same. type Ref = ExplorerM.Ref type Explorer a b o = ExplorerM.Explorer a Identity b o+type PureLanguage p c o = (Eq p, Eq o, Monoid o) +mkExplorer :: PureLanguage p c o => Bool -> (c -> c -> Bool) -> (p -> c -> (Maybe c, o)) -> c -> Explorer p c o+mkExplorer shadowing eqfunc definterp initialConf = ExplorerM.mkExplorer shadowing eqfunc (wrap definterp) initialConf++mkExplorerNoSharing :: PureLanguage p c o => (p -> c -> (Maybe c, o)) -> c -> Explorer p c o+mkExplorerNoSharing = mkExplorer False (const . const $ False)+ currRef :: Explorer a b o -> Ref currRef = ExplorerM.currRef @@ -46,24 +51,15 @@ deref :: Explorer p c o -> Ref -> Maybe c deref = ExplorerM.deref -wrap :: (Monad m, Monoid o) => (a -> b -> (Maybe b,o)) -> a -> b -> m (Maybe b, o)+wrap :: (Monad m, Monoid o) => (a -> b -> (Maybe b, o)) -> a -> b -> m (Maybe b, o) wrap def p e = return $ def p e -mkExplorerStack, mkExplorerTree, mkExplorerGraph, mkExplorerGSS:: (Show a, Eq a, Eq b, Monoid o) => (a -> b -> (Maybe 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 :: PureLanguage p c 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 :: PureLanguage p c 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 @@ -82,7 +78,7 @@ 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 :: Explorer p c o -> ((Ref, c), [(Ref, c)], [((Ref, c), (p, o), (Ref, c))]) executionGraph = ExplorerM.executionGraph leaves :: Explorer p c o -> [(Ref, c)]
+ Language/Explorer/Tools/Protocol.hs view
@@ -0,0 +1,451 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MultiParamTypeClasses #-}++++module Language.Explorer.Tools.Protocol where++import GHC.Generics+import Data.Monoid+import Data.Aeson+import Network.HTTP.Types.Status+import Network.HTTP.Types.Header (hContentType)+import Data.Maybe+import Control.Concurrent (forkFinally)+import qualified Control.Exception as E+import Control.Monad (unless, forever, void)+import qualified Data.ByteString.Lazy as S+import qualified Data.Attoparsec.ByteString.Lazy as AB+import qualified Data.Attoparsec.ByteString.Char8 as ABC+import Network.Socket hiding (recv)+import Network.Socket.ByteString.Lazy (recv, sendAll)+import Data.Scientific+import qualified Language.Explorer.Monadic as Ex+import Control.Monad.RWS.Lazy hiding (listen)+import Control.Monad.Trans.Except+import Data.List++type ExplorerParser p m c o = (Ex.Explorer p m c o, String -> Maybe p)+type ProcessResult = Either ErrorMessage Value++type EIP p m c o = RWST (String -> Maybe p) S.ByteString (Ex.Explorer p m c o) m++class ExplorerPostValue p c o where+ postExecute :: Ex.Explorer p m c o -> Ex.Explorer p m c o -> o -> Value+ postExecute = \_ _ _ -> Null+ postJump :: Ex.Explorer p m c o -> Ex.Explorer p m c o -> Value+ postJump = \_ _ -> Null+ postRevert :: Ex.Explorer p m c o -> Ex.Explorer p m c o -> [Ex.Ref] -> Value+ postRevert = \ _ _ _ -> Null++data RequestMessage = RequestMessage {+ jsonrpc :: String,+ req_id :: String,+ method :: String,+ params :: Maybe Value+} deriving (Show, Generic)++instance ToJSON RequestMessage where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON RequestMessage where+ parseJSON = withObject "RequestMessage" $ \v -> RequestMessage+ <$> v .: "jsonrpc"+ <*> v .: "id"+ <*> v .: "method"+ <*> v .:? "params"++data ResponseMessage = ResponseMessage {+ res_id :: String,+ body :: ProcessResult+} deriving (Show)++instance ToJSON ResponseMessage where+ toJSON (ResponseMessage res_id (Left e)) = object ["id" .= res_id, "error" .= e]+ toJSON (ResponseMessage res_id (Right res)) = object ["id" .= res_id, "result" .= res]++ toEncoding (ResponseMessage res_id (Left e)) = pairs ("id" .= res_id <> "error" .= e)+ toEncoding (ResponseMessage res_id (Right res)) = pairs ("id" .= res_id <> "result" .= res)+++data ErrorMessage = ErrorMessage {+ code :: Int,+ message :: String,+ error_data :: Maybe Value+} deriving (Show, Generic)++instance ToJSON ErrorMessage where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON ErrorMessage+ -- No need to provide a parseJSON implementation.++-- instance Except ErrorMessage +-- where+-- noMsg = ErrorMessage { code = 0, message = "", error_data = Nothing}+-- strMsg msg = ErrorMessage {code = 0, message = msg, error_data = Nothing }++data JumpParams = JumpParams {+ jump_ref :: Int+}++instance FromJSON JumpParams where+ parseJSON = withObject "JumpParams" $ \v -> JumpParams+ <$> v .: "reference"++data JumpResult = JumpResult {+ jump_post :: Value+}++instance ToJSON JumpResult where + toJSON res = object ["post" .= jump_post res]++data ExecuteParams = ExecuteParams {+ program :: String+} deriving (Show, Generic)++instance FromJSON ExecuteParams++data ExecuteResult = ExecuteResult {+ exec_ref :: Int,+ exec_out :: Value,+ exec_post :: Value+}++instance ToJSON ExecuteResult where+ toJSON (ExecuteResult ref out post) = object ["reference" .= ref, "output" .= out, "post" .= post]++ toEncoding (ExecuteResult ref out post) = pairs ("reference" .= ref <> "output" .= out <> "post" .= post)++data RevertParams = RevertParams {+ revert_ref :: Int+}++instance FromJSON RevertParams where+ parseJSON = withObject "RevertParams" $ \v -> RevertParams+ <$> v .: "reference"++data RevertResult = RevertResult {+ revert_deleted :: [Ex.Ref],+ post_revert :: Value+}++instance ToJSON RevertResult where + toJSON res = object ["deleted" .= revert_deleted res, "post" .= post_revert res]++data DerefParams = DerefParams {+ deref_ref :: Int+}++instance FromJSON DerefParams where+ parseJSON = withObject "DerefParams" $ \v -> DerefParams+ <$> v .: "reference"+++data TraceParams = TraceParams {+ reference :: Int+} deriving (Generic)++instance FromJSON TraceParams+++data Edge = Edge {+ source :: Int,+ target :: Int,+ label :: EdgeLabel+} deriving (Generic)++instance ToJSON Edge where+ toEncoding = genericToEncoding defaultOptions+++data EdgeLabel = EdgeLabel {+ program :: Value,+ mval :: Value+} deriving (Generic)++instance ToJSON EdgeLabel where+ toEncoding = genericToEncoding defaultOptions+++data ExecutionTree = ExecutionTree {+ current :: Int,+ references :: [Int],+ edges :: [Edge]+} deriving (Generic)++instance ToJSON ExecutionTree where+ toEncoding = genericToEncoding defaultOptions++data PathParams = PathParams {+ source :: Int,+ target :: Int+} deriving (Generic)++instance FromJSON PathParams++parseErrorCode = -32700+invalidRequestCode = -32600+methodNotFoundCode = -32601+invalidParamsCode = -32602+internalErrorCode = -32603++referenceNotInTreeCode = 1+referenceRevertInvalidCode = 2+programParseErrorCode = 3+pathNonExistingCode = 4++++parseError :: ErrorMessage+parseError = ErrorMessage {+ code = parseErrorCode,+ message = "Parse error",+ error_data = Nothing+}++methodNotFound :: ErrorMessage+methodNotFound = ErrorMessage {+ code = methodNotFoundCode,+ message = "Method not found",+ error_data = Nothing+}++invalidParams :: ErrorMessage+invalidParams = ErrorMessage {+ code = invalidParamsCode,+ message = "Invalid method parameter(s)",+ error_data = Nothing+}++ensureParameter :: Monad m => Maybe Value -> ExceptT ErrorMessage (EIP p m c o) Value+ensureParameter Nothing = throwE invalidParams+ensureParameter (Just v) = return v++fromResult :: Monad m => Result a -> Value -> ExceptT ErrorMessage (EIP p m c o) Value+fromResult res onSuccess = case res of+ (Error e) -> throwE invalidParams+ (Success v) -> return onSuccess++jump :: (Monad m, ExplorerPostValue p c o) => Value -> ExceptT ErrorMessage (EIP p m c o) Value+jump v = case (fromJSON v) :: Result JumpParams of+ (Error e) -> throwE invalidParams+ (Success v') -> do+ ex <- lift $ get+ case Ex.jump (jump_ref v') ex of+ Just ex' -> do+ lift $ put $ ex'+ return . toJSON . JumpResult $ postJump ex ex'+ Nothing -> throwE ErrorMessage { code = referenceNotInTreeCode, message = "", error_data = Nothing }++execute :: (Eq o, Monoid o, ToJSON o, Eq p, ExplorerPostValue p c o) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value+execute v = case (fromJSON v) :: Result ExecuteParams of+ (Error e) -> throwE invalidParams+ (Success v') -> do+ parser <- lift $ ask+ let pl = parser $ program (v' :: ExecuteParams)+ case pl of+ Just prog -> do+ ex <- lift $ get+ (ex', output) <- liftIO $ Ex.execute prog ex+ lift $ put ex'+ return $ toJSON $ ExecuteResult { exec_ref = Ex.currRef ex', exec_out = toJSON output, exec_post = postExecute ex ex' output }+ Nothing -> throwE ErrorMessage { code = programParseErrorCode, message = "", error_data = Nothing }++allRefs :: Ex.Explorer p IO c o -> [(Ex.Ref, c)]+allRefs ex = refs+ where+ (_, refs, _) = Ex.executionGraph ex+++revert :: (Eq o, Monoid o, Eq p, ExplorerPostValue p c o) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value+revert v = case (fromJSON v) :: Result RevertParams of+ (Error e) -> throwE invalidParams+ (Success v) -> do+ ex <- lift $ get+ case Ex.revert (revert_ref v) ex of+ Just ex' -> do+ lift $ put ex'+ return $ toJSON $ RevertResult { revert_deleted = deleted, post_revert = postRevert ex ex' deleted}+ where + refs = map fst (allRefs ex)+ refs' = map fst (allRefs ex')+ deleted = (refs \\ refs')+ Nothing -> throwE ErrorMessage { code = referenceRevertInvalidCode, message = "", error_data = Nothing }++deref :: (Eq o, Monoid o, Eq p, ToJSON c) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value+deref v = case (fromJSON v) :: Result DerefParams of+ (Error e) -> throwE invalidParams+ (Success v) -> do+ ex <- lift $ get+ case Ex.deref ex (deref_ref v) of+ (Just conf) -> return $ toJSON conf+ Nothing -> throwE ErrorMessage { code = referenceNotInTreeCode, message = "", error_data = Nothing}++executionTree :: (ToJSON o, ToJSON p) => ExceptT ErrorMessage (EIP p IO c o) Value+executionTree = do+ ex <- lift $ get+ let (curr, nodes, edges) = Ex.executionGraph ex+ return $ toJSON $ ExecutionTree + { current = fst curr+ , references = map fst nodes+ , edges = map (\(s, (p, o), t) -> Edge { source = fst s+ , label = EdgeLabel { program = toJSON p, mval = toJSON o}+ , target = fst t} ) edges}++getCurrentReference :: ExceptT ErrorMessage (EIP p IO c o) Value+getCurrentReference = do+ ex <- lift $ get+ return $ toJSON $ Ex.currRef ex++getAllReferences :: ExceptT ErrorMessage (EIP p IO c o) Value+getAllReferences = do+ ex <- lift $ get+ return $ toJSON $ map fst (allRefs ex)++getTrace :: (ToJSON p, ToJSON o) => Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value+getTrace (Just r) = case (fromJSON r) :: Result TraceParams of+ (Error e) -> throwE invalidParams+ (Success v) -> do+ ex <- lift $ get+ let path = Ex.getPathFromTo ex 1 (reference (v :: TraceParams)) -- Fix hardcode 1(it's initialRef).+ return $ toJSON $ map (\(s, (p, o), t) -> Edge { source = fst s, target = fst t, label = EdgeLabel { program = toJSON p, mval = toJSON o} }) path+getTrace Nothing = do+ ex <- lift $ get+ let trace = Ex.getTrace ex+ return $ toJSON $ map (\(s, (p, o), t) -> Edge { source = fst s, target = fst t, label = EdgeLabel { program = toJSON p, mval = toJSON o} }) trace++getPath :: (ToJSON o, ToJSON p) => Value -> ExceptT ErrorMessage (EIP p IO c o) Value+getPath val = case (fromJSON val) :: Result PathParams of+ (Error e) -> throwE ErrorMessage { code = pathNonExistingCode, message = "", error_data = Nothing}+ (Success v) -> do+ ex <- lift $ get+ let path = Ex.getPathFromTo ex (source (v :: PathParams)) (target (v :: PathParams))+ return $ toJSON $ map (\(s, (p, o), t) -> Edge { source = fst s, target = fst t, label = EdgeLabel { program = toJSON p, mval = toJSON o} }) path++getLeaves :: ExceptT ErrorMessage (EIP p IO c o) Value+getLeaves = do+ ex <- lift $ get+ return $ toJSON $ map fst (Ex.leaves ex)++methodDispatch :: (Eq o, Monoid o, ToJSON o, ToJSON p, Eq p, ToJSON c, ExplorerPostValue p c o) => String -> Maybe Value -> ExceptT ErrorMessage (EIP p IO c o) Value+methodDispatch "jump" mval = ensureParameter mval >>= jump+methodDispatch "execute" mval = ensureParameter mval >>= execute+methodDispatch "revert" mval = ensureParameter mval >>= revert+methodDispatch "deref" mval = ensureParameter mval >>= deref+methodDispatch "getTrace" mval = getTrace mval+methodDispatch "getPath" mval = ensureParameter mval >>= getPath+methodDispatch "getExecutionTree" _ = executionTree+methodDispatch "getCurrentReference" _ = getCurrentReference+methodDispatch "getAllReferences" _ = getAllReferences+methodDispatch "getLeaves" _ = getLeaves+methodDispatch _ _ = throwE methodNotFound++handleRequest :: (Eq o, Monoid o, ToJSON o, ToJSON o, ToJSON p, Eq p, ToJSON c, ExplorerPostValue p c o) => Maybe RequestMessage -> EIP p IO c o ResponseMessage+handleRequest (Just msg) = do+ res <- runExceptT $ methodDispatch (method msg) (params msg)+ return $ ResponseMessage { res_id = req_id msg, body = res }+handleRequest Nothing = return $ ResponseMessage { res_id = "0", body = Left parseError { message = "NOthing" }}+++handleRequest' :: (Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c, ExplorerPostValue p c o) => S.ByteString -> EIP p IO c o ResponseMessage+handleRequest' body =+ case decode body of+ (Just m) -> handleRequest m+ Nothing -> return invalidHeader++invalidHeader :: ResponseMessage+invalidHeader = ResponseMessage { res_id = "0", body = Left parseError {message = "Headeer"} }++parseHeader :: AB.Parser (Int, String)+parseHeader = do+ AB.string "Content-Length:"+ AB.skipMany (ABC.char ' ')+ res <- ABC.scientific+ AB.skipMany (ABC.char ' ')+ ABC.char '\r'+ ABC.char '\n'+ ABC.string "Content-Type:"+ AB.skipMany (ABC.char ' ')+ typ <- AB.manyTill ABC.letter_ascii (ABC.char '\r')+ AB.skipMany (ABC.char ' ')+ ABC.char '\n'+ ABC.char '\r'+ ABC.char '\n'+ return $ (fromJust $ ((toBoundedInteger res) :: Maybe Int), typ)+++intProg :: Int -> Int -> IO (Maybe Int, ())+intProg x y = do+ putStrLn . show $ y+ return (Just x, ())++intParse :: String -> Maybe Int+intParse _ = Just 1++-- TODO: Handle incorrect request.+-- TODO: Send correct error messages.+serve :: (Eq o, Monoid o, ToJSON o, Eq p, ToJSON p, ToJSON c, ExplorerPostValue p c o) => String -> Ex.Explorer p IO c o -> (String -> Maybe p) -> IO ()+serve port ex parser = withSocketsDo $ do+ addr <- resolve port+ E.bracket (open addr) close loop+ where+ resolve port = do+ let hints = defaultHints {+ addrFlags = [AI_PASSIVE]+ , addrSocketType = Stream+ }+ addr:_ <- getAddrInfo (Just hints) Nothing (Just port)+ return addr+ open addr = do+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ setSocketOption sock ReuseAddr 1+ bind sock (addrAddress addr)+ -- If the prefork technique is not used,+ -- set CloseOnExec for the security reasons.+ fd <- fdSocket sock+ setCloseOnExecIfNeeded fd+ listen sock 10+ return sock+ loop sock = forever $ do+ (conn, peer) <- accept sock+ putStrLn $ "Connection from " ++ show peer+ forkFinally (talk ex parser conn) (\_ -> close conn)+ talk ex parser conn = do+ putStrLn "Hello receiving"+ msg <- recv conn 1024+ unless (S.null msg) $ do+ ex' <- acceptCommand ex parser conn msg+ talk ex' parser conn++acceptCommand ex parser conn command = do+ let res = AB.parse parseHeader command+ putStrLn $ show res+ (result, toParse) <- case res of+ (AB.Done rem (val, _)) -> do+ case S.length rem < (fromIntegral val) of+ True -> do+ msg <- recv conn 1024+ return (Nothing, S.append command msg)+ False -> do+ let command = S.take (fromIntegral val) rem+ putStrLn "-------------------------"+ putStrLn $ show command+ putStrLn "-------------------------"+ out <- runRWST (handleRequest' command) parser ex+ return (Just out, S.drop (fromIntegral val) rem)+ (AB.Fail _ _ "not enough input") -> do+ msg <- recv conn 1024+ return (Nothing, S.append command msg)+ _ -> return (Just (invalidHeader, ex, ""), "")+ case result of+ Nothing -> if toParse == "" then return ex else acceptCommand ex parser conn toParse+ Just (resp, ex', log) -> do+ let encoded_resp = encode resp+ let full_resp = S.concat ["Content-Length:", encode $ S.length encoded_resp, "\r\nContent-Type: jrpcei\r\n\r\n", encoded_resp]+ sendAll conn full_resp+ putStrLn $ show full_resp+ putStrLn $ show toParse+ if toParse == "" then return ex' else acceptCommand ex' parser conn toParse
+ Language/Explorer/Tools/REPL.hs view
@@ -0,0 +1,72 @@+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 Data.Tree (drawTree)+import Data.Maybe (fromJust, isNothing)+import Data.Char (isSpace)+import Data.List (find, isPrefixOf) +import Text.Read (readMaybe)+import Control.Arrow (Arrow(first))++++type MetaTable p m c o = [(String, String -> Explorer p m c o -> m (Explorer p m c o))]+type RParser p c = String -> c -> Maybe p+type Prompt p m c o = Explorer p m c o -> String+type MetaHandler p m c o = String -> Explorer p m c o -> m (Explorer p m c o)+type OutputHandler m o = o -> m ()+type Repl p m c o = Prompt p m c o -> RParser p c -> String -> MetaTable p m c o -> MetaHandler p m c o -> OutputHandler m o -> Explorer p m c o -> m ()+++handleJump :: MonadIO m => String -> Explorer p m c o -> m (Explorer p m c o)+handleJump input ex = case readMaybe (dropWhile isSpace input) of+ (Just ref_id) -> case jump ref_id ex of+ (Just ex') -> return ex'+ Nothing -> liftIO $ putStrLn "Given reference is not in the exploration tree." >> return ex+ Nothing -> liftIO $ putStrLn "the jump command requires an integer argument." >> return ex++handleRevert :: MonadIO m => MetaHandler p m c o+handleRevert input ex = case readMaybe (dropWhile isSpace input) of+ (Just ref_id) -> case revert ref_id ex of+ (Just ex') -> do+ liftIO $ putStrLn "reverting"+ return ex'+ Nothing -> liftIO $ putStrLn "Given reference is not valid for reverting." >> return ex+ Nothing -> liftIO $ putStrLn "the jump command requires an integer argument." >> return ex++handleTree :: MonadIO m => MetaHandler p m c o+handleTree input ex = do+ liftIO $ putStrLn . drawTree $ fmap (show . fst) (toTree ex)+ return ex++metaTable :: MonadIO m => [(String, String -> Explorer p m c o -> m (Explorer p m c o))]+metaTable = [+ ("jump", handleJump),+ ("revert", handleRevert),+ ("tree", handleTree)]++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
examples/Whilelang.hs view
@@ -2,6 +2,7 @@ import qualified Data.Map as Map import Data.List+import Data.Maybe import Data.Graph.Inductive (emap) import Control.Monad.Trans.Writer.Lazy import Control.Monad.Trans.State.Lazy@@ -135,49 +136,63 @@ 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 + 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 (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 (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+start = return whileExplorer -startM :: IO WhileExplorerM-startM = return whileGraphM+-- startM :: IO WhileExplorerM+-- startM = return whileTree -startO :: WhileExplorerO-startO = whileGraphO+-- startO :: WhileExplorerO+-- startO = whileGraphO session1 :: IO WhileExplorer session1 = start >>=- do_ (assign "x" (intToExpr 1)) >>= - do_ (assign "y" (Id "x")) >>= - do_ (Print (Id "y"))+ do_ (assign "x" (intToExpr 1)) >>=+ do_ (assign "y" (Id "x")) >>=+ do_ (assign "x" (intToExpr 1)) >>=+ do_ (Print (Id "y")) >>=+ do_ (Print (Id "x")) . fromJust . EM.jump 2 >>=+ do_ (assign "z" (intToExpr 100)) >>=+ do_ (Print (Id "z")) --- 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"))+sessionS :: IO WhileExplorer+sessionS = start >>=+ do_ (assign "x" (intToExpr 1)) >>=+ do_ (assign "y" (Id "x")) >>=+ do_ (assign "x" (intToExpr 1)) >>=+ do_ (assign "z" (intToExpr 20)) >>=+ do_ (assign "y" (Id "x")) -session3 :: (WhileExplorerO, [String])-session3 =- do_3 (Print (Id "y")) $ do_3 (assign "y" (Id "x")) $ do_3 (assign "x" (intToExpr 1)) (startO, []) +-- -- 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))@@ -214,20 +229,8 @@ wseq :: Command -> Command -> Command wseq = Seq -whileGraph :: WhileExplorer-whileGraph = E.mkExplorerGraph definterp initialConfig--whileGraphM :: WhileExplorerM-whileGraphM = EM.mkExplorerGraph (\p c -> (\c -> (Just 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+whileExplorer :: WhileExplorer+whileExplorer = E.mkExplorer True (==) 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"))))
exploring-interpreters.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.10 name: exploring-interpreters-version: 0.4.0.0+version: 1.0.0.0 synopsis: A generic exploring interpreter for exploratory programming -- synopsis: -- description:@@ -22,7 +22,9 @@ library exposed-modules: Language.Explorer.Monadic,- Language.Explorer.Pure+ Language.Explorer.Pure,+ Language.Explorer.Tools.REPL,+ Language.Explorer.Tools.Protocol other-modules: Language.Explorer.Basic -- other-extensions:@@ -31,7 +33,15 @@ containers >=0.5 && <0.7, fgl >= 5.7.0 && < 5.8, transformers >= 0.5.2 && < 0.6,- mtl >= 2.2.1 && < 2.3+ mtl >= 2.2.1 && < 2.3,+ aeson >= 1.5.6 && < 1.6,+ attoparsec >= 0.14.1 && < 0.15,+ bytestring >= 0.10.10 && < 0.11,+ scientific >= 0.3.7 && < 0.4,+ 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 -- hs-source-dirs: default-language: Haskell2010