f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzDescription : Mathematica instance for the AssignmentStore class
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzLicense : GPLv2 or higher, see LICENSE.txt
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzMaintainer : Ewaryst.Schulz@dfki.de
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzStability : experimental
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzPortability : non-portable (via imports)
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst SchulzMathematica as AssignmentStore based on the Mathlink interface
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- import Control.Monad.Trans (MonadTrans (..), MonadIO (..))
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzimport Data.List hiding (lookup)
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzimport qualified Data.Set as Set
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulzimport Prelude hiding (lookup)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ----------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederMathematica Types and Instances
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder---------------------------------------------------------------------- -}
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz-- | MathematicaInterpreter with Translator based on the MathLink interface
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulztype MathState = ASState (MLState, Maybe FilePath)
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz-- Mathematica interface, built on MathLink
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulztype MathematicaIO = ErrorT ASError (StateT MathState ML)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzgetMLState :: MathState -> MLState
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzgetMLState = fst . getConnectInfo
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzgetMLLogFile :: MathState -> Maybe FilePath
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzgetMLLogFile = snd . getConnectInfo
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzliftML :: ML a -> MathematicaIO a
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzliftML = lift . lift
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzinstance AssignmentStore MathematicaIO where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder assign = genAssign mathematicaAssign
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz assigns l = genAssigns mathematicaAssigns l >> return ()
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz lookup = genLookup mathematicaLookup
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz eval = genEval mathematicaEval
6091bd7fb65c7def81e5a5d0359ceeed7a88bb7fEwaryst Schulz check = mathematicaCheck
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder names = liftM (SMem . getBMapget) get
6091bd7fb65c7def81e5a5d0359ceeed7a88bb7fEwaryst Schulz evalRaw s = get >>= liftIO . mathematicaDirect s
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz getUndefinedConstants e = do
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz adg <- gets depGraph
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz let g = isNothing . depGraphLookup adg
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz return $ Set.filter g $ Set.map SimpleConstant $ setOfUserDefined e
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz genNewKey = do
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz let (bm, i) = genKey $ getBMap mit
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz put mit { getBMap = bm }
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz getDepGraph = gets depGraph
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz updateConstant n def =
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz let f gr = updateGraph gr n
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder DepGraphAnno { annoDef = def
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder , annoVal = () }
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz mf mit = mit { depGraph = f $ depGraph mit }
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzinstance VCGenerator MathematicaIO where
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz addVC ea e = do
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz vcHdl <- liftM (fromMaybe stdout) $ gets vericondOut
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder liftIO $ hPrint vcHdl $ printVCForIsabelle ea "lemma1" e
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzinstance StepDebugger MathematicaIO where
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz setDebugMode b = modify mf where mf mit = mit { debugMode = b }
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz getDebugMode = gets debugMode
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzinstance SymbolicEvaluator MathematicaIO where
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz setSymbolicMode b = modify mf where mf mit = mit { symbolicMode = b }
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz getSymbolicMode = gets symbolicMode
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulzinstance MessagePrinter MathematicaIO where
f474203c4cef7d85cb078f15ce5c2cea71e9a030Ewaryst Schulz printMessage = liftIO . putStrLn
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ----------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederMathematica syntax and special terms
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder---------------------------------------------------------------------- -}
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmmShowOPNAME :: OPNAME -> String
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmmShowOPNAME x =
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz OP_plus -> "Plus"
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz OP_mult -> "Times"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_pow -> "Power"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_div -> "Divide"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_neq -> "Unequal"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_lt -> "Less"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_leq -> "LessEqual"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_eq -> "Equal"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_gt -> "Greater"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_geq -> "GreaterEqual"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_sqrt -> "Sqrt"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_abs -> "Abs"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_sign -> "Sign"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_max -> "Max"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_min -> "Min"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_sin -> "Sin"
9316034585ad46e11b1307ec8289f25b7699d74dEwaryst Schulz OP_cos -> "Cos"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_tan -> "Tan"
9316034585ad46e11b1307ec8289f25b7699d74dEwaryst Schulz OP_cot -> "Cot"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_Pi -> "Pi"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_and -> "And"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_not -> "Not"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_or -> "Or"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_impl -> "Implies"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_false -> "False"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_true -> "True"
21c27810fa966e9253073efaf7f36458715d84bbEwaryst Schulz OP_approx -> "N"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz -- these functions have to be defined in a package
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz OP_minus -> "minus"
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz OP_neg -> "negate"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_fthrt -> "fthrt"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_maxloc -> "maxloc"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_minloc -> "minloc"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_reldist -> "reldist"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_reldistLe -> "reldistLe"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_undef -> "undef"
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz OP_failure -> "fail"
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz _ -> showOPNAME x
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmmShowOPID :: OPID -> String
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmmShowOPID (OpId x) = mmShowOPNAME x
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmmShowOPID (OpUser (SimpleConstant s)) = s
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmmShowOPID _ = error "mmShowOpId: unsupported constant"
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmmFlexFoldOpList :: [OPNAME]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmmFlexFoldOpList = [ OP_plus, OP_mult, OP_and, OP_or ]
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaOperatorInfo :: [OpInfo]
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaOperatorInfo = toFlexFold mmFlexFoldOpList operatorInfo
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz-- | opInfoMap for mathematica's prdefined symbols
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzmathematicaOpInfoMap :: OpInfoMap
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaOpInfoMap =
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz getOpInfoMap (mmShowOPNAME . opname) mathematicaOperatorInfo
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz-- | opInfoNameMap for mathematica's prdefined symbols
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaOpInfoNameMap :: OpInfoNameMap
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaOpInfoNameMap =
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz getOpInfoNameMap mathematicaOperatorInfo
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmathematicaBindInfoMap :: BindInfoMap
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst SchulzmathematicaBindInfoMap = getBindInfoMap mathematicaOperatorInfo
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulztoFlexFold :: [OPNAME] -> [OpInfo] -> [OpInfo]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedertoFlexFold nl = map f where
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz f oi | Set.member (opname oi) ns = oi { arity = -1, foldNAry = True }
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz | otherwise = oi
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz-- | mathematica term "Set"
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtDef :: String -> AssDefinition -> EXPRESSION
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtDef s (ConstDef e) = mkOp "Set" [mkOp s [], e]
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtDef s (FunDef args e) = mkOp "Set" [mkOp s $ map mtVarDecl args, e]
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtVarDecl :: String -> EXPRESSION
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtVarDecl s = mkOp "Pattern" [mkOp s [], mkOp "Blank" []]
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtList :: [EXPRESSION] -> EXPRESSION
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtList = mkOp "List"
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtCompound :: [EXPRESSION] -> EXPRESSION
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtCompound = mkOp "CompoundExpression"
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtIsBlank :: OPID -> Bool
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmtIsBlank oi = mmShowOPID oi == "Blank"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ----------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederMathematica pretty printing
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder---------------------------------------------------------------------- -}
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzdata OfMathematica a = OfMathematica { mmValue :: a }
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulztype MathPrinter = Reader (OfMathematica OpInfoNameMap)
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzinstance ExpressionPrinter MathPrinter where
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz getOINM = asks mmValue
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz printOpname = return . text . mmShowOPNAME
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder printArgs = return . brackets . sepByCommas
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prefixMode = return True
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz printArgPattern s = return $ text s <> text "_"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintMathPretty :: MathPrinter Doc -> Doc
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzprintMathPretty = flip runReader $ OfMathematica mathematicaOpInfoNameMap
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzclass MathPretty a where
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz mmPretty :: a -> Doc
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzinstance MathPretty EXPRESSION where
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz mmPretty e = printMathPretty $ printExpression e
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzinstance MathPretty AssDefinition where
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz mmPretty def = printMathPretty $ printAssDefinition def
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzinstance MathPretty String where
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz mmPretty = text
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulzinstance (MathPretty a, MathPretty b) => MathPretty [(a, b)] where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder mmPretty = ppPairlist mmPretty mmPretty braces sepBySemis (<>)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ----------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederMathematica over ML Interface
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder---------------------------------------------------------------------- -}
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzsendExpressionString :: String -> ML ()
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzsendExpressionString s = do
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz mlPutFunction' "ToExpression" 1
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz mlPutString s
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst SchulzsendExpression :: Bool -- ^ symbolic mode
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz -> EXPRESSION -> ML ()
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst SchulzsendExpression sm e =
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz Var token -> mlPutSymbol (tokStr token) >> return ()
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz -- blanks get extra empty brackets
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz | mtIsBlank oi -> mlPutFunction' "Blank" 0 >> return ()
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz | otherwise -> mlPutSymbol (mmShowOPID oi) >> return ()
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz Op oi _ exps _ -> do
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz mlPutFunction' (mmShowOPID oi) (length exps)
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz mapM_ (sendExpression sm) exps
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Int i _ -> mlPutInteger'' i >> return ()
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz | sm -> putRational r
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz | otherwise -> mlPutFunction' "N" 1 >> putRational r
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz where putRational r' = do
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz let (n1, dn2) = toFraction r'
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz mlPutFunction' "Rational" 2
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz mlPutInteger'' n1
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz mlPutInteger'' dn2
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz List _ _ -> error "sendExpression: List not supported"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Interval {} -> error "sendExpression: Interval not supported"
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst SchulzreceiveExpression :: ML EXPRESSION
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederreceiveExpression = do
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz et <- mlGetNext
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz let mkMLOp s args = mkAndAnalyzeOp ( mathematicaOpInfoMap
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz , mathematicaBindInfoMap )
ee3bb87ab2da52ee1ad0c6675ea8b699b0af9ddcEwaryst Schulz s [] args nullRange
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pr | et == dfMLTKSYM = liftM (`mkMLOp` []) mlGetSymbol
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder | et == dfMLTKINT = liftM (`Int` nullRange) mlGetInteger''
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder | et == dfMLTKREAL = liftM (`Rat` nullRange . toRational) mlGetReal'
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz | et == dfMLTKFUNC =
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz ac <- mlGetArgCount
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz if ac == 0 then mlProcError
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz -- the head is expected to be a symbol
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz et' <- mlGetNext
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz s <- if et' == dfMLTKSYM then mlGetSymbol else
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz error $ "receiveExpression: Expecting symbol at "
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz ++ "function head, but got " ++ show et'
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz if s == "Rational" then
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz nn <- mlGetInteger''
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz dn <- mlGetInteger''
213ff2bc64713dccda8de3db300ba188bd585866Ewaryst Schulz return $ Rat (fromFraction nn dn) nullRange
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder liftM (mkMLOp s) $ forM [1 .. ac] $ const receiveExpression
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz | et == dfMLTKERROR = mlProcError
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz | otherwise = mlProcError
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzreceiveString :: ML String
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederreceiveString = do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz et <- mlGetNext
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz if et == dfMLTKSTR then mlGetString
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz else error $ "receiveString: Got " ++ showTK et
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ----------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederMethods for Mathematica 'AssignmentStore' Interface
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder---------------------------------------------------------------------- -}
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmathematicaSend :: EXPRESSION -> MathematicaIO ()
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaSend e = do
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prettyInfo3 $ text "Sending expression" <+> braces (mmPretty e)
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz sm <- getSymbolicMode
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz liftML $ sendEvalPacket (sendExpression sm e) >> skipAnswer >> return ()
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmathematicaEval :: EXPRESSION -> MathematicaIO EXPRESSION
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaEval e = do
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prettyInfo3 $ text "Sending expression for evaluation"
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz <+> braces (mmPretty e)
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz sm <- getSymbolicMode
f31eef72d6536eeb5a51e86d1f367cbb1a1b8e06Ewaryst Schulz res <- liftML $ sendEvalPacket (sendExpression sm e) >> waitForAnswer
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz >> receiveExpression
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prettyInfo3 $ text "Received expression"
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz <+> braces (mmPretty res)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaAssign :: String -> AssDefinition -> MathematicaIO EXPRESSION
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaAssign s def = do
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prettyInfo $ text "Assigning" <+> mmPretty s <+> mmPretty def
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz mathematicaEval $ mtDef s def
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaAssigns :: [(String, AssDefinition)] -> MathematicaIO ()
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst SchulzmathematicaAssigns l = do
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prettyInfo $ text "Assigning list" <+> mmPretty l
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz let l' = map (uncurry mtDef) l
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz mathematicaSend $ mtCompound l'
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaLookup :: String -> MathematicaIO EXPRESSION
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaLookup s = mathematicaEval $ mkOp s []
6091bd7fb65c7def81e5a5d0359ceeed7a88bb7fEwaryst SchulzmathematicaCheck :: EXPRESSION -> MathematicaIO Bool
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaCheck e = do
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz prettyInfo $ text "Checking expression" <+> mmPretty e
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz eB <- genCheck mathematicaEval e
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Right b -> return b
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz throwError $ ASError CASError $
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz concat [ "mathematicaCheck:", show e, "\n", s ]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmathematicaDirect :: String -> MathState -> IO String
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmathematicaDirect s st =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz liftM snd $ withMathematica st $ liftML
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz $ sendTextResultPacket s >> waitForAnswer >> receiveString
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- ----------------------------------------------------------------------
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederThe Mathematica system via MathLink
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder---------------------------------------------------------------------- -}
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzloadMathematicaModule :: FilePath -> MathematicaIO ()
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzloadMathematicaModule fp =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz liftML $ sendTextPacket ("<<" ++ show fp) >> skipAnswer >> return ()
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzwithMathematica :: MathState -> MathematicaIO a -> IO (MathState, a)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzwithMathematica st mprog = do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let stE = runErrorT mprog -- (:: StateT MathState ML (Either ASError a))
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz mlE = runStateT stE st -- (:: ML (Either ASError a, MathState))
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz (eRes, st') <- withLink (getMLState st) (getMLLogFile st) mlE
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Left err -> throwASError err
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Right res -> return (st', res)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz-- | Init the Mathematica communication
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaInit :: AssignmentDepGraph ()
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz -> Int -- ^ Verbosity level
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz -> Maybe FilePath -- ^ Log MathLink messages into this file
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder -> Maybe String {- ^ Connection name
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (launches a new kernel if not specified) -}
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz -> IO MathState
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaInit adg v mFp mN = do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz eMLSt <- openLink v mN
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz case eMLSt of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz error $ "mathematicaInit: MathLink connection failure " ++ show i
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Right mlSt ->
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz return $ initASState (mlSt, mFp) mathematicaOpInfoMap adg v
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaExit :: MathState -> IO ()
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzmathematicaExit = closeLink . getMLState
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzrunWithMathematica :: AssignmentDepGraph () -> Int -- ^ Verbosity level
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz -> Maybe FilePath -- ^ Log MathLink messages into this file
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder -> Maybe String {- ^ Connection name
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (launches a new kernel if not specified) -}
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz -> [String] -- ^ mathematica modules to load
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz -> MathematicaIO a -- ^ the mathematica program to run
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz -> IO (MathState, a)
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzrunWithMathematica adg i mFp mN mods p = do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mst <- mathematicaInit adg i mFp mN
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz withMathematica mst $ mapM_ loadMathematicaModule mods >> p