junk `naughty x86_64 register' after expression

[igloo]

This is a cut-down version of the hmm and logfloat packages on hackage. On amd64/Linux, the 6.10 branch can build this, but the HEAD fails with:

$ ghc -fforce-recomp -O --make A.hs
[1 of 2] Compiling B                ( B.hs, B.o )
[2 of 2] Compiling A                ( A.hs, A.o )
/tmp/ghc29040_0/ghc29040_0.s: Assembler messages:

/tmp/ghc29040_0/ghc29040_0.s:393:0:
     Error: junk `naughty x86_64 register' after expression

A.hs:

module A (train) where

import qualified Data.Map as M
import Data.List (groupBy, foldl')
import Data.Maybe (fromMaybe, fromJust)
import Data.Function (on)
import B

type Prob = LogFloat

learn_states :: (Ord state) => [(observation, state)] -> M.Map state Prob
learn_states xs = histogram $ map snd xs

learn_observations ::  (Ord state, Ord observation) =>
                       M.Map state Prob
                    -> [(observation, state)]
                    -> M.Map (observation, state) Prob
learn_observations state_prob = M.mapWithKey f . histogram
    where f (_, state) prob = prob / (fromJust $ M.lookup state state_prob)

histogram :: (Ord a) => [a] -> M.Map a Prob
histogram xs = let hist = foldl' undefined M.empty xs in
                M.map (/ M.fold (+) 0 hist) hist

train :: (Ord observation, Ord state) =>
            [(observation, state)]
         -> (observation -> [Prob])
train sample = model
    where
        states = learn_states sample
        state_list = M.keys states

        observations = learn_observations states sample
        observation_probs = fromMaybe (fill state_list []) . (flip M.lookup $
                            M.fromList $ map (\ (e, xs) -> (e, fill state_list xs)) $
                                map (\ xs -> (fst $ head xs, map snd xs)) $
                                groupBy     ((==) `on` fst)
                                            [(observation, (state, prob))
                                                | ((observation, state), prob) <- M.toAscList observations])

        model = observation_probs

        fill :: Eq state => [state] -> [(state, Prob)] -> [Prob]
        fill = undefined

B.hs:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module B (LogFloat) where

newtype LogFloat = LogFloat Double
    deriving (Eq, Ord, Num, Show)

instance Fractional LogFloat where
    (/) (LogFloat x) (LogFloat y)
        |    x == 1
          && y == 1 = error "(/)"
        | otherwise                = LogFloat (x-y)
    fromRational = LogFloat . fromRational

[simonmar]

Allegedly fixed by #3132 - Ian could you check please?

[igloo]

Confirmed now working in the HEAD.