[Haskell] ANNOUNCE: GHC version 7.8.3

Sven Panne svenpanne at gmail.com
Tue Aug 5 11:32:43 UTC 2014


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?


More information about the ghc-devs mailing list