funcons-tools 0.2.0.9 → 0.2.0.10
raw patch · 8 files changed
+153/−27 lines, 8 filesdep +exploring-interpretersdep +readlinedep ~containersdep ~funcons-valuesnew-component:exe:funcons-repl
Dependencies added: exploring-interpreters, readline
Dependency ranges changed: containers, funcons-values
Files
- funcons-tools.cabal +10/−6
- src/Funcons/Explorer.hs +119/−0
- src/Funcons/GLLParser.hs +10/−0
- src/Funcons/MSOS.hs +1/−1
- src/Funcons/Parser.hs +2/−2
- src/Funcons/Simulation.hs +7/−5
- src/Main.hs +0/−13
- src/REPL.hs +4/−0
funcons-tools.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: funcons-tools-version: 0.2.0.9+version: 0.2.0.10 synopsis: A modular interpreter for executing funcons description: The PLanCompS project (<http://plancomps.org>) has developed a component-based approach to formal semantics.@@ -45,7 +45,7 @@ , Funcons.RunOptions build-depends: base >=4.8 && <= 5 ,text >= 1.2- ,containers >= 0.5 && <= 0.6.0.1+ ,containers >= 0.5 && < 0.7 ,vector>=0.12 ,bv >= 0.5 ,multiset >= 0.3@@ -57,6 +57,7 @@ ,regex-applicative ,random-strings ,funcons-values >= 0.1.0.5+ ,readline >= 1.0.3.0 hs-source-dirs: src, cbs, manual default-language: Haskell2010 other-extensions: OverloadedStrings@@ -136,12 +137,12 @@ , Funcons.Core.Values.TypesBuiltin , Funcons.Core.Computations.TypesBuiltin -executable runfct- main-is: Main.hs+executable funcons-repl + main-is: REPL.hs other-extensions: OverloadedStrings build-depends: base >=4.8 && <= 5 ,text >= 1.2- ,containers >= 0.5 && <= 0.6.0.1+ ,containers >= 0.5 && < 0.7 ,vector>=0.12 ,bv >= 0.5 ,funcons-tools@@ -154,6 +155,8 @@ ,regex-applicative ,random-strings ,funcons-values >= 0.1.0.5+ ,exploring-interpreters >= 0.3.0.0+ ,readline >= 1.0.3.0 hs-source-dirs: src, manual, cbs default-language: Haskell2010 -- ghc-options: -rtsopts@@ -176,6 +179,7 @@ Funcons.Core.Computations.Normal.Linking.Linking Funcons.Core.Computations.Normal.Storing.Storing Funcons.Core.Computations.TypesBuiltin+ Funcons.Core Funcons.Core.Library Funcons.Core.Manual Funcons.Core.Values.Abstraction.Functions.Functions@@ -230,4 +234,4 @@ Funcons.Tools Funcons.TypeSubstitution Funcons.Types-+ Funcons.Explorer
+ src/Funcons/Explorer.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, LambdaCase #-}++module Funcons.Explorer where++import qualified Language.Explorer.Monadic as EI++import Funcons.EDSL hiding (isMap)+import Funcons.Operations (isMap, Values(Map)) +import Funcons.MSOS+import Funcons.RunOptions+import Funcons.Core+import Funcons.Core.Library+import Funcons.Core.Manual+import Funcons.Entities+import Funcons.Tools+import Funcons.Parser+import Funcons.Printer++import Control.Monad (forM_)+import Data.IORef+import qualified Data.Map as M+import Data.Char (isSpace)+import Data.Tree (drawTree)+import Text.Read (readMaybe)++import System.Console.Readline+import System.Environment+import System.IO++data Config = Config {+ reader :: MSOSReader IO+ , state :: MSOSState IO + }+ deriving (Eq)++type Explorer = EI.Explorer Funcons IO Config ()++handle_revert :: EI.Ref -> Explorer -> IO Explorer+handle_revert r exp =+ case EI.revert r exp of+ Just e -> return e+ Nothing -> putStrLn "Invalid reference for revert" >> return exp++repl :: IO ()+repl = getArgs >>= mk_explorer >>= repl'+ where + repl' exp = do+ hFlush stdout+ readline ("#" ++ show (EI.currRef exp) ++ " > ") >>= \case + Nothing -> return ()+ Just input -> do+ addHistory input + case break isSpace input of+ (":session", _) -> do+ (putStrLn . drawTree . fmap (show . fst) . EI.toTree) exp+ repl' exp+ (":revert", mint) | Just ref_id' <- readMaybe (dropWhile isSpace mint)+ -> handle_revert ref_id' exp >>= repl'+ | otherwise -> putStrLn "Revert requires an integer argument" >> repl' exp+ _ -> case fct_parse_either input of + Left err -> putStrLn err >> repl' exp + Right fct -> EI.execute fct exp >>= (repl' . fst)++ +mk_explorer :: [String] -> IO Explorer +mk_explorer args = do+ (opts, unknown_opts) <- run_options args+ forM_ unknown_opts $ \arg -> do+ putStrLn ("unknown option: " ++ arg) + opts_ref <- newIORef opts + cfg <- mk_initial_config library entities typeenv opts+ return $ EI.mkExplorerTree (\f c -> (\c -> (c, ())) <$> def_interpreter opts_ref f c) cfg+ where+ library = libUnions [ Funcons.Core.Library.funcons, Funcons.EDSL.library, Funcons.Core.Manual.library ]+ entities = Funcons.Core.Library.entities + typeenv = Funcons.Core.Library.types++mk_initial_config :: FunconLibrary -> EntityDefaults -> TypeRelation -> RunOptions -> IO Config+mk_initial_config lib defaults tyenv opts = do+ let msos_ctxt = MSOSReader (RewriteReader lib tyenv opts f0 f0) emptyINH emptyDCTRL (fread (string_inputs opts))+ ((e_exc_f, mut, wr), rem_ins) <- + fexec (runMSOS (setEntityDefaults defaults (stepTrans opts 0 (toStepRes f0)))+ msos_ctxt (emptyMSOSState {inp_es = M.empty})) (inputValues opts)+ return $ Config { reader = init msos_ctxt, state = mut }+ where f0 = initialise_binding_ [initialise_storing_ [map_empty_ []]]+ init msos_reader = msos_reader {inh_entities = M.insert "environment" [Map M.empty] (inh_entities msos_reader) }++def_interpreter :: IORef RunOptions -> Funcons -> Config -> IO (Maybe Config)+def_interpreter opts_ref f0' cfg = do+ let f0 = give_ [f0', + give_ [if_else_ [is_ [given_, environments_], given_+ ,if_else_ [is_ [given_, null_type_], given_+ ,bind_ [Funcons.EDSL.string_ "it", given_]]]+ ,if_else_ [is_ [given_, null_type_], given_+ ,sequential_ [print_ [given_,Funcons.EDSL.string_ "\n"], given_]]]]+ opts <- readIORef opts_ref+ let msos_ctxt = (reader cfg) { ereader = (ereader (reader cfg)) { local_fct = f0, global_fct = f0 } }+ (e_exc_f, mut, wr) <- runMSOS (stepTrans opts 0 (toStepRes f0)) msos_ctxt (state cfg)+ case e_exc_f of+ Left ie -> putStrLn (showIException ie) >> return Nothing + Right (Left fct) -> return $ Just $ cfg { state = mut } -- did not yield an environment+ Right (Right efvs) -> case filter isMap efvs of+ [] -> return $ Just $ cfg { state = mut }+ [env] -> return $ Just $ cfg { reader = accumulate (reader cfg) env, state = mut } + _ -> putStrLn ("multiple environments computed") >> return Nothing+ where accumulate msos_reader env = msos_reader { inh_entities = M.update override "environment" (inh_entities msos_reader) }+ where override [old_env] = case (env, old_env) of + (Map m1, Map m2) -> Just [Map (M.union m1 m2)] + _ -> Nothing+ override _ = Nothing++-- assumes all components of RewriteReader do not change per session+instance Eq (MSOSReader IO) where+ r1 == r2 = inh_entities r1 == inh_entities r2 + && dctrl_entities r1 == dctrl_entities r2++-- assumes input is not used // does not change per session+instance Eq (MSOSState IO) where+ s1 == s2 = mut_entities s1 == mut_entities s2
src/Funcons/GLLParser.hs view
@@ -15,6 +15,13 @@ fct_parse :: String -> Funcons fct_parse = parser_a pFuncons +fct_parse_either :: String -> Either String Funcons+fct_parse_either s = case parsesWithErrors pFuncons s of+ Left err -> Left err+ Right [] -> Left "no parse result"+ Right [f] -> Right f+ Right fs -> Left "ambiguous parse result"+ fvalue_parse :: String -> Funcons fvalue_parse = FValue . fvalue_parse_ @@ -33,6 +40,9 @@ allParses :: Parser a -> String -> [a] allParses p string = GLL.Combinators.parseWithOptions [throwErrors] p (Funcons.GLLParser.lexer string) ++parsesWithErrors :: Parser a -> String -> Either String [a]+parsesWithErrors p string = GLL.Combinators.parseWithOptionsAndError [] p (Funcons.GLLParser.lexer string) fct_lexerSettings = emptyLanguage { lineComment = "//"
src/Funcons/MSOS.hs view
@@ -174,7 +174,7 @@ Just f -> Right f _ -> case M.lookup key (builtin_funcons (run_opts ctxt)) of Just f -> Right (NullaryFuncon (rewriteTo f))- _ -> error ("unknown funcon: "++ unpack key)+ _ -> Left (evalctxt2exception (Internal ("unknown funcon: "++ unpack key)) ctxt) , st, mempty) ---------------------------------------------------------------------------
src/Funcons/Parser.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Funcons.Parser (fct_parse, fvalue_parse) where+module Funcons.Parser (fct_parse, fct_parse_either, fvalue_parse) where -import Funcons.GLLParser (fct_parse, fvalue_parse)+import Funcons.GLLParser (fct_parse, fct_parse_either, fvalue_parse)
src/Funcons/Simulation.hs view
@@ -10,7 +10,7 @@ import Control.Applicative import Control.Monad.State-import System.IO (hFlush,stdout)+import System.Console.Readline import qualified Data.Map as M import Data.Text (unpack) @@ -22,12 +22,14 @@ instance Interactive IO where fexec ma _ = (,M.empty) <$> ma - fread str_inp nm = (case nm of- "standard-in" -> putStr "\n> " >> hFlush stdout- _ -> putStrLn ("Please provide input for " ++ unpack nm ++ ":"))- >> getLine >>= return . toFuncon+ fread str_inp nm = do+ mLine <- readline prompt + case mLine of Nothing -> return (string_ "")+ Just s -> addHistory s >> return (toFuncon s) where toFuncon str | str_inp = string_ str | otherwise = fvalue_parse str+ prompt | nm == "standard-in" = "\n> "+ | otherwise = "Please provide input for " ++ unpack nm ++ ":" fprint _ v | isString_ v = putStr (unString v) | otherwise = putStr (showValues v)
− src/Main.hs
@@ -1,13 +0,0 @@--module Main where--import Funcons.EDSL-import Funcons.Tools -import Funcons.Core.Manual as Manual--import qualified Data.Map as M--main :: IO ()-main = mkMain--
+ src/REPL.hs view
@@ -0,0 +1,4 @@++import Funcons.Explorer++main = repl