[Haskell] ANNOUNCE: GHC version 7.8.3
Simon Marlow
marlowsd at gmail.com
Mon Sep 1 07:26:44 UTC 2014
Hi Sven - you would need to compile the module with -dynamic or
-dynamic-too to have it be picked up by the new dynamically-linked GHCi
in 7.8.
Cheers,
Simon
On 05/08/2014 12:32, Sven Panne wrote:
> Coming a bit late to the party, but I've just realized this when
> playing around with the platform release candidate: I've successfully
> built and installed the 2014 RC3 on x64 Ubuntu Linux 12.04 LTS using
> ghc-7.8.3-x86_64-unknown-linux-centos65.tar.bz2 from the GHC download
> page. But somehow loading compiled code into ghci doesn't work, ghci
> always uses interpreted code. To verify this I've followed the simple
> example at http://www.haskell.org/ghc/docs/7.8.3/html/users_guide/ghci-compiled.html:
>
> -------------------------------------------------------------------------------------------------
> svenpanne at svenpanne:~/ghci-test$ ll
> total 16
> -rw-r----- 1 svenpanne eng 33 Aug 5 13:01 A.hs
> -rw-r----- 1 svenpanne eng 24 Aug 5 13:02 B.hs
> -rw-r----- 1 svenpanne eng 24 Aug 5 13:02 C.hs
> -rw-r----- 1 svenpanne eng 15 Aug 5 13:02 D.hs
> svenpanne at svenpanne:~/ghci-test$ more *.hs
> ::::::::::::::
> A.hs
> ::::::::::::::
> module A where
> import B
> import C
> ::::::::::::::
> B.hs
> ::::::::::::::
> module B where
> import D
> ::::::::::::::
> C.hs
> ::::::::::::::
> module C where
> import D
> ::::::::::::::
> D.hs
> ::::::::::::::
> module D where
> svenpanne at svenpanne:~/ghci-test$ ghci-7.6.3
> GHCi, version 7.6.3: http://www.haskell.org/ghc/ :? for help
> Loading package ghc-prim ... linking ... done.
> Loading package integer-gmp ... linking ... done.
> Loading package base ... linking ... done.
> Prelude> :! ghc-7.6.3 -c D.hs
> Prelude> :load A
> [2 of 4] Compiling C ( C.hs, interpreted )
> [3 of 4] Compiling B ( B.hs, interpreted )
> [4 of 4] Compiling A ( A.hs, interpreted )
> Ok, modules loaded: D, C, A, B.
> *A> :show modules
> D ( D.hs, D.o )
> C ( C.hs, interpreted )
> A ( A.hs, interpreted )
> B ( B.hs, interpreted )
> *A>
> Leaving GHCi.
> svenpanne at svenpanne:~/ghci-test$ rm *.hi *.o
> svenpanne at svenpanne:~/ghci-test$ ghci-7.8.3
> GHCi, version 7.8.3: http://www.haskell.org/ghc/ :? for help
> Loading package ghc-prim ... linking ... done.
> Loading package integer-gmp ... linking ... done.
> Loading package base ... linking ... done.
> Prelude> :! ghc-7.8.3 -c D.hs
> Prelude> :load A
> [1 of 4] Compiling D ( D.hs, interpreted )
> [2 of 4] Compiling C ( C.hs, interpreted )
> [3 of 4] Compiling B ( B.hs, interpreted )
> [4 of 4] Compiling A ( A.hs, interpreted )
> Ok, modules loaded: D, C, A, B.
> *A> :show modules
> D ( D.hs, interpreted )
> C ( C.hs, interpreted )
> A ( A.hs, interpreted )
> B ( B.hs, interpreted )
> *A>
> Leaving GHCi.
> -------------------------------------------------------------------------------------------------
>
> Using strace showed that ghci-7.8.3 reads D.hs twice (huh?) and D.hi
> once, but only "stat"s D.o (never reads its contents):
>
> -------------------------------------------------------------------------------------------------
> [...]
> 12124 stat("D.hs", {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 stat("./D.hs", {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 open("./D.hs", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 11
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 ioctl(11, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff90c12938) = -1
> ENOTTY (Inappropriate ioctl for device)
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 lseek(11, 0, SEEK_CUR) = 0
> 12124 read(11, "module D where\n", 8096) = 15
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 lseek(11, 0, SEEK_CUR) = 15
> 12124 close(11) = 0
> 12124 open("./D.hs", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 11
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 ioctl(11, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff90c12938) = -1
> ENOTTY (Inappropriate ioctl for device)
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=15, ...}) = 0
> 12124 read(11, "module D where\n", 8096) = 15
> 12124 close(11) = 0
> 12124 stat("./D.o", {st_mode=S_IFREG|0640, st_size=933, ...}) = 0
> 12124 stat("Prelude.hs", 0x7f28b26e2b30) = -1 ENOENT (No such file or directory)
> 12124 stat("Prelude.lhs", 0x7f28b26e2cd0) = -1 ENOENT (No such file or
> directory)
> 12124 stat("B.hs", {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 stat("./B.hs", {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 open("./B.hs", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 11
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 ioctl(11, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff90c12938) = -1
> ENOTTY (Inappropriate ioctl for device)
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 lseek(11, 0, SEEK_CUR) = 0
> 12124 read(11, "module B where\nimport D\n", 8096) = 24
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 lseek(11, 0, SEEK_CUR) = 24
> 12124 close(11) = 0
> 12124 open("./B.hs", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 11
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 ioctl(11, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff90c12938) = -1
> ENOTTY (Inappropriate ioctl for device)
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=24, ...}) = 0
> 12124 read(11, "module B where\nimport D\n", 8096) = 24
> 12124 close(11) = 0
> 12124 stat("./B.o", 0x7f28b26fa780) = -1 ENOENT (No such file or directory)
> 12124 stat("Prelude.hs", 0x7f28b26fa900) = -1 ENOENT (No such file or directory)
> 12124 stat("Prelude.lhs", 0x7f28b26faaa0) = -1 ENOENT (No such file or
> directory)
> 12124 mkdir("/tmp/ghc12124_0", 0777) = 0
> 12124 stat("/tmp/ghc12124_0/ghc12124_1.o", 0x7f28b26facf0) = -1 ENOENT
> (No such file or directory)
> 12124 open("./D.hi", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 11
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=500, ...}) = 0
> 12124 ioctl(11, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff90c12938) = -1
> ENOTTY (Inappropriate ioctl for device)
> 12124 fstat(11, {st_mode=S_IFREG|0640, st_size=500, ...}) = 0
> 12124 read(11, "\1\372\316d\0\0\0\0\0\0\0\0\4\0"..., 8096) = 500
> 12124 close(11) = 0
> 12124 select(2, [], [1], NULL, {0, 0}) = 1 (out [1], left {0, 0})
> 12124 write(1, "[1 of 4] Compiling D ( D.hs,
> interpreted )\n", 58) = 58
> [...]
> -------------------------------------------------------------------------------------------------
>
> This looks wrong to me. Did I miss something and/or did something
> stupid? Known bug?
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://www.haskell.org/mailman/listinfo/ghc-devs
>
More information about the ghc-devs
mailing list