{-# LANGUAGE OverloadedStrings #-}

module Funcons.Tools (
    -- * Creating standalone interpreters.

    -- $moduledoc
    mkMain, mkMainWithLibrary, mkMainWithLibraryEntities,
    mkMainWithLibraryTypes, mkMainWithLibraryEntitiesTypes,
    mkFullyFreshInterpreter, mkFreshInterpreter,
    -- * Creating embedded interpreters.
    run, runWithExtensions, runWithExtensionsNoCore, runWithExtensionsNoNothing,
    -- * Utility functions for interpreter extensions. 
    -- ** Funcon libraries.
    FunconLibrary, libEmpty, libUnion, libOverride, libUnions, libOverrides, libFromList,
    -- ** Type environments.
    TypeRelation, DataTypeMembers(..), DataTypeAltt(..), TypeParam, 
        emptyTypeRelation, typeEnvUnion, typeEnvUnions, typeEnvFromList,
    -- ** Entity declarations 
    EntityDefaults, EntityDefault(..), noEntityDefaults,
    ) where

import Funcons.EDSL (library)
import Funcons.RunOptions
import Funcons.Types
import Funcons.Entities
import Funcons.MSOS
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)

-- | The empty collection of entity defaults.
noEntityDefaults :: [EntityDefault]
noEntityDefaults :: [EntityDefault]
noEntityDefaults = []

-- | Creates a /main/ function for the default interpreter (no extension).
-- The executable made from this /main/ function receives command line
-- argumenst as explained above ("Funcons.Tools"). 
mkMain :: IO ()
mkMain :: IO ()
mkMain = FunconLibrary -> IO ()
mkMainWithLibrary FunconLibrary
libEmpty 

-- | Creates a /main/ function for the interpreter obtained by extending
-- the default library with the funcons in the 'FunconLibrary' argument.
mkMainWithLibrary :: FunconLibrary -> IO() 
mkMainWithLibrary :: FunconLibrary -> IO ()
mkMainWithLibrary FunconLibrary
lib = FunconLibrary -> [EntityDefault] -> IO ()
mkMainWithLibraryEntities FunconLibrary
lib [] 

-- | Creates a /main/ function for the interpreter obtained by extending
-- the main interpreter  with the funcons in the 'FunconLibrary' argument
-- and with default values for entities defined in the 'EntityDefaults' 
-- argument.
mkMainWithLibraryEntities :: FunconLibrary -> EntityDefaults -> IO ()
mkMainWithLibraryEntities :: FunconLibrary -> [EntityDefault] -> IO ()
mkMainWithLibraryEntities FunconLibrary
lib [EntityDefault]
ents = 
    FunconLibrary -> [EntityDefault] -> TypeRelation -> IO ()
mkMainWithLibraryEntitiesTypes FunconLibrary
lib [EntityDefault]
ents TypeRelation
emptyTypeRelation

-- | Creates a /main/ function for the interpreter obtained by extending
-- the main interpreter with the funcons in the 'FunconLibrary' argument
-- and with a 'TypeRelation' mapping datatypes to their constructors and
-- type arguments.
mkMainWithLibraryTypes :: FunconLibrary -> TypeRelation -> IO ()
mkMainWithLibraryTypes :: FunconLibrary -> TypeRelation -> IO ()
mkMainWithLibraryTypes FunconLibrary
lib TypeRelation
tys = FunconLibrary -> [EntityDefault] -> TypeRelation -> IO ()
mkMainWithLibraryEntitiesTypes FunconLibrary
lib [] TypeRelation
tys

-- | Creates a /main/ function for the interpreter obtained by extending
-- the main interpreter with funcons, 'EntityDefaults' and a 'TypeRelation'. 
mkMainWithLibraryEntitiesTypes :: FunconLibrary -> EntityDefaults -> TypeRelation -> IO ()
mkMainWithLibraryEntitiesTypes :: FunconLibrary -> [EntityDefault] -> TypeRelation -> IO ()
mkMainWithLibraryEntitiesTypes FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv = do   
    [String]
args <- IO [String]
getArgs
    FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensions FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv [String]
args Maybe Funcons
forall a. Maybe a
Nothing

-- | Creates a /main/ function for the interpreter aware of only
-- the given 'FunconLibrary', 'EntityDefaults' and 'TypeRelation'. 
mkFullyFreshInterpreter :: FunconLibrary -> EntityDefaults -> TypeRelation -> IO ()
mkFullyFreshInterpreter :: FunconLibrary -> [EntityDefault] -> TypeRelation -> IO ()
mkFullyFreshInterpreter FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv = do   
    [String]
args <- IO [String]
getArgs
    FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensionsNoNothing FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv [String]
args Maybe Funcons
forall a. Maybe a
Nothing 

-- | Creates a /main/ function for the interpreter aware of only
-- the given 'FunconLibrary', 'EntityDefaults' and 'TypeRelation',
-- and the built-in types and operations. 
mkFreshInterpreter :: FunconLibrary -> EntityDefaults -> TypeRelation -> IO ()
mkFreshInterpreter :: FunconLibrary -> [EntityDefault] -> TypeRelation -> IO ()
mkFreshInterpreter FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv = do   
    [String]
args <- IO [String]
getArgs
    FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensionsNoCore FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv [String]
args Maybe Funcons
forall a. Maybe a
Nothing 

-- | Same as 'run', except receiving additional interpreter extensions as arguments.
-- Useful when a translation to 'Funcons' has been implemented in Haskell as
-- well as 'Funcons', entities or datatypes specific to the object language.
-- Includes the 'Funcons.Core' funcons.
runWithExtensions :: 
    FunconLibrary -> EntityDefaults -> TypeRelation -> [String] -> Maybe Funcons -> IO ()
runWithExtensions :: FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensions FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv = 
  FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensionsNoCore 
    ([FunconLibrary] -> FunconLibrary
libUnions [FunconLibrary
Funcons.Core.Library.funcons, FunconLibrary
lib]) 
    ([[EntityDefault]] -> [EntityDefault]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[EntityDefault]
defaults, [EntityDefault]
forall a. [a]
Funcons.Core.Library.entities])
    ([TypeRelation] -> TypeRelation
typeEnvUnions [TypeRelation
tyenv, TypeRelation
Funcons.Core.Library.types])

-- | Same as 'run', except receiving additional interpreter extensions as arguments.
-- Useful when a translation to 'Funcons' has been implemented in Haskell as
-- well as 'Funcons', entities or datatypes specific to the object language.
-- Does not include the 'Funcons.Core' funcons.
runWithExtensionsNoCore :: 
    FunconLibrary -> EntityDefaults -> TypeRelation -> [String] -> Maybe Funcons -> IO ()
runWithExtensionsNoCore :: FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensionsNoCore FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv = FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensionsNoNothing FunconLibrary
full_lib [EntityDefault]
defaults TypeRelation
tyenv
 where  full_lib :: FunconLibrary
full_lib = [FunconLibrary] -> FunconLibrary
libUnions    [FunconLibrary
lib
                                ,FunconLibrary
Funcons.EDSL.library
                                ,FunconLibrary
Funcons.Core.Manual.library]

-- | Same as 'run', except receiving additional interpreter extensions as arguments.
-- Useful when a translation to 'Funcons' has been implemented in Haskell as
-- well as 'Funcons', entities or datatypes specific to the object language.
-- Does not include the 'Funcons.Core' funcons.
runWithExtensionsNoNothing :: 
    FunconLibrary -> EntityDefaults -> TypeRelation -> [String] -> Maybe Funcons -> IO ()
runWithExtensionsNoNothing :: FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensionsNoNothing FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv = FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
emulate FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv 


-- | 
-- Creates a main function by passing in a list of command line arguments 
-- and an optional initial 'Funcons' to execute. The 'Funcons' argument is optional
-- as one of the command line arguments may refer to an .fct file or .config
-- file that specifies an initial 'Funcons' term.
-- Useful when a translation to 'Funcons' has been implemented in Haskell.
run :: [String] -> Maybe Funcons -> IO ()
run :: [String] -> Maybe Funcons -> IO ()
run = FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
runWithExtensions FunconLibrary
libEmpty [] TypeRelation
emptyTypeRelation 

------------------------------------------------------------------------------
--- running programs 
emulate :: FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> [String]
-> Maybe Funcons
-> IO ()
emulate FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv [String]
args Maybe Funcons
mf0 = do
    (RunOptions
opts, [String]
unknown_opts) <- [String] -> IO (RunOptions, [String])
run_options [String]
args
    [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
unknown_opts ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
arg -> do
        String -> IO ()
putStrLn (String
"unknown option: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg)
    case RunOptions -> Bool
interactive_mode RunOptions
opts of 
        Bool
True    -> (Name -> IO Funcons)
-> FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> RunOptions
-> Maybe Funcons
-> IO ()
forall (m :: * -> *).
Interactive m =>
(Name -> m Funcons)
-> FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> RunOptions
-> Maybe Funcons
-> IO ()
emulate' (Bool -> Name -> IO Funcons
forall (m :: * -> *). Interactive m => Bool -> Name -> m Funcons
fread (RunOptions -> Bool
string_inputs RunOptions
opts) :: Name -> IO Funcons) FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv RunOptions
opts Maybe Funcons
mf0
        Bool
False   -> (Name -> StateT InputValues Identity Funcons)
-> FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> RunOptions
-> Maybe Funcons
-> IO ()
forall (m :: * -> *).
Interactive m =>
(Name -> m Funcons)
-> FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> RunOptions
-> Maybe Funcons
-> IO ()
emulate' (Bool -> Name -> StateT InputValues Identity Funcons
forall (m :: * -> *). Interactive m => Bool -> Name -> m Funcons
fread (RunOptions -> Bool
string_inputs RunOptions
opts) :: Name -> SimIO Funcons) FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv RunOptions
opts Maybe Funcons
mf0

emulate' :: Interactive m => (Name -> m Funcons) ->
            FunconLibrary -> EntityDefaults -> TypeRelation -> RunOptions -> Maybe Funcons -> IO ()
emulate' :: (Name -> m Funcons)
-> FunconLibrary
-> [EntityDefault]
-> TypeRelation
-> RunOptions
-> Maybe Funcons
-> IO ()
emulate' Name -> m Funcons
reader FunconLibrary
lib [EntityDefault]
defaults TypeRelation
tyenv RunOptions
opts Maybe Funcons
mf0 = do
    -- the initial funcon term must be either given from a .fct file (Maybe Funcons)
    -- or specified in a configuration file
    let f0 :: Funcons
f0 = Funcons -> (Funcons -> Funcons) -> Maybe Funcons -> Funcons
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RunOptions -> Funcons
funcon_term RunOptions
opts) Funcons -> Funcons
forall a. a -> a
id Maybe Funcons
mf0
        msos_ctxt :: MSOSReader m
msos_ctxt = RewriteReader
-> InputValues
-> DownControl
-> (Name -> m Funcons)
-> MSOSReader m
forall (m :: * -> *).
RewriteReader
-> InputValues
-> DownControl
-> (Name -> m Funcons)
-> MSOSReader m
MSOSReader (FunconLibrary
-> TypeRelation
-> RunOptions
-> Funcons
-> Funcons
-> RewriteReader
RewriteReader FunconLibrary
lib TypeRelation
tyenv RunOptions
opts Funcons
f0 Funcons
f0) InputValues
emptyINH DownControl
emptyDCTRL Name -> m Funcons
reader
    -- run the Interactive monad, returning in the evaluation results + entity values.
    -- if in --interactive-mode the Interactive monad will be IO 
    --  and all the desired output will already have been printed to the screen
    ((Either IException StepRes
e_exc_f, MSOSState m
mut, MSOSWriter
wr), InputValues
rem_ins) <- 
        m (Either IException StepRes, MSOSState m, MSOSWriter)
-> InputValues
-> IO
     ((Either IException StepRes, MSOSState m, MSOSWriter), InputValues)
forall (m :: * -> *) a.
Interactive m =>
m a -> InputValues -> IO (a, InputValues)
fexec (MSOS StepRes
-> MSOSReader m
-> MSOSState m
-> m (Either IException StepRes, MSOSState m, MSOSWriter)
forall a.
MSOS a
-> forall (m :: * -> *).
   Interactive m =>
   MSOSReader m
   -> MSOSState m -> m (Either IException a, MSOSState m, MSOSWriter)
runMSOS ([EntityDefault] -> MSOS StepRes -> MSOS StepRes
setEntityDefaults [EntityDefault]
defaults (RunOptions -> Int -> StepRes -> MSOS StepRes
stepTrans RunOptions
opts Int
0 (Funcons -> StepRes
toStepRes Funcons
f0)))
                MSOSReader m
msos_ctxt (MSOSState Any
forall (m :: * -> *). MSOSState m
emptyMSOSState {inp_es :: Input m
inp_es = Input m
forall a. Map Name ([a], Maybe (m Funcons))
inputs})) (RunOptions -> InputValues
inputValues RunOptions
opts)
    -- if not in --interactive-mode then print additional information based on flags
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RunOptions -> Bool
interactive_mode RunOptions
opts)
        ([EntityDefault]
-> MSOSReader m
-> Either IException StepRes
-> MSOSState m
-> MSOSWriter
-> InputValues
-> IO ()
forall (m :: * -> *).
[EntityDefault]
-> MSOSReader m
-> Either IException StepRes
-> MSOSState m
-> MSOSWriter
-> InputValues
-> IO ()
withResults [EntityDefault]
defaults MSOSReader m
msos_ctxt Either IException StepRes
e_exc_f MSOSState m
mut MSOSWriter
wr InputValues
rem_ins)
 where inputs :: Map Name ([a], Maybe (m Funcons))
inputs = (Name
 -> [Values]
 -> Map Name ([a], Maybe (m Funcons))
 -> Map Name ([a], Maybe (m Funcons)))
-> Map Name ([a], Maybe (m Funcons))
-> InputValues
-> Map Name ([a], Maybe (m Funcons))
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey Name
-> [Values]
-> Map Name ([a], Maybe (m Funcons))
-> Map Name ([a], Maybe (m Funcons))
forall p a.
Name
-> p
-> Map Name ([a], Maybe (m Funcons))
-> Map Name ([a], Maybe (m Funcons))
op Map Name ([a], Maybe (m Funcons))
forall k a. Map k a
M.empty (RunOptions -> InputValues
inputValues RunOptions
opts)
                where   op :: Name
-> p
-> Map Name ([a], Maybe (m Funcons))
-> Map Name ([a], Maybe (m Funcons))
op Name
nm p
_ = Name
-> ([a], Maybe (m Funcons))
-> Map Name ([a], Maybe (m Funcons))
-> Map Name ([a], Maybe (m Funcons))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
nm ([], m Funcons -> Maybe (m Funcons)
forall a. a -> Maybe a
Just (Name -> m Funcons
reader Name
nm))

withResults :: [EntityDefault]
-> MSOSReader m
-> Either IException StepRes
-> MSOSState m
-> MSOSWriter
-> InputValues
-> IO ()
withResults [EntityDefault]
defaults MSOSReader m
msos_ctxt Either IException StepRes
e_exc_f MSOSState m
msos_state MSOSWriter
wr InputValues
rem_ins
        | RunOptions -> Bool
show_tests RunOptions
opts =
            case Either IException StepRes
e_exc_f of
             Left IException
ie -> String -> IO ()
putStrLn (IException -> String
showIException IException
ie)
             Right StepRes
efvs -> [Funcons]
-> [EntityDefault]
-> MSOSReader m
-> MSOSState m
-> MSOSWriter
-> InputValues
-> IO ()
forall (m :: * -> *).
[Funcons]
-> [EntityDefault]
-> MSOSReader m
-> MSOSState m
-> MSOSWriter
-> InputValues
-> IO ()
printTestResults ((Funcons -> [Funcons])
-> ([Values] -> [Funcons]) -> StepRes -> [Funcons]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Funcons -> [Funcons] -> [Funcons]
forall a. a -> [a] -> [a]
:[]) ((Values -> Funcons) -> [Values] -> [Funcons]
forall a b. (a -> b) -> [a] -> [b]
map Values -> Funcons
FValue) StepRes
efvs)
                              [EntityDefault]
defaults MSOSReader m
msos_ctxt MSOSState m
msos_state MSOSWriter
wr InputValues
rem_ins
        | Bool
otherwise = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RunOptions -> Bool
show_output_only RunOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO ()
printCounts 
        case Either IException StepRes
e_exc_f of
            Left IException
ie -> String -> IO ()
putStrLn (IException -> String
showIException IException
ie)
            Right StepRes
f -> [Funcons] -> IO ()
printResult ((Funcons -> [Funcons])
-> ([Values] -> [Funcons]) -> StepRes -> [Funcons]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Funcons -> [Funcons] -> [Funcons]
forall a. a -> [a] -> [a]
:[]) ((Values -> Funcons) -> [Values] -> [Funcons]
forall a b. (a -> b) -> [a] -> [b]
map Values -> Funcons
FValue) StepRes
f)
        IO ()
printMutable
        IO ()
printControl
        InputValues -> [Name] -> IO ()
printInput InputValues
rem_ins (RunOptions -> [Name]
hide_input RunOptions
opts)
    IO ()
printOutput
 where
    muts :: Mutable
muts = MSOSState m -> Mutable
forall (m :: * -> *). MSOSState m -> Mutable
mut_entities MSOSState m
msos_state 
    opts :: RunOptions
opts = RewriteReader -> RunOptions
run_opts (MSOSReader m -> RewriteReader
forall (m :: * -> *). MSOSReader m -> RewriteReader
ereader MSOSReader m
msos_ctxt)
    printResult :: [Funcons] -> IO ()
printResult [Funcons]
f = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunOptions -> Bool
show_result RunOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        String -> IO ()
putStrLn String
"Result:"
                        String -> IO ()
putStrLn (RunOptions -> [Funcons] -> String
ppFunconsSeq RunOptions
opts [Funcons]
f)
                        String -> IO ()
putStrLn String
""

    printCounts :: IO ()
printCounts = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunOptions -> Bool
show_counts RunOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do 
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunOptions -> Bool
csv_output_with_keys RunOptions
opts) (String -> IO ()
putStrLn String
counterKeys) 
        if (RunOptions -> Bool
csv_output RunOptions
opts) 
          then String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Counters -> String
displayCounters (RewriteWriterr -> Counters
counters (MSOSWriter -> RewriteWriterr
ewriter MSOSWriter
wr))
          else String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Counters -> String
ppCounters (RewriteWriterr -> Counters
counters (MSOSWriter -> RewriteWriterr
ewriter MSOSWriter
wr))

    printMutable :: IO ()
printMutable = [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
toShow Name -> IO ()
display
     where toShow :: [Name]
toShow = RunOptions -> [Name]
show_mutable RunOptions
opts
           display :: Name -> IO ()
display Name
name = case Name -> Mutable -> Maybe Values
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Mutable
muts of
                            Maybe Values
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just Values
v ->  String -> IO ()
putStrLn (String
"Mutable Entity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                       String -> IO ()
putStrLn (Values -> String
displayValue Values
v) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
""

    printControl :: IO ()
printControl = [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DownControl -> [Name]
forall k a. Map k a -> [k]
M.keys DownControl
ctrl [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
toHide) Name -> IO ()
display
     where ctrl :: DownControl
ctrl = MSOSWriter -> DownControl
ctrl_entities MSOSWriter
wr
           toHide :: [Name]
toHide = RunOptions -> [Name]
hide_control RunOptions
opts
           display :: Name -> IO ()
display Name
name = case Name -> DownControl -> Maybe (Maybe Values)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name DownControl
ctrl of
                            Just (Just Values
v) -> do
                                String -> IO ()
putStrLn (String
"Control Entity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name) 
                                String -> IO ()
putStrLn (Values -> String
displayValue Values
v) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
""
                            Maybe (Maybe Values)
_             -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    printOutput :: IO ()
printOutput = [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (InputValues -> [Name]
forall k a. Map k a -> [k]
M.keys InputValues
out [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
toHide) Name -> IO ()
display
     where out :: InputValues
out = MSOSWriter -> InputValues
out_entities MSOSWriter
wr
           display :: Name -> IO ()
display Name
name = do
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RunOptions -> Bool
show_output_only RunOptions
opts) 
                        (String -> IO ()
putStrLn (String
"Output Entity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name))
                    case (Values -> Bool) -> [Values] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values -> Bool
forall t. HasValues t => Values t -> Bool
isString_ [Values]
vs Bool -> Bool -> Bool
&& RunOptions -> Bool
pp_string_outputs RunOptions
opts of
                        Bool
True    -> (Values -> IO ()) -> [Values] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStr (String -> IO ()) -> (Values -> String) -> Values -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> String
forall t. HasValues t => Values t -> String
unString) [Values]
vs
                        Bool
False   -> String -> IO ()
putStrLn ([Values] -> String
displayValues [Values]
vs)
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RunOptions -> Bool
show_output_only RunOptions
opts) (String -> IO ()
putStrLn String
"")
            where vs :: [Values]
vs = InputValues
out InputValues -> Name -> [Values]
forall k a. Ord k => Map k a -> k -> a
M.! Name
name
           toHide :: [Name]
toHide = RunOptions -> [Name]
hide_output RunOptions
opts


    printInput :: InputValues -> [Name] -> IO ()
printInput InputValues
ios [Name]
toHide = [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (InputValues -> [Name]
forall k a. Map k a -> [k]
M.keys InputValues
ios [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
toHide) Name -> IO ()
display
     where display :: Name -> IO ()
display Name
name = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Values] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Values]
vs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do 
                            String -> IO ()
putStrLn (String
"Input Entity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name)
                            String -> IO ()
putStrLn ([Values] -> String
displayValues [Values]
vs)
                            String -> IO ()
putStrLn String
""
            where vs :: [Values]
vs = InputValues
ios InputValues -> Name -> [Values]
forall k a. Ord k => Map k a -> k -> a
M.! Name
name

    displayValues :: [Values] -> String
displayValues [Values]
vs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((Values -> String) -> [Values] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Values -> String
displayValue [Values]
vs)
    displayValue :: Values -> String
displayValue (Map ValueMaps Values
m) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" 
                                   [ Values -> String
displayValue Values
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" |-> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Values] -> String
displayValues [Values]
val 
                                   | (Values
key, [Values]
val) <- ValueMaps Values -> [(Values, [Values])]
forall k a. Map k a -> [(k, a)]
M.assocs ValueMaps Values
m ]
    displayValue (ADTVal Name
"variable" [FValue (Atom String
a)
                                     ,FValue (ComputationType (Type Types Funcons
t))]) = 
        String
"variable(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Values -> String
displayValue (String -> Values
forall t. String -> Values t
Atom String
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Funcons -> String) -> Types Funcons -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes (RunOptions -> Funcons -> String
ppFuncons RunOptions
opts) Types Funcons
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    displayValue (Atom String
a) = String
a
    displayValue Values
val | Values -> Bool
forall t. HasValues t => Values t -> Bool
isString_ Values
val = String -> String
forall a. Show a => a -> String
show (Values -> String
forall t. HasValues t => Values t -> String
unString Values
val)
    displayValue Values
val = (Funcons -> String) -> Values -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues (RunOptions -> Funcons -> String
ppFuncons RunOptions
opts) Values
val

printTestResults :: [Funcons] -> EntityDefaults -> MSOSReader m -> 
                        MSOSState m -> MSOSWriter -> InputValues -> IO ()
printTestResults :: [Funcons]
-> [EntityDefault]
-> MSOSReader m
-> MSOSState m
-> MSOSWriter
-> InputValues
-> IO ()
printTestResults [Funcons]
fs [EntityDefault]
defaults MSOSReader m
msos_ctxt MSOSState m
msos_state MSOSWriter
wr InputValues
rem_ins = do
        [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Name [Funcons] -> [Name]
forall k a. Map k a -> [k]
M.keys Map Name [Funcons]
opts) Name -> IO ()
printNotExists
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Map Name [Funcons] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Name
"result-term" Map Name [Funcons]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Funcons]
result_term [Funcons] -> [Funcons] -> Bool
forall a. Eq a => a -> a -> Bool
== [Funcons]
fs) (Name -> String -> String -> IO ()
reportError Name
"result-term" ([Funcons] -> String
showFunconsSeq [Funcons]
result_term) ([Funcons] -> String
showFunconsSeq [Funcons]
fs))
        IO ()
printMutable
        IO ()
printControl
        InputValues -> IO ()
printInputOutput InputValues
out
        InputValues -> IO ()
printInputOutput InputValues
rem_ins

    where   eval_ctxt :: RewriteReader
eval_ctxt = MSOSReader m -> RewriteReader
forall (m :: * -> *). MSOSReader m -> RewriteReader
ereader MSOSReader m
msos_ctxt
            muts :: Mutable
muts = MSOSState m -> Mutable
forall (m :: * -> *). MSOSState m -> Mutable
mut_entities MSOSState m
msos_state
            eval_state :: RewriteState
eval_state = MSOSState m -> RewriteState
forall (m :: * -> *). MSOSState m -> RewriteState
estate MSOSState m
msos_state
            localEval :: Name -> Funcons -> Values
localEval Name
name Funcons
term = case Rewrite Rewritten
-> RewriteReader
-> RewriteState
-> (Either IException Rewritten, RewriteState, RewriteWriterr)
forall a.
Rewrite a
-> RewriteReader
-> RewriteState
-> (Either IException a, RewriteState, RewriteWriterr)
runRewrite (Funcons -> Rewrite Rewritten
rewriteFuncons Funcons
term) RewriteReader
eval_ctxt RewriteState
eval_state
                of  (Left IException
ie,RewriteState
_,RewriteWriterr
_) -> String -> Values
forall a. HasCallStack => String -> a
error (String
"internal exception in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name 
                                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" evaluation:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IException -> String
showIException IException
ie)
                    (Right (ValTerm [Values
v]),RewriteState
_,RewriteWriterr
_) -> Values
v
                    (Right (ValTerm [Values]
vs),RewriteState
_,RewriteWriterr
_) -> String -> Values
forall a. HasCallStack => String -> a
error 
                      (String
"evaluation of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" results in sequence")
                    (Right Rewritten
_,RewriteState
_,RewriteWriterr
_) ->
                         String -> Values
forall a. HasCallStack => String -> a
error (String
"evaluation of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" requires step")
    
            mLocalEval :: Funcons -> Maybe Values
mLocalEval Funcons
term = case Rewrite Rewritten
-> RewriteReader
-> RewriteState
-> (Either IException Rewritten, RewriteState, RewriteWriterr)
forall a.
Rewrite a
-> RewriteReader
-> RewriteState
-> (Either IException a, RewriteState, RewriteWriterr)
runRewrite(Funcons -> Rewrite Rewritten
rewriteFuncons Funcons
term) RewriteReader
eval_ctxt RewriteState
eval_state of
                (Right (ValTerm [Values
v]),RewriteState
_,RewriteWriterr
_) -> Values -> Maybe Values
forall a. a -> Maybe a
Just Values
v
                (Either IException Rewritten, RewriteState, RewriteWriterr)
_                         -> Maybe Values
forall a. Maybe a
Nothing

            result_term :: [Funcons]
result_term = case [Maybe Values] -> Maybe [Values]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Funcons -> Maybe Values) -> [Funcons] -> [Maybe Values]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Funcons -> Maybe Values
recursiveFunconValue [Funcons]
rf) of
                Maybe [Values]
Nothing -> case [Maybe Values] -> Maybe [Values]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Funcons -> Maybe Values) -> [Funcons] -> [Maybe Values]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Funcons -> Maybe Values
mLocalEval [Funcons]
rf) of
                                Maybe [Values]
Nothing -> [Funcons]
rf
                                Just [Values]
vs -> (Values -> Funcons) -> [Values] -> [Funcons]
forall a b. (a -> b) -> [a] -> [b]
map Values -> Funcons
FValue [Values]
vs
                Just [Values]
vs -> (Values -> Funcons) -> [Values] -> [Funcons]
forall a b. (a -> b) -> [a] -> [b]
map Values -> Funcons
FValue [Values]
vs
             where rf :: [Funcons]
rf = (Map Name [Funcons]
opts Map Name [Funcons] -> Name -> [Funcons]
forall k a. Ord k => Map k a -> k -> a
M.! Name
"result-term")
            opts :: Map Name [Funcons]
opts = RunOptions -> Map Name [Funcons]
expected_outcomes (RewriteReader -> RunOptions
run_opts RewriteReader
eval_ctxt)

            reportError :: Name -> String -> String -> IO ()
reportError Name
name String
expected String
actual = do
                String -> IO ()
putStrLn (String
"expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected)
                String -> IO ()
putStrLn (String
"actual   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
actual)

            printNotExists :: Name -> IO ()
printNotExists Name
"result-term" = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            printNotExists Name
name = 
                case (Name -> Mutable -> Maybe Values
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Mutable
muts, Name -> InputValues -> Maybe [Values]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name InputValues
out
                     ,Name -> DownControl -> Maybe (Maybe Values)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name DownControl
ctrl, Name -> InputValues -> Maybe [Values]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name InputValues
rem_ins) of
                    (Maybe Values
Nothing, Maybe [Values]
Nothing, Maybe (Maybe Values)
Nothing, Maybe [Values]
Nothing) -> 
                        String -> IO ()
putStrLn (String
"unknown entity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name)
                    (Maybe Values, Maybe [Values], Maybe (Maybe Values),
 Maybe [Values])
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        
            printMutable :: IO ()
printMutable = [(Name, Values)] -> ((Name, Values) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Mutable -> [(Name, Values)]
forall k a. Map k a -> [(k, a)]
M.assocs Mutable
muts) ((Name -> Values -> IO ()) -> (Name, Values) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Values -> IO ()
display)
             where display :: Name -> Values -> IO ()
display Name
name Values
val = case Name -> Map Name [Funcons] -> Maybe [Funcons]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name [Funcons]
opts of
                        Maybe [Funcons]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just [Funcons]
expected -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless 
                                            ((Funcons -> Values) -> [Funcons] -> [Values]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Funcons -> Values
localEval Name
name) [Funcons]
expected [Values] -> [Values] -> Bool
forall a. Eq a => a -> a -> Bool
== [Values
val]) 
                                            (Name -> String -> String -> IO ()
reportError Name
name ([String] -> String
showL ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Funcons -> String) -> [Funcons] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Funcons -> String
showFuncons [Funcons]
expected) (Values -> String
showValues Values
val))

            -- set default values of output and control entities
            ctrl :: M.Map Name (Maybe Values)
            ctrl :: DownControl
ctrl = (EntityDefault -> DownControl -> DownControl)
-> DownControl -> [EntityDefault] -> DownControl
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EntityDefault -> DownControl -> DownControl
forall a. EntityDefault -> Map Name (Maybe a) -> Map Name (Maybe a)
op (MSOSWriter -> DownControl
ctrl_entities MSOSWriter
wr) [EntityDefault]
defaults
             where  op :: EntityDefault -> Map Name (Maybe a) -> Map Name (Maybe a)
op (DefControl Name
name) Map Name (Maybe a)
ctrl 
                        | Bool -> Bool
not (Name -> Map Name (Maybe a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Name
name Map Name (Maybe a)
ctrl) = Name -> Maybe a -> Map Name (Maybe a) -> Map Name (Maybe a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name Maybe a
forall a. Maybe a
Nothing Map Name (Maybe a)
ctrl
                    op EntityDefault
_ Map Name (Maybe a)
ctrl = Map Name (Maybe a)
ctrl

            out :: InputValues
out = (EntityDefault -> InputValues -> InputValues)
-> InputValues -> [EntityDefault] -> InputValues
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EntityDefault -> InputValues -> InputValues
forall a. EntityDefault -> Map Name [a] -> Map Name [a]
op (MSOSWriter -> InputValues
out_entities MSOSWriter
wr) [EntityDefault]
defaults
             where  op :: EntityDefault -> Map Name [a] -> Map Name [a]
op (DefOutput Name
name) Map Name [a]
out 
                        | Bool -> Bool
not (Name -> Map Name [a] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Name
name Map Name [a]
out) = Name -> [a] -> Map Name [a] -> Map Name [a]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name [] Map Name [a]
out
                    op EntityDefault
_ Map Name [a]
out = Map Name [a]
out

            -- TODO this does not test the case that a control signal is expected 
            --      according to the test, but not present.
            printControl :: IO ()
printControl = [(Name, Maybe Values)] -> ((Name, Maybe Values) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DownControl -> [(Name, Maybe Values)]
forall k a. Map k a -> [(k, a)]
M.assocs DownControl
ctrl) ((Name -> Maybe Values -> IO ()) -> (Name, Maybe Values) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Maybe Values -> IO ()
display)
             where  display :: Name -> Maybe Values -> IO ()
                    -- test whether control signal is expected when there is none
                    -- shows expected signal 
                    display :: Name -> Maybe Values -> IO ()
display Name
name Maybe Values
Nothing = case Name -> Map Name [Funcons] -> Maybe [Funcons]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name [Funcons]
opts of 
                        Maybe [Funcons]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just [Funcons]
vals -> String -> IO ()
putStrLn (String
"expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++Name -> String
unpack Name
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "
                                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showL ((Funcons -> String) -> [Funcons] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Values -> String
showValues (Values -> String) -> (Funcons -> Values) -> Funcons -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Funcons -> Values
localEval Name
name) [Funcons]
vals))
                    -- test whether control signal is expected when there is one
                    -- shows that the emitted signal was unexpected
                    -- if a signal was expected, shows if actual and expected are unequal
                    display Name
name (Just Values
val) = case Name -> Map Name [Funcons] -> Maybe [Funcons]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name [Funcons]
opts of
                        Maybe [Funcons]
Nothing -> String -> IO ()
putStrLn (String
"unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Values -> String
showValues Values
val)
                        Just [Funcons]
expected -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless 
                                            ((Funcons -> Values) -> [Funcons] -> [Values]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Funcons -> Values
localEval Name
name) [Funcons]
expected [Values] -> [Values] -> Bool
forall a. Eq a => a -> a -> Bool
== [Values
val]) 
                                            (Name -> String -> String -> IO ()
reportError Name
name ([String] -> String
showL ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Funcons -> String) -> [Funcons] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Funcons -> String
showFuncons [Funcons]
expected) (Values -> String
showValues Values
val))

            printInputOutput :: InputValues -> IO ()
printInputOutput InputValues
remaining = [(Name, [Values])] -> ((Name, [Values]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (InputValues -> [(Name, [Values])]
forall k a. Map k a -> [(k, a)]
M.assocs InputValues
remaining) ((Name -> [Values] -> IO ()) -> (Name, [Values]) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> [Values] -> IO ()
display)
             where  -- no test-error if the input/output is empty 
                    -- (and no input/output was specified)
                    display :: Name -> [Values] -> IO ()
display Name
name [] | Maybe [Funcons]
Nothing <- Name -> Map Name [Funcons] -> Maybe [Funcons]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name [Funcons]
opts = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    display Name
name [Values]
vals = case Name -> Map Name [Funcons] -> Maybe [Funcons]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name [Funcons]
opts of
                        Maybe [Funcons]
Nothing -> String -> IO ()
putStrLn (String
"unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showL ((Values -> String) -> [Values] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Values -> String
showValues [Values]
vals))
                        Just [Funcons]
expected -> case (Funcons -> Values) -> [Funcons] -> [Values]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Funcons -> Values
localEval Name
name) [Funcons]
expected of 
                            [ADTVal Name
"list" [Funcons]
exps] -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Funcons]
exps [Funcons] -> [Funcons] -> Bool
forall a. Eq a => a -> a -> Bool
== (Values -> Funcons) -> [Values] -> [Funcons]
forall a b. (a -> b) -> [a] -> [b]
map Values -> Funcons
FValue [Values]
vals) (Name -> String -> String -> IO ()
reportError Name
name ([String] -> String
showL ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Funcons -> String) -> [Funcons] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Funcons -> String
showFuncons [Funcons]
exps) ([String] -> String
showL ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Values -> String) -> [Values] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Values -> String
showValues [Values]
vals))
                            [Values]
val -> String -> IO ()
forall a. HasCallStack => String -> a
error (String
"non-list given as expected output entity ("String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                        Name -> String
unpack Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showL ((Values -> String) -> [Values] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Values -> String
showValues [Values]
val))
                    
showL :: [String] -> String
showL :: [String] -> String
showL [String]
elems = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
elems String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"


-- $moduledoc
-- This module exports functions for creating executables for funcon interpeters.
-- The executables accepts a number of command line and configuration options that
-- are explained here. The /funcons-tools/ package exports an interpreter for
-- the core library of reusable funcons. This executable is called /runfct/ and is used
-- as an example here.
--
-- @ dist\/build\/runfct\/runfct \<options\>@
--
-- === Options
--  Options are used to change the behaviour of the interpreter and to change the
--  output the interpreter provides after execution.
--  An option is either a boolean-option, a string-option, a .config file or a .fct file.
--  All command line flags are considered from left to right,
--    each changing the current configuration.
--
-- (1) __Funcon term file__: A file containing a funcon term. (must have .fct extension). 
--        These files contain funcon terms written 
--          in prefix form with parentheses surrounding comma-separated arguments,
--          e.g. integer-multiply(6,7). The parser also accepts notation for lists, 
--          tuples, sets and map. For example, @[1,2,3]@, @(1,2,3)@, @&#x7b;1,2,3&#x7d;@,
--          and @&#x7b;1 |-> true, 2 |-> false, 3 |-> true &#x7d;@ respectively.
--  
-- (2) __Configurations file__: A file containing configuration options (see below).
--          (must have .config extension)
--  
-- (3) __String options__ (comma-separate strings for multiple inputs):
--
--      * --display-mutable-entity \<string\>: by default mutable entities are not displayed
--            this option is used to display one or more mutable entities.
--
--      * --hide-output-entity \<string\>:
--            by default output entities are displayed when output is available.
--            this option is used to hide one or more output entities.
--
--      * --hide-control-entity \<string\>:
--            by default control entities are displayed when a signal is raised.
--            this option is used to hide one or more control entities .
--
--      * --hide-input-entity \<string\>:
--            by default input entities are displayed when input has not been consumed.
--            this option is used to hide one or more input entities.
--      * --max-restarts \<natural\>:
--          perform a maximum of `n` transitive steps, useful for debugging.
--
-- (4) __Boolean options__ (/true/, /false/ or no argument (/true/ by default)):
--
--      * --refocus \<bool\>: use refocusing, only valid under certain conditions.
--    
--      * --full-environments \<bool\>: when printing funcons, display environments 
--              using map-notation, by default an environment is printed as "...".
--    
--      * --hide-result \<bool\>: do not show the resulting funcon term.
--    
--      * --display-steps \<bool\>: show meta-information about the interpretation, 
--              e.g. the number of steps, rewrites and restarts. 
--    
--      * --no-abrupt-termination \<bool\>: disable abrupt termination (affects uncaught control signals).
--    
--      * --interactive-mode \<bool\>: use real I/O for input and output.
--              By default I/O is simulated and all input is expected to be 
--              provided in a configuration file (see below) and output is collected
--              and displayed after execution is finished.
--              In interactive mode, the user has to provide input via the standard input,
--              and output is printed to the standard output as soon as it is available.
--    
--      * --string-inputs \<bool\>: by default input is parsed into a 'Values'.
--            This option tells the interpreter to yield the given string as input.
--    
--      * --format-string-outputs \<bool\>: if all output values are strings (and with this option on),
--            any escape characters are interpreted (e.g. "\\n" becomes an actual newline), and
--            the strings are concatenated and not enclosed in double quotes.
--    
--      * --hide-tests \<bool\>: do not execute tests (by default tests are executed if specified in a configuration file).
--    
--      * --show-output-only \<bool\>: print only output (omits all other information).
--    
--      * --auto-config \<bool\>: if a .fct file is given, search for a .config file
--            with the same name and apply it (on by default).
--     
-- === Configuration files
--  A configuration file is a sequence of 'fragments', where each fragment is of the form:
--
-- > <group> {
-- >    <keyvalue>*
-- > }
-- 
--  A \<keyvalue\> is a colon separated key-value pair, closed off by a semicolon, e.g.
-- 
-- > hide-control-entity: failed,thrown;
--
--  There are 4 valid groups: /general/, /funcons/, /tests/ and /inputs/.
--  
-- (1) __general__:
--    The general /group/ is used as an alternative to command line flags,
--    All Boolean and string options are available.
--    Additionally, the option "funcon-term" is available for giving an initial 
--    funcon term:
--
--        > general {
--        >     funcon-term: integer-add(3,2);
--        > }
--
-- (2) __funcons__:
--    This group is used to define simple (nullary) funcons.
--    They key is the name of the funcon,
--    the value is a funcon term to which the funcon will rewrite once evaluated.
--    Keys and values are separated by '=' in this group. This group is useful
--    to choose an interpretation for unspecified components of a language specification.
--    For example (from a Caml Light specification):
--
--         > funcons {
--         >     implemented-vectors        = vectors(values);
--         >     implemented-floats-format  = binary64;
--         >     implemented-integers-width = 31;
--         >     implemented-characters     = unicode-characters;
--         >     implemented-strings        = strings;
--         > }
--
-- (3) __tests__:
--    With this group unit-tests can be defined.
--    Each key-value pairs specifies the expected value of a semantic entities,
--    where the key is the name of a semantic entity
--    and the value is the expected value.
--    Additionally, the key "result-term" can be used to specify the expected result term.
--    The tests group is useful to specify a complete unit-test in a single file, e.g.
--
--         > general {
--         >     funcon-term: else(integer-add(integer-add(2,3),fail),print(3));
--         > }
--         > tests {
--         >    result-term: ();
--         >    standard-out: [3];
--         > }
--
-- (4) __inputs__:
--    The inputs group is used to specify default values for input entities, e.g.
--
--         > inputs {
--         >     standard-in: [1,2,3];
--         > }
--
--        When input entities are given default values, simulation mode is turned on
--        (even if --interactive-mode is used).
-- 
-- === Languages specific interpreters
--    This package does not provide just one interpreter, it provides
--    the ability to play `mix and match' with 'FunconLibrary's to form interpreters.
--    This enables the creation of interpreters for object languages from funcons
--    (entities, or datatypes) specific to that object language.
-- 
--    For this purpose, this module exports 'mkMainWithLibraryEntitiesTypes' (and variants). 
--    Say that a module exporting
--    a 'FunconLibrary' is a "funcon module".
--    An interpreter is obtained by importing the chosen "funcon modules" and uniting 
--    their 'FunconLibrary's (with 'libUnions'), perhaps together with default
--    values for entities ('EntityDefault') and information about custom datatypes ('TypeRelation').
--    The resulting maps are given as arguments to 'mkMainWithLibraryEntitiesTypes'
--    (or variant).
--    By using 'mkMainWithLibraryEntitiesTypes', all interpreters inherit the 
--        core reusable funcon library.