id,summary,reporter,owner,description,type,status,priority,milestone,component,version,resolution,keywords,cc,os,architecture,failure,testcase,blockedby,blocking,related,differential
3286,junk `naughty x86_64 register' after expression,igloo,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
}}}
",bug,closed,high,6.12.1,Compiler (NCG),6.11,fixed,,,Linux,x86_64 (amd64),None/Unknown,T3286,,,,