<interactive>: internal error: interpretBCO: unknown or unimplemented opcode
I did try to post this to glasgow-haskell-bugs@haskell.org before christmas because I could not log into trac but as a non-subscriber it was "moderated" and never appeared...
(Although architecture is set to x86, this also occurs on x86_64)
I'm not sure precisely what the problem is here, but if you remove all the strictness modifiers then the problem goes away.
Also, the following works fine:
buildOctTree (Vec 0 0 0) 10 10 10 [(a,(Vec a a a)) | a <- [(-4.0),(-2.0)..4.0]]
Also, having done that, the problematic expressions work fine - the bug only appears if the expression below is run as the first call to buildOctTree in the ghci session.
This is on a P4, 2GB RAM, Debian unstable, ghc 6.6 (both hand rolled and from debian).
uname -a =
Linux smudge 2.6.18-2-686 #1 (closed) SMP Wed Nov 8 19:52:12 UTC 2006 i686 GNU/Linux
ghci -v OctTree
/ _ \ /\ /\/ __(_)
/ /\// // / / | | GHC Interactive, version 6.6, for Haskell 98. / /\\/ __ / /| | http://www.haskell.org/ghc/ \__/\/ //\___/|_| Type :? for help.
Using package config file: /usr/lib/ghc-6.6/package.conf wired-in package base mapped to base-2.0 wired-in package rts mapped to rts-1.0 wired-in package haskell98 mapped to haskell98-1.0 wired-in package template-haskell mapped to template-haskell-2.0 Hsc static flags: -static Loading package base ... linking ... done.
- ** Parser:
- ** Desugar:
- ** Simplify:
- ** CorePrep:
- ** ByteCodeGen:
- ** Parser:
- ** Desugar:
- ** Simplify:
- ** CorePrep:
- ** ByteCodeGen:
- ** Chasing dependencies:
Stable obj: [] Stable BCO: [] unload: retaining objs [] unload: retaining bcos [] Upsweep completely successful.
- ** Deleting temp files:
Deleting:
- ** Chasing dependencies:
Stable obj: [] Stable BCO: [] unload: retaining objs [] unload: retaining bcos [] compile: input file OctTree.hs
- ** Checking old interface for main:OctTree:
[1 of 1] Compiling OctTree ( OctTree.hs, interpreted )
- ** Parser:
- ** Renamer/typechecker:
- ** Desugar:
Result size = 1587
- ** Simplify:
Result size = 2390
Result size = 2137
Result size = 2105
Result size = 2100
- ** Tidy Core:
Result size = 2198
- ** CorePrep:
Result size = 2646
- ** ByteCodeGen:
- ** Deleting temp files:
Deleting: Upsweep completely successful.
- ** Deleting temp files:
Deleting: Ok, modules loaded: OctTree.
- OctTree> buildOctTree (Vec 0 0 0) 10 10 10 [(a,(Vec a a a)) | a <- [(-4.0),(-3.9)..4.0]]
- ** Parser:
- ** Desugar:
- ** Simplify:
- ** CorePrep:
- ** ByteCodeGen:
<interactive>: internal error: interpretBCO: unknown or unimplemented opcode 20196
(GHC version 6.6 for i386_unknown_linux)
Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
Aborted
Thanks,
Matthew
Code follows:
{-
- OctTrees.hs: Implementation of OctTrees in Haskell
- Copyright (C) 2006 Matthew Sackman
- This program is free software; you can redistribute it and/or
- modify it under the terms of the GNU General Public License
- as published by the Free Software Foundation; version 2
- of the License only.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -}
module OctTree
(OctTree,
buildOctTree,
findInRadius
)
where
import Data.List
data Vector = Vec !Double !Double !Double
deriving (Show, Eq)
findDisplacement :: Vector -> Vector -> (Double, Vector) findDisplacement (Vec ax ay az) (Vec bx by bz) =
(len, Vec dx dy dz)
where
len = sqrt ((dx*dx) + (dy*dy) + (dz*dz))
dx = (bx - ax)
dy = (by - ay)
dz = (bz - az)
-- lne usw data OctTree value = OctTree !Vector !Vector !(OctTreeNode value)
deriving (Show)
data OctTreeNode value = EmptyLeaf -- pos value
| Leaf !Vector !(value)
| Node
-- lne lse lsw lnw
!(OctTree value) !(OctTree value) !(OctTree value) !(OctTree value)
-- unw usw use une
!(OctTree value) !(OctTree value) !(OctTree value) !(OctTree value)
deriving (Show)
buildOctTree :: (Show a) => Vector -> Double -> Double -> Double -> [(a,Vector)] -> (OctTree a) buildOctTree (Vec mx my mz) x_size y_size z_size values = foldl' (\t (v,pos) -> insertValue t v pos) initial values
where
initial = OctTree (Vec (mx+x) (my+y) (mz-z)) (Vec (mx-x) (my-y) (mz+z)) EmptyLeaf
x = x_size /2
y = y_size /2
z = z_size /2
insertValue :: (Show a) => (OctTree a) -> a -> Vector -> (OctTree a) insertValue (OctTree lnePos uswPos EmptyLeaf) value pos = OctTree lnePos uswPos (Leaf pos value) insertValue (OctTree lnePos@(Vec lne_x lne_y lne_z) uswPos@(Vec usw_x usw_y usw_z) (Leaf pos1 v1)) v2 pos2 = n3
where
n1 = OctTree lnePos uswPos (Node lne lse lsw lnw unw usw use une)
n2 = insertValue n1 v1 pos1
n3 = insertValue n2 v2 pos2
middle@(Vec mx my mz) = (Vec ((lne_x + usw_x)/2) ((lne_y + usw_y)/2) ((lne_z + usw_z)/2))
lne = OctTree lnePos middle EmptyLeaf
lse = OctTree (Vec lne_x my lne_z) (Vec mx usw_y mz) EmptyLeaf
lsw = OctTree (Vec mx my lne_z) (Vec usw_x usw_y mz) EmptyLeaf
lnw = OctTree (Vec mx lne_y lne_z) (Vec usw_x my mz) EmptyLeaf
unw = OctTree (Vec mx lne_y mz) (Vec usw_x my usw_z) EmptyLeaf
usw = OctTree middle uswPos EmptyLeaf
use = OctTree (Vec lne_x my mz) (Vec mx usw_y usw_z) EmptyLeaf
une = OctTree (Vec lne_x lne_y mz) (Vec mx my usw_z) EmptyLeaf
insertValue n@(OctTree lnePos uswPos (Node lne lse lsw lnw unw usw use une))
value pos = OctTree lnePos uswPos node
where
node =
case inQuadrant lne pos of
True -> (Node (insertValue lne value pos) lse lsw lnw unw usw use une)
False -> case inQuadrant lse pos of
True -> (Node lne (insertValue lse value pos) lsw lnw unw usw use une)
False -> case inQuadrant lsw pos of
True -> (Node lne lse (insertValue lsw value pos) lnw unw usw use une)
False -> case inQuadrant lnw pos of
True -> (Node lne lse lsw (insertValue lnw value pos) unw usw use une)
False -> case inQuadrant unw pos of
True -> (Node lne lse lsw lnw (insertValue unw value pos) usw use une)
False -> case inQuadrant usw pos of
True -> (Node lne lse lsw lnw unw (insertValue usw value pos) use une)
False -> case inQuadrant use pos of
True -> (Node lne lse lsw lnw unw usw (insertValue use value pos) une)
False -> case inQuadrant une pos of
True -> (Node lne lse lsw lnw unw usw use (insertValue une value pos))
False -> error $ "Value " ++ (show value)
+++ " at position " ++ (show pos) ++ " is not in node " ++ (show n)
inQuadrant :: (OctTree a) -> Vector -> Bool inQuadrant (OctTree (Vec lne_x lne_y lne_z) (Vec usw_x usw_y usw_z) _) (Vec x y z) =
(x > usw_x) && (y > usw_y) && (z < usw_z) && (x <= lne_x) && (y <= lne_y) && (z >= lne_z)
findInRadius :: OctTree a -> Vector -> Double -> [(a,Vector,Double)] findInRadius (OctTree _ _ EmptyLeaf) _ _ = [] findInRadius (OctTree _ _ (Leaf vPos value)) from radius =
case dist <= radius of
True -> [(value, vPos, dist)]
False -> []
where
(dist,_) = findDisplacement from vPos
findInRadius (OctTree _ _ (Node lne lse lsw lnw unw usw use une)) from@(Vec fx fy fz) radius =
concat result
where
children = filter findInRadius' [lne, lse, lsw, lnw, unw, usw, use, une]
result = map (\n -> findInRadius n from radius) children
findInRadius' | OctTree a -\> Bool |
---|---|
findInRadius' (OctTree _ _ EmptyLeaf) = False | |
findInRadius' (OctTree (Vec lne_x lne_y lne_z) (Vec usw_x usw_y usw_z) _) = | |
((fx + radius) \> usw_x) && ((fx - radius) \<= lne_x) && | |
((fy + radius) \> usw_y) && ((fy - radius) \<= lne_y) && | |
((fz - radius) \< usw_z) && ((fz + radius) \>= lne_z) |
Trac metadata
Trac field | Value |
---|---|
Version | 6.6 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | GHCi |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |