module CSPM (
CSPMSession, newCSPMSession,
EV.ProfilerOptions(..), EV.defaultProfilerOptions,
EV.EvaluatorOptions(..), EV.defaultEvaluatorOptions,
CSPMMonad(..),
withSession,
CSPM, unCSPM,
module CSPM.DataStructures.Names,
module CSPM.DataStructures.Syntax,
module CSPM.DataStructures.Types,
module CSPM.Evaluator.Values,
parseStringAsFile, parseFile, parseInteractiveStmt, parseExpression,
renameFile, renameInteractiveStmt, renameExpression, getBoundNames,
typeCheckFile, typeCheckInteractiveStmt, typeCheckExpression,
ensureExpressionIsOfType, typeOfExpression, modifyTypeCheckerErrorOptions,
typeOfName, boundProcessNames,
desugarFile, desugarInteractiveStmt, desugarExpression,
bindFile, bindDeclaration,
evaluateExpression, maybeProcessNameToProcess, profilingData,
stringToValue,
runParserInCurrentState,
runRenamerInCurrentState,
runTypeCheckerInCurrentState,
runEvaluatorInCurrentState,
reportWarnings,
getLibCSPMVersion,
)
where
import Control.Applicative
import Control.Monad.State
import Data.Version
import System.FilePath
import CSPM.DataStructures.Names
import CSPM.DataStructures.Syntax
import CSPM.DataStructures.Types
import qualified CSPM.Evaluator as EV
import CSPM.Evaluator.Values
import qualified CSPM.Parser as P
import qualified CSPM.Renamer as RN
import qualified CSPM.TypeChecker as TC
import qualified CSPM.Desugar as DS
import Paths_libcspm (version)
import Util.Exception
import Util.PrettyPrint
import qualified Util.MonadicPrettyPrint as M
data CSPMSession = CSPMSession {
rnState :: RN.RenamerState,
tcState :: TC.TypeInferenceState,
evState :: EV.EvaluationState
}
newCSPMSession :: MonadIO m => EV.EvaluatorOptions -> m CSPMSession
newCSPMSession profilerOptions = do
rnState <- liftIO $ RN.initRenamer
tcState <- liftIO $ TC.initTypeChecker
evState <- liftIO $ EV.initEvaluator profilerOptions
return $ CSPMSession rnState tcState evState
class (MonadIO m) => CSPMMonad m where
getSession :: m CSPMSession
setSession :: CSPMSession -> m ()
handleWarnings :: [ErrorMessage] -> m ()
withSession :: CSPMMonad m => (CSPMSession -> m a) -> m a
withSession f = getSession >>= f
modifySession :: CSPMMonad m => (CSPMSession -> CSPMSession) -> m ()
modifySession f = do
s <- getSession
setSession (f s)
reportWarnings :: CSPMMonad m => m (a, [ErrorMessage]) -> m a
reportWarnings prog = withSession $ \ sess -> do
(v, ws) <- prog
when (ws /= []) $ handleWarnings ws
return v
type CSPM = StateT CSPMSession IO
unCSPM :: CSPMSession -> CSPM a -> IO (a, CSPMSession)
unCSPM = flip runStateT
instance CSPMMonad CSPM where
getSession = get
setSession = put
handleWarnings ms = liftIO $ putStrLn $ show $ prettyPrint ms
runParserInCurrentState :: CSPMMonad m => FilePath -> P.ParseMonad a -> m a
runParserInCurrentState dir p = liftIO $ P.runParser p dir
parseFile :: CSPMMonad m => FilePath -> m PCSPMFile
parseFile fp =
let (dir, fname) = splitFileName fp
in runParserInCurrentState dir (P.parseFile fname)
parseStringAsFile :: CSPMMonad m => String -> m PCSPMFile
parseStringAsFile str = runParserInCurrentState "" (P.parseStringAsFile str)
parseInteractiveStmt :: CSPMMonad m => String -> m PInteractiveStmt
parseInteractiveStmt str =
runParserInCurrentState "" (P.parseInteractiveStmt str)
parseExpression :: CSPMMonad m => String -> m PExp
parseExpression str = runParserInCurrentState "" (P.parseExpression str)
runRenamerInCurrentState :: CSPMMonad m => RN.RenamerMonad a -> m a
runRenamerInCurrentState p = withSession $ \s -> do
(a, st) <- liftIO $ RN.runFromStateToState (rnState s) p
modifySession (\s -> s { rnState = st })
return a
renameFile :: CSPMMonad m => PCSPMFile -> m TCCSPMFile
renameFile m = runRenamerInCurrentState $ do
RN.newScope
RN.rename m
renameExpression :: CSPMMonad m => PExp -> m TCExp
renameExpression e = runRenamerInCurrentState $ RN.rename e
renameInteractiveStmt :: CSPMMonad m => PInteractiveStmt -> m TCInteractiveStmt
renameInteractiveStmt e = runRenamerInCurrentState $ do
RN.newScope
RN.rename e
getBoundNames :: CSPMMonad m => m [Name]
getBoundNames = runRenamerInCurrentState RN.getBoundNames
runTypeCheckerInCurrentState :: CSPMMonad m => TC.TypeCheckMonad a -> m (a, [ErrorMessage])
runTypeCheckerInCurrentState p = withSession $ \s -> do
(a, ws, st) <- liftIO $ TC.runFromStateToState (tcState s) p
modifySession (\s -> s { tcState = st })
return (a, ws)
typeCheckFile :: CSPMMonad m => TCCSPMFile -> m TCCSPMFile
typeCheckFile ms = reportWarnings $ runTypeCheckerInCurrentState $ do
TC.typeCheck ms
typeCheckInteractiveStmt :: CSPMMonad m => TCInteractiveStmt -> m TCInteractiveStmt
typeCheckInteractiveStmt pstmt = reportWarnings $ runTypeCheckerInCurrentState $ do
TC.typeCheck pstmt
typeCheckExpression :: CSPMMonad m => TCExp -> m TCExp
typeCheckExpression exp = reportWarnings $ runTypeCheckerInCurrentState $ do
TC.typeCheck exp
ensureExpressionIsOfType :: CSPMMonad m => Type -> TCExp -> m TCExp
ensureExpressionIsOfType t exp = reportWarnings $ runTypeCheckerInCurrentState $ do
TC.typeCheckExpect t exp
typeOfExpression :: CSPMMonad m => TCExp -> m Type
typeOfExpression exp =
reportWarnings $ runTypeCheckerInCurrentState (TC.typeOfExp exp)
boundProcessNames :: CSPMMonad m =>
Bool
-> m [Name]
boundProcessNames includeFunctions = do
ns <- getBoundNames
ts <- mapM typeOfName ns
let isProcessFunction (TFunction _ (f@(TFunction _ _))) =
isProcessFunction f
isProcessFunction (TFunction _ t) = isProcess t
isProcessFunction _ = False
isProcess TProc = True
isProcess _ = False
nonFuncNames = map fst $ filter (isProcess . typeSchemeType . snd)
(zip ns ts)
funcNames = map fst $ filter (isProcessFunction . typeSchemeType . snd)
(zip ns ts)
return $ nonFuncNames ++ (if includeFunctions then funcNames else [])
typeOfName :: CSPMMonad m => Name -> m TypeScheme
typeOfName n = reportWarnings $ runTypeCheckerInCurrentState (TC.typeOfName n)
modifyTypeCheckerErrorOptions :: CSPMMonad m =>
(TC.ErrorOptions -> TC.ErrorOptions) -> m ()
modifyTypeCheckerErrorOptions f = reportWarnings $
runTypeCheckerInCurrentState (TC.modifyErrorOptions f)
desugarFile :: CSPMMonad m => TCCSPMFile -> m TCCSPMFile
desugarFile m = DS.runDesugar $ DS.desugar m
desugarExpression :: CSPMMonad m => TCExp -> m TCExp
desugarExpression e = DS.runDesugar $ DS.desugar e
desugarInteractiveStmt :: CSPMMonad m => TCInteractiveStmt -> m TCInteractiveStmt
desugarInteractiveStmt s = DS.runDesugar $ DS.desugar s
runEvaluatorInCurrentState :: CSPMMonad m => EV.EvaluationMonad a -> m a
runEvaluatorInCurrentState p = withSession $ \s -> do
let (a, st) = EV.runFromStateToState (evState s) p
modifySession (\s -> s { evState = st })
return a
bindDeclaration :: CSPMMonad m => TCDecl -> m ()
bindDeclaration d = withSession $ \s -> do
evSt <- runEvaluatorInCurrentState (do
ds <- EV.evaluateDecl d
EV.addToEnvironment ds)
modifySession (\s -> s { evState = evSt })
bindFile :: CSPMMonad m => TCCSPMFile -> m ()
bindFile m = do
evSt <- runEvaluatorInCurrentState $ do
ds <- EV.evaluateFile m
EV.addToEnvironment ds
modifySession (\s -> s { evState = evSt })
return ()
evaluateExpression :: CSPMMonad m => TCExp -> m Value
evaluateExpression e = runEvaluatorInCurrentState (EV.evaluateExp e)
profilingData :: CSPMMonad m => m EV.ProfilingData
profilingData = runEvaluatorInCurrentState EV.profilingData
maybeProcessNameToProcess :: CSPMMonad m => EV.ProcName -> m (Maybe EV.UProc)
maybeProcessNameToProcess pn =
runEvaluatorInCurrentState (EV.maybeProcessNameToProcess pn)
stringToValue :: CSPMMonad m => Type -> String -> m Value
stringToValue typ str =
parseExpression str >>= renameExpression >>=
ensureExpressionIsOfType typ >>= desugarExpression >>= evaluateExpression
getLibCSPMVersion :: Version
getLibCSPMVersion = version
instance (Applicative m, CSPMMonad m,
M.MonadicPrettyPrintable EV.EvaluationMonad a) =>
M.MonadicPrettyPrintable m a where
prettyPrint = runEvaluatorInCurrentState . M.prettyPrint