Help Haskell driving Medical Instruments
Recently, I received as gift medical instruments designed by one of my father former students. There is a description of these instruments on my web page. Here is the address:
http://www.discenda.org/med/
By the way, I am not that guy that appears in a picture wearing emg sensors. That said, the instruments and everything else are programmed in Clean. Then I have a new opportunity of translating Clean programs to Haskell and test them in a real application application. Of course, I simplified the programs to see how they work.
The medical instruments have on-board computers, that record signals (electromyograms, electroencephalograms, electrocardiograms, end-tydal CO2 partial pressure and temperature), pre-process them and send them to the main computer. The main-computer recognizes patterns in the signals, and use the result to drive a wheelchair, or to call a doctor. On my page you wil find more complete explanations and pictures of the instruments. For ready reference, here is my address:
http://www.discenda.org/med/
I decided start my translation work from the most simple programs, the graphical interface and the communication protocol. After substituting a Haskell program for the Clean original, I discovered that the system did not work anymore if I exited the Haskell program. In few words, after leaving the Haskell program without turning off the computer or the sensors, and entering the Haskell program again, Haskell failed to communicate with the sensors. I did what I always do in such a situation: I simplified the program until I reduced it to a few lines. I discovered that Haskell failed to close the serial port. There is a serial to UART-0 driver that allows me to plug the serial cable to a USB port, that both feeds the sensors, and permit communication.
I fixed the bug by passing a useless integer argument to the function used to close the port. Since I don't like this kind of patch (useless arguments), I would like to know why the original program does not work, and also I would appreciate if someone could suggest a way to get rid of the argument whose sole job is force Haskell to close the port. The GUI is based on the Small JAPI biding, fixed and incremented with text processing components. Here is the fixed Haskell program:
import Gui.Binding
import Gui.Types
import Gui.Constants
import SER.IAL
import Control.Monad
import Data.Char
main = do rv <- j_start
frame <- j_frame "Sensors"
exit_button <- j_button frame "Exit"
j_setpos exit_button 50 50
j_setsize exit_button 80 30
fld <- j_textfield frame 30
j_setpos fld 50 100
j_show frame
opencport(4)
waitForFrameAction frame fld exit_button
let r = closecport 7 {- without the argument, closecport does not work -}
print r
return j_quit
waitForFrameAction :: Frame -> Object -> Object -> IO Bool
waitForFrameAction frame f b =
do obj <- j_nextaction
again <- if obj == event b
then return False
else
do {- nm <- j_gettext f 200 -}
tx <- sendMessage 1 "t"
let tp= filter (> ' ') tx
rx <- sendMessage 1 "x"
let rd= filter (> ' ') rx
let x = hex2dec rd
let tt= (fromIntegral x)*209.0/1024 - 67.5
j_settext f ((show tt)++" ==> "++tp)
return True
if not again
then return True
else waitForFrameAction frame f b
hex2dec :: String -> Int
hex2dec h= sum (zipWith (*)
(map (16^) [3,2,1,0])
[digitToInt c | c <- h])
convert d r s0= (fromIntegral (hex2dec d))*r/1024.0- s0
As I told before, let r = closecport 7 did not work until I gave it an argument. Here is the interface between the C-side, and the Haskell-side of the program:
{-# LANGUAGE ForeignFunctionInterface #-}
module SER.IAL where
import Control.Monad
import Foreign
import Foreign.C.Types
import Foreign.C
foreign import ccall "rs232.h opencport" opencport :: CInt -> IO ()
foreign import ccall "rs232.h closecport" closecport :: CInt -> CInt
foreign import ccall "rs232.h rdrs232" c_sendmsg :: CInt -> CString -> CString
sendMessage :: Int -> String -> IO String
sendMessage n msg =
withCString msg $
\str -> peekCString (c_sendmsg (fromIntegral n) str)
Originally, I had the following line (that did not work properly):
foreign import ccall "rs232.h closecport" closecport :: IO ()
You will find below the C-program. The original program (that did not work) had the following definition for closecport:
int closecport() {
CloseComport();
return 3; }
This deffinition (that did not work) was replaced by the following one:
int closecport(int n) {
CloseComport();
return n; }
Here is the complete C program:
#include "serial.h"
#include
Does marking the call `unsafe` make any difference? This is running on a *NIX of some flavour? -- Jason Dusek
Hi, Jason.
I don't know how to mark the call unsafe. And I don't know what is a *Nix (perhaps unix?). I am running the main program on Windows. Here is the compilation script:
ghc -fglasgow-exts serial.c %1.hs -L./ -ljapi --make
erase *.hi
erase *.o
strip %1.exe
BTW I figure out that passing an argument to closecport only makes the problem occur less often. Here is an example:
D:\ghc\sensors>strip temper.exe
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
4
D:\ghc\sensors>temper.exe
unable to set comport cfg settings
4
--- On Mon, 11/9/09, Jason Dusek
Am Dienstag 10 November 2009 14:01:33 schrieb Philippos Apolinarius:
Hi, Jason. I don't know how to mark the call unsafe. And I don't know what is a *Nix (perhaps unix?).
Unix or unix-derivate (linux, BSD, ...)
I am running the main program on Windows.
Then it might be necesary to let the foreign calls have the calling convention stdcall instead of ccall.
2009/11/10 Philippos Apolinarius
I don't know how to mark the call unsafe. [...] I am running the main program on Windows.
Marking it unsafe is done by putting "unsafe" in the foreign import declaration. Even if it turns out not to fix the problem, it reduces the overhead of foreign calls (and is safe as long as they aren't going to call back into Haskell). Because your on Windows, you want to use "stdcall", as mentioned by Daniel Fischer. Thus the full declaration is: foreign import stdcall unsafe "rs232.h closecport" closecport :: IO () Let us know if this helps.
Here is the compilation script:
ghc -fglasgow-exts serial.c %1.hs -L./ -ljapi --make erase *.hi erase *.o strip %1.exe
I encourage you to look into Cabal soon :) -- Jason Dusek
Hi, Jason.
Thank you for your explanations. They were very useful. In the light of what you said, I modified the programs as shown below (commented lines failed to work). Forcing the C function to return a number, wrapping the returned number in IO, and printing the number, I succeeded in bringing falures down to 1 case in 20 trials (average). By the way, I talked to doctors who work with capnograms, and they said that all Windows or Linux machines have problems in closing communication ports. However, it seems that capnographs are not turned off very often. I mean, when the doctor move the capnograph from one patient to another, s/he turns off the instrument. Therefore, this behavior does not create problems. However, what bothers me is that Clean always succeds in closeing the port.
{-# LANGUAGE ForeignFunctionInterface #-}
{- file: SER/IAL.hs -}
module SER.IAL where
import Control.Monad
import Foreign
import Foreign.C.Types
import Foreign.C
foreign import ccall "rs232.h opencport" opencport :: CInt -> IO ()
-- foreign import ccall "rs232.h closecport" closecport :: CInt -> CInt
-- foreign import stdcall unsafe "rs232.h closecport" closecport :: IO ()
-- foreign import ccall unsafe "rs232.h closecport" c_closecport :: CInt
foreign import ccall unsafe "rs232.h closecport" c_closecport :: CInt -> CInt
closecport :: Int -> IO Int
closecport n= return (fromIntegral (c_closecport (fromIntegral n)))
foreign import ccall "rs232.h rdrs232" c_sendmsg :: CInt -> CString -> CString
sendMessage :: Int -> String -> IO String
sendMessage n msg =
withCString msg $
\str -> peekCString (c_sendmsg (fromIntegral n) str)
{- file: sensors.hs -}
import Gui.Binding
import Gui.Types
import Gui.Constants
import SER.IAL
import Control.Monad
import Data.Char
main = do rv <- j_start
frame <- j_frame "Sensors"
avg <- j_button frame "Sampling"
j_setpos avg 20 150
j_setsize avg 90 30
rb <- j_button frame "Read"
j_setpos rb 125 150
j_setsize rb 90 30
tb <- j_button frame "Acquisition"
j_setpos tb 230 150
j_setsize tb 90 30
fld <- j_textfield frame 40
j_setpos fld 20 100
menubar <- j_menubar frame
file <- j_menu menubar "File"
quitMI <- j_menuitem file "Quit"
j_show frame
opencport(3)
waitForFrameAction frame fld rb tb avg quitMI
r <- closecport 5
putStrLn (show r)
return j_quit
waitForFrameAction frame f rb tb avg q =
do obj <- j_nextaction
again <- if obj == event q then return False
else if obj == event rb then
(do msg <- sendMessage 1 "r"
putStrLn msg
return True)
else if obj == event tb then
(do
tx <- sendMessage 1 "t"
let tp= filter (> ' ') tx
j_settext f tp
return True)
else if obj == event avg then
(do ok <- sendMessage 1 "m"
val <- j_gettext f 300
ns <- sendMessage 2 val
putStrLn ((filter (> ' ') ok) ++ ns)
return True)
else
(do
tx <- sendMessage 1 "t"
let tp= filter (> ' ') tx
rx <- sendMessage 1 "x"
let rd= filter (> ' ') rx
let x = hex2dec rd
let tt= (fromIntegral x)*209.1/1023.0 - 67.23
j_settext f ((show tt)++" ==> "++tp)
return True)
if not again
then return True
else waitForFrameAction frame f rb tb avg q
hex2dec :: String -> Int
hex2dec h= sum (zipWith (*)
(map (16^) [3,2,1,0])
[digitToInt c | c <- h])
convert d r s0= (fromIntegral (hex2dec d))*r/1024.0- s0
{- 1a43 67.23; 082b - 209.1 -}
// file: serial.c
#include "serial.h"
#include
I don't know how to mark the call unsafe. [...] I am running the main program on Windows.
Marking it unsafe is done by putting "unsafe" in the foreign import declaration. Even if it turns out not to fix the problem, it reduces the overhead of foreign calls (and is safe as long as they aren't going to call back into Haskell). Because your on Windows, you want to use "stdcall", as mentioned by Daniel Fischer. Thus the full declaration is: foreign import stdcall unsafe "rs232.h closecport" closecport :: IO () Let us know if this helps.
Here is the compilation script:
ghc -fglasgow-exts serial.c %1.hs -L./ -ljapi --make erase *.hi erase *.o strip %1.exe
I encourage you to look into Cabal soon :) -- Jason Dusek __________________________________________________________________ Make your browsing faster, safer, and easier with the new Internet Explorer® 8. Optimized for Yahoo! Get it Now for Free! at http://downloads.yahoo.com/ca/internetexplorer/
On Wed, Nov 11, 2009 at 6:00 PM, Philippos Apolinarius
closecport :: Int -> IO Int closecport n= return (fromIntegral (c_closecport (fromIntegral n)))
The return here doesn't do what you think it does - semantically, the value of c_closecport is still considered pure and assumed to be referentially transparent, so multiple calls to closecport are allowed to share the value returned, or delay the call until the value is unwrapped, call it multiple times for each use of the value, or anything else. You need to use IO *directly* in the foreign import declaration so that the compiler knows that the function calls can't be shared or inlined or generally messed about with: the IO tells it that order of execution with respect to your other IO actions is important. This one looks the most right: foreign import stdcall unsafe "rs232.h closecport" closecport :: IO () so I think you need to look closer about why it wasn't working for you, and where or how you were using it.
First of all, I find it striking that you are using the declaration: foreign import ccall unsafe "rs232.h closecport" c_closecport :: CInt -> CInt and that it actually works. I would think the only workable declaration would be: foreign import stdcall unsafe "rs232.h closecport" closecport :: IO () You've tried the signature with `stdcall` and `IO ()` and it doesn't work at all? Likewise, your signature for `c_sendmsg` strikes me as perilous. It should result in a value in `IO`. However, let's ignore all that for now. I wonder, does the Haskell always call `closecport`? Maybe you could put in a print statement in the C to find out? -- Jason Dusek
On Tue, Nov 10, 2009 at 5:04 AM, Philippos Apolinarius
foreign import ccall "rs232.h opencport" opencport :: CInt -> IO () foreign import ccall "rs232.h closecport" closecport :: CInt -> CInt
[...]
Originally, I had the following line (that did not work properly):
foreign import ccall "rs232.h closecport" closecport :: IO ()
I don't know why the latter line didn't work properly, but I'm pretty sure it's closer to the right answer than the former. If you don't have an IO type for your function, then Haskell is allowed to assume it is pure (has no side effects) and can then call it only when the result is needed, or multiple times if it likes, without affecting the meaning of the program. For a function that closes a handle this is clearly not the case. So I'm pretty sure your type signature needs to be in IO if you want to guarantee it is called at the right time; it might be worth elaborating on how the IO () version did not work, and how you used it. The way you are using it now would appear to work most of the time because the print statement will force the result to be evaluated, forcing the function to be called - but having a handle closed based on when an apparently irrelevant print statement runs or doesn't is obviously not ideal.
participants (4)
-
Ben Millwood -
Daniel Fischer -
Jason Dusek -
Philippos Apolinarius