From 0927a2a6e0530e32c49c1ce0237261727181afbd Mon Sep 17 00:00:00 2001 From: sof Date: Sat, 26 Jul 1997 22:59:44 +0000 Subject: [PATCH] [project @ 1997-07-26 22:59:33 by sof] --- ghc/tests/ccall/should_compile/Makefile | 32 + ghc/tests/ccall/should_compile/cc001.hs | 25 + ghc/tests/ccall/should_compile/cc001.stderr | 333 ++++++++ ghc/tests/ccall/should_compile/cc002.hs | 22 + ghc/tests/ccall/should_compile/cc002.stderr | 9 + ghc/tests/ccall/should_compile/cc003.hs | 9 + ghc/tests/ccall/should_compile/cc003.stderr | 115 +++ ghc/tests/ccall/should_compile/cc004.hs | 27 + ghc/tests/ccall/should_compile/cc004.stderr | 9 + ghc/tests/ccall/should_compile/cc005.hs | 25 + ghc/tests/ccall/should_compile/cc005.stderr | 1100 +++++++++++++++++++++++++++ ghc/tests/ccall/should_compile/cc006.hs | 22 + ghc/tests/ccall/should_compile/cc006.stderr | 671 ++++++++++++++++ ghc/tests/ccall/should_compile/cc007.hs | 27 + ghc/tests/ccall/should_compile/cc007.stderr | 9 + 15 files changed, 2435 insertions(+) create mode 100644 ghc/tests/ccall/should_compile/Makefile create mode 100644 ghc/tests/ccall/should_compile/cc001.hs create mode 100644 ghc/tests/ccall/should_compile/cc001.stderr create mode 100644 ghc/tests/ccall/should_compile/cc002.hs create mode 100644 ghc/tests/ccall/should_compile/cc002.stderr create mode 100644 ghc/tests/ccall/should_compile/cc003.hs create mode 100644 ghc/tests/ccall/should_compile/cc003.stderr create mode 100644 ghc/tests/ccall/should_compile/cc004.hs create mode 100644 ghc/tests/ccall/should_compile/cc004.stderr create mode 100644 ghc/tests/ccall/should_compile/cc005.hs create mode 100644 ghc/tests/ccall/should_compile/cc005.stderr create mode 100644 ghc/tests/ccall/should_compile/cc006.hs create mode 100644 ghc/tests/ccall/should_compile/cc006.stderr create mode 100644 ghc/tests/ccall/should_compile/cc007.hs create mode 100644 ghc/tests/ccall/should_compile/cc007.stderr diff --git a/ghc/tests/ccall/should_compile/Makefile b/ghc/tests/ccall/should_compile/Makefile new file mode 100644 index 0000000..a02df9b --- /dev/null +++ b/ghc/tests/ccall/should_compile/Makefile @@ -0,0 +1,32 @@ +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 diff --git a/ghc/tests/ccall/should_compile/cc001.hs b/ghc/tests/ccall/should_compile/cc001.hs new file mode 100644 index 0000000..8aeca95 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc001.hs @@ -0,0 +1,25 @@ +--!!! 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 + + + diff --git a/ghc/tests/ccall/should_compile/cc001.stderr b/ghc/tests/ccall/should_compile/cc001.stderr new file mode 100644 index 0000000..952647f --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc001.stderr @@ -0,0 +1,333 @@ + + +================================================================================ +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. diff --git a/ghc/tests/ccall/should_compile/cc002.hs b/ghc/tests/ccall/should_compile/cc002.hs new file mode 100644 index 0000000..c970d88 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc002.hs @@ -0,0 +1,22 @@ +--!!! 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 diff --git a/ghc/tests/ccall/should_compile/cc002.stderr b/ghc/tests/ccall/should_compile/cc002.stderr new file mode 100644 index 0000000..4d70998 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc002.stderr @@ -0,0 +1,9 @@ + +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 diff --git a/ghc/tests/ccall/should_compile/cc003.hs b/ghc/tests/ccall/should_compile/cc003.hs new file mode 100644 index 0000000..b8c8d35 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc003.hs @@ -0,0 +1,9 @@ +--!!! 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) diff --git a/ghc/tests/ccall/should_compile/cc003.stderr b/ghc/tests/ccall/should_compile/cc003.stderr new file mode 100644 index 0000000..1f8dfdc --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc003.stderr @@ -0,0 +1,115 @@ + + +================================================================================ +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. diff --git a/ghc/tests/ccall/should_compile/cc004.hs b/ghc/tests/ccall/should_compile/cc004.hs new file mode 100644 index 0000000..f53c61d --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc004.hs @@ -0,0 +1,27 @@ +--!!! 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 + diff --git a/ghc/tests/ccall/should_compile/cc004.stderr b/ghc/tests/ccall/should_compile/cc004.stderr new file mode 100644 index 0000000..b8cd850 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc004.stderr @@ -0,0 +1,9 @@ + +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 diff --git a/ghc/tests/ccall/should_compile/cc005.hs b/ghc/tests/ccall/should_compile/cc005.hs new file mode 100644 index 0000000..8aeca95 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc005.hs @@ -0,0 +1,25 @@ +--!!! 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 + + + diff --git a/ghc/tests/ccall/should_compile/cc005.stderr b/ghc/tests/ccall/should_compile/cc005.stderr new file mode 100644 index 0000000..ed9f6bb --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc005.stderr @@ -0,0 +1,1100 @@ + +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 diff --git a/ghc/tests/ccall/should_compile/cc006.hs b/ghc/tests/ccall/should_compile/cc006.hs new file mode 100644 index 0000000..27579e9 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc006.hs @@ -0,0 +1,22 @@ +--!!! 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 diff --git a/ghc/tests/ccall/should_compile/cc006.stderr b/ghc/tests/ccall/should_compile/cc006.stderr new file mode 100644 index 0000000..df765d7 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc006.stderr @@ -0,0 +1,671 @@ + +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 diff --git a/ghc/tests/ccall/should_compile/cc007.hs b/ghc/tests/ccall/should_compile/cc007.hs new file mode 100644 index 0000000..42d1260 --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc007.hs @@ -0,0 +1,27 @@ +--!!! 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 + diff --git a/ghc/tests/ccall/should_compile/cc007.stderr b/ghc/tests/ccall/should_compile/cc007.stderr new file mode 100644 index 0000000..a5da32e --- /dev/null +++ b/ghc/tests/ccall/should_compile/cc007.stderr @@ -0,0 +1,9 @@ + +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 -- 1.7.10.4