diff --git a/examples/mltest.cabal b/examples/mltest.cabal --- a/examples/mltest.cabal +++ b/examples/mltest.cabal @@ -13,7 +13,8 @@ Executable mltest Build-Depends: base >= 4.0 && < 4.1, mathlink >= 0.1 && < 0.2, - array >= 0.2 && < 0.3 + array >= 0.2 && < 0.3, + mtl >= 1.1.0.2 && < 1.2 Hs-Source-Dirs: src Main-Is: Main.hs diff --git a/examples/mltest.nb b/examples/mltest.nb --- a/examples/mltest.nb +++ b/examples/mltest.nb @@ -10,10 +10,10 @@ NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] -NotebookDataLength[ 6650, 216] -NotebookOptionsPosition[ 5513, 170] -NotebookOutlinePosition[ 5872, 186] -CellTagsIndexPosition[ 5829, 183] +NotebookDataLength[ 8910, 274] +NotebookOptionsPosition[ 7550, 220] +NotebookOutlinePosition[ 7909, 236] +CellTagsIndexPosition[ 7866, 233] WindowFrame->Normal*) (* Beginning of Notebook Content *) @@ -54,11 +54,10 @@ Cell[BoxData[ RowBox[{"LinkObject", "[", - RowBox[{"\<\"/home/twadleigh/hs/mathlink/examples/mltest.sh\"\>", ",", "8", - ",", "8"}], "]"}]], "Output", - CellChangeTimes->{3.44016866928712*^9, 3.440177537593532*^9, - 3.440177639653508*^9, 3.44017776858574*^9, 3.440178011557703*^9, - 3.440180317121654*^9}] + RowBox[{"\<\"/home/twadleigh/hs/mathlink/examples/mltest.sh\"\>", ",", "25", + ",", "11"}], "]"}]], "Output", + CellChangeTimes->{3.440263039836529*^9, 3.440264120592161*^9, + 3.44026426385889*^9, 3.440264416235961*^9}] }, Open ]], Cell[CellGroupData[{ @@ -69,9 +68,12 @@ CellChangeTimes->{{3.43931006947751*^9, 3.43931007209233*^9}}], Cell[BoxData["5"], "Output", - CellChangeTimes->{3.44016867170964*^9, 3.4401775395852757`*^9, - 3.440177642067905*^9, 3.440177770296537*^9, 3.440178013081019*^9, - 3.440180318765966*^9}] + CellChangeTimes->{ + 3.44016867170964*^9, 3.4401775395852757`*^9, 3.440177642067905*^9, + 3.440177770296537*^9, 3.440178013081019*^9, 3.440180318765966*^9, + 3.440261706988338*^9, 3.440262267330207*^9, 3.44026304258245*^9, + 3.4402641219488163`*^9, 3.4402642658697*^9, {3.4402644178146067`*^9, + 3.4402644191880302`*^9}}] }, Open ]], Cell[CellGroupData[{ @@ -92,7 +94,8 @@ CellChangeTimes->{ 3.440168712981926*^9, 3.440177541747458*^9, 3.4401776436073923`*^9, 3.440177771845735*^9, 3.4401780146157618`*^9, {3.440180323067984*^9, - 3.440180359740733*^9}}] + 3.440180359740733*^9}, 3.440261709575554*^9, 3.4402630445039377`*^9, + 3.440264267960457*^9, 3.440264420978492*^9}] }, Open ]], Cell[CellGroupData[{ @@ -102,9 +105,11 @@ CellChangeTimes->{{3.440168718131279*^9, 3.4401687204719067`*^9}}], Cell[BoxData["\<\"Hello, world!\"\>"], "Output", - CellChangeTimes->{3.4401687210248337`*^9, 3.440177543338463*^9, - 3.4401776462215652`*^9, 3.440177773588876*^9, 3.440178015619836*^9, - 3.440180378796352*^9}] + CellChangeTimes->{ + 3.4401687210248337`*^9, 3.440177543338463*^9, 3.4401776462215652`*^9, + 3.440177773588876*^9, 3.440178015619836*^9, 3.440180378796352*^9, + 3.4402617123528633`*^9, 3.4402630465175877`*^9, {3.440264269597514*^9, + 3.440264271412078*^9}, 3.4402644226770697`*^9}] }, Open ]], Cell[CellGroupData[{ @@ -128,7 +133,8 @@ RowBox[{"3", ",", "2", ",", "1"}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.440168948815699*^9, 3.4401775454085293`*^9, 3.440177647824188*^9, 3.4401777759225273`*^9, 3.440178017618819*^9, - 3.4401803839453077`*^9}] + 3.4401803839453077`*^9, 3.4402617143337603`*^9, 3.4402630480736322`*^9, + 3.440264274052725*^9, 3.440264424466619*^9}] }, Open ]], Cell[CellGroupData[{ @@ -152,24 +158,68 @@ RowBox[{"a", ",", "b", ",", "c"}], "]"}]}], "]"}]], "Output", CellChangeTimes->{ 3.4401777251469917`*^9, 3.440177777974738*^9, 3.4401778462290287`*^9, { - 3.4401780196886597`*^9, 3.440178050944537*^9}, 3.440180387144931*^9}] + 3.4401780196886597`*^9, 3.440178050944537*^9}, 3.440180387144931*^9, + 3.440261716956626*^9, 3.440263049754879*^9, 3.440264276797727*^9, + 3.440264426317778*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ + RowBox[{"AddExtendedComplexes", "[", + RowBox[{ + RowBox[{"1", "+", + RowBox[{"3", "\[ImaginaryI]"}]}], ",", + RowBox[{"2", "+", + RowBox[{"5", "\[ImaginaryI]"}]}]}], "]"}]], "Input", + CellChangeTimes->{{3.440261725819941*^9, 3.44026175272886*^9}, { + 3.440261869617639*^9, 3.440261870522575*^9}, {3.4402623078593616`*^9, + 3.44026232761686*^9}, {3.440264128954616*^9, 3.440264134710162*^9}}], + +Cell[BoxData[ + RowBox[{"3.`", "\[InvisibleSpace]", "+", + RowBox[{"8.`", " ", "\[ImaginaryI]"}]}]], "Output", + CellChangeTimes->{ + 3.4402617532268353`*^9, {3.440261864732419*^9, 3.440261871312593*^9}, + 3.440262143838559*^9, 3.4402622723110037`*^9, 3.440262328404337*^9, + 3.440263051601795*^9, 3.4402641351875563`*^9, 3.4402642789828243`*^9, + 3.4402644285115223`*^9}] +}, Open ]], + +Cell[CellGroupData[{ + +Cell[BoxData[ + RowBox[{"AddExtendedComplexes", "[", + RowBox[{"Infinity", ",", + RowBox[{"1", "+", + RowBox[{"3", "\[ImaginaryI]"}]}]}], "]"}]], "Input", + CellChangeTimes->{{3.4402623440640917`*^9, 3.4402623453541613`*^9}, { + 3.440262468823717*^9, 3.440262473845871*^9}, {3.440264138208585*^9, + 3.440264140343564*^9}}], + +Cell[BoxData["\[Infinity]"], "Output", + CellChangeTimes->{3.440262345780912*^9, 3.44026247434591*^9, + 3.440263054136756*^9, 3.440264140800539*^9, 3.4402642809102592`*^9, + 3.440264430358942*^9}] +}, Open ]], + +Cell[CellGroupData[{ + +Cell[BoxData[ RowBox[{"Uninstall", "[", "lnk", "]"}]], "Input", CellChangeTimes->{{3.439313773653487*^9, 3.439313777607768*^9}}], Cell[BoxData["\<\"/home/twadleigh/hs/mathlink/examples/mltest.sh\"\>"], \ "Output", - CellChangeTimes->{3.440168967229312*^9, 3.440177561117154*^9, - 3.440177755031232*^9, 3.440177984565681*^9, 3.4401780921022263`*^9, - 3.440180388638576*^9}] + CellChangeTimes->{ + 3.440168967229312*^9, 3.440177561117154*^9, 3.440177755031232*^9, + 3.440177984565681*^9, 3.4401780921022263`*^9, 3.440180388638576*^9, + 3.440261841211409*^9, {3.440264295025028*^9, 3.44026429805313*^9}, + 3.440264432207209*^9}] }, Open ]] }, WindowSize->{1590, 1102}, -WindowMargins->{{0, Automatic}, {Automatic, 27}}, +WindowMargins->{{0, Automatic}, {Automatic, 31}}, ShowSelection->True, FrontEndVersion->"7.0 for Linux x86 (64-bit) (November 11, 2008)", StyleDefinitions->"Default.nb" @@ -187,36 +237,44 @@ Notebook[{ Cell[CellGroupData[{ Cell[567, 22, 213, 4, 61, "Input"], -Cell[783, 28, 209, 2, 88, "Output"] +Cell[783, 28, 209, 2, 61, "Output"] }, Open ]], Cell[1007, 33, 398, 10, 96, "Text"], Cell[CellGroupData[{ -Cell[1430, 47, 315, 5, 61, "Input"], -Cell[1748, 54, 310, 6, 88, "Output"] +Cell[1430, 47, 315, 5, 88, "Input"], +Cell[1748, 54, 266, 5, 88, "Output"] }, Open ]], Cell[CellGroupData[{ -Cell[2095, 65, 146, 3, 61, "Input"], -Cell[2244, 70, 187, 3, 88, "Output"] +Cell[2051, 64, 146, 3, 88, "Input"], +Cell[2200, 69, 359, 6, 88, "Output"] }, Open ]], Cell[CellGroupData[{ -Cell[2468, 78, 284, 6, 61, "Input"], -Cell[2755, 86, 353, 8, 88, "Output"] +Cell[2596, 80, 284, 6, 88, "Input"], +Cell[2883, 88, 447, 9, 88, "Output"] }, Open ]], Cell[CellGroupData[{ -Cell[3145, 99, 126, 2, 61, "Input"], -Cell[3274, 103, 210, 3, 88, "Output"] +Cell[3367, 102, 126, 2, 88, "Input"], +Cell[3496, 106, 337, 5, 88, "Output"] }, Open ]], Cell[CellGroupData[{ -Cell[3521, 111, 300, 8, 61, "Input"], -Cell[3824, 121, 355, 9, 88, "Output"] +Cell[3870, 116, 300, 8, 88, "Input"], +Cell[4173, 126, 450, 10, 88, "Output"] }, Open ]], Cell[CellGroupData[{ -Cell[4216, 135, 444, 8, 61, "Input"], -Cell[4663, 145, 421, 9, 88, "Output"] +Cell[4660, 141, 444, 8, 88, "Input"], +Cell[5107, 151, 517, 11, 88, "Output"] }, Open ]], Cell[CellGroupData[{ -Cell[5121, 159, 130, 2, 88, "Input"], -Cell[5254, 163, 243, 4, 88, "Output"] +Cell[5661, 167, 418, 9, 88, "Input"], +Cell[6082, 178, 377, 7, 88, "Output"] +}, Open ]], +Cell[CellGroupData[{ +Cell[6496, 190, 327, 7, 88, "Input"], +Cell[6826, 199, 197, 3, 88, "Output"] +}, Open ]], +Cell[CellGroupData[{ +Cell[7060, 207, 130, 2, 88, "Input"], +Cell[7193, 211, 341, 6, 88, "Output"] }, Open ]] } ] diff --git a/examples/src/Main.hs b/examples/src/Main.hs --- a/examples/src/Main.hs +++ b/examples/src/Main.hs @@ -20,6 +20,8 @@ import Foreign.MathLink import Data.Array.Unboxed +import Data.Complex +import Control.Monad.Error (throwError) -- Example 1: get a pair of integers and return their sum. addTwo :: ML () @@ -31,10 +33,10 @@ -- argumentPattern <=> mprep's :Arguments: directive -- Note that, in argumentPattern, the desired 2-tuple of integers -- is represented as a Mathematica list of length 2. -addTwoAction = - Action { callPattern = "AddTwo[i_Integer,j_Integer]" +addTwoFunction = + Function { callPattern = "AddTwo[i_Integer,j_Integer]" , argumentPattern = "{i,j}" - , action = addTwo + , function = addTwo } -- Example 2: reverse a list of numbers (coercing them to Doubles). @@ -52,10 +54,10 @@ -- matches more expressions, while still ensuring that on the -- Haskell side, the arguments have the desired, more specific, -- form when marshaled. -reverseNumbersAction = - Action { callPattern = "ReverseNumbers[is___?NumericQ]" +reverseNumbersFunction = + Function { callPattern = "ReverseNumbers[is___?NumericQ]" , argumentPattern = "N[Re[{is}]]" - , action = reverseNumbers + , function = reverseNumbers } -- Example 3: put a string. @@ -66,10 +68,10 @@ greetWorld = do put "Hello, world!" -greetWorldAction = - Action { callPattern = "GreetWorld[]" +greetWorldFunction = + Function { callPattern = "GreetWorld[]" , argumentPattern = "" - , action = greetWorld + , function = greetWorld } -- Example 4: get and put a 2D array, reversing its contents. @@ -83,10 +85,10 @@ let xs = elems (arr :: UArray (Int,Int) Int) put $ ((listArray (bounds arr) $ reverse xs) :: UArray (Int,Int) Int) -reverseArrayAction = - Action { callPattern = "ReverseArray[a_?(ArrayQ[#,2,IntegerQ]&)]" +reverseArrayFunction = + Function { callPattern = "ReverseArray[a_?(ArrayQ[#,2,IntegerQ]&)]" , argumentPattern = "a" - , action = reverseArray + , function = reverseArray } -- Example 5: gets an arbitrary Mathematica expression and returns @@ -103,17 +105,50 @@ ExSymbol s -> ExSymbol $ reverse s ExFunction hd args -> ExFunction (reverse hd) $ map tweak args -tweakExpressionAction = - Action { callPattern = "TweakExpression[expr_]" +tweakExpressionFunction = + Function { callPattern = "TweakExpression[expr_]" , argumentPattern = "expr" - , action = tweakExpression + , function = tweakExpression } +-- Example 6: use your own instance of Expressible +data ExtendedComplex = Finite (Complex Double) + | Infinity + deriving (Eq,Show) + +instance Expressible ExtendedComplex where + put Infinity = put $ ExSymbol "Infinity" + put (Finite (r :+ i)) = put $ ExFunction "Complex" [ExReal r,ExReal i] + get = do + expr <- get + case (expr :: Expression) of + ExFunction "DirectedInfinity" [_] -> + return Infinity + ExFunction "Complex" [ExReal r, ExReal i] -> + return $ Finite (r :+ i) + _ -> + throwError $ "Unexpected expression: " ++ show expr + +addExtendedComplexes :: ML () +addExtendedComplexes = do + (ec1,ec2) <- get + case (ec1,ec2) of + (Infinity,_) -> put Infinity + (_,Infinity) -> put Infinity + (Finite c1,Finite c2) -> put $ Finite (c1 + c2) + +addExtendedComplexesFunction = + Function { callPattern = "AddExtendedComplexes[ec1:(Infinity|Complex[_,_]),ec2:(Infinity|Complex[_,_])]" + , argumentPattern = "N[{ec1,ec2}]" + , function = addExtendedComplexes + } + -- run mathlink exposing the given list of actions -main = runMathLink [ addTwoAction - , reverseNumbersAction - , greetWorldAction - , reverseArrayAction - , tweakExpressionAction +main = runMathLink [ addTwoFunction + , reverseNumbersFunction + , greetWorldFunction + , reverseArrayFunction + , tweakExpressionFunction + , addExtendedComplexesFunction ] diff --git a/mathlink.cabal b/mathlink.cabal --- a/mathlink.cabal +++ b/mathlink.cabal @@ -1,5 +1,5 @@ Name: mathlink -Version: 0.1.0.0 +Version: 0.1.0.1 Cabal-Version: >= 1.2 Build-Type: Simple License: BSD3 @@ -9,7 +9,7 @@ Maintainer: Bug-Reports: mailto:tracy.wadleigh@gmail.com?subject=dev-mathlink Stability: experimental -Synopsis: A library for Mathematica's MathLink +Synopsis: Call Haskell from Mathematica Tested-With: GHC == 6.10.1 Category: Foreign Extra-Source-Files: examples/mltest.cabal diff --git a/src/Foreign/MathLink/ML.hs b/src/Foreign/MathLink/ML.hs --- a/src/Foreign/MathLink/ML.hs +++ b/src/Foreign/MathLink/ML.hs @@ -118,6 +118,11 @@ _ -> return $ mkPacket 0 return pkt +printString :: String -> ML () +printString str = do + evaluate $ "Print[\"" ++ str ++ "\"]" + return () + processCallPacket :: ML () processCallPacket = do expr <- get @@ -126,12 +131,11 @@ config <- Rd.ask case n `IM.lookup` (functionTable config) of Just fn -> function fn - _ -> Er.throwError - "processCallPacket: Function lookup failed." - _ -> Er.throwError - "processCallPacket: Expected int." + _ -> Er.throwError "Function lookup failed." + _ -> Er.throwError "Expected int." `Er.catchError` \err -> do clearError + printString err put $ ExSymbol "$Failed"