#3286: junk `naughty x86_64 register' after expression
-----------------------------+----------------------------------------------
Reporter: igloo | Owner:
Type: bug | Status: new
Priority: high | Milestone: 6.12.1
Component: Compiler (NCG) | Version: 6.11
Severity: normal | Keywords:
Difficulty: Unknown | Testcase:
Os: Linux | Architecture: x86_64 (amd64)
-----------------------------+----------------------------------------------
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
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/3286>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
