compilation succeeds -- execution fails

I have a program here: https://svn.j-s-n.org/public/haskell/cedict currently at revision 302, which compiles okay but I can't get it to work. I'm using the FFI to take a (currently small) array and translate it into a Map. It compiles fine and loads fine -- but it doesn't run fine: GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. Prelude> import Data.Char.CEDICT Prelude Data.Char.CEDICT> traditional 'a' Loading package array-0.1.0.0 ... linking ... done. Loading package containers-0.1.0.1 ... linking ... done. Loading package parsec-2.1.0.0 ... linking ... done. Loading package utf8-string-0.2 ... linking ... done. Loading package cedict-0.1.1 ... linking ... <interactive>: unknown symbol `___stginit_cedictzm0zi1zi1_DataziCharziCEDICTziMatter_' ghc-6.8.2: unable to load package `cedict-0.1.1' Prelude Data.Char.CEDICT> I'm on a Mac -- Leopard. A whole bunch of things *could* be wrong -- I'd appreciate some help in narrowing the list. -- _jsn

Did you try removing all .hi and .o files? On 28 mar 2008, at 10.34, Jason Dusek wrote:
I have a program here:
https://svn.j-s-n.org/public/haskell/cedict
currently at revision 302, which compiles okay but I can't get it to work. I'm using the FFI to take a (currently small) array and translate it into a Map.
It compiles fine and loads fine -- but it doesn't run fine:
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. Prelude> import Data.Char.CEDICT Prelude Data.Char.CEDICT> traditional 'a' Loading package array-0.1.0.0 ... linking ... done. Loading package containers-0.1.0.1 ... linking ... done. Loading package parsec-2.1.0.0 ... linking ... done. Loading package utf8-string-0.2 ... linking ... done. Loading package cedict-0.1.1 ... linking ... <interactive>: unknown symbol `___stginit_cedictzm0zi1zi1_DataziCharziCEDICTziMatter_' ghc-6.8.2: unable to load package `cedict-0.1.1' Prelude Data.Char.CEDICT>
I'm on a Mac -- Leopard. A whole bunch of things *could* be wrong -- I'd appreciate some help in narrowing the list.
-- _jsn _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Thomas Schilling
Did you try removing all .hi and .o files?
Yes. I tried it again this morning, and I've got the same error -- same unknown symbol, &c. I don't have trouble with most Haskell programs on my Mac, so I assume it's the way I'm connecting to C that is the problem. I've pasted in the relevant code below my signature -- it seems plain enough to me, but I've not done much with foreign declarations. The `Ptr Char` declarations, for example, point to things which are actually C ints -- they are all valid Unicode code points, so I figure there's no harm done. -- _jsn module Data.Char.CEDICT.Lists where import Foreign import Foreign.C import Foreign.Storable import Foreign.Marshal.Array {-# INCLUDE "c/data.h" #-} foreign import ccall unsafe "&" ts :: Ptr Char foreign import ccall unsafe "&" ts_len :: Ptr Int forTradSimp = pairUp $ readIn ts_len ts foreign import ccall unsafe "&" st :: Ptr Char foreign import ccall unsafe "&" st_len :: Ptr Int forSimpTrad = pairUp $ readIn st_len st readIn lenPtr arrPtr = unsafePerformIO $ peekArray len arrPtr where len = unsafePerformIO $ peek lenPtr pairUp [] = [] pairUp [item] = [] pairUp (a:b:rest) = (a, b):(pairUp rest) forLookup = [ ("\64013",[("huo4","to vomit")]) , ("\64012",[("wu4","duplicate of Big Five A461")]) , ("\40868",[("xie2","to harmonize / to accord with / to agree")]) , ("\40866",[("he2","harmonious")]) ]

On Fri, Mar 28, 2008 at 11:33:52AM -0700, Jason Dusek wrote:
Thomas Schilling
wrote: Did you try removing all .hi and .o files?
Yes. I tried it again this morning, and I've got the same error -- same unknown symbol, &c.
I don't have trouble with most Haskell programs on my Mac, so I assume it's the way I'm connecting to C that is the problem. I've pasted in the relevant code below my signature -- it seems plain enough to me, but I've not done much with foreign declarations.
The `Ptr Char` declarations, for example, point to things which are actually C ints -- they are all valid Unicode code points, so I figure there's no harm done.
The only type that you are allowed to assume corresponds to a C int is CInt, in the Foreign.C.Types module. This probably isn't the problem, but it could make problems of its own on a 64-bit or otherwise weird system. Stefan

Stefan O'Rear
The only type that you are allowed to assume corresponds to a C int is CInt, in the Foreign.C.Types module. This probably isn't the problem, but it could make problems of its own on a 64-bit or otherwise weird system.
So say I turn everything back to pointers to CInt, what is the accepted way to convert from CInt to Int and CInt to Char? Is relying on the fact that CInt always wraps a Haskell integer an okay way to go? I might was well learn these things now, before I get into bad habits. -- _jsn

On Sat, Mar 29, 2008 at 10:21:32PM -0700, Jason Dusek wrote:
Stefan O'Rear
wrote: The only type that you are allowed to assume corresponds to a C int is CInt, in the Foreign.C.Types module. This probably isn't the problem, but it could make problems of its own on a 64-bit or otherwise weird system.
So say I turn everything back to pointers to CInt, what is the accepted way to convert from CInt to Int
Same as any other pair of whole-number types - fromIntegral.
and CInt to Char?
fromIntegral and toEnum
Is relying on the fact that CInt always wraps a Haskell integer an okay way to go?
What do you mean by wraps? It's an opaque type... Stefan

On 29 Mar 2008, at 10:21 PM, Jason Dusek wrote:
Stefan O'Rear
wrote: The only type that you are allowed to assume corresponds to a C int is CInt, in the Foreign.C.Types module. This probably isn't the problem, but it could make problems of its own on a 64-bit or otherwise weird system.
So say I turn everything back to pointers to CInt, what is the accepted way to convert from CInt to Int
Use fromIntegral to go CInt -> Int, Int -> CInt. This only depends on CInt being an Integral type.
and CInt to Char?
Use toEnum . fromIntegral jcc

Jason Dusek wrote:
Stefan O'Rear
wrote: The only type that you are allowed to assume corresponds to a C int is CInt, in the Foreign.C.Types module. This probably isn't the problem, but it could make problems of its own on a 64-bit or otherwise weird system.
So say I turn everything back to pointers to CInt, what is the accepted way to convert from CInt to Int and CInt to Char?
Type class methods: -- for numbers like Int, CInt fromIntegral :: (Num b, Integral a) => a -> b -- for Char fromEnum :: (Enum a) => a -> Int toEnum :: (Enum a) => Int -> a
Is relying on the fact that CInt always wraps a Haskell integer an okay way to go?
I don't know what you mean by this.
I might was well learn these things now, before I get into bad habits.
Hope this helps, Claude -- http://claudiusmaximus.goto10.org

Jason Dusek wrote:
I have a program here:
https://svn.j-s-n.org/public/haskell/cedict
currently at revision 302, which compiles okay but I can't get it to work. I'm using the FFI to take a (currently small) array and translate it into a Map.
It compiles fine and loads fine -- but it doesn't run fine:
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. Prelude> import Data.Char.CEDICT Prelude Data.Char.CEDICT> traditional 'a' Loading package array-0.1.0.0 ... linking ... done. Loading package containers-0.1.0.1 ... linking ... done. Loading package parsec-2.1.0.0 ... linking ... done. Loading package utf8-string-0.2 ... linking ... done. Loading package cedict-0.1.1 ... linking ... <interactive>: unknown symbol `___stginit_cedictzm0zi1zi1_DataziCharziCEDICTziMatter_'
This is a cabal pitfall. Note that this is a symbol from Data.Char.CEDICT.Matter. (The 'zi' represents a dot) The problem is that this module wasn't packaged up in the library; you have to list it in the extra-modules field in the cabal file, along with the other used Data.Char.CEDICT.* modules. See also http://hackage.haskell.org/trac/hackage/ticket/128 HTH, Bertram
participants (6)
-
Bertram Felgenhauer
-
Claude Heiland-Allen
-
Jason Dusek
-
Jonathan Cast
-
Stefan O'Rear
-
Thomas Schilling