diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,5 @@ +- 0.5.4.2: Generate unique C names by prefixing the already generated + name with the Haskell module name. See issue #25. - 0.5.4.1: Do not generate C code when haddock is type checking. See issue #24. - 0.5.4.0: Allow Haskell identifiers in anti-quotes. See issue #23. diff --git a/examples/gsl-ode.c b/examples/gsl-ode.c --- a/examples/gsl-ode.c +++ b/examples/gsl-ode.c @@ -5,12 +5,12 @@ #include -int inline_c_0_31a6738e02530b20854a5ca8638293b1032edaf3() { +int inline_c_Main_0_31a6738e02530b20854a5ca8638293b1032edaf3() { return ( GSL_SUCCESS ); } -int inline_c_1_a6e274e32d1c2e90339edd389a8b86d3fe8dae07(int (* funIO_inline_c_0)(double t, const double y[], double dydt[], void * params), int dim_c_inline_c_1, double x0_inline_c_2, double xend_inline_c_3, double * fMut_inline_c_4) { +int inline_c_Main_1_a6e274e32d1c2e90339edd389a8b86d3fe8dae07(int (* funIO_inline_c_0)(double t, const double y[], double dydt[], void * params), int dim_c_inline_c_1, double x0_inline_c_2, double xend_inline_c_3, double * fMut_inline_c_4) { gsl_odeiv2_system sys = { funIO_inline_c_0, @@ -34,17 +34,17 @@ } -int inline_c_2_189238c774f5c8439b92bfd53fe3cdd4e56f6e81() { +int inline_c_Main_2_189238c774f5c8439b92bfd53fe3cdd4e56f6e81() { return ( GSL_EMAXITER ); } -int inline_c_3_b4b4adc018e7fe003e77992771fc803668198b63() { +int inline_c_Main_3_b4b4adc018e7fe003e77992771fc803668198b63() { return ( GSL_ENOPROG ); } -int inline_c_4_31a6738e02530b20854a5ca8638293b1032edaf3() { +int inline_c_Main_4_31a6738e02530b20854a5ca8638293b1032edaf3() { return ( GSL_SUCCESS ); } diff --git a/inline-c.cabal b/inline-c.cabal --- a/inline-c.cabal +++ b/inline-c.cabal @@ -1,5 +1,5 @@ name: inline-c -version: 0.5.4.1 +version: 0.5.4.2 synopsis: Write Haskell source files including C code inline. No FFI required. description: See . license: MIT diff --git a/src/Language/C/Inline/Internal.hs b/src/Language/C/Inline/Internal.hs --- a/src/Language/C/Inline/Internal.hs +++ b/src/Language/C/Inline/Internal.hs @@ -178,17 +178,17 @@ -- (e.g. with @-fno-code@ or in @haddock@) cSourceLoc :: Context -> TH.Q (Maybe FilePath) cSourceLoc ctx = do - thisFile <- TH.loc_filename <$> TH.location - let ext = fromMaybe "c" $ ctxFileExtension ctx - emitCode <- TH.runIO $ do - prog <- getProgName - -- Hard-code a common case for not generating code. haddock just - -- type-checks, so we do not need to generate the C file again. - -- See issue #24. - return $ prog /= "haddock" - return $ if emitCode - then Just $ dropExtension thisFile `addExtension` ext - else Nothing + prog <- TH.runIO getProgName + -- Hard-code a common case for not generating code. haddock just + -- type-checks, so we do not need to generate the C file again. + -- See issue #24. + let emitCode = prog /= "haddock" + if not emitCode + then return Nothing + else do + thisFile <- TH.loc_filename <$> TH.location + let ext = fromMaybe "c" $ ctxFileExtension ctx + return $ Just $ dropExtension thisFile `addExtension` ext removeIfExists :: FilePath -> IO () removeIfExists fileName = removeFile fileName `catch` handleExists @@ -270,11 +270,29 @@ TH.addTopDecls [dec] TH.varE ffiImportName -uniqueCName :: String -> TH.Q String +uniqueCName + :: String + -- ^ Some string identifying the body of the symbol the name will + -- refer too -- e.g. the function arguments + body. This is used to + -- generate persistent names: we do not want completely random names + -- since this causes issues when cabal builds things repeatedly, for + -- example when building with profiling. + -> TH.Q String uniqueCName x = do + -- The name looks like this: + -- inline_c_MODULE_INDEX_HASH + -- + -- Where: + -- * MODULE is the module name but with _s instead of .s; + -- * INDEX is a counter that keeps track of how many names we're generating + -- for each module; + -- * HASH is the SHA1 hash of the contents. c' <- bumpGeneratedNames let unique :: CryptoHash.Digest CryptoHash.SHA1 = CryptoHash.hashlazy $ Binary.encode x - return $ "inline_c_" ++ show c' ++ "_" ++ show unique + module_ <- TH.loc_module <$> TH.location + let replaceDot '.' = '_' + replaceDot c = c + return $ "inline_c_" ++ map replaceDot module_ ++ "_" ++ show c' ++ "_" ++ show unique -- | Same as 'inlineCItems', but with a single expression. -- diff --git a/test/tests.c b/test/tests.c --- a/test/tests.c +++ b/test/tests.c @@ -15,92 +15,92 @@ int francescos_add(int x, int y) { int z = x + y; return z; } -int inline_c_0_23225c6b2d15328585f210dc2f989269e95d08ee(int x) { +int inline_c_Main_0_23225c6b2d15328585f210dc2f989269e95d08ee(int x) { return x + 3; } -int inline_c_1_7ac34f446e8519c3b967b9fafdc79c95552f35e4() { +int inline_c_Main_1_7ac34f446e8519c3b967b9fafdc79c95552f35e4() { return ( 1 + 4 ); } -int inline_c_2_5fdbbe6da0475522165cd251c48497d38f4710fb(int x_inline_c_0, int y_inline_c_1) { +int inline_c_Main_2_5fdbbe6da0475522165cd251c48497d38f4710fb(int x_inline_c_0, int y_inline_c_1) { return ( x_inline_c_0 + y_inline_c_1 + 5 ); } -int inline_c_3_856f16273cbef2af269b645953d316cb9426784c(int x_inline_c_0, int y_inline_c_1) { +int inline_c_Main_3_856f16273cbef2af269b645953d316cb9426784c(int x_inline_c_0, int y_inline_c_1) { return ( x_inline_c_0 + 10 + y_inline_c_1 ); } -int inline_c_4_f58397f6204cd35d25406cea930cdd76127e7a8d(int x_inline_c_0, int y_inline_c_1) { +int inline_c_Main_4_f58397f6204cd35d25406cea930cdd76127e7a8d(int x_inline_c_0, int y_inline_c_1) { return ( 7 + x_inline_c_0 + y_inline_c_1 ); } -void inline_c_5_bbad659b194c6226bc20ec8262bc1c599dddeb28() { +void inline_c_Main_5_bbad659b194c6226bc20ec8262bc1c599dddeb28() { printf("Hello\n") ; } -ptrdiff_t inline_c_6_4475cd73db749194709e394483ff3e5205688ff8(ptrdiff_t x_inline_c_0) { +ptrdiff_t inline_c_Main_6_4475cd73db749194709e394483ff3e5205688ff8(ptrdiff_t x_inline_c_0) { char a[2]; return &a[1] - &a[0] + x_inline_c_0; } -size_t inline_c_7_9782c357435fb488c3166bf10e839da13328001e() { +size_t inline_c_Main_7_9782c357435fb488c3166bf10e839da13328001e() { return ( sizeof (char) ); } -uintmax_t inline_c_8_c0df91f70bbf1f85671339d1bdc524414e112cc2() { +uintmax_t inline_c_Main_8_c0df91f70bbf1f85671339d1bdc524414e112cc2() { return ( UINTMAX_MAX ); } -int16_t inline_c_9_9e29ba00e56a81c765067e09a3136fa5232d49a0(int16_t x_inline_c_0) { +int16_t inline_c_Main_9_9e29ba00e56a81c765067e09a3136fa5232d49a0(int16_t x_inline_c_0) { return ( 1 + x_inline_c_0 ); } -uint32_t inline_c_10_08a42fa8f755a36db897898b73bb7aab5b1b58e1(uint32_t y_inline_c_0) { +uint32_t inline_c_Main_10_08a42fa8f755a36db897898b73bb7aab5b1b58e1(uint32_t y_inline_c_0) { return ( y_inline_c_0 * 7 ); } -int inline_c_11_4ffe4d055df0966eedc85f08247aa8880402694a(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_Main_11_4ffe4d055df0966eedc85f08247aa8880402694a(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermannPtr_inline_c_0(x_inline_c_1, y_inline_c_2) ); } -int (* inline_c_12_7e6957a671db751a0a5b5e9721b3c45002fab68f())(int , int ) { +int (* inline_c_Main_12_7e6957a671db751a0a5b5e9721b3c45002fab68f())(int , int ) { return ( &francescos_add ); } -int inline_c_13_55555bbb777d25d03fef0a6d6ce9193474a74a35(int (* ackermann__inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_Main_13_55555bbb777d25d03fef0a6d6ce9193474a74a35(int (* ackermann__inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermann__inline_c_0(x_inline_c_1, y_inline_c_2) ); } -int inline_c_14_4ffe4d055df0966eedc85f08247aa8880402694a(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_Main_14_4ffe4d055df0966eedc85f08247aa8880402694a(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermannPtr_inline_c_0(x_inline_c_1, y_inline_c_2) ); } -int inline_c_15_b7d965842e65c49fcc08b03f70454988290e61e4(int (* ackermann_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_Main_15_b7d965842e65c49fcc08b03f70454988290e61e4(int (* ackermann_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermann_inline_c_0(x_inline_c_1, y_inline_c_2) ); } -double inline_c_16_5dce1654ef6186acdb189a6ce36f0a66660eb346(double (* fun_inline_c_0)(double )) { +double inline_c_Main_16_5dce1654ef6186acdb189a6ce36f0a66660eb346(double (* fun_inline_c_0)(double )) { return ( fun_inline_c_0(3.0) ); } -int inline_c_17_8d0f093895f51773152915c33b75c7aafd8f4f45(int n_inline_c_0, int * ptr_inline_c_1) { +int inline_c_Main_17_8d0f093895f51773152915c33b75c7aafd8f4f45(int n_inline_c_0, int * ptr_inline_c_1) { int i; int x = 0; @@ -112,7 +112,7 @@ } -int inline_c_18_62ce8aade5e693f134c6a5c9add3523edab1a63e(long vec_inline_c_0, int * vec_inline_c_1) { +int inline_c_Main_18_62ce8aade5e693f134c6a5c9add3523edab1a63e(long vec_inline_c_0, int * vec_inline_c_1) { int i; int x = 0; @@ -124,7 +124,7 @@ } -int inline_c_19_75f1401fb8545756b6d329a5352a252bf52db946(long bs_inline_c_0, char * bs_inline_c_1) { +int inline_c_Main_19_75f1401fb8545756b6d329a5352a252bf52db946(long bs_inline_c_0, char * bs_inline_c_1) { int i, bits = 0; for (i = 0; i < bs_inline_c_0; i++) { @@ -136,17 +136,17 @@ } -int inline_c_20_6fa3d382d3ab7f6d57eec7fbfe64e87fbc2a0ca9(int x_27_inline_c_0) { +int inline_c_Main_20_6fa3d382d3ab7f6d57eec7fbfe64e87fbc2a0ca9(int x_27_inline_c_0) { return ( x_27_inline_c_0 ); } -int inline_c_21_dbf060cb8fa2b86c6c6838ef9b645ac20f38ba79(int _e4_inline_c_0) { +int inline_c_Main_21_dbf060cb8fa2b86c6c6838ef9b645ac20f38ba79(int _e4_inline_c_0) { return ( _e4_inline_c_0 ); } -int inline_c_22_2421969c444755bea2c6f2060e0921ce7f3d16d7(int PreludemaxBound_2e_inline_c_0) { +int inline_c_Main_22_2421969c444755bea2c6f2060e0921ce7f3d16d7(int PreludemaxBound_2e_inline_c_0) { return ( PreludemaxBound_2e_inline_c_0 ); }