Hello, If one of the modules you are importing (for example, Fu.NewLogging), does *not* contain a line at the top like:
> module Fu.NewLogging where then I think you will get an error that looks something like that. I am not sure if this is your problem, but if it is, it is an easy fix :) hope this helps, j. At Sat, 12 May 2007 22:13:36 +0100, Frederik Eaton wrote: > > [1 <text/plain; us-ascii (7bit)>] > Hello, > > I'm suddenly getting the following error when I compile a program: > > bayesian-sets.hs:1:0: > The main function `main' is not defined in module `Main' > When checking the type of the main function `main' > > I don't know what that means. Perhaps the error could be made more > human-friendly? Here is the output of 'ghc -v': > > [1]$ ghc -v --make $A.hs -package vectro -lstdc++ -fallow-incoherent-instances > Glasgow Haskell Compiler, Version 6.6.20070420, for Haskell 98, compiled by > GHC version 6.6.20070420 > Using package config file: > /home/frederik/arch/i386//lib/ghc-6.6.20070420/package.conf > Using package config file: > /home/frederik/.ghc/i386-linux-6.6.20070420/package.conf > wired-in package base mapped to base-2.0 > wired-in package rts mapped to rts-1.0 > wired-in package haskell98 mapped to haskell98-1.0 > wired-in package template-haskell mapped to template-haskell-2.0 > Hsc static flags: -static > *** Chasing dependencies: > Chasing modules from: bayesian-sets.hs > Stable obj: [] > Stable BCO: [] > compile: input file bayesian-sets.hs > Created temporary directory: /tmp/ghc8785_0 > *** Checking old interface for main:Main: > [1 of 1] Compiling Main ( bayesian-sets.hs, bayesian-sets.o ) > *** Parser: > *** Renamer/typechecker: > > bayesian-sets.hs:1:0: > The main function `main' is not defined in module `Main' > When checking the type of the main function `main' > *** Deleting temp files: > Deleting: /tmp/ghc8785_0/ghc8785_0.s > Warning: deleting non-existent /tmp/ghc8785_0/ghc8785_0.s > Upsweep partially successful. > *** Deleting temp files: > Deleting: > link(batch): upsweep (partially) failed OR > Main.main not exported; not linking. > *** Deleting temp files: > Deleting: > *** Deleting temp dirs: > Deleting: /tmp/ghc8785_0 > > Thanks, > > Frederik > > -- > http://ofb.net/~frederik/ > [2 bayesian-sets.hs <text/x-haskell; us-ascii (7bit)>] > {-# OPTIONS_GHC -fglasgow-exts -fth #-} > module Main where > > import Foreign.C.Types > import Control.Arrow > import System.Environment > import Data.Typeable > > import Fu.GenUtil > import Fu.NewLogging > import Fu.Prepose > import Fu.Domain > import Fu.HList > > import Vector.Sparse > import Vector.TypeVector > import Vector.Sparse.Ops > import Vector.Base > import Vector.FileIO > import qualified Vector.Sparse.Wrappers as W > import Vector.Sparse.Raw > import Vector.Sparse.RawTypes > import Vector.Sparse.ArrowUtil > > --type I = CInt > --type I = CUInt > --type I = CInt > --type E = Bool > > type I = CULLong > type E = Double > type V = Sparse I E > > type RV = RSV E I > > type SV a = Sparse I E E a > > e0 :: E > e0 = 1.0 > > c :: E > c = 2 > > main :: IO () > main = do > withLogLevel Normal $ do > qsR::RV <- load "data/query-sess-2e6" > $(typeVec (__::RV) ("query","session")) qsR $ \ (x_QS::(SV (L query, L > session))) -> do > putStrLn $ "sum="++show(vsum x_QS) > let x_SQ = trans x_QS > let mask_Q = mask $ vsum $ vcurry x_QS > let qCount = vsum mask_Q > let m_S = (vsum $ vcurry x_SQ) /. qCount > let alpha_S = c .* m_S > let beta_S = c .* (mask m_S - m_S) > -- let v_S = vsum $ vcurry d_SQ > putStrLn $ "(vsum alpha_S, vsum beta_S)="++show (vsum alpha_S, vsum > beta_S) > putStrLn $ "(nnz alpha_S, nnz beta_S)="++show (nnz alpha_S, nnz beta_S) > putStrLn $ "qCount="++show qCount > vseq m_S $ vseq x_QS $ vseq alpha_S $ do > t <- profile $ > putStrLn $ "vsum (m_S >@ x_QS)"++show(vsum (m_S >@ x_QS)) > putStrLn $ "t="++show t > -- test about how long computation of q_S will take: > t <- profile $ > putStrLn $ "vsum (m_S + alpha_S)"++show(vsum (m_S + alpha_S)) > putStrLn $ "t="++show t > return () > [3 <text/plain; us-ascii (7bit)>] > _______________________________________________ > Glasgow-haskell-bugs mailing list > Glasgow-haskell-bugs@haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs _______________________________________________ Glasgow-haskell-bugs mailing list Glasgow-haskell-bugs@haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs