--- /dev/null
+TOP = ../../..
+include $(TOP)/mk/boilerplate.mk
+
+HS_SRCS = $(wildcard *.hs)
+
+SRC_RUNTEST_OPTS += -o1 $*.stdout -o2 $*.stderr -x 0
+HC_OPTS += -dcore-lint -fglasgow-exts
+
+cc002_RUNTEST_OPTS = -x 1
+cc004_RUNTEST_OPTS = -x 1
+cc007_RUNTEST_OPTS = -x 1
+
+# Note that these tests are still in a state of flux... don't believe errors
+# they report. In fact, these aren't really very good tests at all...
+
+cc001_HC_OPTS = -noC -ddump-tc -ddump-ds
+cc002_HC_OPTS = -noC -ddump-tc -ddump-ds
+cc003_HC_OPTS = -noC -ddump-tc -ddump-ds
+cc004_HC_OPTS = -noC -ddump-tc -ddump-ds
+cc005_HC_OPTS = -fvia-C -ddump-stg -ddump-flatC
+cc006_HC_OPTS = -fvia-C -ddump-stg -ddump-flatC
+cc007_HC_OPTS = -fvia-C -ddump-stg -ddump-flatC
+
+
+%.o : %.hs
+
+%.o : %.hs
+ $(RUNTEST) $(HC) $(RUNTEST_OPTS) $(HC_OPTS) -c $< -o $@ -osuf $(subst .,,$(suffix $@))
+
+all :: $(HS_OBJS)
+
+include $(TOP)/mk/target.mk
--- /dev/null
+--!!! cc001 -- ccall with standard boxed arguments and results
+
+module Test where
+
+import GlaExts
+
+-- simple functions
+
+a :: PrimIO Int
+a = _ccall_ a
+
+b :: Int -> PrimIO Int
+b x = _ccall_ b x
+
+c :: Int -> Char -> Float -> Double -> PrimIO Float
+c x1 x2 x3 x4 = _ccall_ c x1 x2 x3 x4
+
+-- simple monadic code
+
+d = a `thenPrimIO` \ x ->
+ b x `thenPrimIO` \ y ->
+ c y 'f' 1.0 2.0
+
+
+
--- /dev/null
+
+
+================================================================================
+Typechecked:
+{- nonrec -}
+{- nonrec -}
+{- nonrec -}
+d.Fractional_a16j =
+ PrelNum.$d23{-rtW,p-}
+fromRational_a16o =
+ PrelNum.fromRational{-8T,p-}
+ PrelBase.Float{-3c,p-}
+ d.Fractional_a16j
+lit_a16r =
+ fromRational_a16o
+ 1.0000000000000000
+d.Fractional_a16n =
+ PrelNum.$d14{-rtM,p-}
+fromRational_a16q =
+ PrelNum.fromRational{-8T,p-}
+ PrelBase.Double{-3a,p-}
+ d.Fractional_a16n
+lit_a16p =
+ fromRational_a16q
+ 2.0000000000000000
+{- nonrec -}
+AbsBinds [] [] [([], c{-r5,x-}, c_a15h)]
+ c_a15h
+ x1_r4l x2_r4n x3_r4p x4_r4r
+ = STBase.ST{-5G,p-}{i}
+ [GHC.RealWorld{-3s,p-}, PrelBase.Float{-3c,p-}]
+ _ccall_ c
+ x1_r4l x2_r4n x3_r4p x4_r4r
+{- nonrec -}
+{- nonrec -}
+AbsBinds [] [] [([], b{-r3,x-}, b_a15F)]
+ b_a15F
+ x_r4j = STBase.ST{-5G,p-}{i}
+ [GHC.RealWorld{-3s,p-}, PrelBase.Int{-3g,p-}]
+ _ccall_ b
+ x_r4j
+{- nonrec -}
+{- nonrec -}
+AbsBinds [] [] [([], a{-r1,x-}, a_a15R)]
+ a_a15R
+ = STBase.ST{-5G,p-}{i}
+ [GHC.RealWorld{-3s,p-}, PrelBase.Int{-3g,p-}]
+ _ccall_ a
+{- nonrec -}
+{- nonrec -}
+AbsBinds [] [] [([], d{-r7,x-}, d_a15Y)]
+ d_a15Y
+ = STBase.thenPrimIO{-r4w,p-}
+ [PrelBase.Int{-3g,p-}, PrelBase.Float{-3c,p-}]
+ a{-r1,x-}
+ (\ x_r4t -> STBase.thenPrimIO{-r4w,p-}
+ [PrelBase.Int{-3g,p-}, PrelBase.Float{-3c,p-}]
+ (b{-r3,x-}
+ x_r4t)
+ (\ y_r4v -> c{-r5,x-}
+ y_r4v 'f' lit_a16r lit_a16p))
+{- nonrec -}
+
+
+================================================================================
+Desugared:
+Rec {
+d.Fractional_a16j ::
+ {PrelNum.Fractional{-26,p-} PrelBase.Float{-3c,p-}}
+{-# L #-}
+d.Fractional_a16j =
+ PrelNum.$d23{-rtW,p-}
+fromRational_a16o ::
+ PrelNum.Rational{-3r,p-} -> PrelBase.Float{-3c,p-}
+{-# L #-}
+fromRational_a16o =
+ PrelNum.fromRational{-8T,p-}
+ _@_ PrelBase.Float{-3c,p-} d.Fractional_a16j
+lit_a16r ::
+ PrelBase.Float{-3c,p-}
+{-# L #-}
+lit_a16r =
+ fromRational_a16o
+ _rational_ 1 1
+d.Fractional_a16n ::
+ {PrelNum.Fractional{-26,p-} PrelBase.Double{-3a,p-}}
+{-# L #-}
+d.Fractional_a16n =
+ PrelNum.$d14{-rtM,p-}
+fromRational_a16q ::
+ PrelNum.Rational{-3r,p-} -> PrelBase.Double{-3a,p-}
+{-# L #-}
+fromRational_a16q =
+ PrelNum.fromRational{-8T,p-}
+ _@_ PrelBase.Double{-3a,p-} d.Fractional_a16n
+lit_a16p ::
+ PrelBase.Double{-3a,p-}
+{-# L #-}
+lit_a16p =
+ fromRational_a16q
+ _rational_ 2 1
+c_a15h ::
+ PrelBase.Int{-3g,p-}
+ -> PrelBase.Char{-38,p-}
+ -> PrelBase.Float{-3c,p-}
+ -> PrelBase.Double{-3a,p-}
+ -> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
+{-# L #-}
+c_a15h =
+ \ x1_r4l ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ x1_r4l x2_r4n ::
+ PrelBase.Char{-38,p-}
+ {-# L #-}
+ x2_r4n x3_r4p ::
+ PrelBase.Float{-3c,p-}
+ {-# L #-}
+ x3_r4p x4_r4r ::
+ PrelBase.Double{-3a,p-}
+ {-# L #-}
+ x4_r4r ->
+ let {
+ ds_d1et ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ -> (PrelBase.Float{-3c,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ {-# L #-}
+ ds_d1et =
+ \ ds_d1ez ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d1ez ->
+ case ds_d1ez of { STBase.S#{-5D,p-}{i} ds_d1eI ->
+ case x1_r4l of { PrelBase.I#{-5b,p-}{i} ds_d1eR ->
+ case x2_r4n of { PrelBase.C#{-54,p-}{i} ds_d1f0 ->
+ case x3_r4p of { PrelBase.F#{-59,p-}{i} ds_d1f9 ->
+ case x4_r4r of { PrelBase.D#{-56,p-}{i} ds_d1fw ->
+ case
+ _ccall_ c [(STBase.StateAndFloat#{-3C,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-} GHC.Char#{-37,p-} GHC.Float#{-3b,p-} GHC.Double#{-39,p-}]!
+ ds_d1eI ds_d1eR ds_d1f0 ds_d1f9 ds_d1fw
+ of {
+ STBase.StateAndFloat#{-5u,p-}{i} ds_d1fZ ds_d1fX ->
+ let {
+ ds_d1fO ::
+ PrelBase.Float{-3c,p-}
+ {-# L #-}
+ ds_d1fO =
+ PrelBase.F#{-59,p-}{i}
+ {ds_d1fX} } in
+ let {
+ ds_d1fS ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d1fS =
+ STBase.S#{-5D,p-}{i}
+ {_@_ GHC.RealWorld{-3s,p-} ds_d1fZ}
+ } in
+ PrelTup.(,){-62,p-}{i}
+ {_@_ PrelBase.Float{-3c,p-}
+ _@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ ds_d1fO
+ ds_d1fS};};};};};};}
+ } in
+ STBase.ST{-5G,p-}{i}
+ _@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Float{-3c,p-} ds_d1et
+c{-r5,x-} ::
+ PrelBase.Int{-3g,p-}
+ -> PrelBase.Char{-38,p-}
+ -> PrelBase.Float{-3c,p-}
+ -> PrelBase.Double{-3a,p-}
+ -> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
+{-# L #-}
+c{-r5,x-} =
+ c_a15h
+b_a15F ::
+ PrelBase.Int{-3g,p-} -> STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+{-# L #-}
+b_a15F =
+ \ x_r4j ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ x_r4j ->
+ let {
+ ds_d1gj ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ -> (PrelBase.Int{-3g,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ {-# L #-}
+ ds_d1gj =
+ \ ds_d1gp ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d1gp ->
+ case ds_d1gp of { STBase.S#{-5D,p-}{i} ds_d1gy ->
+ case x_r4j of { PrelBase.I#{-5b,p-}{i} ds_d1gM ->
+ case
+ _ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-}]!
+ ds_d1gy ds_d1gM
+ of {
+ STBase.StateAndInt#{-5v,p-}{i} ds_d1hf ds_d1hd ->
+ let {
+ ds_d1h4 ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ ds_d1h4 =
+ PrelBase.I#{-5b,p-}{i}
+ {ds_d1hd} } in
+ let {
+ ds_d1h8 ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d1h8 =
+ STBase.S#{-5D,p-}{i}
+ {_@_ GHC.RealWorld{-3s,p-} ds_d1hf}
+ } in
+ PrelTup.(,){-62,p-}{i}
+ {_@_ PrelBase.Int{-3g,p-}
+ _@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ ds_d1h4
+ ds_d1h8};};};}
+ } in
+ STBase.ST{-5G,p-}{i}
+ _@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Int{-3g,p-} ds_d1gj
+b{-r3,x-} ::
+ PrelBase.Int{-3g,p-} -> STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+{-# L #-}
+b{-r3,x-} =
+ b_a15F
+a_a15R ::
+ STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+{-# L #-}
+a_a15R =
+ let {
+ ds_d1hy ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ -> (PrelBase.Int{-3g,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ {-# L #-}
+ ds_d1hy =
+ \ ds_d1hE ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d1hE ->
+ case ds_d1hE of { STBase.S#{-5D,p-}{i} ds_d1hP ->
+ case
+ _ccall_ a [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]!
+ ds_d1hP
+ of {
+ STBase.StateAndInt#{-5v,p-}{i} ds_d1ii ds_d1ig ->
+ let {
+ ds_d1i7 ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ ds_d1i7 =
+ PrelBase.I#{-5b,p-}{i}
+ {ds_d1ig} } in
+ let {
+ ds_d1ib ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d1ib =
+ STBase.S#{-5D,p-}{i}
+ {_@_ GHC.RealWorld{-3s,p-} ds_d1ii}
+ } in
+ PrelTup.(,){-62,p-}{i}
+ {_@_ PrelBase.Int{-3g,p-}
+ _@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ ds_d1i7
+ ds_d1ib};};}
+ } in
+ STBase.ST{-5G,p-}{i}
+ _@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Int{-3g,p-} ds_d1hy
+a{-r1,x-} ::
+ STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+{-# L #-}
+a{-r1,x-} =
+ a_a15R
+d_a15Y ::
+ STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
+{-# L #-}
+d_a15Y =
+ let {
+ ds_d1iE ::
+ PrelBase.Int{-3g,p-}
+ -> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
+ {-# L #-}
+ ds_d1iE =
+ \ x_r4t ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ x_r4t ->
+ let {
+ ds_d1iT ::
+ STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+ {-# L #-}
+ ds_d1iT =
+ b{-r3,x-}
+ x_r4t } in
+ let {
+ ds_d1iX ::
+ PrelBase.Int{-3g,p-}
+ -> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
+ {-# L #-}
+ ds_d1iX =
+ \ y_r4v ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ y_r4v ->
+ let {
+ ds_d1jf ::
+ PrelBase.Char{-38,p-}
+ {-# L #-}
+ ds_d1jf =
+ PrelBase.C#{-54,p-}{i}
+ {'f'}
+ } in
+ c{-r5,x-}
+ y_r4v ds_d1jf lit_a16r lit_a16p
+ } in
+ STBase.thenPrimIO{-r4w,p-}
+ _@_ PrelBase.Int{-3g,p-} _@_ PrelBase.Float{-3c,p-} ds_d1iT ds_d1iX
+ } in
+ STBase.thenPrimIO{-r4w,p-}
+ _@_ PrelBase.Int{-3g,p-}
+ _@_ PrelBase.Float{-3c,p-}
+ a{-r1,x-}
+ ds_d1iE
+d{-r7,x-} ::
+ STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
+{-# L #-}
+d{-r7,x-} =
+ d_a15Y
+end Rec }
+
+NOTE: Simplifier still going after 4 iterations; bailing out.
--- /dev/null
+--!!! cc002 -- ccall with non-standard boxed arguments and results
+
+module Test where
+
+import GlaExts
+import Foreign
+
+-- Test returning results
+
+a :: PrimIO ForeignObj
+a = _ccall_ a
+
+b :: PrimIO (StablePtr Double)
+b = _ccall_ b
+
+-- Test taking arguments
+
+c :: ForeignObj -> PrimIO Int
+c x = _ccall_ c x
+
+d :: StablePtr Int -> PrimIO Int
+d x = _ccall_ d x
--- /dev/null
+
+cc002.hs:11: No instance for:
+ `Foreign.CReturnable Foreign.ForeignObj'
+ cc002.hs:11:
+ in the result of the _ccall_ to a
+ When checking signature(s) for: `a'
+
+
+Compilation had errors
--- /dev/null
+--!!! cc003 -- ccall with unresolved polymorphism (should fail)
+--!!! not anymore (as of 0.29, result type will default to ())
+module Test where
+
+import GlaExts
+
+fubar :: PrimIO Int
+fubar = _ccall_ f `seqPrimIO` _ccall_ b
+ --^ result type of f "lost" (never gets generalised)
--- /dev/null
+
+
+================================================================================
+Typechecked:
+{- nonrec -}
+{- nonrec -}
+AbsBinds [] [] [([], fubar{-r1,x-}, fubar_aZa)]
+ fubar_aZa
+ = STBase.seqPrimIO{-r46,p-}
+ [PrelBase.(){-40,p-}, PrelBase.Int{-3g,p-}]
+ (STBase.ST{-5G,p-}{i}
+ [GHC.RealWorld{-3s,p-}, PrelBase.(){-40,p-}]
+ _ccall_ f)
+ (STBase.ST{-5G,p-}{i}
+ [GHC.RealWorld{-3s,p-}, PrelBase.Int{-3g,p-}]
+ _ccall_ b)
+{- nonrec -}
+
+
+================================================================================
+Desugared:
+fubar_aZa ::
+ STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+{-# L #-}
+fubar_aZa =
+ let { ds_d110 ::
+ STBase.ST{-3O,p-} GHC.RealWorld{-3s,p-} PrelBase.(){-40,p-}
+ {-# L #-}
+ ds_d110 =
+ let {
+ ds_d11g ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ -> (PrelBase.(){-40,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ {-# L #-}
+ ds_d11g =
+ \ ds_d11m ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d11m ->
+ case ds_d11m of { STBase.S#{-5D,p-}{i} ds_d11x ->
+ case
+ _ccall_ f [(STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]!
+ ds_d11x
+ of {
+ STBase.S#{-5D,p-}{i} ds_d11X ->
+ let {
+ ds_d11Q ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d11Q =
+ STBase.S#{-5D,p-}{i}
+ {_@_ GHC.RealWorld{-3s,p-} ds_d11X}
+ } in
+ PrelTup.(,){-62,p-}{i}
+ {_@_ PrelBase.(){-40,p-}
+ _@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ PrelBase.(){-60,p-}{i}
+ ds_d11Q};};}
+ } in
+ STBase.ST{-5G,p-}{i}
+ _@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.(){-40,p-} ds_d11g
+ } in
+ let { ds_d114 ::
+ STBase.ST{-3O,p-} GHC.RealWorld{-3s,p-} PrelBase.Int{-3g,p-}
+ {-# L #-}
+ ds_d114 =
+ let {
+ ds_d12a ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ -> (PrelBase.Int{-3g,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ {-# L #-}
+ ds_d12a =
+ \ ds_d12g ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d12g ->
+ case ds_d12g of { STBase.S#{-5D,p-}{i} ds_d12r ->
+ case
+ _ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]!
+ ds_d12r
+ of {
+ STBase.StateAndInt#{-5v,p-}{i} ds_d12U ds_d12S ->
+ let {
+ ds_d12J ::
+ PrelBase.Int{-3g,p-}
+ {-# L #-}
+ ds_d12J =
+ PrelBase.I#{-5b,p-}{i}
+ {ds_d12S} } in
+ let {
+ ds_d12N ::
+ STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ {-# L #-}
+ ds_d12N =
+ STBase.S#{-5D,p-}{i}
+ {_@_ GHC.RealWorld{-3s,p-} ds_d12U}
+ } in
+ PrelTup.(,){-62,p-}{i}
+ {_@_ PrelBase.Int{-3g,p-}
+ _@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
+ ds_d12J
+ ds_d12N};};}
+ } in
+ STBase.ST{-5G,p-}{i}
+ _@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Int{-3g,p-} ds_d12a
+ } in
+ STBase.seqPrimIO{-r46,p-}
+ _@_ PrelBase.(){-40,p-} _@_ PrelBase.Int{-3g,p-} ds_d110 ds_d114
+fubar{-r1,x-} ::
+ STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
+{-# L #-}
+fubar{-r1,x-} =
+ fubar_aZa
+
+NOTE: Simplifier still going after 4 iterations; bailing out.
--- /dev/null
+--!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
+module Test where
+
+import GlaExts
+
+-- Since I messed up the handling of polymorphism originally, I'll
+-- explicitly test code with UserSysTyVar (ie an explicit polymorphic
+-- signature)
+
+foo = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1)
+ where
+ thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
+ thenADR = thenPrimIO
+
+-- and with a PolySysTyVar (ie no explicit signature)
+
+bar = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1)
+ where
+ -- thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
+ thenADR = thenPrimIO
+
+-- and with a type synonym
+
+type INT = Int
+barfu :: PrimIO INT
+barfu = _ccall_ b
+
--- /dev/null
+
+cc004.hs:2: Cannot generalise these overloadings (in a _ccall_):
+ `Foreign.CReturnable t{-a12p-}'
+
+cc004.hs:2: Cannot generalise these overloadings (in a _ccall_):
+ `Foreign.CReturnable t{-a138-}'
+
+
+Compilation had errors
--- /dev/null
+--!!! cc001 -- ccall with standard boxed arguments and results
+
+module Test where
+
+import GlaExts
+
+-- simple functions
+
+a :: PrimIO Int
+a = _ccall_ a
+
+b :: Int -> PrimIO Int
+b x = _ccall_ b x
+
+c :: Int -> Char -> Float -> Double -> PrimIO Float
+c x1 x2 x3 x4 = _ccall_ c x1 x2 x3 x4
+
+-- simple monadic code
+
+d = a `thenPrimIO` \ x ->
+ b x `thenPrimIO` \ y ->
+ c y 'f' 1.0 2.0
+
+
+
--- /dev/null
+
+NOTE: Simplifier still going after 4 iterations; bailing out.
+
+
+================================================================================
+STG syntax:
+nrlit_s25b =
+ PrelNum.:%{-5l,p-}{i}! [PrelNum.integer_2{-8e,p-} PrelNum.integer_1{-8d,p-}];
+lit_a19u =
+ (False, True, False, False, True) [] \u []
+ case
+ PrelNum.$d14{-rtM,p-} ::{PrelNum.Fractional{-26,p-} PrelBase.Double{-3a,p-}}
+ of {
+ -- lvs: []; rhs lvs: []; uniq: c2b9
+ PrelTup.(,,,){-64,p-}{i} tpl_s1V1 tpl_s1V2 tpl_s1V3 tpl_s1V0 ->
+ tpl_s1V0
+ nrlit_s25b;
+ };
+nrlit_s25c =
+ PrelNum.:%{-5l,p-}{i}! [PrelNum.integer_1{-8d,p-} PrelNum.integer_1{-8d,p-}];
+lit_a19w =
+ (False, True, False, False, True) [] \u []
+ case
+ PrelNum.$d23{-rtW,p-} ::{PrelNum.Fractional{-26,p-} PrelBase.Float{-3c,p-}}
+ of {
+ -- lvs: []; rhs lvs: []; uniq: c2ba
+ PrelTup.(,,,){-64,p-}{i} tpl_s1Vt tpl_s1Vu tpl_s1Vv tpl_s1Vs ->
+ tpl_s1Vs
+ nrlit_s25c;
+ };
+s_s1MF =
+ [] \r [ds_s1VJ]
+ case ds_s1VJ ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-} of {
+ -- lvs: [ds_s1VJ]; rhs lvs: []; uniq: c2bb
+ STBase.S#{-5D,p-}{i} ds_s1Wa ->
+ case
+ _ccall_ a [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]# [ds_s1Wa] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1Wa]; rhs lvs: []; uniq: c2bc
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1Wk ds_s1W9 ->
+ let {
+ ds_s1WA =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1W9]; } in
+ let {
+ ds_s1Wz =
+ STBase.S#{-5D,p-}{i}! [ds_s1Wk];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1WA ds_s1Wz];
+ };
+ };
+s_s1Xu =
+ [] \r [ds_s1WI]
+ case ds_s1WI ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-} of {
+ -- lvs: [ds_s1WI]; rhs lvs: []; uniq: c2bd
+ STBase.S#{-5D,p-}{i} ds_s1X9 ->
+ case
+ _ccall_ a [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]# [ds_s1X9] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1X9]; rhs lvs: []; uniq: c2be
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1Xj ds_s1X8 ->
+ let {
+ ds_s1XP =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1X8]; } in
+ let {
+ ds_s1XO =
+ STBase.S#{-5D,p-}{i}! [ds_s1Xj];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1XP ds_s1XO];
+ };
+ };
+a{-r1,x-} =
+ [] \u []
+ s_s1Xu;
+b{-r3,x-} =
+ [] \r [x_s1XY]
+ let {
+ stg_c2ac =
+ (False, True, False, False, True) [x_s1XY] \r [ds_s1XN]
+ case
+ ds_s1XN{-lvs:x_s1XY-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1XN x_s1XY]; rhs lvs: [x_s1XY]; uniq: c2bf
+ STBase.S#{-5D,p-}{i} ds_s1XZ ->
+ case x_s1XY{-lvs:ds_s1XZ-} ::PrelBase.Int{-3g,p-} of {
+ -- lvs: [x_s1XY ds_s1XZ]; rhs lvs: [ds_s1XZ]; uniq: c2bg
+ PrelBase.I#{-5b,p-}{i} ds_s1Yp ->
+ case
+ _ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-}]# [ds_s1XZ ds_s1Yp] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1XZ ds_s1Yp]; rhs lvs: []; uniq: c2bh
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1YA ds_s1Yq ->
+ let {
+ ds_s1Za =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1Yq]; } in
+ let {
+ ds_s1Z9 =
+ STBase.S#{-5D,p-}{i}! [ds_s1YA];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1Za ds_s1Z9];
+ };
+ };
+ };
+ } in
+ stg_c2ac;
+c{-r5,x-} =
+ [] \r [x1_s1Zj x2_s1Zt x3_s1ZD x4_s1ZN]
+ let {
+ stg_c29C =
+ (False, True, False, False, True) [x1_s1Zj x2_s1Zt x3_s1ZD x4_s1ZN] \r [ds_s1Z8]
+ case
+ ds_s1Z8{-lvs:x1_s1Zj, x2_s1Zt, x3_s1ZD, x4_s1ZN-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1Z8 x1_s1Zj x2_s1Zt x3_s1ZD x4_s1ZN]; rhs lvs: [x1_s1Zj x2_s1Zt x3_s1ZD x4_s1ZN]; uniq: c2bi
+ STBase.S#{-5D,p-}{i} ds_s1Zk ->
+ case
+ x1_s1Zj{-lvs:ds_s1Zk, x2_s1Zt, x3_s1ZD, x4_s1ZN-} ::PrelBase.Int{-3g,p-}
+ of {
+ -- lvs: [x1_s1Zj ds_s1Zk x2_s1Zt x3_s1ZD x4_s1ZN]; rhs lvs: [ds_s1Zk x2_s1Zt x3_s1ZD x4_s1ZN]; uniq: c2bj
+ PrelBase.I#{-5b,p-}{i} ds_s1Zu ->
+ case
+ x2_s1Zt{-lvs:ds_s1Zk, ds_s1Zu, x3_s1ZD, x4_s1ZN-} ::PrelBase.Char{-38,p-}
+ of {
+ -- lvs: [ds_s1Zk x2_s1Zt ds_s1Zu x3_s1ZD x4_s1ZN]; rhs lvs: [ds_s1Zk ds_s1Zu x3_s1ZD x4_s1ZN]; uniq: c2bk
+ PrelBase.C#{-54,p-}{i} ds_s1ZE ->
+ case
+ x3_s1ZD{-lvs:ds_s1Zk, ds_s1Zu, ds_s1ZE, x4_s1ZN-} ::PrelBase.Float{-3c,p-}
+ of {
+ -- lvs: [ds_s1Zk ds_s1Zu x3_s1ZD ds_s1ZE x4_s1ZN]; rhs lvs: [ds_s1Zk ds_s1Zu ds_s1ZE x4_s1ZN]; uniq: c2bl
+ PrelBase.F#{-59,p-}{i} ds_s1ZO ->
+ case
+ x4_s1ZN{-lvs:ds_s1Zk, ds_s1Zu, ds_s1ZE, ds_s1ZO-} ::PrelBase.Double{-3a,p-}
+ of {
+ -- lvs: [ds_s1Zk ds_s1Zu ds_s1ZE x4_s1ZN ds_s1ZO]; rhs lvs: [ds_s1Zk ds_s1Zu ds_s1ZE ds_s1ZO]; uniq: c2bm
+ PrelBase.D#{-56,p-}{i} ds_s20e ->
+ case
+ _ccall_ c [(STBase.StateAndFloat#{-3C,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-} GHC.Char#{-37,p-} GHC.Float#{-3b,p-} GHC.Double#{-39,p-}]# [ds_s1Zk ds_s1Zu ds_s1ZE ds_s1ZO ds_s20e] ::STBase.StateAndFloat#{-3C,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1Zk ds_s1Zu ds_s1ZE ds_s1ZO ds_s20e]; rhs lvs: []; uniq: c2bn
+ STBase.StateAndFloat#{-5u,p-}{i} ds_s20p ds_s20f ->
+ let {
+ ds_s217 =
+ PrelBase.F#{-59,p-}{i}! [ds_s20f]; } in
+ let {
+ ds_s216 =
+ STBase.S#{-5D,p-}{i}! [ds_s20p];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s217 ds_s216];
+ };
+ };
+ };
+ };
+ };
+ };
+ } in
+ stg_c29C;
+d{-r7,x-} =
+ [] \u []
+ let {
+ ds_s258 =
+ [] \r [x_s21g]
+ let { s_s22a = [x_s21g] \r [ds_s215]
+ case
+ ds_s215{-lvs:x_s21g-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s215 x_s21g]; rhs lvs: [x_s21g]; uniq: c2bo
+ STBase.S#{-5D,p-}{i} ds_s21h ->
+ case x_s21g{-lvs:ds_s21h-} ::PrelBase.Int{-3g,p-} of {
+ -- lvs: [x_s21g ds_s21h]; rhs lvs: [ds_s21h]; uniq: c2bp
+ PrelBase.I#{-5b,p-}{i} ds_s21H ->
+ case
+ _ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-}]# [ds_s21h ds_s21H] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s21h ds_s21H]; rhs lvs: []; uniq: c2bq
+ STBase.StateAndInt#{-5v,p-}{i} ds_s21S ds_s21I ->
+ let {
+ ds_s22c =
+ PrelBase.I#{-5b,p-}{i}! [ds_s21I]; } in
+ let {
+ ds_s22b =
+ STBase.S#{-5D,p-}{i}! [ds_s21S];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s22c ds_s22b];
+ };
+ };
+ } } in
+ let { s_s23h = [x_s21g] \r [ds_s22k]
+ case
+ ds_s22k{-lvs:x_s21g-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [x_s21g ds_s22k]; rhs lvs: [x_s21g]; uniq: c2br
+ STBase.S#{-5D,p-}{i} ds_s22t ->
+ case x_s21g{-lvs:ds_s22t-} ::PrelBase.Int{-3g,p-} of {
+ -- lvs: [x_s21g ds_s22t]; rhs lvs: [ds_s22t]; uniq: c2bs
+ PrelBase.I#{-5b,p-}{i} ds_s22T ->
+ case
+ _ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-}]# [ds_s22t ds_s22T] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s22t ds_s22T]; rhs lvs: []; uniq: c2bt
+ STBase.StateAndInt#{-5v,p-}{i} ds_s234 ds_s22U ->
+ let {
+ ds_s23A =
+ PrelBase.I#{-5b,p-}{i}! [ds_s22U]; } in
+ let {
+ ds_s23z =
+ STBase.S#{-5D,p-}{i}! [ds_s234];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s23A ds_s23z];
+ };
+ };
+ } } in
+ let {
+ ds_s24V =
+ [] \r [y_s23K]
+ let {
+ stg_c28E =
+ (False, True, False, False, True) [y_s23K] \r [ds_s23y]
+ case
+ ds_s23y{-lvs:y_s23K-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s23y y_s23K]; rhs lvs: [y_s23K]; uniq: c2bu
+ STBase.S#{-5D,p-}{i} ds_s23L ->
+ case y_s23K{-lvs:ds_s23L-} ::PrelBase.Int{-3g,p-} of {
+ -- lvs: [y_s23K ds_s23L]; rhs lvs: [ds_s23L]; uniq: c2bv
+ PrelBase.I#{-5b,p-}{i} ds_s23U ->
+ case
+ lit_a19w{-lvs:ds_s23L, ds_s23U-} ::PrelBase.Float{-3c,p-}
+ of {
+ -- lvs: [ds_s23L ds_s23U]; rhs lvs: [ds_s23L ds_s23U]; uniq: c2bw
+ PrelBase.F#{-59,p-}{i} ds_s243 ->
+ case
+ lit_a19u{-lvs:ds_s23L, ds_s23U, ds_s243-} ::PrelBase.Double{-3a,p-}
+ of {
+ -- lvs: [ds_s23L ds_s23U ds_s243]; rhs lvs: [ds_s23L ds_s23U ds_s243]; uniq: c2bx
+ PrelBase.D#{-56,p-}{i} ds_s24t ->
+ case
+ _ccall_ c [(STBase.StateAndFloat#{-3C,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-} GHC.Char#{-37,p-} GHC.Float#{-3b,p-} GHC.Double#{-39,p-}]# [ds_s23L ds_s23U 'f' ds_s243 ds_s24t] ::STBase.StateAndFloat#{-3C,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s23L ds_s23U ds_s243 ds_s24t]; rhs lvs: []; uniq: c2by
+ STBase.StateAndFloat#{-5u,p-}{i} ds_s24E ds_s24u ->
+ let {
+ ds_s24U =
+ PrelBase.F#{-59,p-}{i}! [ds_s24u]; } in
+ let {
+ ds_s24T =
+ STBase.S#{-5D,p-}{i}! [ds_s24E];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s24U ds_s24T];
+ };
+ };
+ };
+ };
+ };
+ } in
+ stg_c28E;
+ } in
+ STBase.thenPrimIO{-r4w,p-}
+ s_s23h ds_s24V;
+ } in
+ STBase.thenPrimIO{-r4w,p-}
+ s_s1Xu ds_s258;
+
+
+================================================================================
+Flat Abstract C:
+ED_(PrelNum_integerZu2_closure);
+ED_(PrelNum_integerZu1_closure);
+SET_STATIC_HDR(s25b_closure,PrelNum_ZcZ37_static_info,0,static ,ED_RO_)
+ , (W_)PrelNum_integerZu2_closure, (W_)PrelNum_integerZu1_closure
+};
+IFN_(ret_c2b9) {
+ID_(s25b_closure);
+ FB_
+ SpA[-1]=s25b_closure;
+ RetReg=StdUpdRetVecReg;
+ R1=R6;
+ SpA=SpA-1;
+ SpB=SpB-1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(6,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2b9,ret_c2b9)
+STATIC_ITBL(a19u_info,a19u_entry,StdErrorCode,1,-1,(STATIC_VHS+
+ 2),0,static const,IF_,0,0,0);
+IFN_(a19u_entry) {
+ED_(PrelNum_Z36d14_closure);
+ FB_
+ STK_CHK(1,1,5,0,0,0,1);
+ HEAP_CHK(1,(BH_HS+2),1);
+ SET_BH_HDR(Hp-(BH_HS+1),BH_UPD_info,0,(BH_VHS+2),0);
+ UPD_CAF(R1.p,Hp-(BH_HS+1));
+ PUSH_STD_UPD_FRAME(Hp-(BH_HS+1),0,0);
+ RetReg=(StgRetAddr)UNVEC(ret_c2b9,vtbl_c2b9);
+ R1.p=PrelNum_Z36d14_closure;
+ SpB=SpB+5;
+ ENT_VIA_NODE();
+ GRAN_EXEC(19,2,2,8,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(a19u_closure,a19u_info,0,static ,ID_RO_)
+ , (W_)0, (W_)0
+};
+ED_(PrelNum_integerZu1_closure);
+SET_STATIC_HDR(s25c_closure,PrelNum_ZcZ37_static_info,0,static ,ED_RO_)
+ , (W_)PrelNum_integerZu1_closure, (W_)PrelNum_integerZu1_closure
+};
+IFN_(ret_c2ba) {
+ID_(s25c_closure);
+ FB_
+ SpA[-1]=s25c_closure;
+ RetReg=StdUpdRetVecReg;
+ R1=R6;
+ SpA=SpA-1;
+ SpB=SpB-1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(6,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2ba,ret_c2ba)
+STATIC_ITBL(a19w_info,a19w_entry,StdErrorCode,1,-1,(STATIC_VHS+
+ 2),0,static const,IF_,0,0,0);
+IFN_(a19w_entry) {
+ED_(PrelNum_Z36d23_closure);
+ FB_
+ STK_CHK(1,1,5,0,0,0,1);
+ HEAP_CHK(1,(BH_HS+2),1);
+ SET_BH_HDR(Hp-(BH_HS+1),BH_UPD_info,0,(BH_VHS+2),0);
+ UPD_CAF(R1.p,Hp-(BH_HS+1));
+ PUSH_STD_UPD_FRAME(Hp-(BH_HS+1),0,0);
+ RetReg=(StgRetAddr)UNVEC(ret_c2ba,vtbl_c2ba);
+ R1.p=PrelNum_Z36d23_closure;
+ SpB=SpB+5;
+ ENT_VIA_NODE();
+ GRAN_EXEC(19,2,2,8,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(a19w_closure,a19w_info,0,static ,ID_RO_)
+ , (W_)0, (W_)0
+};
+IFN_(ret_c2bb) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1W9;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (a());
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1W9=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1W9);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,21,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bb,ret_c2bb)
+STATIC_ITBL(s1MF_info,s1MF_entry,StdErrorCode,1,-1,STATIC_VHS,0,static const,IF_,0,0,0);
+IFN_(s1MF_entry) {
+ID_(s1MF_closure);
+IF_(s1MF_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,s1MF_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s1MF_fast1);
+ FE_
+}
+IFN_(s1MF_fast1) {
+ FB_
+ STK_CHK(1,0,1,0,0,0,0);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2bb,vtbl_c2bb);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(s1MF_closure,s1MF_info,0,static ,ID_RO_)
+};
+IFN_(ret_c2bd) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1X8;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (a());
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1X8=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1X8);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,21,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bd,ret_c2bd)
+STATIC_ITBL(s1Xu_info,s1Xu_entry,StdErrorCode,1,-1,STATIC_VHS,0,static const,IF_,0,0,0);
+IFN_(s1Xu_entry) {
+ID_(s1Xu_closure);
+IF_(s1Xu_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,s1Xu_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s1Xu_fast1);
+ FE_
+}
+IFN_(s1Xu_fast1) {
+ FB_
+ STK_CHK(1,0,1,0,0,0,0);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2bd,vtbl_c2bd);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(s1Xu_closure,s1Xu_info,0,static ,ID_RO_)
+};
+STATIC_ITBL(Test_a_info,Test_a_entry,StdErrorCode,1,-1,(STATIC_VHS+
+ 2),0,const,EF_,0,0,0);
+FN_(Test_a_entry) {
+IF_(s1Xu_entry);
+ FB_
+ STK_CHK(1,0,4,0,0,0,1);
+ HEAP_CHK(1,(BH_HS+2),1);
+ SET_BH_HDR(Hp-(BH_HS+1),BH_UPD_info,0,(BH_VHS+2),0);
+ UPD_CAF(R1.p,Hp-(BH_HS+1));
+ PUSH_STD_UPD_FRAME(Hp-(BH_HS+1),0,0);
+ RetReg=StdUpdRetVecReg;
+ SpB=SpB+4;
+ GRAN_EXEC(16,2,1,8,0);
+ JMP_(s1Xu_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_a_closure,Test_a_info,0,,ED_RO_)
+ , (W_)0, (W_)0
+};
+IFN_(ret_c2bg) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1Yq;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ I_ _ccall_arg1=R3.i;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (b((_ccall_arg1)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1Yq=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1Yq);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,22,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bg,ret_c2bg)
+IFN_(ret_c2bf) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bg,vtbl_c2bg);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bf,ret_c2bf)
+SPEC_N_ITBL(c2ac_info,c2ac_entry,StdErrorCode,1,-1,1,1,static const,IF_,0,0,0);
+IFN_(c2ac_entry) {
+IF_(c2ac_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(c2ac_fast1);
+ FE_
+}
+IFN_(c2ac_fast1) {
+ FB_
+ STK_CHK(3,1,1,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2bf,vtbl_c2bf);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-1;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+STATIC_ITBL(Test_b_info,Test_b_entry,StdErrorCode,1,-1,STATIC_VHS,0,const,EF_,0,0,0);
+FN_(Test_b_entry) {
+ED_(Test_b_closure);
+EF_(Test_b_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,Test_b_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(Test_b_fast1);
+ FE_
+}
+FN_(Test_b_fast1) {
+ID_RO_(c2ac_info);
+IF_(c2ac_entry);
+ FB_
+ HEAP_CHK(1,(_FHS+1),0);
+ SET_SPEC_HDR(Hp-_FHS,c2ac_info,0,1,1);
+ *Hp=(W_)(R1.p);
+ R1.p=Hp-_FHS;
+ GRAN_EXEC(5,2,0,2,0);
+ JMP_(c2ac_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_b_closure,Test_b_info,0,,ED_RO_)
+};
+IFN_(ret_c2bm) {
+ED_RO_(PrelBase_FZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+StgFloat s20f;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ StgFloat _ccall_result;
+ I_ _ccall_arg1=(I_)(SpB[-2]);
+ StgChar _ccall_arg2=(StgChar)(SpB[-1]);
+ StgFloat _ccall_arg3=PK_FLT(SpB);
+ StgDouble _ccall_arg4=DblReg1;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (c((_ccall_arg1),(_ccall_arg2),(_ccall_arg3),(_ccall_arg4)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s20f=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_FZh_con_info,0,1,0);
+ ASSIGN_FLT(Hp,s20f);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-4;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,25,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bm,ret_c2bm)
+IFN_(ret_c2bl) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bm,vtbl_c2bm);
+ R1.p=*SpA;
+ ASSIGN_FLT(SpB+1,FltReg1);
+ SpA=SpA+4;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(4,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bl,ret_c2bl)
+IFN_(ret_c2bk) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bl,vtbl_c2bl);
+ R1.p=SpA[1];
+ SpB[1]=(W_)(R3.c);
+ SpA[1]=StkStubReg;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bk,ret_c2bk)
+IFN_(ret_c2bj) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bk,vtbl_c2bk);
+ R1.p=SpA[2];
+ SpB[1]=(W_)(R3.i);
+ SpA[2]=StkStubReg;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bj,ret_c2bj)
+IFN_(ret_c2bi) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bj,vtbl_c2bj);
+ R1.p=SpA[3];
+ SpA[3]=StkStubReg;
+ ENT_VIA_NODE();
+ GRAN_EXEC(2,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bi,ret_c2bi)
+SPEC_N_ITBL(c29C_info,c29C_entry,StdErrorCode,1,-1,4,4,static const,IF_,0,0,0);
+IFN_(c29C_entry) {
+IF_(c29C_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(c29C_fast1);
+ FE_
+}
+IFN_(c29C_fast1) {
+ FB_
+ STK_CHK(3,4,4,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2bi,vtbl_c2bi);
+ SpA[-4]=(P_)(R1.p[(_FHS+3)]);
+ SpA[-3]=(P_)(R1.p[(_FHS+2)]);
+ SpA[-2]=(P_)(R1.p[(_FHS+1)]);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-4;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,5,5,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+STATIC_ITBL(Test_c_info,Test_c_entry,StdErrorCode,1,-1,STATIC_VHS,0,const,EF_,0,0,0);
+FN_(Test_c_entry) {
+ED_(Test_c_closure);
+EF_(Test_c_fast4);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(4,Test_c_closure);
+ R1.p=*SpA;
+ R2.p=SpA[1];
+ R3.p=SpA[2];
+ R4.p=SpA[3];
+ SpA=SpA+4;
+ GRAN_EXEC(5,2,4,0,0);
+ JMP_(Test_c_fast4);
+ FE_
+}
+FN_(Test_c_fast4) {
+ID_RO_(c29C_info);
+IF_(c29C_entry);
+ FB_
+ HEAP_CHK(15,(_FHS+4),0);
+ SET_SPEC_HDR(Hp-(_FHS+3),c29C_info,0,4,4);
+ Hp[-3]=(W_)(R1.p);
+ Hp[-2]=(W_)(R2.p);
+ Hp[-1]=(W_)(R3.p);
+ *Hp=(W_)(R4.p);
+ R1.p=Hp-(_FHS+3);
+ GRAN_EXEC(5,2,0,5,0);
+ JMP_(c29C_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_c_closure,Test_c_info,0,,ED_RO_)
+};
+IFN_(ret_c2bp) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s21I;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ I_ _ccall_arg1=R3.i;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (b((_ccall_arg1)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s21I=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s21I);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,22,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bp,ret_c2bp)
+IFN_(ret_c2bo) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bp,vtbl_c2bp);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bo,ret_c2bo)
+SPEC_N_ITBL(s22a_info,s22a_entry,StdErrorCode,1,-1,1,1,static const,IF_,0,0,0);
+IFN_(s22a_entry) {
+IF_(s22a_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s22a_fast1);
+ FE_
+}
+IFN_(s22a_fast1) {
+ FB_
+ STK_CHK(3,1,1,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2bo,vtbl_c2bo);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-1;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+IFN_(ret_c2bs) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s22U;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ I_ _ccall_arg1=R3.i;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (b((_ccall_arg1)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s22U=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s22U);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,22,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bs,ret_c2bs)
+IFN_(ret_c2br) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bs,vtbl_c2bs);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2br,ret_c2br)
+SPEC_N_ITBL(s23h_info,s23h_entry,StdErrorCode,1,-1,1,1,static const,IF_,0,0,0);
+IFN_(s23h_entry) {
+IF_(s23h_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s23h_fast1);
+ FE_
+}
+IFN_(s23h_fast1) {
+ FB_
+ STK_CHK(3,1,1,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2br,vtbl_c2br);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-1;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+IFN_(ret_c2bx) {
+ED_RO_(PrelBase_FZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+StgFloat s24u;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ StgFloat _ccall_result;
+ I_ _ccall_arg1=(I_)(SpB[-1]);
+ StgChar _ccall_arg2=(C_)'f';
+ StgFloat _ccall_arg3=PK_FLT(SpB);
+ StgDouble _ccall_arg4=DblReg1;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (c((_ccall_arg1),(_ccall_arg2),(_ccall_arg3),(_ccall_arg4)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s24u=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_FZh_con_info,0,1,0);
+ ASSIGN_FLT(Hp,s24u);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-3;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(11,2,24,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bx,ret_c2bx)
+IFN_(ret_c2bw) {
+ID_(a19u_closure);
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bx,vtbl_c2bx);
+ R1.p=a19u_closure;
+ ASSIGN_FLT(SpB+1,FltReg1);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bw,ret_c2bw)
+IFN_(ret_c2bv) {
+ID_(a19w_closure);
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bw,vtbl_c2bw);
+ R1.p=a19w_closure;
+ SpB[1]=(W_)(R3.i);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bv,ret_c2bv)
+IFN_(ret_c2bu) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c2bv,vtbl_c2bv);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c2bu,ret_c2bu)
+SPEC_N_ITBL(c28E_info,c28E_entry,StdErrorCode,1,-1,1,1,static const,IF_,0,0,0);
+IFN_(c28E_entry) {
+IF_(c28E_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(c28E_fast1);
+ FE_
+}
+IFN_(c28E_fast1) {
+ FB_
+ STK_CHK(3,1,3,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c2bu,vtbl_c2bu);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-1;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SPEC_N_ITBL(s24V_info,s24V_entry,StdErrorCode,1,-1,1,0,static const,IF_,0,0,0);
+IFN_(s24V_entry) {
+IF_(s24V_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s24V_fast1);
+ FE_
+}
+IFN_(s24V_fast1) {
+ID_RO_(c28E_info);
+IF_(c28E_entry);
+ FB_
+ HEAP_CHK(3,(_FHS+1),1);
+ SET_SPEC_HDR(Hp-_FHS,c28E_info,0,1,1);
+ *Hp=(W_)(R2.p);
+ R1.p=Hp-_FHS;
+ GRAN_EXEC(5,2,0,2,0);
+ JMP_(c28E_entry);
+ FE_
+}
+SPEC_N_ITBL(s258_info,s258_entry,StdErrorCode,1,-1,1,0,static const,IF_,0,0,0);
+IFN_(s258_entry) {
+IF_(s258_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s258_fast1);
+ FE_
+}
+IFN_(s258_fast1) {
+ID_RO_(s22a_info);
+ID_RO_(s23h_info);
+ID_RO_(s24V_info);
+ED_(STBase_thenPrimIO_closure);
+ FB_
+ STK_CHK(3,2,0,0,0,0,1);
+ HEAP_CHK(3,((_FHS*3)+3),1);
+ SET_SPEC_HDR(Hp-((_FHS*3)+2),s22a_info,0,1,1);
+ Hp[-((_FHS*2)+2)]=(W_)(R2.p);
+ SET_SPEC_HDR(Hp-((_FHS*2)+1),s23h_info,0,1,1);
+ Hp[-(_FHS+1)]=(W_)(R2.p);
+ SET_SPEC_HDR(Hp-_FHS,s24V_info,0,1,0);
+ SpA[-1]=Hp-_FHS;
+ SpA[-2]=Hp-((_FHS*2)+1);
+ R1.p=STBase_thenPrimIO_closure;
+ SpA=SpA-2;
+ ENT_VIA_NODE();
+ GRAN_EXEC(11,2,3,7,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+STATIC_ITBL(Test_d_info,Test_d_entry,StdErrorCode,1,-1,(STATIC_VHS+
+ 2),0,const,EF_,0,0,0);
+FN_(Test_d_entry) {
+ID_RO_(s258_info);
+ID_(s1Xu_closure);
+ED_(STBase_thenPrimIO_closure);
+ FB_
+ STK_CHK(1,2,4,0,0,0,1);
+ HEAP_CHK(1,(BH_HS+_FHS+3),1);
+ SET_BH_HDR(Hp-(BH_HS+_FHS+2),BH_UPD_info,0,(BH_VHS+2),0);
+ UPD_CAF(R1.p,Hp-(BH_HS+_FHS+2));
+ PUSH_STD_UPD_FRAME(Hp-(BH_HS+_FHS+2),0,0);
+ SET_SPEC_HDR(Hp-_FHS,s258_info,0,1,0);
+ SpA[-1]=Hp-_FHS;
+ SpA[-2]=s1Xu_closure;
+ RetReg=StdUpdRetVecReg;
+ R1.p=STBase_thenPrimIO_closure;
+ SpA=SpA-2;
+ SpB=SpB+4;
+ ENT_VIA_NODE();
+ GRAN_EXEC(23,2,3,11,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(Test_d_closure,Test_d_info,0,,ED_RO_)
+ , (W_)0, (W_)0
+};
+ghc: module version changed to 1; reason: no old .hi file
--- /dev/null
+--!!! cc006 -- ccall with non-standard boxed arguments and results
+
+module Test where
+
+import GlaExts
+import Foreign
+
+-- Test returning results
+
+a :: PrimIO Int
+a = _ccall_ a
+
+b :: PrimIO (StablePtr Int)
+b = _ccall_ b
+
+-- Test taking arguments
+
+c :: ForeignObj -> PrimIO Int
+c x = _ccall_ c x
+
+d :: StablePtr Int -> PrimIO Int
+d x = _ccall_ d x
--- /dev/null
+
+NOTE: Simplifier still going after 4 iterations; bailing out.
+
+
+================================================================================
+STG syntax:
+d{-r5y,x-} =
+ [] \r [x_s1vw]
+ let {
+ stg_c1Fh =
+ (False, True, False, False, True) [x_s1vw] \r [ds_s1vn]
+ case
+ ds_s1vn{-lvs:x_s1vw-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1vn x_s1vw]; rhs lvs: [x_s1vw]; uniq: c1Fi
+ STBase.S#{-5D,p-}{i} ds_s1vx ->
+ case
+ x_s1vw{-lvs:ds_s1vx-} ::Foreign.StablePtr{-3w,p-} PrelBase.Int{-3g,p-}
+ of {
+ -- lvs: [x_s1vw ds_s1vx]; rhs lvs: [ds_s1vx]; uniq: c1Fj
+ Foreign.StablePtr{-5o,p-}{i} ds_s1vX ->
+ case
+ _ccall_ d [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) (GHC.StablePtr#{-3v,p-} PrelBase.Int{-3g,p-})]# [ds_s1vx ds_s1vX] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1vx ds_s1vX]; rhs lvs: []; uniq: c1Fk
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1w8 ds_s1vY ->
+ let {
+ ds_s1wC =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1vY]; } in
+ let {
+ ds_s1wB =
+ STBase.S#{-5D,p-}{i}! [ds_s1w8];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1wC ds_s1wB];
+ };
+ };
+ };
+ } in
+ stg_c1Fh;
+c{-r5x,x-} =
+ [] \r [x_s1wL]
+ let {
+ stg_c1EH =
+ (False, True, False, False, True) [x_s1wL] \r [ds_s1wA]
+ case
+ ds_s1wA{-lvs:x_s1wL-} ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1wA x_s1wL]; rhs lvs: [x_s1wL]; uniq: c1Fl
+ STBase.S#{-5D,p-}{i} ds_s1wM ->
+ case x_s1wL{-lvs:ds_s1wM-} ::Foreign.ForeignObj{-3l,p-} of {
+ -- lvs: [x_s1wL ds_s1wM]; rhs lvs: [ds_s1wM]; uniq: c1Fm
+ Foreign.ForeignObj{-5f,p-}{i} ds_s1xc ->
+ case
+ _ccall_ c [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.ForeignObj#{-3k,p-}]# [ds_s1wM ds_s1xc] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1wM ds_s1xc]; rhs lvs: []; uniq: c1Fn
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1xn ds_s1xd ->
+ let {
+ ds_s1xL =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1xd]; } in
+ let {
+ ds_s1xK =
+ STBase.S#{-5D,p-}{i}! [ds_s1xn];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1xL ds_s1xK];
+ };
+ };
+ };
+ } in
+ stg_c1EH;
+s_s1sE =
+ [] \r [ds_s1xJ]
+ case ds_s1xJ ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-} of {
+ -- lvs: [ds_s1xJ]; rhs lvs: []; uniq: c1Fo
+ STBase.S#{-5D,p-}{i} ds_s1yc ->
+ case
+ _ccall_ b [(Foreign.StateAndStablePtr#{-3J,p-} GHC.RealWorld{-3s,p-} PrelBase.Int{-3g,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]# [ds_s1yc] ::Foreign.StateAndStablePtr#{-3J,p-} GHC.RealWorld{-3s,p-} PrelBase.Int{-3g,p-}
+ of {
+ -- lvs: [ds_s1yc]; rhs lvs: []; uniq: c1Fp
+ Foreign.StateAndStablePtr#{-5B,p-}{i} ds_s1ym ds_s1yb ->
+ let {
+ ds_s1yC =
+ Foreign.StablePtr{-5o,p-}{i}! [ds_s1yb]; } in
+ let {
+ ds_s1yB =
+ STBase.S#{-5D,p-}{i}! [ds_s1ym];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1yC ds_s1yB];
+ };
+ };
+s_s1zw =
+ (False, True, False, False, True) [] \r [ds_s1yK]
+ case ds_s1yK ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-} of {
+ -- lvs: [ds_s1yK]; rhs lvs: []; uniq: c1Fq
+ STBase.S#{-5D,p-}{i} ds_s1zb ->
+ case
+ _ccall_ b [(Foreign.StateAndStablePtr#{-3J,p-} GHC.RealWorld{-3s,p-} PrelBase.Int{-3g,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]# [ds_s1zb] ::Foreign.StateAndStablePtr#{-3J,p-} GHC.RealWorld{-3s,p-} PrelBase.Int{-3g,p-}
+ of {
+ -- lvs: [ds_s1zb]; rhs lvs: []; uniq: c1Fr
+ Foreign.StateAndStablePtr#{-5B,p-}{i} ds_s1zl ds_s1za ->
+ let {
+ ds_s1zL =
+ Foreign.StablePtr{-5o,p-}{i}! [ds_s1za]; } in
+ let {
+ ds_s1zK =
+ STBase.S#{-5D,p-}{i}! [ds_s1zl];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1zL ds_s1zK];
+ };
+ };
+b{-r5w,x-} =
+ [] \u []
+ s_s1zw;
+s_s1uE =
+ [] \r [ds_s1zJ]
+ case ds_s1zJ ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-} of {
+ -- lvs: [ds_s1zJ]; rhs lvs: []; uniq: c1Fs
+ STBase.S#{-5D,p-}{i} ds_s1Ac ->
+ case
+ _ccall_ a [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]# [ds_s1Ac] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1Ac]; rhs lvs: []; uniq: c1Ft
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1Am ds_s1Ab ->
+ let {
+ ds_s1AC =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1Ab]; } in
+ let {
+ ds_s1AB =
+ STBase.S#{-5D,p-}{i}! [ds_s1Am];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1AC ds_s1AB];
+ };
+ };
+s_s1Bw =
+ (False, True, False, False, True) [] \r [ds_s1AK]
+ case ds_s1AK ::STBase.State{-3M,p-} GHC.RealWorld{-3s,p-} of {
+ -- lvs: [ds_s1AK]; rhs lvs: []; uniq: c1Fu
+ STBase.S#{-5D,p-}{i} ds_s1Bb ->
+ case
+ _ccall_ a [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]# [ds_s1Bb] ::STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}
+ of {
+ -- lvs: [ds_s1Bb]; rhs lvs: []; uniq: c1Fv
+ STBase.StateAndInt#{-5v,p-}{i} ds_s1Bl ds_s1Ba ->
+ let {
+ ds_s1BE =
+ PrelBase.I#{-5b,p-}{i}! [ds_s1Ba]; } in
+ let {
+ ds_s1BF =
+ STBase.S#{-5D,p-}{i}! [ds_s1Bl];
+ } in
+ PrelTup.(,){-62,p-}{i}! [ds_s1BE ds_s1BF];
+ };
+ };
+a{-r5v,x-} =
+ [] \u []
+ s_s1Bw;
+
+
+================================================================================
+Flat Abstract C:
+IFN_(ret_c1Fj) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1vY;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ StgStablePtr _ccall_arg1=R3.i;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (d((_ccall_arg1)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1vY=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1vY);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,22,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fj,ret_c1Fj)
+IFN_(ret_c1Fi) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fj,vtbl_c1Fj);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fi,ret_c1Fi)
+SPEC_N_ITBL(c1Fh_info,c1Fh_entry,StdErrorCode,1,-1,1,1,static const,IF_,0,0,0);
+IFN_(c1Fh_entry) {
+IF_(c1Fh_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(c1Fh_fast1);
+ FE_
+}
+IFN_(c1Fh_fast1) {
+ FB_
+ STK_CHK(3,1,1,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fi,vtbl_c1Fi);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-1;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+STATIC_ITBL(Test_d_info,Test_d_entry,StdErrorCode,1,-1,STATIC_VHS,0,const,EF_,0,0,0);
+FN_(Test_d_entry) {
+ED_(Test_d_closure);
+EF_(Test_d_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,Test_d_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(Test_d_fast1);
+ FE_
+}
+FN_(Test_d_fast1) {
+ID_RO_(c1Fh_info);
+IF_(c1Fh_entry);
+ FB_
+ HEAP_CHK(1,(_FHS+1),0);
+ SET_SPEC_HDR(Hp-_FHS,c1Fh_info,0,1,1);
+ *Hp=(W_)(R1.p);
+ R1.p=Hp-_FHS;
+ GRAN_EXEC(5,2,0,2,0);
+ JMP_(c1Fh_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_d_closure,Test_d_info,0,,ED_RO_)
+};
+IFN_(ret_c1Fm) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1xd;
+ FB_
+ HEAP_CHK(4,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ StgForeignObj _ccall_arg1=ForeignObj_CLOSURE_DATA(R3.p);
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (c((_ccall_arg1)));
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1xd=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1xd);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,22,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fm,ret_c1Fm)
+IFN_(ret_c1Fl) {
+ FB_
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fm,vtbl_c1Fm);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,2,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fl,ret_c1Fl)
+SPEC_N_ITBL(c1EH_info,c1EH_entry,StdErrorCode,1,-1,1,1,static const,IF_,0,0,0);
+IFN_(c1EH_entry) {
+IF_(c1EH_fast1);
+ FB_
+ ARGS_CHK_A(1);
+ R2.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(c1EH_fast1);
+ FE_
+}
+IFN_(c1EH_fast1) {
+ FB_
+ STK_CHK(3,1,1,0,0,0,1);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fl,vtbl_c1Fl);
+ SpA[-1]=(P_)(R1.p[_FHS]);
+ R1=R2;
+ SpA=SpA-1;
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(5,1,2,2,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+STATIC_ITBL(Test_c_info,Test_c_entry,StdErrorCode,1,-1,STATIC_VHS,0,const,EF_,0,0,0);
+FN_(Test_c_entry) {
+ED_(Test_c_closure);
+EF_(Test_c_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,Test_c_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(Test_c_fast1);
+ FE_
+}
+FN_(Test_c_fast1) {
+ID_RO_(c1EH_info);
+IF_(c1EH_entry);
+ FB_
+ HEAP_CHK(1,(_FHS+1),0);
+ SET_SPEC_HDR(Hp-_FHS,c1EH_info,0,1,1);
+ *Hp=(W_)(R1.p);
+ R1.p=Hp-_FHS;
+ GRAN_EXEC(5,2,0,2,0);
+ JMP_(c1EH_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_c_closure,Test_c_info,0,,ED_RO_)
+};
+IFN_(ret_c1Fo) {
+ED_RO_(Foreign_StablePtr_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+StgStablePtr s1yb;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ StgStablePtr _ccall_result;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (b());
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1yb=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,Foreign_StablePtr_con_info,0,1,0);
+ *Hp=(W_)(s1yb);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,21,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fo,ret_c1Fo)
+STATIC_ITBL(s1sE_info,s1sE_entry,StdErrorCode,1,-1,STATIC_VHS,0,static const,IF_,0,0,0);
+IFN_(s1sE_entry) {
+ID_(s1sE_closure);
+IF_(s1sE_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,s1sE_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s1sE_fast1);
+ FE_
+}
+IFN_(s1sE_fast1) {
+ FB_
+ STK_CHK(1,0,1,0,0,0,0);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fo,vtbl_c1Fo);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(s1sE_closure,s1sE_info,0,static ,ID_RO_)
+};
+IFN_(ret_c1Fq) {
+ED_RO_(Foreign_StablePtr_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+StgStablePtr s1za;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ StgStablePtr _ccall_result;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (b());
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1za=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,Foreign_StablePtr_con_info,0,1,0);
+ *Hp=(W_)(s1za);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,21,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fq,ret_c1Fq)
+STATIC_ITBL(s1zw_info,s1zw_entry,StdErrorCode,1,-1,STATIC_VHS,0,static const,IF_,0,0,0);
+IFN_(s1zw_entry) {
+ID_(s1zw_closure);
+IF_(s1zw_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,s1zw_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s1zw_fast1);
+ FE_
+}
+IFN_(s1zw_fast1) {
+ FB_
+ STK_CHK(1,0,1,0,0,0,0);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fq,vtbl_c1Fq);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(s1zw_closure,s1zw_info,0,static ,ID_RO_)
+};
+STATIC_ITBL(Test_b_info,Test_b_entry,StdErrorCode,1,-1,(STATIC_VHS+
+ 2),0,const,EF_,0,0,0);
+FN_(Test_b_entry) {
+IF_(s1zw_entry);
+ FB_
+ STK_CHK(1,0,4,0,0,0,1);
+ HEAP_CHK(1,(BH_HS+2),1);
+ SET_BH_HDR(Hp-(BH_HS+1),BH_UPD_info,0,(BH_VHS+2),0);
+ UPD_CAF(R1.p,Hp-(BH_HS+1));
+ PUSH_STD_UPD_FRAME(Hp-(BH_HS+1),0,0);
+ RetReg=StdUpdRetVecReg;
+ SpB=SpB+4;
+ GRAN_EXEC(16,2,1,8,0);
+ JMP_(s1zw_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_b_closure,Test_b_info,0,,ED_RO_)
+ , (W_)0, (W_)0
+};
+IFN_(ret_c1Fs) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1Ab;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (a());
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1Ab=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1Ab);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,21,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fs,ret_c1Fs)
+STATIC_ITBL(s1uE_info,s1uE_entry,StdErrorCode,1,-1,STATIC_VHS,0,static const,IF_,0,0,0);
+IFN_(s1uE_entry) {
+ID_(s1uE_closure);
+IF_(s1uE_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,s1uE_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s1uE_fast1);
+ FE_
+}
+IFN_(s1uE_fast1) {
+ FB_
+ STK_CHK(1,0,1,0,0,0,0);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fs,vtbl_c1Fs);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(s1uE_closure,s1uE_info,0,static ,ID_RO_)
+};
+IFN_(ret_c1Fu) {
+ED_RO_(PrelBase_IZh_con_info);
+ED_(STBase_SZh_static_closure);
+ED_RO_(PrelTup_Z40Z44Z41_inregs_info);
+I_ s1Ba;
+ FB_
+ HEAP_CHK(0,(_FHS+1),0);
+ {
+ I_ _ccall_result;
+ CALLER_SAVE_Base
+ CALLER_SAVE_SpA
+ CALLER_SAVE_SuA
+ CALLER_SAVE_SpB
+ CALLER_SAVE_SuB
+ CALLER_SAVE_Ret
+ CALLER_SAVE_Hp
+ CALLER_SAVE_HpLim
+ _ccall_result = (a());
+ CALLER_RESTORE_Base
+ CALLER_RESTORE_SpA
+ CALLER_RESTORE_SuA
+ CALLER_RESTORE_SpB
+ CALLER_RESTORE_SuB
+ CALLER_RESTORE_Ret
+ CALLER_RESTORE_Hp
+ CALLER_RESTORE_HpLim
+ CALLER_RESTORE_StdUpdRetVec
+ CALLER_RESTORE_StkStub
+ s1Ba=_ccall_result;
+ }
+ SET_SPEC_HDR(Hp-_FHS,PrelBase_IZh_con_info,0,1,0);
+ *Hp=(W_)(s1Ba);
+ R4.p=STBase_SZh_static_closure;
+ R3.p=Hp-_FHS;
+ SpB=SpB-1;
+ R2.d=PrelTup_Z40Z44Z41_inregs_info;
+ GRAN_EXEC(10,2,21,22,0);
+ JMP_(DIRECT((StgRetAddr)(SpB[1])));
+ FE_
+}
+UNVECTBL(static,vtbl_c1Fu,ret_c1Fu)
+STATIC_ITBL(s1Bw_info,s1Bw_entry,StdErrorCode,1,-1,STATIC_VHS,0,static const,IF_,0,0,0);
+IFN_(s1Bw_entry) {
+ID_(s1Bw_closure);
+IF_(s1Bw_fast1);
+ FB_
+ ARGS_CHK_A_LOAD_NODE(1,s1Bw_closure);
+ R1.p=*SpA;
+ SpA=SpA+1;
+ GRAN_EXEC(5,2,1,0,0);
+ JMP_(s1Bw_fast1);
+ FE_
+}
+IFN_(s1Bw_fast1) {
+ FB_
+ STK_CHK(1,0,1,0,0,0,0);
+ SpB[1]=(W_)(RetReg);
+ RetReg=(StgRetAddr)UNVEC(ret_c1Fu,vtbl_c1Fu);
+ SpB=SpB+1;
+ ENT_VIA_NODE();
+ GRAN_EXEC(3,1,1,1,0);
+ JMP_((P_)(ENTRY_CODE((D_)(INFO_PTR(R1.p)))));
+ FE_
+}
+SET_STATIC_HDR(s1Bw_closure,s1Bw_info,0,static ,ID_RO_)
+};
+STATIC_ITBL(Test_a_info,Test_a_entry,StdErrorCode,1,-1,(STATIC_VHS+
+ 2),0,const,EF_,0,0,0);
+FN_(Test_a_entry) {
+IF_(s1Bw_entry);
+ FB_
+ STK_CHK(1,0,4,0,0,0,1);
+ HEAP_CHK(1,(BH_HS+2),1);
+ SET_BH_HDR(Hp-(BH_HS+1),BH_UPD_info,0,(BH_VHS+2),0);
+ UPD_CAF(R1.p,Hp-(BH_HS+1));
+ PUSH_STD_UPD_FRAME(Hp-(BH_HS+1),0,0);
+ RetReg=StdUpdRetVecReg;
+ SpB=SpB+4;
+ GRAN_EXEC(16,2,1,8,0);
+ JMP_(s1Bw_entry);
+ FE_
+}
+SET_STATIC_HDR(Test_a_closure,Test_a_info,0,,ED_RO_)
+ , (W_)0, (W_)0
+};
+ghc: module version changed to 1; reason: no old .hi file
--- /dev/null
+--!!! cc007 -- ccall with synonyms, polymorphic type variables and user type variables.
+module Test where
+
+import GlaExts
+
+-- Since I messed up the handling of polymorphism originally, I'll
+-- explicitly test code with UserSysTyVar (ie an explicit polymorphic
+-- signature)
+
+foo = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1)
+ where
+ thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
+ thenADR = thenPrimIO
+
+-- and with a PolySysTyVar (ie no explicit signature)
+
+bar = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1)
+ where
+ -- thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
+ thenADR = thenPrimIO
+
+-- and with a type synonym
+
+type INT = Int
+barfu :: PrimIO INT
+barfu = _ccall_ b
+
--- /dev/null
+
+cc007.hs:2: Cannot generalise these overloadings (in a _ccall_):
+ `Foreign.CReturnable t{-a12t-}'
+
+cc007.hs:2: Cannot generalise these overloadings (in a _ccall_):
+ `Foreign.CReturnable t{-a13c-}'
+
+
+Compilation had errors
projects / ghc-hetmet.git / commitdiff