MathematicaInterpreter.hs revision 67f09e0fddea50c48620c011b6d001cffe565de6
181e56d8b348d301d615ccf5465ae600fee2867berikabele{-# LANGUAGE FlexibleContexts, TypeSynonymInstances #-}
181e56d8b348d301d615ccf5465ae600fee2867berikabele{- |
fd9abdda70912b99b24e3bf1a38f26fde908a74cndModule : $Header$
fd9abdda70912b99b24e3bf1a38f26fde908a74cndDescription : Mathematica instance for the AssignmentStore class
fd9abdda70912b99b24e3bf1a38f26fde908a74cndCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fsliveLicense : GPLv2 or higher, see LICENSE.txt
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fslive
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fsliveMaintainer : Ewaryst.Schulz@dfki.de
5a58787efeb02a1c3f06569d019ad81fd2efa06endStability : experimental
96ad5d81ee4a2cc66a4ae19893efc8aa6d06fae7jailletcPortability : non-portable (via imports)
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimMathematica as AssignmentStore based on the Mathlink interface
d29d9ab4614ff992b0e8de6e2b88d52b6f1f153erbowen-}
2e545ce2450a9953665f701bb05350f0d3f26275nd
d29d9ab4614ff992b0e8de6e2b88d52b6f1f153erbowenmodule CSL.MathematicaInterpreter where
d29d9ab4614ff992b0e8de6e2b88d52b6f1f153erbowen
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimimport Common.Id
5a58787efeb02a1c3f06569d019ad81fd2efa06endimport Common.Doc
af33a4994ae2ff15bc67d19ff1a7feb906745bf8rbowenimport Common.DocUtils
3f08db06526d6901aa08c110b5bc7dde6bc39905nd
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimimport Common.MathLink
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
5a58787efeb02a1c3f06569d019ad81fd2efa06end
3f08db06526d6901aa08c110b5bc7dde6bc39905ndimport CSL.AS_BASIC_CSL
3b3b7fc78d1f5bfc2769903375050048ff41ff26ndimport CSL.Interpreter
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimimport CSL.Verification
af84459fbf938e508fd10b01cb8d699c79083813takashiimport CSL.Analysis
7f5b59ccc63c0c0e3e678a168f09ee6a2f51f9d0ndimport CSL.GenericInterpreter
f3ec420152ca921e4c1ce77782f51b53f659018dnd
f086b4b402fa9a2fefc7dda85de2a3cc1cd0a654rjung
3b3b7fc78d1f5bfc2769903375050048ff41ff26ndimport Control.Monad
3b3b7fc78d1f5bfc2769903375050048ff41ff26nd--import Control.Monad.Trans (MonadTrans (..), MonadIO (..))
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenimport Control.Monad.Error
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenimport Control.Monad.State
c7ed811e89712261aaa4432198e331389044e1f8rjung
c7ed811e89712261aaa4432198e331389044e1f8rjungimport Data.List hiding (lookup)
c7ed811e89712261aaa4432198e331389044e1f8rjungimport qualified Data.Set as Set
c7ed811e89712261aaa4432198e331389044e1f8rjungimport Data.Maybe
c7ed811e89712261aaa4432198e331389044e1f8rjungimport System.IO
c7ed811e89712261aaa4432198e331389044e1f8rjung
c7ed811e89712261aaa4432198e331389044e1f8rjung
c7ed811e89712261aaa4432198e331389044e1f8rjungimport Prelude hiding (lookup)
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
5a58787efeb02a1c3f06569d019ad81fd2efa06end-- ----------------------------------------------------------------------
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim-- * Mathematica Types and Instances
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim-- ----------------------------------------------------------------------
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim-- | MathematicaInterpreter with Translator based on the MathLink interface
30471a4650391f57975f60bbb6e4a90be7b284bfhumbedoohtype MathState = ASState (MLState, Maybe FilePath)
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
5a58787efeb02a1c3f06569d019ad81fd2efa06end-- Mathematica interface, built on MathLink
5a58787efeb02a1c3f06569d019ad81fd2efa06endtype MathematicaIO = ErrorT ASError (StateT MathState ML)
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fslive
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimgetMLState :: MathState -> MLState
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fslivegetMLState = fst . getConnectInfo
c6e63344e43c53e7a81e94fac04c1842767de22arbowen
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimgetMLLogFile :: MathState -> Maybe FilePath
c6e63344e43c53e7a81e94fac04c1842767de22arbowengetMLLogFile = snd . getConnectInfo
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
c7ed811e89712261aaa4432198e331389044e1f8rjung
c7ed811e89712261aaa4432198e331389044e1f8rjungliftML :: ML a -> MathematicaIO a
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowenliftML = lift . lift
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fslive
5ce121e164ea2c1b0cc554cb8c2e8540cfdac02fslive
c7ed811e89712261aaa4432198e331389044e1f8rjunginstance AssignmentStore MathematicaIO where
c7ed811e89712261aaa4432198e331389044e1f8rjung assign = genAssign mathematicaAssign
c7ed811e89712261aaa4432198e331389044e1f8rjung assigns l = genAssigns mathematicaAssigns l >> return ()
c7ed811e89712261aaa4432198e331389044e1f8rjung lookup = genLookup mathematicaLookup
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen eval = genEval mathematicaEval
c6e63344e43c53e7a81e94fac04c1842767de22arbowen check = mathematicaCheck
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrbowen names = get >>= return . SMem . getBMap
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim evalRaw s = get >>= liftIO . mathematicaDirect s
9bcfc3697a91b5215893a7d0206865b13fc72148nd
c6e63344e43c53e7a81e94fac04c1842767de22arbowen getUndefinedConstants e = do
c6e63344e43c53e7a81e94fac04c1842767de22arbowen adg <- gets depGraph
c6e63344e43c53e7a81e94fac04c1842767de22arbowen let g = isNothing . depGraphLookup adg
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen return $ Set.filter g $ Set.map SimpleConstant $ setOfUserDefined e
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim genNewKey = do
c6e63344e43c53e7a81e94fac04c1842767de22arbowen mit <- get
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen let (bm, i) = genKey $ getBMap mit
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen put mit { getBMap = bm }
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen return i
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim
5a58787efeb02a1c3f06569d019ad81fd2efa06end getDepGraph = gets depGraph
5a58787efeb02a1c3f06569d019ad81fd2efa06end updateConstant n def =
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen let f gr = updateGraph gr n
c6e63344e43c53e7a81e94fac04c1842767de22arbowen $ DepGraphAnno { annoDef = def
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen , annoVal = () }
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen mf mit = mit { depGraph = f $ depGraph mit }
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen in modify mf
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrboweninstance VCGenerator MathematicaIO where
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen addVC ea e = do
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrbowen let
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen s = show
181e56d8b348d301d615ccf5465ae600fee2867berikabele $ (text "Verification condition for" <+> pretty ea <> text ":")
c7ed811e89712261aaa4432198e331389044e1f8rjung $++$ printExpForVC e
35c69680976019d8c68d83236614752d1d8e6081slive vcHdl <- liftM (fromMaybe stdout) $ gets vericondOut
181e56d8b348d301d615ccf5465ae600fee2867berikabele liftIO $ hPutStrLn vcHdl s where
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rboweninstance StepDebugger MathematicaIO where
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen setDebugMode b = modify mf where mf mit = mit { debugMode = b }
eceded617d1b6f35497902cea1788f87596d9854rjung getDebugMode = gets debugMode
eceded617d1b6f35497902cea1788f87596d9854rjung
eceded617d1b6f35497902cea1788f87596d9854rjunginstance SymbolicEvaluator MathematicaIO where
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrbowen setSymbolicMode b = modify mf where mf mit = mit { symbolicMode = b }
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen getSymbolicMode = gets symbolicMode
181e56d8b348d301d615ccf5465ae600fee2867berikabele
c7ed811e89712261aaa4432198e331389044e1f8rjunginstance MessagePrinter MathematicaIO where
35c69680976019d8c68d83236614752d1d8e6081slive printMessage = liftIO . putStrLn
181e56d8b348d301d615ccf5465ae600fee2867berikabele
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- ----------------------------------------------------------------------
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- * Mathematica syntax and special terms
eceded617d1b6f35497902cea1788f87596d9854rjung-- ----------------------------------------------------------------------
eceded617d1b6f35497902cea1788f87596d9854rjung
eceded617d1b6f35497902cea1788f87596d9854rjungmmShowOPNAME :: OPNAME -> String
eceded617d1b6f35497902cea1788f87596d9854rjungmmShowOPNAME x =
eceded617d1b6f35497902cea1788f87596d9854rjung case x of
eceded617d1b6f35497902cea1788f87596d9854rjung OP_plus -> "Plus"
eceded617d1b6f35497902cea1788f87596d9854rjung OP_mult -> "Times"
eceded617d1b6f35497902cea1788f87596d9854rjung OP_pow -> "Power"
eceded617d1b6f35497902cea1788f87596d9854rjung OP_div -> "Divide"
eceded617d1b6f35497902cea1788f87596d9854rjung
eceded617d1b6f35497902cea1788f87596d9854rjung
eceded617d1b6f35497902cea1788f87596d9854rjung OP_neq -> "Unequal"
eceded617d1b6f35497902cea1788f87596d9854rjung OP_lt -> "Less"
eceded617d1b6f35497902cea1788f87596d9854rjung OP_leq -> "LessEqual"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_eq -> "Equal"
c6e63344e43c53e7a81e94fac04c1842767de22arbowen OP_gt -> "Greater"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_geq -> "GreaterEqual"
c6e63344e43c53e7a81e94fac04c1842767de22arbowen
9a58dc6a2b26ec128b1270cf48810e705f1a90dbsf OP_sqrt -> "Sqrt"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_abs -> "Abs"
181e56d8b348d301d615ccf5465ae600fee2867berikabele OP_sign -> "Sign"
181e56d8b348d301d615ccf5465ae600fee2867berikabele
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrbowen OP_max -> "Max"
181e56d8b348d301d615ccf5465ae600fee2867berikabele OP_min -> "Min"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_cos -> "Cos"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_sin -> "Sin"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_tan -> "Tan"
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim OP_Pi -> "Pi"
c6e63344e43c53e7a81e94fac04c1842767de22arbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_and -> "And"
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrbowen OP_not -> "Not"
42dcfa2aba12aaa08c30caa333d67b96889eb4ffrbowen OP_or -> "Or"
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim OP_impl -> "Implies"
5a58787efeb02a1c3f06569d019ad81fd2efa06end OP_false -> "False"
5a58787efeb02a1c3f06569d019ad81fd2efa06end OP_true -> "True"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen -- these functions have to be defined in a package
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_minus -> "Minus"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_neg -> "Negate"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_fthrt -> "fthrt"
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_maxloc -> "maxloc"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_minloc -> "minloc"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_reldist -> "reldist"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_reldistLe -> "reldistLe"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_undef -> "undef"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen OP_failure -> "fail"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen _ -> showOPNAME x
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmmShowOPID :: OPID -> String
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmmShowOPID (OpId x) = mmShowOPNAME x
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmmShowOPID (OpUser (SimpleConstant s)) = s
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmmShowOPID _ = error "mmShowOpId: unsupported constant"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- | opInfoMap for mathematica's prdefined symbols
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaOpInfoMap :: OpInfoMap
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaOpInfoMap = getOpInfoMap (mmShowOPNAME . opname) operatorInfo
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowensendExpressionString :: String -> ML ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowensendExpressionString s = do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen mlPutFunction' "ToExpression" 1
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen mlPutString s
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen return ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowensendExpression :: EXPRESSION -> ML ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowensendExpression e =
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen case e of
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Var token -> mlPutSymbol (tokStr token) >> return ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Op oi _ [] _ -> mlPutSymbol (mmShowOPID oi) >> return ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Op oi _ exps _ ->
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen mlPutFunction' (mmShowOPID oi) (length exps) >> mapM_ sendExpression exps
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Int i _ -> mlPutInteger'' i >> return ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Double r _ -> mlPutReal' r >> return ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen List _ _ -> error "sendExpression: List not supported"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Interval _ _ _ -> error "sendExpression: Interval not supported"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenreceiveExpression :: ML EXPRESSION
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenreceiveExpression = do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen et <- mlGetNext
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen let mkMLOp s args = mkAndAnalyzeOp mathematicaOpInfoMap s [] args nullRange
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen pr | et == dfMLTKSYM = liftM (flip mkMLOp []) mlGetSymbol
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen | et == dfMLTKINT = liftM (flip Int nullRange) mlGetInteger''
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen | et == dfMLTKREAL = liftM (flip Double nullRange) mlGetReal'
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen | et == dfMLTKFUNC =
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen len <- mlGetArgCount
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen if len == 0 then mlProcError
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen else do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen -- the head is expected to be a symbol
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen et' <- mlGetNext
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen s <- if et' == dfMLTKSYM then mlGetSymbol else
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen error $ "receiveExpression: Expecting symbol at "
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen ++ "function head, but got " ++ show et'
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen liftM (mkMLOp s) $ forM [1..len] $ const receiveExpression
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen | et == dfMLTKERROR = mlProcError
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen | otherwise = mlProcError
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen pr
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaSetTerm :: String -> AssDefinition -> EXPRESSION
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaSetTerm s (ConstDef e) = mkOp "Set" [mkOp s [], e]
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaSetTerm _ _ = error "mathematicaSetTerm: fundefs unsupported"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaListTerm :: [EXPRESSION] -> EXPRESSION
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaListTerm = mkOp "List"
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaSend :: EXPRESSION -> MathematicaIO ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaSend e = liftML $ sendEvalPacket (sendExpression e) >> skipAnswer
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- ----------------------------------------------------------------------
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- * Methods for Mathematica 'AssignmentStore' Interface
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- ----------------------------------------------------------------------
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaAssign :: String -> AssDefinition -> MathematicaIO EXPRESSION
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimmathematicaAssign s def = mathematicaEval $ mathematicaSetTerm s def
5a58787efeb02a1c3f06569d019ad81fd2efa06end
5a58787efeb02a1c3f06569d019ad81fd2efa06endmathematicaAssigns :: [(String, AssDefinition)] -> MathematicaIO ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaAssigns l = mathematicaSend $ mathematicaListTerm l'
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen where l' = map (uncurry mathematicaSetTerm) l
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaLookup :: String -> MathematicaIO EXPRESSION
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaLookup s = mathematicaEval $ mkOp s []
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowenmathematicaEval :: EXPRESSION -> MathematicaIO EXPRESSION
7add1372edb1ee95a2c4d1314df4c7567bda7c62jimmathematicaEval e =
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen liftML $ sendEvalPacket (sendExpression e) >> waitForAnswer
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen >> receiveExpression
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowenmathematicaCheck :: EXPRESSION -> MathematicaIO Bool
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowenmathematicaCheck e = do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen eB <- genCheck mathematicaEval e
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen case eB of
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Right b -> return b
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen Left s ->
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen throwError $ ASError CASError $
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen concat [ "mathematicaCheck: CAS error for expression "
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen , show e, "\n", s ]
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim-- ----------------------------------------------------------------------
c6e63344e43c53e7a81e94fac04c1842767de22arbowen-- * The Mathematica system via MathLink
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- ----------------------------------------------------------------------
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
c6e63344e43c53e7a81e94fac04c1842767de22arbowen-- TODO: implement the textpackage stuff
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaDirect :: String -> MathState -> IO String
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaDirect = error ""
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenwithMathematica :: MathState -> MathematicaIO a -> IO (MathState, a)
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenwithMathematica st mprog = do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen let stE = runErrorT mprog -- (:: StateT MathState ML (Either ASError a))
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen mlE = runStateT stE st -- (:: ML (Either ASError a, MathState))
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen (eRes, st') <- withLink (getMLState st) (getMLLogFile st) mlE
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen case eRes of
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen Left err -> throwASError err
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Right res -> return (st', res)
50abbb3ef90b5708d61f9c92a7bed70a993da36arbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen-- | Init the Mathematica communication
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowenmathematicaInit :: AssignmentDepGraph ()
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen -> Int -- ^ Verbosity level
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen -> Maybe FilePath -- ^ Log MathLink messages into this file
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen -> Maybe String -- ^ Connection name
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen -- (launches a new kernel if not specified)
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen -> IO MathState
c6e63344e43c53e7a81e94fac04c1842767de22arbowenmathematicaInit adg v mFp mN = do
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen eMLSt <- openLink v mN
c6e63344e43c53e7a81e94fac04c1842767de22arbowen case eMLSt of
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen Left i ->
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen error $ "mathematicaInit: MathLink connection failure " ++ show i
c6e63344e43c53e7a81e94fac04c1842767de22arbowen Right mlSt ->
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen return ASState { getBMap = initWithOpMap mathematicaOpInfoMap
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen , getConnectInfo = (mlSt, mFp)
57d0156f7bbd9ea3a72342cf9912aba61d118702rbowen , depGraph = adg
5a58787efeb02a1c3f06569d019ad81fd2efa06end , debugMode = False
3b3b7fc78d1f5bfc2769903375050048ff41ff26nd , symbolicMode = False
7add1372edb1ee95a2c4d1314df4c7567bda7c62jim , verbosity = v
af84459fbf938e508fd10b01cb8d699c79083813takashi , vericondOut = Nothing
7f5b59ccc63c0c0e3e678a168f09ee6a2f51f9d0nd }
f3ec420152ca921e4c1ce77782f51b53f659018dnd
f086b4b402fa9a2fefc7dda85de2a3cc1cd0a654rjungmathematicaExit :: MathState -> IO ()
727872d18412fc021f03969b8641810d8896820bhumbedoohmathematicaExit = closeLink . getMLState
0d0ba3a410038e179b695446bb149cce6264e0abnd
727872d18412fc021f03969b8641810d8896820bhumbedooh{-
cc7e1025de9ac63bd4db6fe7f71c158b2cf09fe4humbedooh
0d0ba3a410038e179b695446bb149cce6264e0abnd-- | Open connection to MathLink or return error code on failure
cc7e1025de9ac63bd4db6fe7f71c158b2cf09fe4humbedoohopenLink :: Maybe String -- ^ Connection name
727872d18412fc021f03969b8641810d8896820bhumbedooh -- (launches a new kernel if not specified)
0d0ba3a410038e179b695446bb149cce6264e0abnd -> IO (Either Int MLState)
0d0ba3a410038e179b695446bb149cce6264e0abnd-- | Run ML-program on an opened connection to MathLink
0d0ba3a410038e179b695446bb149cce6264e0abndwithLink :: MLState -- ^ MathLink connection
ac082aefa89416cbdc9a1836eaf3bed9698201c8humbedooh -> Maybe FilePath -- ^ Log low level messages into this file (or STDOUT)
0d0ba3a410038e179b695446bb149cce6264e0abnd -> ML a -- ^ The program to run
0d0ba3a410038e179b695446bb149cce6264e0abnd -> IO a
0d0ba3a410038e179b695446bb149cce6264e0abnd
727872d18412fc021f03969b8641810d8896820bhumbedooh
0d0ba3a410038e179b695446bb149cce6264e0abnd
0d0ba3a410038e179b695446bb149cce6264e0abndtype MathState = ASState MLState
30471a4650391f57975f60bbb6e4a90be7b284bfhumbedoohtype MathematicaIO = ErrorT ASError (StateT MathState ML)
205f749042ed530040a4f0080dbcb47ceae8a374rjung
af33a4994ae2ff15bc67d19ff1a7feb906745bf8rbowen
0d0ba3a410038e179b695446bb149cce6264e0abndrunStateT ms $ runErrorT m
7fec19672a491661b2fe4b29f685bc7f4efa64d4nd
7fec19672a491661b2fe4b29f685bc7f4efa64d4ndrunErrorT :: ErrorT e m a -> m (Either e a)
7fec19672a491661b2fe4b29f685bc7f4efa64d4ndrunStateT :: StateT s m a -> s -> m (a, s)
5a58787efeb02a1c3f06569d019ad81fd2efa06end-}