Usually, his reply is then "for what value of works?". Especially with compilers, there is quite a gap between "sorta works", "seems to work" and "industrial strength".
Last night I was taking a stroll through the "sorta" end of town while hacking on a Disciple version of the fannkuch-redux program from the languages benchmarks game. Disciple is a dialect of Haskell, so I started with one of the nicer existing Haskell versions.
Here is the version by Miha Vučkovič. I've reformatted it a bit and used the Disciple string pasting operator % instead of the (hated) Haskell ++, but it's otherwise the same program. (I've also added a type sig because DDC doesn't do dictionary passing yet, and used iterateL, but more on that later.)
It doesn't matter what it does, or how it does it. Check the shootout page if you're interested, we're just trying to get it running for now.
flop (2:x1:t) = x1:2:t
flop (3:x1:x2:t) = x2:x1:3:t
flop (4:x1:x2:x3:t) = x3:x2:x1:4:t
flop (5:x1:x2:x3:x4:t) = x4:x3:x2:x1:5:t
flop (6:x1:x2:x3:x4:x5:t) = x5:x4:x3:x2:x1:6:t
flop (7:x1:x2:x3:x4:x5:x6:t) = x6:x5:x4:x3:x2:x1:7:t
flop lst@(h:_) = r
where flop' 0 (t, r) = (t, r)
flop' n ((h:t), r) = flop' (n-1) (t, h:r)
(t, r) = flop' h (lst, t)
flopS (1:_) = 0
flopS lst = 1 + flopS (flop lst)
rotate n (h:t) = rotate' (n-1) t
where rotate' 0 l = h:l
rotate' n (f:t) = f:(rotate' (n-1) t)
checksum :: Int -> Int -> Int
checksum i f
| mod i 2 == 0 = f
| True = -f
pfold :: (Int, Int) -> [(Int, Int)] -> (Int, Int)
pfold r [] = r
pfold (ac, af) ((c, f):t) = pfold (sc, sf) t
where sc = ac+c
sf = max af f
permut n = foldr perm [[1..n]] [2..n]
where perm x lst = concat [take x $ iterateL (rotate x) l | l <- lst]
main ()
= do n = 8
(chksm, mflops)
= pfold (0,0)
$ map (\(i, p) -> let flops = flopS p
in (checksum i flops, flops))
$ zip [0..] (permut n)
putStr $ show chksm % "\nPfannkuchen(" % show n % ") = " % show mflops % "\n"
Faking value recursion
My first compile attempt reported:
desire:ddc-head-devel benl$ bin/ddc -O --make test/60-Shootout/Fannkuch-Redex/MainShoot.hs
[1 of 1] Compiling MainShoot
ddc: ERROR
./test/60-Shootout/Fannkuch-Redex/MainShoot.hs:16:29
Conflicting region constraints.
constraint: Direct %115
from the use of: flop
at: ./test/60-Shootout/Fannkuch-Redex/MainShoot.hs:16:29
conflicts with,
constraint: Lazy %115
from the use of: permut
at: ./test/60-Shootout/Fannkuch-Redex/MainShoot.hs:42:29
Confusing, yes, but at least it's a civilised message. What it's trying to say it thought the region named %115 was Direct, meaning it cannot contain thunks, but later code wants to add thunks to it (make it Lazy). Disciple tracks what objects can or cannot be thunks, because if the backend doesn't have to check for them then the code can be a lot faster.
The confusing thing is why it thinks this region is supposed to be Direct. Top level data (like global integers) default to Direct because when we create them we know they're fully evaluated, and not thunks. However, flop is a function so should be polymorphic in this aspect, it should not require its arguments to be Direct.
Ok, looking in the interface file for the inferred type of flop says:
flop :: Data.List.List %rTC0 (Int32 %rTC4) -(!e0 $c0)> Data.List.List %rTC0 (Int32 %rTC4)
:- $c0 = ${t : %rTC0} + ${t : %rTC4}
, !e0 = !Read %rTC0 + !Read %rTC4
, Const %rTC0
, Const %rTC4
, Direct %rTC0
, Direct %rTC4
What I'm looking at is the line:
This is a closure constraint, and reveals that the inferencer thinks this function is referencing data in regions %rTC0 and %rTC4 from its environment. This might be true if it was referring to some top level piece of data, but it's not. The closure constraint also reports the variable being used to refer to this data, namely "t".
$c0 = ${t : %rTC0} + ${t : %rTC4}
A closer inspection of flop reveals the underlying problem:
flop lst@(h:_) = r
where flop' 0 (t, r) = (t, r)
flop' n ((h:t), r) = flop' (n-1) (t, h:r)
(t, r) = flop' h (lst, t)
Here, Miha has been tricky and used value recursion in the last line. Notice that "t" appears on both the left and the right of the binding, but the binding isn't defining a recursive function -- it's a recursive value.
Disciple doesn't support value recursion yet, as it's tricky to implement in a default-strict language, but I'd like to look into it in the future. Anyway, in Disciple today only function bindings can be recursive, so what should have happened is that the renamer should have said that "t" is not in scope in the right of the binding. Instead, that screwup has gotten through the renamer, and now the inferencer thinks that "t" has been defined outside of "flop". It has then defaulted its region to Direct and Const, as there are no opposing Lazy or Mutable constraints.
The work around is to rewrite this as an actual function binding, then use laziness to break the recursive loop:
flop lst@(h:_) = snd (thing ())
where flop' 0 (t, r) = (t, r)
flop' n ((h:t), r) = flop' (n-1) (t, h:r)
thing () = flop' h @ (lst, fst @ (thing @ ()))
A @ on the right of a binding means "lazy function application". For example, the expression (f @ x) builds a thunk holding pointers to the code for "f" and its argument "x". The programmer decides where to suspend expressions, and they are forced automatically by consumers as needed. I should probably use a different operator because it looks weird with respect to the @ on the left of bindings, but no matter.
Changing this makes the program run fine, at least with an input size of 7 (the "n" in the main function).
desire:ddc-head-devel benl$ bin/ddc -O --make test/60-Shootout/Fannkuch-Redex/MainShoot.hs
[1 of 1] Compiling MainShoot
desire:ddc-head-devel benl$ ./a.out
228
Pfannkuchen(7) = 16
Sadly, setting n >= 8 gives
desire:ddc-head-devel benl$ ./a.out
*** DDC RTS PANIC! Slot stack overflow.
Abort trap
Explicit Laziness
The "slot stack" is the stack that holds pointers to heap objects. This is sometimes called a "shadow stack" and the pointers are used as roots for the garbage collector. The reason it's overflown is that Disciple is a default strict language, so our friends map, fold, filter etc evaluate the entire list when called. We can see where the stack has overflown by running the program in GDB, the GNU debugger.
Usefully, DDC compiles via C and also uses the regular C stack for return addresses and unboxed data. The intermediate C files look like they almost could have been written by a human, and there is no evil mangler butchering the assembly code once it's been compiled. This means we get real stack traces, and I don't have the same sense of impending doom as when a GHC compiled program segfaults on me.
desire:ddc-head-devel benl$ gdb a.out
GNU gdb 6.3.50-20050815 (Apple version gdb-1346) (Fri Sep 18 20:40:51 UTC 2009)
...
(gdb) run
Starting program: /Users/benl/devel/ddc/ddc-head-devel/a.out
Reading symbols for shared libraries ++. done
*** DDC RTS PANIC! Slot stack overflow.
Program received signal SIGABRT, Aborted.
0x93a74732 in __kill ()
(gdb)
(gdb) bt
#0 0x93a74732 in __kill ()
#1 0x93a74724 in kill$UNIX2003 ()
#2 0x93b0798d in raise ()
#3 0x93b1da44 in abort ()
#4 0x00012041 in _panicOutOfSlots ()
#5 0x00003a0c in Data_List__symCl ()
#6 0x00003c04 in Data_List_iterateL ()
#7 0x00014d17 in _forceStep ()
#8 0x00014db8 in _force ()
#9 0x000048a0 in Data_List_take ()
#10 0x000049c5 in Data_List_take ()
#11 0x0000363c in Data_Function__symDl ()
#12 0x0000679f in _permut_vCL2 ()
#13 0x0000434a in Data_List_concatMap ()
#14 0x00004362 in Data_List_concatMap ()
#15 0x00004362 in Data_List_concatMap ()
#16 0x00004362 in Data_List_concatMap ()
#17 0x00004362 in Data_List_concatMap ()
#18 0x00004362 in Data_List_concatMap ()
#19 0x00004362 in Data_List_concatMap ()
#20 0x00004362 in Data_List_concatMap ()
#21 0x00004362 in Data_List_concatMap ()
#22 0x00004362 in Data_List_concatMap ()
#23 0x00004362 in Data_List_concatMap ()
... 5000 more lines
From the stack trace, it looks a bit like it's run out of space in concatMap. There is no concatMap in the source code, but of course every Haskell hacker knows that list comprehensions are desugared to concatMap, so it's run out of space in the list comprehension.
Disciple is default strict, so if you want producer/consumer style list processing to run in constant space using laziness, then you have to say so. Here are new versions of permut and main after rewriting the list comprehension to use a map, and converting to the lazy list functions concatL mapL and zipL:
permut n = foldr perm [[1..n]] [2..n]
where perm x lst = concatL $ mapL (\l -> take x $ iterateL (rotate x) l) lst
main ()
= do n = 10
(chksm, mflops)
= pfold (0,0)
$ mapL (\(i, p) -> let flops = flopS p
in (checksum i flops, flops))
$ zipL [0..] (permut n)
putStr $ show chksm % "\nPfannkuchen(" % show n % ") = " % show mflops % "\n"
The functions concatL, mapL and zipL have similar definitions to the strict versions, but they're more lazy. This is like the difference between foldl and foldl' in the Haskell libraries. iterateL builds an infinite list, so there is no strict version called plain "iterate".
This makes n=8 work, but n=9 runs out of heap.
In a real runtime system, when the runtime heap is full it would ask for more from the OS. Unfortunately, the Disciple runtime is less featureful, uses a fixed size heap, and when it's full it's dead. It does have a garbage collector, but when all data in the heap is live there's nothing more the GC can do. However, you can set the size of the heap on the command line. Giving it 100Megs gets us n=9.
desire:ddc-head-devel benl$ bin/ddc -O --make test/60-Shootout/Fannkuch-Redex/MainShoot.hs
[1 of 1] Compiling MainShoot
desire:ddc-head-devel benl$ ./a.out
*** DDC RTS PANIC! Out of heap space.
current (full) heap size: 9999999 bytes
could not allocate another: 16 bytes
Abort trap
desire:ddc-head-devel benl$ ./a.out +RTS -H 100000000
8629
Pfannkuchen(9) = 30
The Treasure Finder
Garbage collection is a misnomer. Garbage collectors don't collect unused data, they copy out live data to a new space. It'd be more accurate to call them "Treasure Finders". Anyway, for interests sake we can examine the rate treasure is being found in our program. The DDC runtime supports some simple statistics like so:
desire:ddc-head-devel benl$ ./a.out +RTS -H 100000000 -profile-gc
8629
Pfannkuchen(9) = 30
desire:ddc-head-devel benl$ cat ddc-rts.prof
-- Garbage Collection
collection count = 17
alloc total = 760,836,560 (bytes)
copy total = 1,034,618,572 (bytes)
count = 68,351,051 (objects)
avg object size = 15.137 (bytes)
process time user = 6.120 (s)
system = 0.070 (s)
mutator total = 1.760 (s)
user = 1.700 (s)
system = 0.060 (s)
collector total = 4.430 (s)
user = 4.420 (s)
system = 0.010 (s)
time efficiency = 28.433 (%)
Heh, 28% time efficiency isn't the best. The Disciple GC is a simple two space collector. It's not a generational GC and there is no nursery. The way the code is compiled also makes it hold onto far too much intermediate data. Fixing that would be equivalent do doing "register allocation" on the GC slot stack, so it doesn't treat an object as a root unless it really needs it.
Of course, the great thing about having 8GB of RAM in your desktop machine is that you can achieve so much with a naive language implementation. Let's compare against GHC to see how we're going:
desire:ddc-head-devel benl$ /usr/bin/time ./a.out +RTS -H 1000000000
73196
Pfannkuchen(10) = 38
83.04 real 82.12 user 0.90 sys
desire:ddc-head-devel benl$ ghc -O2 --make test/60-Shootout/Fannkuch-Redex/MainGHC.hs -o Main
desire:ddc-head-devel benl$ /usr/bin/time ./Main 10
73196
Pfannkuchen(10) = 38
2.10 real 2.08 user 0.01 sys
That's when I went to bed.
