module Foreign.MathLink.Types (
Expressible(..)
, Dimensional(..)
, Expression(..)
, ML(..)
, Config(..)
, Function(..)
, State(..)
, runML
, Link(..)
, Environment(..)
, Type(..)
, mkType
, Message(..)
, mkMessage
, Error(..)
, mkError
, Packet(..)
, mkPacket
) where
import Foreign
import Foreign.C
import Data.Ix
import Data.Data
import Data.IntMap
import qualified Control.Monad.State as St
import qualified Control.Monad.Reader as Rd
import qualified Control.Monad.Error as Er
import Control.Monad.Trans
class Expressible a where
put :: a -> ML ()
get :: ML a
class Ix ix => Dimensional ix where
rank :: ix -> Int
dimensions :: (ix,ix) -> [Int]
fromDimensions :: [Int] -> (ix,ix)
data Expression =
ExInt Int
| ExReal Double
| ExString String
| ExSymbol String
| ExFunction String [Expression]
deriving (Eq,Ord,Read,Show,Data,Typeable)
data State = State { abort :: Bool
, done :: Bool
}
data Config = Config { environment :: Environment
, link :: Link
, functionTable :: IntMap Function
}
newtype ML a = ML {
runMLMonad :: Er.ErrorT String (St.StateT State (Rd.ReaderT Config IO)) a
} deriving ( Monad
, MonadIO
, St.MonadState State
, Rd.MonadReader Config
, Er.MonadError String
)
runML :: ML a -> State -> Config -> IO (Either String a)
runML ac s c = Rd.runReaderT (St.evalStateT (Er.runErrorT (runMLMonad ac)) s) c
data Function =
Function {
callPattern :: String
, argumentPattern :: String
, function :: ML ()
}
instance Show Function where
show fn = "Function { callPattern = " ++
(show $ callPattern fn) ++
", argumentPattern = " ++
(show $ argumentPattern fn) ++ " }"
newtype Link = Link (Ptr ()) deriving (Eq)
newtype Environment = Environment (Ptr ()) deriving (Eq)
data Error = NoError
| DeadLnkError
| GetInconsistentError
| GetOutOfSeqError
| PutBadTokError
| PutOutOfSeqError
| PutTooBigError
| MachineOverflowError
| OutOfMemoryError
| SocketUnacceptedError
| UnconnectedError
| PutEndPacketError
| NextIncompleteCurrentPacketError
| NextUnknownPacketError
| GetEndPacketError
| AbortError
| ClosedError
| InitError
| ArgvError
| ProtocolError
| ModeError
| LaunchError
| RelaunchError
| LaunchSpaceError
| NoParentError
| NameTakenError
| NoListenError
| BadNameError
| BadHostError
| LaunchFailedError
| LaunchNameError
| PutConvertError
| GetConvertError
| PutBadEncodingError
| UnknownError Int
deriving (Eq,Show)
instance Enum Error where
fromEnum r =
case r of
NoError -> 0
DeadLnkError -> 1
GetInconsistentError -> 2
GetOutOfSeqError -> 3
PutBadTokError -> 4
PutOutOfSeqError -> 5
PutTooBigError -> 6
MachineOverflowError -> 7
OutOfMemoryError -> 8
SocketUnacceptedError -> 9
UnconnectedError -> 10
PutEndPacketError -> 21
NextIncompleteCurrentPacketError -> 22
NextUnknownPacketError -> 23
GetEndPacketError -> 24
AbortError -> 25
ClosedError -> 11
InitError -> 32
ArgvError -> 33
ProtocolError -> 34
ModeError -> 35
LaunchError -> 36
RelaunchError -> 37
LaunchSpaceError -> 38
NoParentError -> 39
NameTakenError -> 40
NoListenError -> 41
BadNameError -> 42
BadHostError -> 43
LaunchFailedError -> 45
LaunchNameError -> 46
PutConvertError -> 48
GetConvertError -> 49
PutBadEncodingError -> 47
UnknownError i -> i
toEnum i =
case i of
0 -> NoError
1 -> DeadLnkError
2 -> GetInconsistentError
3 -> GetOutOfSeqError
4 -> PutBadTokError
5 -> PutOutOfSeqError
6 -> PutTooBigError
7 -> MachineOverflowError
8 -> OutOfMemoryError
9 -> SocketUnacceptedError
10 -> UnconnectedError
21 -> PutEndPacketError
22 -> NextIncompleteCurrentPacketError
23 -> NextUnknownPacketError
24 -> GetEndPacketError
25 -> AbortError
11 -> ClosedError
32 -> InitError
33 -> ArgvError
34 -> ProtocolError
35 -> ModeError
36 -> LaunchError
37 -> RelaunchError
38 -> LaunchSpaceError
39 -> NoParentError
40 -> NameTakenError
41 -> NoListenError
42 -> BadNameError
43 -> BadHostError
45 -> LaunchFailedError
46 -> LaunchNameError
48 -> PutConvertError
49 -> GetConvertError
47 -> PutBadEncodingError
i -> UnknownError i
instance Ord Error where
compare e1 e2 = compare (fromEnum e1) (fromEnum e2)
mkError :: Integral a => a -> Error
mkError = toEnum . fromIntegral
data Message = TerminateMessage
| InterruptMessage
| AbortMessage
| EndPacketMessage
| SynchronizeMessage
| ImDyingMessage
| WaitingAcknowledgementMessage
| MarkTopLevelMessage
| LinkClosingMessage
| AuthenticateFailureMessage
| UserMessage Int
| UnknownMessage Int
deriving (Eq,Show)
instance Enum Message where
fromEnum m =
case m of
TerminateMessage -> 1
InterruptMessage -> 2
AbortMessage -> 3
EndPacketMessage -> 4
SynchronizeMessage -> 5
ImDyingMessage -> 6
WaitingAcknowledgementMessage -> 7
MarkTopLevelMessage -> 8
LinkClosingMessage -> 9
AuthenticateFailureMessage -> 10
UserMessage i -> i
UnknownMessage i -> i
toEnum i =
case i of
i | i >= 128 && i <= 255 -> UserMessage i
1 -> TerminateMessage
2 -> InterruptMessage
3 -> AbortMessage
4 -> EndPacketMessage
5 -> SynchronizeMessage
6 -> ImDyingMessage
7 -> WaitingAcknowledgementMessage
8 -> MarkTopLevelMessage
9 -> LinkClosingMessage
10 -> AuthenticateFailureMessage
i -> UnknownMessage i
instance Ord Message where
compare m1 m2 = compare (fromEnum m1) (fromEnum m2)
firstUserMessage :: Message
firstUserMessage = UserMessage 128
lastUserMessage :: Message
lastUserMessage = UserMessage 255
mkMessage :: Integral a => a -> Message
mkMessage = toEnum . fromIntegral
data Packet = IllegalPacket
| CallPacket
| EvaluatePacket
| ReturnPacket
| InputNamePacket
| EnterTextPacket
| EnterExpressionPacket
| OutputNamePacket
| ReturnTextPacket
| ReturnExpressionPacket
| DisplayPacket
| DisplayEndPacket
| MessagePacket
| TextPacket
| InputPacket
| InputStringPacket
| MenuPacket
| SyntaxPacket
| SuspendPacket
| ResumePacket
| BeginDialogPacket
| EndDialogPacket
| UserPacket Int
| UnknownPacket Int
deriving (Eq,Show)
instance Enum Packet where
fromEnum p =
case p of
IllegalPacket -> 0
CallPacket -> 7
EvaluatePacket -> 13
ReturnPacket -> 3
InputNamePacket -> 8
EnterTextPacket -> 14
EnterExpressionPacket -> 15
OutputNamePacket -> 9
ReturnTextPacket -> 4
ReturnExpressionPacket -> 16
DisplayPacket -> 11
DisplayEndPacket -> 12
MessagePacket -> 5
TextPacket -> 2
InputPacket -> 1
InputStringPacket -> 21
MenuPacket -> 6
SyntaxPacket -> 10
SuspendPacket -> 17
ResumePacket -> 18
BeginDialogPacket -> 19
EndDialogPacket -> 20
UserPacket i -> i
UnknownPacket i -> i
toEnum i =
case i of
0 -> IllegalPacket
7 -> CallPacket
13 -> EvaluatePacket
3 -> ReturnPacket
8 -> InputNamePacket
14 -> EnterTextPacket
15 -> EnterExpressionPacket
9 -> OutputNamePacket
4 -> ReturnTextPacket
16 -> ReturnExpressionPacket
11 -> DisplayPacket
12 -> DisplayEndPacket
5 -> MessagePacket
2 -> TextPacket
1 -> InputPacket
21 -> InputStringPacket
6 -> MenuPacket
10 -> SyntaxPacket
17 -> SuspendPacket
18 -> ResumePacket
19 -> BeginDialogPacket
20 -> EndDialogPacket
i | i >= 128 && i <= 255 -> UserPacket i
i -> UnknownPacket i
instance Ord Packet where
compare p1 p2 = compare (fromEnum p1) (fromEnum p2)
firstUserPacket :: Packet
firstUserPacket = UserPacket 128
lastUserPacket :: Packet
lastUserPacket = UserPacket 255
mkPacket :: Integral a => a -> Packet
mkPacket = toEnum . fromIntegral
data Type = ErrorType
| IntType
| RealType
| StringType
| SymbolType
| FunctionType
| UnknownType Int
deriving (Eq,Show)
instance Enum Type where
fromEnum t =
case t of
ErrorType -> 0
IntType -> 43
RealType -> 42
StringType -> 34
SymbolType -> 35
FunctionType -> 70
UnknownType i -> i
toEnum i =
case i of
0 -> ErrorType
43 -> IntType
42 -> RealType
34 -> StringType
35 -> SymbolType
70 -> FunctionType
73 -> IntType
82 -> RealType
83 -> StringType
89 -> SymbolType
i -> UnknownType i
instance Ord Type where
compare t1 t2 = compare (fromEnum t1) (fromEnum t2)
mkType :: Integral a => a -> Type
mkType = toEnum . fromIntegral