The duplicate definition error appears when I compile Main.hs and execute it. But when I run it with runghc the behaviour is different.  It works well:

> runghc Main.hs
3

Any idea? is this a bug of hs-plugins? it is just something expected??

2008/12/6 Alberto G. Corona <agocorona@gmail.com>
I have a web server which load server extensions. these extensions eval-uate configuration files that contains code (user-editable workflow descriptions). The problem is that I need common definitions (inside imported modules)  for the extensions and for the configuration files. This is not permitted by ha-plugins.

The minimal code example are the  files below. main loads eval.hs , that evaluate a expression. The common definitions are in Include.hs. The error is:

GHCi runtime linker: fatal error: I found a duplicate definition for symbol
   Include_sum1_srt
whilst processing object file
   /home/magocoal/haskell/devel/votesWorkflow/src/unused/tests/Include.o

This could be caused by:
   * Loading two different object files which export the same symbol
   * Specifying the same object file twice on the GHCi command line
   * An incorrect `package.conf' entry, causing some object to be
     loaded twice.
GHCi cannot safely continue in this situation.  Exiting now.  Sorry.



Do you kno how to solve the problem while maintaining the functionality?

-------Include.hs-------
module Include where

sum [x,y]= x+y


------Main.hs-----  
module Main where                                                                                                                                                                                                                                                                                                                                                                                                                                      
import Include
import System.Plugins

main= do
      s <-loadExec "eval.o" "mainc" 
      print s
     
loadExec:: String-> String->IO String          
loadExec file method = do    
    
               mv <- load file ["."] [] method
               case mv of
                LoadSuccess mod v ->    v :: IO String
                LoadFailure msg   ->    return $ concat msg
     


------------Eval.hs--------

module Eval(mainc) where
import System.IO.Unsafe
import System.Eval.Haskell

mainc= do  i <- unsafeEval_ "sum1 [1,2]" ["Include"] [] []["."] ::  IO (Either  [String]  Int)
           return $ show i