Hello,

         I have tried to compile a code like the following with GHC ...

==============================================
module Foo where

import MutableArray
import ByteArray
import ST
import PrelArrExtra

class Foo t where

     foo :: t -> ByteArray ix

instance Ix ix => Foo (MutableByteArray s ix) where

          foo x = runST(unsafeFreezeByteArray x)
         -- in this context, foo converts a Mutable ByteArray  to a
ByteArray

===============================================

  ... and  the result of the compilation is the following error message
:

===============================================

Compilation Dump for: /usr/local/lib/ghc-4.08.1/hsc /tmp/ghc1047.cpp 2>>
erros -fglasgow-exts -fignore-interface-pragmas -fomit-interface-pragmas
-fsimplify [ -fmax-simplifier-iterations4 ]
-fwarn-overlapping-patterns -fwarn-missing-methods -fwarn-missing-fields
-fwarn-deprecations -fwarn-duplicate-exports -fhi-version=408 -static
"-himap=.%.hi:/usr/local/lib/ghc-4.08.1/imports/lang%.hi:/usr/local/lib/ghc-4.08.1/imports/lang%.hi:/usr/local/lib/ghc-4.08.1/imports/std%.hi"
"-himap-sep=:"     -hifile=/tmp/ghc1047.hi -olang=asm
-ofile=/tmp/ghc1047.s -F=/tmp/ghc1047_stb.c -FH=/tmp/ghc1047_stb.h +RTS
-H6000000 -K1000000


duvida.hs:15:
    Inferred type is less polymorphic than expected
 Quantified type variable `s' escapes
 It unifies with `s1', which is mentioned in the environment
 The following variables in the environment mention `s1'
   x :: MutableByteArray s1 ix
    Signature type:     forall s. ST s a
    Type to generalise: ST s1 (ByteArray ix)
    When checking an expression type signature
    In the first argument of `runST', namely
 `(unsafeFreezeByteArray x)'
    In the right-hand side of an equation for `foo':
 runST (unsafeFreezeByteArray x)

Compilation had errors
====================================================

       I am trying to find a solution for making possible the "foo"
function to convert a MutableByteArray to a ByteArray in this context,
but without sucess.

       How can I avoid this error in this code. Is it possible the foo
function to convert a MutableByteArray to a ByteArray in that context
???  I accept suggestions, some explanation about why this code is wrong
or some reference that can help me to find a solution ... :-)

 F. Heron de Carvalho Jr.



Reply via email to