#2060: Unknown opcode 10904
--------------------------+-------------------------------------------------
Reporter: ezrakilty | Owner:
Type: bug | Status: new
Priority: normal | Component: Compiler
Version: 6.6 | Severity: normal
Keywords: | Testcase:
Architecture: x86 | Os: MacOS X
--------------------------+-------------------------------------------------
I got this error working with ghci just now. Contrary to what it says, I'm
not on linux but on Mac OS X 10.4.11 (intel).
{{{
*Main> quickCheck prop_typecheck
<interactive>: internal error: interpretBCO: unknown or unimplemented
opcode 10904
(GHC version 6.6 for i386_unknown_linux)
Please report this as a GHC bug:
http://www.haskell.org/ghc/reportabug
}}}
The text of the program follows.
{{{
import Foreign (unsafePerformIO)
import List (nub)
import System.Random (mkStdGen)
import Test.QuickCheck
data Term = Const | Var Int | Abs Term | Appl Term Term
deriving (Show)
data Type = Base | Type :->: Type
deriving (Eq, Show)
data TypeScheme = T Type | V Int | Arr TypeScheme TypeScheme
deriving (Eq, Show)
eval env Const = Const
eval env (Var x) | x < length env = env !! x
eval env (Abs n) = Abs n
eval env (Appl m n) = case eval env m of
Abs m' -> eval env' m'
where env' = eval env n : env
_ -> error "non-functional application"
data Fresh a = Fr(Int -> (Int, a))
instance Monad Fresh where
return x = Fr(\ctr -> (ctr, x))
(Fr m) >>= f = Fr(\x -> let (ctr, x') = m x in
let Fr f' = f x' in
f' ctr)
fresh :: Fresh Int
fresh = Fr(\ctr -> (ctr+1, ctr))
runFresh (Fr f) = snd $ f 0
arrowTy (s :->: t) = True
arrowTy _ = False
unify (T s) (T t) | s == t = Just[]
unify (V x) t = Just [(x, t)]
unify s (V y) = Just [(y, s)]
unify (Arr s1 t1) (Arr s2 t2) =
do subst1 <- unify s1 s2
subst2 <- unify t1 t2
Just (List.nub $ subst1 ++ subst2)
applySubst :: (Int, TypeScheme) -> TypeScheme -> TypeScheme
applySubst (x, xIm) (T ty) = T ty
applySubst (x, xIm) (V y) | x == y = xIm
| otherwise = V y
applySubst (x, xIm) (Arr s t) = Arr (applySubst (x, xIm) s)
(applySubst (x, xIm) t)
applySubsts :: [(Int, TypeScheme)] -> TypeScheme -> TypeScheme
applySubsts substs ty = foldr (applySubst) ty substs
typeCheck :: [TypeScheme] -> Term -> Fresh TypeScheme
typeCheck env Const = return $ T Base
typeCheck env (Var x) | x < length env = return (env !! x)
typeCheck env (Abs n) =
do xTy <- fresh
nTy <- typeCheck (V xTy : env) n
return (Arr (V xTy) nTy)
typeCheck env (Appl m n) =
do mTy <- typeCheck env m
nTy <- typeCheck env n
case mTy of
Arr mArgTy mResTy ->
case unify mArgTy nTy of
Nothing -> error "unification failed"
Just substn ->
return (applySubsts substn mResTy)
_ -> error "ill-typed application"
typeGen :: Int -> Gen Type
typeGen size = oneof $
[return Base] ++
if size <= 0 then [] else
[do s <- typeGen (size-1)
t <- typeGen (size-1)
return $ s :->: t ]
asList Nothing = []
asList (Just x) = [x]
oneofMaybe :: [Gen(Maybe a)] -> Gen (Maybe a)
oneofMaybe [] = return Nothing
oneofMaybe (x:xs) = do x' <- x
xs' <- oneofMaybe xs
case (x', xs') of
(Nothing, Nothing) -> return Nothing
_ -> oneof (map (return . Just) $
asList x' ++ asList xs')
typedTermGen :: [Type] -> Type -> Int -> Gen (Maybe Term)
typedTermGen ctxt tau size = oneofMaybe (
(case tau of
Base -> [return $ Just Const]
tau :->: tau' ->
if size <= 0 then [] else
[do n <- typedTermGen (tau:ctxt) tau' decSize
return $ do n' <- n
Just(Abs n')]
) ++
(if size <= 0 then [] else
[do sigma <- typeGen decSize
-- let sigma = (unsafePerformIO $ putStr $ show sigma') `seq`
sigma'
m <- typedTermGen ctxt (sigma :->: tau) decSize
n <- typedTermGen ctxt (sigma) decSize
return $ do m' <- m ; n' <- n; Just (Appl m' n')
]) ++
[return$ Just (Var x) | (x, xType) <- zip [0..] ctxt, xType == tau]
)
where decSize = size-1
-- graph a function over certain inputs
graph f xs = [(x, f x) | x <- xs]
make n g size = [generate size (System.Random.mkStdGen i) g | i<-[0..n]]
prop_typecheck = forAll (sized (typedTermGen [] Base)) (\m ->
let m' = Maybe.fromJust m in
(runFresh (typeCheck [] m')) == Some (T Base))
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2060>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
