Trying to compile my first program that imports another program

Hi, I created (with help) a function to test for prime numbers. It worked well enough for now in ghci. ---------------- f x n y | n>y = True | rem x n == 0 = False | otherwise = f x (n+1) y primeQ x = f x 2 y where y = floor(sqrt(fromIntegral x)) --------------- I then wanted to create object code so that I could import it. It seemed that I had to precede the above with the 2 lines: ---------------- module Prime where ---------------- I ran: ghc -c prime.hs, and created prime.o and prime.hi. Next, I wanted to write a program to import and use this function. I wrote: ------------ module Main () where import Prime main = primeQ 123 ------------ I tried to compile this with: ghc -o test Main.hs prime.o I got the following error: Main.hs:5:0: Couldn't match expected type 'IO t' against inferred type 'Bool' In the expression: main When checking the type of the function 'main' ---------------- First I'd like a hint as to what I need to do to make this work. It's pretty obvious that I don't know what I'm doing with regard to types. Also, I have no idea if I have to name this module Main, but when I didn't the compiler complained about that. In the function that I think I had to re-write to make object code, I wound up with 2 where statements, which worries me. I'd really appreciate any help in getting me unraveled. Mitchell

Hi, Mitchell First of all, you don't really need to compile your module Prime to be able to import it. Supposing you just want to, though: Your funcion primeO is 'pure', it work on numbers only, and will return the same results for the same arguments every time, without "launching missiles" or side-effects of any kind. The main function (in the Main module), which is the 'main entry point' (like in C), is of type 'IO ()' ... this means a lot, and you should really look into types for Haskell; but in a nutshell, it means the function 'main' may have side-effects (like printing to stdout, or opening a socket, deleting a file, etc) which cannot be predicted. Haskell is very careful as to keep pure code pure, and non-pure code, well, non-pure... [check out 'monads']. The 'main' function is of type 'IO ()', so all functions called by it must have type 'IO something'. [IO is a monad]. Your function prime0 is of type 'Bool', so you need to inject it into the 'IO' [get it into the monad]. This is done with the function 'return' (which is quite different to that of C): module Main where import Prime main = return (primeQ 123) BTW, your Haskell program must have a Main module. You will write your modules with "module SomeThing where", and name that file SomeThing.hs; the Main module can have any filename you want, though. El dom, 25-04-2010 a las 21:07 -0400, Mitchell Kaplan escribió:
Hi,
I created (with help) a function to test for prime numbers. It worked well enough for now in ghci.
----------------
f x n y
| n>y = True
| rem x n == 0 = False
| otherwise = f x (n+1) y
primeQ x = f x 2 y
where
y = floor(sqrt(fromIntegral x))
---------------
I then wanted to create object code so that I could import it. It seemed that I had to precede the above with the 2 lines:
----------------
module Prime
where
----------------
I ran:
ghc –c prime.hs, and created prime.o and prime.hi.
Next, I wanted to write a program to import and use this function.
I wrote:
------------
module Main () where
import Prime
main = primeQ 123
------------
I tried to compile this with:
ghc –o test Main.hs prime.o
I got the following error:
Main.hs:5:0:
Couldn’t match expected type ‘IO t’ against inferred type ‘Bool’
In the expression: main
When checking the type of the function ‘main’
----------------
First I’d like a hint as to what I need to do to make this work.
It’s pretty obvious that I don’t know what I’m doing with regard to types. Also, I have no idea if I have to name this module Main, but when I didn’t the compiler complained about that.
In the function that I think I had to re-write to make object code, I wound up with 2 where statements, which worries me.
I’d really appreciate any help in getting me unraveled.
Mitchell
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

MAN's nutshell explanation is good, and his rewrite of the Main module is type-correct. But note that the result of the `main` action (of type IO t for some type t) is deliberately discarded, so you probably want something more useful, such as: module Main where import Prime main = print (primeQ 123) Dean At 10:25 PM -0300 4/25/10, MAN wrote:
Hi, Mitchell
First of all, you don't really need to compile your module Prime to be able to import it. Supposing you just want to, though:
Your funcion primeO is 'pure', it work on numbers only, and will return the same results for the same arguments every time, without "launching missiles" or side-effects of any kind.
The main function (in the Main module), which is the 'main entry point' (like in C), is of type 'IO ()' ... this means a lot, and you should really look into types for Haskell; but in a nutshell, it means the function 'main' may have side-effects (like printing to stdout, or opening a socket, deleting a file, etc) which cannot be predicted.
Haskell is very careful as to keep pure code pure, and non-pure code, well, non-pure... [check out 'monads']. The 'main' function is of type 'IO ()', so all functions called by it must have type 'IO something'. [IO is a monad]. Your function prime0 is of type 'Bool', so you need to inject it into the 'IO' [get it into the monad]. This is done with the function 'return' (which is quite different to that of C):
module Main where import Prime main = return (primeQ 123)
BTW, your Haskell program must have a Main module. You will write your modules with "module SomeThing where", and name that file SomeThing.hs; the Main module can have any filename you want, though.
El dom, 25-04-2010 a las 21:07 -0400, Mitchell Kaplan escribió:
Hi,
I created (with help) a function to test for prime numbers. It worked well enough for now in ghci.
----------------
f x n y
| n>y = True
| rem x n == 0 = False
| otherwise = f x (n+1) y
primeQ x = f x 2 y
where
y = floor(sqrt(fromIntegral x))
---------------
I then wanted to create object code so that I could import it. It seemed that I had to precede the above with the 2 lines:
----------------
module Prime
where
----------------
I ran:
ghc -c prime.hs, and created prime.o and prime.hi.
Next, I wanted to write a program to import and use this function.
I wrote:
------------
module Main () where
import Prime
main = primeQ 123
------------
I tried to compile this with:
ghc -o test Main.hs prime.o
I got the following error:
Main.hs:5:0:
Couldn't match expected type 'IO t' against inferred type 'Bool'
In the expression: main
When checking the type of the function 'main'
----------------
First I'd like a hint as to what I need to do to make this work.
It's pretty obvious that I don't know what I'm doing with regard to types. Also, I have no idea if I have to name this module Main, but when I didn't the compiler complained about that.
In the function that I think I had to re-write to make object code, I wound up with 2 where statements, which worries me.
I'd really appreciate any help in getting me unraveled.
Mitchell

Again, a lot has already been explained, so I have only a few additional remarks. Am Montag 26 April 2010 03:07:36 schrieb Mitchell Kaplan:
Hi,
I created (with help) a function to test for prime numbers. It worked well enough for now in ghci.
----------------
f x n y
| n>y = True | | rem x n == 0 = False | | otherwise = f x (n+1) y
primeQ x = f x 2 y
where
y = floor(sqrt(fromIntegral x))
---------------
I then wanted to create object code so that I could import it. It seemed that I had to precede the above with the 2 lines:
----------------
module Prime
where
----------------
If there is no explicit module declaration, the language standard prescribes the implicit declaration module Main (main) where which means your module is called Main and exports the single function (IO- action) "main". If you load the code in ghci (interpreted), it ignores the export list and makes all definitions from the top-level of the module available at the prompt. Since ghci is mostly used for testing code while it's written, that deviation from the standard is very useful. If a module without module declaration doesn't define a function main :: IO t at the top level, it doesn't compile (implicitly, you say that you're exporting a function main, but you don't define it).
I ran:
ghc -c prime.hs, and created prime.o and prime.hi.
It is generally better to use "ghc --make source.hs". And the filename should match the module name (except the module Main can be in whatever file, test.hs, Main.hs, as you please - since that isn't imported, it's the root of the import chase, GHC doesn't need to automatically find it), so it should be Prime.hs (upper case P). That way, "ghc --make" can find it by itself and you don't need to list all needed object files on the command line.
Next, I wanted to write a program to import and use this function.
I wrote:
------------
module Main () where
That says Main doesn't export anything, but it should export at least main, so module Main (main) where
import Prime
main = primeQ 123
------------
I tried to compile this with:
ghc -o test Main.hs prime.o
If module Prime is defined in the file Prime.hs in the same directory (or somewhere you tell GHC to look), it becomes simply ghc --make Main -o test (or have the Main module in test.hs, then it's simply "ghc --make test").
I got the following error:
Main.hs:5:0: Couldn't match expected type 'IO t' against inferred type 'Bool' In the expression: main When checking the type of the function 'main'
----------------
First I'd like a hint as to what I need to do to make this work.
It's pretty obvious that I don't know what I'm doing with regard to types. Also, I have no idea if I have to name this module Main, but when I didn't the compiler complained about that.
You can call it something else, but then you have to tell the compiler explicitly what should be the 'main' function via "-main-is thing". E.g. witch.hs -------------------------------- module Hello where hello :: String hello = "All hail Macbeth!" greet :: IO () greet = putStrLn hello ---------------------------------- $ ghc -main-is Hello.greet --make witch [1 of 1] Compiling Hello ( witch.hs, witch.o ) Linking witch ... $ ./witch All hail Macbeth! If the module were named Main, it'd be "ghc -main-is greet ...", if the module name isn't Main, but your 'main' function is called "main", it'd be "ghc -main-is Hello --make ..."
In the function that I think I had to re-write to make object code, I wound up with 2 where statements, which worries me.
Nested scopes. You always have one "where" defining the module scope, implicitly if you omit the module declaration. Then you can define local scopes in functions at the top-level of the module using another where (or a let), local-local scopes in local functions etc.
I'd really appreciate any help in getting me unraveled.
Mitchell
participants (4)
-
Daniel Fischer
-
Dean Herington
-
MAN
-
Mitchell Kaplan