diff --git a/funcons-tools.cabal b/funcons-tools.cabal --- a/funcons-tools.cabal +++ b/funcons-tools.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: funcons-tools -version: 0.2.0.11 +version: 0.2.0.13 synopsis: A modular interpreter for executing funcons description: The PLanCompS project () has developed a component-based approach to formal semantics. @@ -56,7 +56,7 @@ ,TypeCompose>=0.9.10 ,regex-applicative ,random-strings - ,funcons-values >= 0.1.0.5 + ,funcons-values >= 0.1.0.9 ,haskeline >= 0.8.1.2 hs-source-dirs: src, cbs, manual default-language: Haskell2010 @@ -153,7 +153,7 @@ ,TypeCompose>=0.9.10 ,regex-applicative ,random-strings - ,funcons-values >= 0.1.0.5 + ,funcons-values >= 0.1.0.9 ,exploring-interpreters >= 0.3.0.0 ,haskeline >= 0.8.1 ,transformers >= 0.5.6 diff --git a/manual/Funcons/Core/Manual.hs b/manual/Funcons/Core/Manual.hs --- a/manual/Funcons/Core/Manual.hs +++ b/manual/Funcons/Core/Manual.hs @@ -1,7 +1,7 @@ module Funcons.Core.Manual ( Funcons.Core.Manual.library , module Funcons.Core.Computations.Normal.GeneratingBuiltin - , module Funcons.Core.Computations.AbnormalBuiltin +-- , module Funcons.Core.Computations.AbnormalBuiltin , module Funcons.Core.Values.Composite.SetsBuiltin , module Funcons.Core.Values.Composite.MultisetsBuiltin -- , module Funcons.Core.Values.Composite.ListsBuiltin diff --git a/manual/Funcons/Core/Values/Primitive/StringsBuiltin.hs b/manual/Funcons/Core/Values/Primitive/StringsBuiltin.hs --- a/manual/Funcons/Core/Values/Primitive/StringsBuiltin.hs +++ b/manual/Funcons/Core/Values/Primitive/StringsBuiltin.hs @@ -3,7 +3,6 @@ module Funcons.Core.Values.Primitive.StringsBuiltin where import Funcons.EDSL -import Funcons.Types hiding (stepTo_String, to_string_) import qualified Funcons.Operations as VAL library = libFromList [ diff --git a/src/Funcons/Explorer.hs b/src/Funcons/Explorer.hs --- a/src/Funcons/Explorer.hs +++ b/src/Funcons/Explorer.hs @@ -16,11 +16,12 @@ import Funcons.Parser import Funcons.Printer -import Control.Monad (forM_) +import Control.Monad (forM_, mapM_) import Data.IORef import qualified Data.Map as M import Data.Char (isSpace) import Data.Tree (drawTree) +import Data.Text (pack) import Text.Read (readMaybe) import Control.Monad.Trans.Class (lift) @@ -44,13 +45,23 @@ Nothing -> putStrLn "Invalid reference for revert" >> return exp repl :: IO () -repl = getArgs >>= mk_explorer >>= (runInputT defaultSettings . repl') +repl = display_help >> getArgs >>= mk_explorer >>= (runInputT defaultSettings . repl') where repl' exp = do getInputLine ("#" ++ show (EI.currRef exp) ++ " > ") >>= \case Nothing -> return () Just input -> do case break isSpace input of + (":help",_) -> lift display_help >> repl' exp + (":h",_) -> lift display_help >> repl' exp + (":quit",_) -> return () + (":q",_) -> return () + (":env",_) -> lift (display_environment (EI.config exp)) >> repl' exp + (":environment",_)-> lift (display_environment (EI.config exp)) >> repl' exp + (":store",_) -> lift (display_mut_entity (EI.config exp) "store") >> repl' exp + (":sto",_) -> lift (display_mut_entity (EI.config exp) "store") >> repl' exp + (":mut", rest) -> lift (display_mut_entity (EI.config exp) (dropWhile isSpace rest)) >> repl' exp + (":mutable", rest)-> lift (display_mut_entity (EI.config exp) (dropWhile isSpace rest)) >> repl' exp (":session", _) -> do (outputStrLn . drawTree . fmap (show . fst) . EI.toTree) exp repl' exp @@ -117,3 +128,26 @@ -- assumes input is not used // does not change per session instance Eq (MSOSState IO) where s1 == s2 = mut_entities s1 == mut_entities s2 + +display_environment :: Config -> IO () +display_environment cfg = + mapM_ (putStrLn . showValues) (inh_entities (reader cfg) M.! "environment") + +display_mut_entity :: Config -> String -> IO () +display_mut_entity cfg ent = + case M.lookup (pack ent) (mut_entities (state cfg)) of + Nothing -> putStrLn ("unknown mutable entity: " ++ ent) + Just v -> putStrLn $ showValues v + +display_help :: IO () +display_help = + putStrLn "Available commands:\n\ + \ :environment :env show the active bindings from identifiers to values\n\ + \ :store :sto show the store with assignments to references\n\ + \ :mutable :mut show the mutable entity with name \n\ + \ :session displays the explored traces in the form of a tree\n\ + \ with nodes labelled by state identifiers\n\ + \ :revert revert to the state with id \n\ + \ :help :h show these commands\n\ + \ :quit :q end the exploration\n\ + \ or just type a funcon term" diff --git a/src/Funcons/GLLParser.hs b/src/Funcons/GLLParser.hs --- a/src/Funcons/GLLParser.hs +++ b/src/Funcons/GLLParser.hs @@ -25,9 +25,19 @@ fvalue_parse :: String -> Funcons fvalue_parse = FValue . fvalue_parse_ +fvalue_parse_either :: String -> Either String Funcons +fvalue_parse_either = fmap FValue . fvalue_parse_either_ + fvalue_parse_ :: String -> Values fvalue_parse_ = parser_a pValues +fvalue_parse_either_ :: String -> Either String Values +fvalue_parse_either_ str = case parsesWithErrors pValues str of + Left err -> Left err + Right [] -> Left "no parse result" + Right [f] -> Right f + Right fs -> Left "ambiguous parse result" + parse :: Parser a -> String -> a parse p str = case allParses p str of [] -> error "no parse" (a:_) -> a @@ -42,7 +52,9 @@ (Funcons.GLLParser.lexer string) parsesWithErrors :: Parser a -> String -> Either String [a] -parsesWithErrors p string = GLL.Combinators.parseWithOptionsAndError [] p (Funcons.GLLParser.lexer string) +parsesWithErrors p string = case (Funcons.GLLParser.lexerEither string) of + Left err -> Left err + Right ts -> GLL.Combinators.parseWithOptionsAndError [] p ts fct_lexerSettings = emptyLanguage { lineComment = "//" @@ -52,6 +64,7 @@ } lexer = GLL.Combinators.lexer fct_lexerSettings +lexerEither = GLL.Combinators.lexerEither fct_lexerSettings fct_keywords = ["void", "depends", "forall", "type_abs" ,"typevar", "?", "*", "+", "|->", "=>"] diff --git a/src/Funcons/Parser.hs b/src/Funcons/Parser.hs --- a/src/Funcons/Parser.hs +++ b/src/Funcons/Parser.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Funcons.Parser (fct_parse, fct_parse_either, fvalue_parse) where +module Funcons.Parser (fct_parse, fct_parse_either, fvalue_parse, fvalue_parse_either) where -import Funcons.GLLParser (fct_parse, fct_parse_either, fvalue_parse) +import Funcons.GLLParser (fct_parse, fct_parse_either, fvalue_parse, fvalue_parse_either) diff --git a/src/Funcons/Simulation.hs b/src/Funcons/Simulation.hs --- a/src/Funcons/Simulation.hs +++ b/src/Funcons/Simulation.hs @@ -5,7 +5,7 @@ import Funcons.Types import Funcons.Exceptions import Funcons.Printer -import Funcons.Parser (fvalue_parse) +import Funcons.Parser (fvalue_parse_either) import Funcons.RunOptions import Control.Applicative @@ -25,11 +25,13 @@ fread str_inp nm = runInputT defaultSettings $ do mLine <- getInputLine prompt case mLine of Nothing -> return (string_ "") - Just 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 ++ ":" + Just s -> toFuncon s + where toFuncon str | str_inp = return (string_ str) + | otherwise = case fvalue_parse_either str of + Left err -> lift (putStrLn err >> fread str_inp nm) + Right f -> return f + prompt | nm == "standard-in" = "Please provide a literal value\n> " + | otherwise = "Please provide a literal value for " ++ unpack nm ++ ":" fprint _ v | isString_ v = putStr (unString v) | otherwise = putStr (showValues v) diff --git a/src/Funcons/Tools.hs b/src/Funcons/Tools.hs --- a/src/Funcons/Tools.hs +++ b/src/Funcons/Tools.hs @@ -27,14 +27,13 @@ import Funcons.Core.Library import Funcons.Core.Manual import Funcons.Printer -import Funcons.Parser import System.Environment (getArgs) import Data.Text (unpack) import Data.List ((\\), intercalate) import qualified Data.Map as M -import Control.Monad (forM_, when, unless,join) +import Control.Monad (forM_, when, unless) -- | The empty collection of entity defaults. noEntityDefaults :: [EntityDefault]