progress in compiling hopengl via jhc
Hi! I did some progress on compilation. The haskell files are preprocessed manually. Not they have no syntax error. Compile with ./compile_with_jhc I've attached the current output. *Important: *.hs_pre files are the original files, but the compiled files have .hs extension. The .hs_pre extension shown in error message is due to preprocessor deirectives. It refers to .hs files.* The error message is: [ 87 of 165] Graphics.Rendering.OpenGL.GL.Extensions Determining Exports/Imports: [Graphics.Rendering.OpenGL.GL.Extensions] Typing: ["Graphics.Rendering.OpenGL.GL.Extensions"] Kind inference Type inference user error ( What: failure Why: context reduction, no instance for: Jhc.Order.Eq (Jhc.Addr.FunPtr Graphics.Rendering.OpenGL.GL.Extensions.v0) Where: on line 40 in Extensions.hs_pre in the explicitly typed Graphics.Rendering.OpenGL.GL.Extensions.throwIfNull Graphics.Rendering.OpenGL.GL.Extensions.7_msg Graphics.Rendering.OpenGL.GL.Extensions.8_act = Graphics.Rendering.OpenGL.GL.Extensions.8_act Jhc.Monad.>>= \ Graphics.Rendering.OpenGL.GL.Extensions.9_res -> if Graphics.Rendering.OpenGL.GL.Extensions.9_res Jhc.Order.== Foreign.Ptr.nullFunPtr then Jhc.IO.ioError (Jhc.IO.userError Graphics.Rendering.OpenGL.GL.Extensions.7_msg) else Jhc.Monad.return Graphics.Rendering.OpenGL.GL.Extensions.9_res {- on line 40 -} Compilation of module: Graphics.Rendering.OpenGL.GL.Extensions)
Hi, thanks for the bug report, I don't have time to work on it at the moment, but a quick fix would be to create a module like the following and include it in your program. I'll add a cleaner fix to the repo at some point.
module FunPtrInstance where
import Jhc.Addr
instance Eq (FunPtr a) where FunPtr a == FunPtr b = a == b FunPtr a /= FunPtr b = a /= b
instance Ord (FunPtr a) where compare (FunPtr a) (FunPtr b) = compare a b FunPtr a <= FunPtr b = a <= b FunPtr a < FunPtr b = a < b FunPtr a > FunPtr b = a > b FunPtr a >= FunPtr b = a >= b
John -- John Meacham - ⑆repetae.net⑆john⑈
Thanks!
I've added this code as a new module.
It fixed that error.
Anyway here the error message:
*[ 96 of 166] Graphics.Rendering.OpenGL.GL.BeginEnd
Determining Exports/Imports: [Graphics.Rendering.OpenGL.GL.BeginEnd]
Typing: ["Graphics.Rendering.OpenGL.GL.BeginEnd"]
Kind inference
Type inference
.....user error (
What: failure
Why: boxyMatch failure: (Jhc.Prim.IO Jhc.Basics.()) (s17 -> Jhc.Prim.IOs18)
Where: on line 100 in BeginEnd.hs_pre
in the application
Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim
Control.Exception.bracket_
in the declaration
Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive
= Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim
Control.Exception.bracket_ {- on line 100 -}
in the explicitly typed
Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive
= Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim
Control.Exception.bracket_ {- on line 100 -})
*
2009/3/31 John Meacham
Hi, thanks for the bug report, I don't have time to work on it at the moment, but a quick fix would be to create a module like the following and include it in your program. I'll add a cleaner fix to the repo at some point.
module FunPtrInstance where
import Jhc.Addr
instance Eq (FunPtr a) where FunPtr a == FunPtr b = a == b FunPtr a /= FunPtr b = a /= b
instance Ord (FunPtr a) where compare (FunPtr a) (FunPtr b) = compare a b FunPtr a <= FunPtr b = a <= b FunPtr a < FunPtr b = a < b FunPtr a > FunPtr b = a > b FunPtr a >= FunPtr b = a >= b
John
-- John Meacham - ⑆repetae.net⑆john⑈ _______________________________________________ jhc mailing list jhc@haskell.org http://www.haskell.org/mailman/listinfo/jhc
I mean the (new/next) error message.
2009/3/31 Csaba Hruska
Thanks! I've added this code as a new module.
It fixed that error. Anyway here the error message:
*[ 96 of 166] Graphics.Rendering.OpenGL.GL.BeginEnd Determining Exports/Imports: [Graphics.Rendering.OpenGL.GL.BeginEnd] Typing: ["Graphics.Rendering.OpenGL.GL.BeginEnd"] Kind inference Type inference .....user error ( What: failure Why: boxyMatch failure: (Jhc.Prim.IO Jhc.Basics.()) (s17 -> Jhc.Prim.IO s18) Where: on line 100 in BeginEnd.hs_pre in the application Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim Control.Exception.bracket_ in the declaration Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive = Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim Control.Exception.bracket_ {- on line 100 -} in the explicitly typed Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive = Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim Control.Exception.bracket_ {- on line 100 -}) *
2009/3/31 John Meacham
Hi, thanks for the bug report, I don't have time to work on it at the
moment, but a quick fix would be to create a module like the following and include it in your program. I'll add a cleaner fix to the repo at some point.
module FunPtrInstance where
import Jhc.Addr
instance Eq (FunPtr a) where FunPtr a == FunPtr b = a == b FunPtr a /= FunPtr b = a /= b
instance Ord (FunPtr a) where compare (FunPtr a) (FunPtr b) = compare a b FunPtr a <= FunPtr b = a <= b FunPtr a < FunPtr b = a < b FunPtr a > FunPtr b = a > b FunPtr a >= FunPtr b = a >= b
John
-- John Meacham - ⑆repetae.net⑆john⑈ _______________________________________________ jhc mailing list jhc@haskell.org http://www.haskell.org/mailman/listinfo/jhc
Hmm.. I'll have to look at that one more carefully. but to translate the error message, it is saying type '()' does not match type 'a -> IO b' on line 100 of BeginEnd.hs_pre cleaning up those error messages would be a useful thing, I have a bug listed for it. John On Tue, Mar 31, 2009 at 01:50:04AM +0200, Csaba Hruska wrote:
Thanks! I've added this code as a new module.
It fixed that error. Anyway here the error message:
*[ 96 of 166] Graphics.Rendering.OpenGL.GL.BeginEnd Determining Exports/Imports: [Graphics.Rendering.OpenGL.GL.BeginEnd] Typing: ["Graphics.Rendering.OpenGL.GL.BeginEnd"] Kind inference Type inference .....user error ( What: failure Why: boxyMatch failure: (Jhc.Prim.IO Jhc.Basics.()) (s17 -> Jhc.Prim.IOs18) Where: on line 100 in BeginEnd.hs_pre in the application Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim Control.Exception.bracket_ in the declaration Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive = Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim Control.Exception.bracket_ {- on line 100 -} in the explicitly typed Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive = Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrim Control.Exception.bracket_ {- on line 100 -}) *
2009/3/31 John Meacham
Hi, thanks for the bug report, I don't have time to work on it at the moment, but a quick fix would be to create a module like the following and include it in your program. I'll add a cleaner fix to the repo at some point.
module FunPtrInstance where
import Jhc.Addr
instance Eq (FunPtr a) where FunPtr a == FunPtr b = a == b FunPtr a /= FunPtr b = a /= b
instance Ord (FunPtr a) where compare (FunPtr a) (FunPtr b) = compare a b FunPtr a <= FunPtr b = a <= b FunPtr a < FunPtr b = a < b FunPtr a > FunPtr b = a > b FunPtr a >= FunPtr b = a >= b
John
-- John Meacham - ⑆repetae.net⑆john⑈ _______________________________________________ jhc mailing list jhc@haskell.org http://www.haskell.org/mailman/listinfo/jhc
-- jhc mailing list jhc@haskell.org http://www.haskell.org/mailman/listinfo/jhc
-- John Meacham - ⑆repetae.net⑆john⑈
participants (2)
-
Csaba Hruska -
John Meacham