Posted to Haskell mail-list
cc: Noel Winstanley <[EMAIL PROTECTED]>
--------------------
Hi,
Although the links on {Tcl,Tk}Haskell homepage are dead,
I have been told that at least TclHaskell is available from other location,
http://yeats.ucc.ie/~dongen/TclHaskell.tar.gz
I have tried TclHaskell using Haskell98 (ghc-4.02 and hugs98) and quite a
few incompatibilities have been arisen. I have done some changes to the code
to make it work, and here are the diffs, if someone is interested.
It would be a good idea for the developer to incorporate them into current
version of TclHaskell, but I haven't understood whether the current
developer is Chris Dornan or Noel Winstanley, or it is not currently
maintained, that is why I post it to the maillist.
The diffs are at the end of this letter, and here is a couple of comments:
- In TclPrims.g302.hs some functions looked like
primInitTcl:: IO Bool
primInitTcl = map int2bool (_ccall_ primInitTcl)
I can't understand why (map int2bool) is applied to
a non-list, neither can Haskell98. Such definitions have been changed to:
primInitTcl = (_ccall_ primInitTcl) >>= (return . int2bool)
You probably want to move the modified version of TclPrims.g302.hs to
TclPrims.g402.hs and make ln -s TclPrims.g402.hs TclPrims.g.hs
(by default, symlink is to TclPrims.g302.hs)
- There is no 'accumulate' function in Haskell98 prelude/libraries, so I
have borrowed it from 1.4 prelude and inserted into Tcl.hs and
TclPrims.hs
- There was a type conflict in TclGUI.hs:
failGUI err = G__ (\_ -> fail err)
Fail required String, err was of a different type, so I changed
it to:
failGUI err = G__ (\_ -> fail "GUI error (can't diagnose)!")
Not very convenient, but works.
- TclPrims.so: hugs98 requires _initModule, while the original
library had initModule (without underscore)
- In order to use unpackCString, `import PrelPack' is needed.
- ghc-4.02, when run with the option -fglasgow-exts, gives parse error when
it sees the definition of function (##), I don't know why. I have changed
## to +++ everywhere.
- demo/demo.hs runs fine with hugs98 (provided that ## was changed); when
compiled with ghc, it can't invoke 'bouncing ball', the rest seems to work.
- You probably don't want to apply the patch to makefile unless you run
FreeBSD, so you could cut last few lines of the diff.
But don't forget to change 'ghc-3.02' to 'ghc' or 'ghc-4.02'
In order to apply diffs, save them to file TclHaskell98.diff,
change to the parent directory of TclHaskell/, and type:
patch <TclHaskell98.diff
This will change files in TclHaskell/src/ and TclHaskell/demo/
Change ghc-3.02 to ghc-4.02 in TclHaskell/bin/tclghc yourself
Grigoriy.
=== Grigoriy Strokin, Lomonosov University (MGU), Moscow ===
=== contact info: http://isabase.philol.msu.ru/~grg/ ===
diff -ur TclHaskell.orig/demo/GraphEdit.hs TclHaskell/demo/GraphEdit.hs
--- TclHaskell.orig/demo/GraphEdit.hs Tue Jul 6 23:34:10 1999
+++ TclHaskell/demo/GraphEdit.hs Thu Jul 22 22:39:30 1999
@@ -29,7 +29,7 @@
cc :: Pos -> CCoord
-cc (x,y) = x ## y
+cc (x,y) = x +++ y
graphEdit :: GUI ()
@@ -52,7 +52,7 @@
node :: Canvas -> Status -> (Int,Int) -> GUI ()
node can st (x,y) =
- do o <- coval can (x-10 ## y-10) (x+10 ## y+10) [ outline "black"
+ do o <- coval can (x-10 +++ y-10) (x+10 +++ y+10) [ outline "black"
, fill "white"
]
bind o "<Enter>" (enterNode st o)
@@ -123,7 +123,7 @@
case mbm of
Nothing -> return ()
Just (Nd ov (x,y)) ->
- do moveObject ov (x'-x ## y'-y)
+ do moveObject ov (x'-x +++ y'-y)
let es' = map (cvt (x,y)) es
mbf' = chg ov mbf
mbh' = chg ov mbh
diff -ur TclHaskell.orig/demo/Koch.hs TclHaskell/demo/Koch.hs
--- TclHaskell.orig/demo/Koch.hs Tue Jul 6 23:35:03 1999
+++ TclHaskell/demo/Koch.hs Thu Jul 22 22:39:30 1999
@@ -160,4 +160,4 @@
_ -> return ()
where
sc (x,y) = (x `div` 10, y `div` 10)
- conv (x,y) = x ## y
+ conv (x,y) = x +++ y
diff -ur TclHaskell.orig/demo/demo.hs TclHaskell/demo/demo.hs
--- TclHaskell.orig/demo/demo.hs Sat Sep 19 19:15:48 1998
+++ TclHaskell/demo/demo.hs Thu Jul 22 22:40:44 1999
@@ -147,7 +147,7 @@
invokeDemo tg prg = do cset tg [foreground "purple"]
i <- tcl ["winfo exists", wn]
case i of
- "1" -> tcl_ ["raise", wn]
+-- "1" -> tcl_ ["raise", wn]
_ -> sequence [g | (p,g) <- demos, p == prg]
return ()
where
diff -ur TclHaskell.orig/src/Tcl.hs TclHaskell/src/Tcl.hs
--- TclHaskell.orig/src/Tcl.hs Sun Dec 6 22:01:12 1998
+++ TclHaskell/src/Tcl.hs Thu Jul 22 21:35:13 1999
@@ -14,6 +14,7 @@
-- module Tcl
+ accumulate,
bind,bindxy,bindXY,
rgb,
trapDeleteWindow,
@@ -50,7 +51,7 @@
Widget,WWidget,WClass,MWidget,MClass,CWidget,CClass,TWidget,TClass,
WPath(..),WTag(..),
wpath,wtag,tcl_append,tcl_string,
- CCoord,(##),moveObject,removeObject,lowerObject,raiseObject,bboxObjects,
+ CCoord,(+++),moveObject,removeObject,lowerObject,raiseObject,bboxObjects,
getCoords,setCoords,Config,
Has_activebackground(..),Has_activeforeground(..),Has_anchor(..),
@@ -85,6 +86,11 @@
import TclCore
import TclWidgets
+accumulate :: Monad m => [m a] -> m [a]
+accumulate [] = return []
+accumulate (c:cs) = do x <- c
+ xs <- accumulate cs
+ return (x:xs)
-- Events ----------------------------------------------------
diff -ur TclHaskell.orig/src/TclCore.hs TclHaskell/src/TclCore.hs
--- TclHaskell.orig/src/TclCore.hs Sun Dec 6 21:30:07 1998
+++ TclHaskell/src/TclCore.hs Thu Jul 22 21:35:13 1999
@@ -7,7 +7,7 @@
import List
import TclGUI
-infix 5 ##
+infix 5 +++
-- Conf w ----------------------------------------------
@@ -229,8 +229,8 @@
type CCoord = String
-(##) :: Int -> Int -> CCoord
-(##) x y = show x ++ " " ++ show y
+(+++) :: Int -> Int -> CCoord
+(+++) x y = show x ++ " " ++ show y
moveObject :: CWidget w -> CCoord -> GUI ()
diff -ur TclHaskell.orig/src/TclGUI.hs TclHaskell/src/TclGUI.hs
--- TclHaskell.orig/src/TclGUI.hs Thu Nov 26 19:52:08 1998
+++ TclHaskell/src/TclGUI.hs Thu Jul 22 21:35:13 1999
@@ -218,7 +218,7 @@
errorGUI err = failGUI (userError err)
failGUI :: IOError -> GUI a
-failGUI err = G__ (\_ -> fail err)
+failGUI err = G__ (\_ -> fail "GUI error (can't diagnose)!")
-- the GUI State ----------------------------------------
diff -ur TclHaskell.orig/src/TclPrims.c TclHaskell/src/TclPrims.c
--- TclHaskell.orig/src/TclPrims.c Wed Aug 19 22:59:56 1998
+++ TclHaskell/src/TclPrims.c Thu Jul 22 21:35:13 1999
@@ -303,8 +303,8 @@
*
* This should be the only symbol exported from this module.
*/
-DLLEXPORT(void) initModule(HugsAPI *);
-DLLEXPORT(void) initModule(HugsAPI *hugsAPI) {
+DLLEXPORT(void) _initModule(HugsAPI *);
+DLLEXPORT(void) _initModule(HugsAPI *hugsAPI) {
hugs = hugsAPI;
hugs->registerPrims(&prims);
controlexterns(INSTALL);
diff -ur TclHaskell.orig/src/TclPrims.g.hs TclHaskell/src/TclPrims.g.hs
--- TclHaskell.orig/src/TclPrims.g.hs Thu Sep 17 18:30:05 1998
+++ TclHaskell/src/TclPrims.g.hs Thu Jul 22 21:35:13 1999
@@ -14,6 +14,7 @@
import GlaExts
import IOExts
import MutableArray
+import PrelPack
import PackedString
import Foreign
@@ -49,10 +50,10 @@
primTclDebug flg = _ccall_ primTclDebug (bool2int flg)
primInitTcl :: IO Bool
-primInitTcl = map int2bool (_ccall_ primInitTcl)
+primInitTcl = (_ccall_ primInitTcl) >>= (return . int2bool)
primRunTcl :: IO Bool
-primRunTcl = map int2bool (_ccall_ primRunTcl)
+primRunTcl = (_ccall_ primRunTcl) >>= (return . int2bool)
primExecuteTcl :: String -> IO String
primExecuteTcl s = unpack(_ccall_ primExecuteTcl s)
@@ -68,11 +69,7 @@
unpack :: IO Addr -> IO String
-unpack m =
- do s <- map unpackCString m;
- case length s of
- 0 -> return s
- _ -> return s
+unpack m = ((\x->x) m) >>= (return . unpackCString)
int2bool :: Int -> Bool
int2bool 0 = False
diff -ur TclHaskell.orig/src/TclPrims.g302.hs TclHaskell/src/TclPrims.g302.hs
--- TclHaskell.orig/src/TclPrims.g302.hs Thu Sep 17 18:30:05 1998
+++ TclHaskell/src/TclPrims.g302.hs Thu Jul 22 21:35:13 1999
@@ -14,6 +14,7 @@
import GlaExts
import IOExts
import MutableArray
+import PrelPack
import PackedString
import Foreign
@@ -49,10 +50,10 @@
primTclDebug flg = _ccall_ primTclDebug (bool2int flg)
primInitTcl :: IO Bool
-primInitTcl = map int2bool (_ccall_ primInitTcl)
+primInitTcl = (_ccall_ primInitTcl) >>= (return . int2bool)
primRunTcl :: IO Bool
-primRunTcl = map int2bool (_ccall_ primRunTcl)
+primRunTcl = (_ccall_ primRunTcl) >>= (return . int2bool)
primExecuteTcl :: String -> IO String
primExecuteTcl s = unpack(_ccall_ primExecuteTcl s)
@@ -68,11 +69,7 @@
unpack :: IO Addr -> IO String
-unpack m =
- do s <- map unpackCString m;
- case length s of
- 0 -> return s
- _ -> return s
+unpack m = ((\x->x) m) >>= (return . unpackCString)
int2bool :: Int -> Bool
int2bool 0 = False
diff -ur TclHaskell.orig/src/TclPrims.hs TclHaskell/src/TclPrims.hs
--- TclHaskell.orig/src/TclPrims.hs Wed Aug 19 22:59:57 1998
+++ TclHaskell/src/TclPrims.hs Thu Jul 22 21:35:13 1999
@@ -17,6 +17,12 @@
import IOExts
import Array
+accumulate :: Monad m => [m a] -> m [a]
+accumulate [] = return []
+accumulate (c:cs) = do x <- c
+ xs <- accumulate cs
+ return (x:xs)
+
type TclVar a = IORef a
diff -ur TclHaskell.orig/src/makefile TclHaskell/src/makefile
--- TclHaskell.orig/src/makefile Thu Sep 17 21:20:51 1998
+++ TclHaskell/src/makefile Thu Jul 22 21:35:14 1999
@@ -1,13 +1,14 @@
# The Locations of the X11 (x11/), Tcl (tcl.h) and Tk (tk.h)
# include directories:
-XINC = /usr/include
+XINC = /usr/X11R6/include
TCLINC = /usr/local/include
TKINC = /usr/local/include
+CFLAGS+=-DHAVE_VSNPRINTF -DHAVE_SNPRINTF
# The directories containing the X11, Tcl and Tk (binary) libraries:
-XLIB = /usr/lib/X11
+XLIB = /usr/X11R6/lib
TCLLIB = /usr/local/lib
TKLIB = /usr/local/lib
@@ -15,16 +16,15 @@
CC = gcc
# HC = ghc-2.10 -H12M
-HC = ghc-3.02 -H12M -syslib misc -fglasgow-exts
+HC = ghc -H12M -syslib misc -fglasgow-exts
# ld options for generating shared libraries for Hugs:
-SLD_OPTS = -r # (Solaris)
-# SLD_OPTS = -shared # (OSF/1+Linux)
+SLD_OPTS = -shared # (OSF/1+Linux)
# the libraries required by Tcl/Tk:
-TCL_REQ = -ltk8.0 -ltcl8.0 -lX11 -lm -lsocket -lnsl -lintl -lw # (Solaris)
+TCL_REQ = -ltk80 -ltcl80 -lX11 -lm
# TCL_REQ = -ltk8.0 -ltcl8.0 -lX11 -lm -lc # (OSF/1+Linux)
=== Grigoriy Strokin, Lomonosov University (MGU), Moscow ===
=== contact info: http://isabase.philol.msu.ru/~grg/ ===
