MathematicaInterpreter.hs revision a3b8d685ae08bf3f83a6c2930e872183c487c844
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder{-# LANGUAGE FlexibleContexts, TypeSynonymInstances #-}
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaederModule : $Header$
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaederDescription : Mathematica instance for the AssignmentStore class
d71c501e69da3973406558162ad439da2b3464d6Christian MaederCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010
d71c501e69da3973406558162ad439da2b3464d6Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
d71c501e69da3973406558162ad439da2b3464d6Christian MaederMaintainer : Ewaryst.Schulz@dfki.de
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaederStability : experimental
46bf8457679e3dd601af7e35cc0966642ba09794Christian MaederPortability : non-portable (via imports)
46bf8457679e3dd601af7e35cc0966642ba09794Christian MaederMathematica as AssignmentStore based on the Mathlink interface
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder--import Control.Monad.Trans (MonadTrans (..), MonadIO (..))
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maederimport Data.List hiding (lookup)
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maederimport qualified Data.Set as Set
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maederimport Prelude hiding (lookup)
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder-- ----------------------------------------------------------------------
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder-- * Mathematica Types and Instances
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- | MathematicaInterpreter with Translator based on the MathLink interface
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maedertype MathState = ASState String
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- Mathematica interface, built on MathLink
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maedertype MathematicaIO = ErrorT ASError (StateT MathState ML)
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maederinstance AssignmentStore MathematicaIO where
ed0055e8e720ca2d07e857e7852de91d47fab9e7Christian Maeder names = get >>= return . SMem . getBMap
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder getUndefinedConstants e = do
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder adg <- gets depGraph
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder let g = isNothing . depGraphLookup adg
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder return $ Set.filter g $ Set.map SimpleConstant $ setOfUserDefined e
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder genNewKey = do
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder let (bm, i) = genKey $ getBMap mit
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder put mit { getBMap = bm }
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder getDepGraph = gets depGraph
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder updateConstant n def =
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder let f gr = updateGraph gr n
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder $ DepGraphAnno { annoDef = def
9d3c461220f8076ef80ca48f7b0574ded9b23e7aChristian Maeder , annoVal = () }
9d3c461220f8076ef80ca48f7b0574ded9b23e7aChristian Maeder mf mit = mit { depGraph = f $ depGraph mit }
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maederinstance VCGenerator MathematicaIO where
af1cb109bce240bcafe3823df022d6088cbfc438Christian Maeder addVC ea e = do
ed0055e8e720ca2d07e857e7852de91d47fab9e7Christian Maeder $ (text "Verification condition for" <+> pretty ea <> text ":")
9d3c461220f8076ef80ca48f7b0574ded9b23e7aChristian Maeder $++$ printExpForVC e
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder vcHdl <- liftM (fromMaybe stdout) $ gets vericondOut
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder liftIO $ hPutStrLn vcHdl s where
ce59e0cc5c7221245ed323290bfccbda4ee32dd9Christian Maederinstance StepDebugger MathematicaIO where
ce59e0cc5c7221245ed323290bfccbda4ee32dd9Christian Maeder setDebugMode b = modify mf where mf mit = mit { debugMode = b }
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder getDebugMode = gets debugMode
af1cb109bce240bcafe3823df022d6088cbfc438Christian Maederinstance SymbolicEvaluator MathematicaIO where
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder setSymbolicMode b = modify mf where mf mit = mit { symbolicMode = b }
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder getSymbolicMode = gets symbolicMode
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maederinstance MessagePrinter MathematicaIO where
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder printMessage = liftIO . putStrLn
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- * Mathematica syntax functions
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- * Generic Communication Interface
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- * The Communication Interface
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- * The Mathematica system via MathLink
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder-- * MathLink stuff
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder-- ----------------------------------------------------------------------
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaederreadAndPrintOutput :: ML ()
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian MaederreadAndPrintOutput = do
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder exptype <- mlGetNext
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder let pr | exptype == dfMLTKSYM = readAndPrintML "Symbol: " mlGetSymbol
ed0055e8e720ca2d07e857e7852de91d47fab9e7Christian Maeder | exptype == dfMLTKSTR = readAndPrintML "String: " mlGetString
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder | exptype == dfMLTKINT = readAndPrintML "Int: " mlGetInteger
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder | exptype == dfMLTKREAL = readAndPrintML "Real: " mlGetReal
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder | exptype == dfMLTKFUNC =
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder len <- mlGetArgCount
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder if len == 0 then mlProcError
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder let f i = readAndPrintOutput
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder >> if i < len then userMessage ", " else return ()
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder readAndPrintOutput
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder userMessage "["
46bf8457679e3dd601af7e35cc0966642ba09794Christian Maeder userMessage "]"
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder | exptype == dfMLTKERROR = userMessageLn "readAndPrintOutput-error" >> mlProcError
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder | otherwise = userMessageLn ("readAndPrintOutput-error" ++ show exptype)
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder >> mlProcError
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian MaederuserMessage :: String -> ML ()
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian MaederuserMessage s = logMessage s >> liftIO (putStr s)
1da2d3de72cd19f22820492bc832c9964762a64eChristian MaederuserMessageLn :: String -> ML ()
1da2d3de72cd19f22820492bc832c9964762a64eChristian MaederuserMessageLn s = logMessageLn s >> liftIO (putStrLn s)
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maederclass MLShow a where
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlshow :: a -> String
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maederinstance MLShow String where
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maederinstance MLShow CDouble where
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maeder mlshow = show
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maederinstance MLShow CInt where
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlshow = show
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaederreadAndPrintML :: MLShow a => String -> ML a -> ML ()
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaederreadAndPrintML _ pr = pr >>= userMessage . mlshow
af1cb109bce240bcafe3823df022d6088cbfc438Christian Maeder-- * Test functionality
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaedersendPlus :: CInt -> CInt -> CInt -> ML ()
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaedersendPlus i j k = do
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutFunction "EvaluatePacket" 1
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutFunction "Plus" 3
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutInteger i
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutInteger j
1da2d3de72cd19f22820492bc832c9964762a64eChristian Maeder mlPutInteger k
af1cb109bce240bcafe3823df022d6088cbfc438Christian Maeder userMessageLn "Sent"
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaedersendFormula :: CInt -> CInt -> CInt -> ML ()
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian MaedersendFormula i j k = do
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutFunction "EvaluatePacket" 1
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maeder mlPutFunction "Plus" 2
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maeder mlPutFunction "Times" 2
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutInteger i
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutInteger j
ed0055e8e720ca2d07e857e7852de91d47fab9e7Christian Maeder mlPutFunction "Times" 3
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutInteger k
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder mlPutInteger k
3db8b71dd1ccc662325b96a5ee8f351ace0293baChristian Maeder mlPutSymbol "xsymb"
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder userMessageLn "Sent"
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder-- ----------------------------------------------------------------------
31c6978fd9066c9d2c3c98c950f7abbe89112522Christian Maeder-- ----------------------------------------------------------------------
31c6978fd9066c9d2c3c98c950f7abbe89112522Christian Maedertest :: [String] -> IO ()
31c6978fd9066c9d2c3c98c950f7abbe89112522Christian Maedertest argv = do
1da2d3de72cd19f22820492bc832c9964762a64eChristian Maeder let (k, i, j) = (read $ argv!!0, read $ argv!!1, read $ argv!!2)
1da2d3de72cd19f22820492bc832c9964762a64eChristian Maeder mN = if length argv > 3 then Just $ argv!!3 else Nothing
1da2d3de72cd19f22820492bc832c9964762a64eChristian Maeder-- liftIO (putStrLn $ "Sending " ++ show (i, j, k))
31c6978fd9066c9d2c3c98c950f7abbe89112522Christian Maeder -- Send Plus[i, j]
af1cb109bce240bcafe3823df022d6088cbfc438Christian Maeder eRes <- runLink (Just "/tmp/mlffi.txt") mN $
af1cb109bce240bcafe3823df022d6088cbfc438Christian Maeder forM_ [1 .. k] $ sendFormula i j >=>
bd8ff5b5f66be563e5be9d3a0c069e32d06f331cChristian Maeder const (receivePacket >> readAndPrintOutput >> userMessageLn "")
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maeder Left eid -> putStrLn $ "Error " ++ show eid
798a3d6fdcb8c17b0bc3502a150be75c9ec8799bChristian Maeder _ -> putStrLn $ "OK"