GHC issueshttps://gitlab.haskell.org/ghc/ghc/-/issues2024-02-05T17:53:15Zhttps://gitlab.haskell.org/ghc/ghc/-/issues/24282SpecConstr regression in NoFib's `spectral/ansi`2024-02-05T17:53:15ZSebastian GrafSpecConstr regression in NoFib's `spectral/ansi`With a recent master GHC, I observe a perf regression in NoFib's [spectral/ansi](
https://gitlab.haskell.org/ghc/nofib/-/blob/0f330c9686ba1a96cc9db010f061a84e748057e5/spectral/ansi/Main.hs) the presence of `-fspec-constr`.
```bash
$ _bu...With a recent master GHC, I observe a perf regression in NoFib's [spectral/ansi](
https://gitlab.haskell.org/ghc/nofib/-/blob/0f330c9686ba1a96cc9db010f061a84e748057e5/spectral/ansi/Main.hs) the presence of `-fspec-constr`.
```bash
$ _build/stage1/bin/ghc -O Main.hs
$ ./Main 400 +RTS -t < ansi.stdout > /dev/null
<<ghc: 24321415416 bytes, 5880 GCs, 258273/364656 avg/max bytes residency (28 samples), 7M in use, 0.000 INIT (0.000 elapsed), 2.297 MUT (2.290 elapsed), 0.167 GC (0.171 elapsed) :ghc>>
$ _build/stage1/bin/ghc -O -fspec-constr Main.hs
$ ./Main 400 +RTS -t < ansi.stdout > /dev/null
<<ghc: 32211087200 bytes, 6471 GCs, 253717/401024 avg/max bytes residency (30 samples), 8M in use, 0.000 INIT (0.000 elapsed), 2.836 MUT (2.827 elapsed), 0.211 GC (0.215 elapsed) :ghc>>
```
(An aside: Perhaps me piping ansi.**stdout** is an incorrect run of the benchmark, but we shouldn't regress either way.)
Note that the second run allocates 33% more. This is due to SpecConstr introducing reboxing.
Having a hunch, I reverted !11689 and got the following results:
```bash
$ _build/stage1/bin/ghc -O -fspec-constr Main.hs
$ ./Main 400 +RTS -t < ansi.stdout > /dev/null
<<ghc: 22238093736 bytes, 5407 GCs, 258627/350776 avg/max bytes residency (22 samples), 7M in use, 0.000 INIT (0.000 elapsed), 2.127 MUT (2.120 elapsed), 0.125 GC (0.129 elapsed) :ghc>>
```
So that improved; hence !11689 is introducing a 40% regression for `spectral/ansi`. Perhaps we should re-evaluate that patch or find a way that it does not regress.
---
I began to diagnose.
Here's a diff of the specialisations we do according to `-ddump-spec-constr`, with !11689 reverted (e.g., OLD) first:
```
loop [Occ=LoopBreaker] :: Int -> [Char] -> Interact
[LclId,
Arity=2,
Str=<L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
Guidance=IF_ARGS [60 30] 585 60},
RULES: "SC:loop0"
forall (sc :: GHC.Prim.Int#).
loop (GHC.Types.I# sc) (GHC.Types.[] @Char)
= $sloop sc
"SC:loop1"
forall (sc :: Char) (sc :: [Char]) (sc :: Int).
loop sc (GHC.Types.: @Char sc sc)
= $sloop sc sc sc
"SC:loop2"
forall (sc :: GHC.Prim.Int#). loop (GHC.Types.I# sc) = $sloop sc]
```
and now with !11689 (e.g., NEW):
```
loop [Occ=LoopBreaker] :: Int -> [Char] -> Interact
[LclId,
Arity=2,
Str=<L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
Guidance=IF_ARGS [60 30] 585 60},
RULES: "SC:loop0"
forall (sc :: GHC.Prim.Int#). loop (GHC.Types.I# sc) = $sloop sc
"SC:loop1"
forall (sc :: Char) (sc :: [Char]) (sc :: Int).
loop sc (GHC.Types.: @Char sc sc)
= $sloop sc sc sc]
```
Apparently, we lose the specialisation
```
RULES: "SC:loop0"
forall (sc :: GHC.Prim.Int#).
loop (GHC.Types.I# sc) (GHC.Types.[] @Char)
= $sloop sc
```
Which IMO is an instance of (OLD)
```
"SC:loop2"
forall (sc :: GHC.Prim.Int#). loop (GHC.Types.I# sc) = $sloop sc]
```
With !11689, we never generate the first one, only the second one. But the `$sloop` of the second one needs to rebox its `I# sc`, resulting in the huge regression, whereas the `$sloop` for the `[]` specialisation does not.
Although I'm tempted to accept this regression because it is ultimately a result of a lack of awareness of reboxing in SpecConstr, I wonder why we so easily discard the specialisation for `[]`.9.10.1https://gitlab.haskell.org/ghc/ghc/-/issues/232099.4.4 core lint error: Rule "SC:$j0": unbound [sg_s1Rr] (SpecConstr)2023-12-21T21:18:02ZMatthew Pickering9.4.4 core lint error: Rule "SC:$j0": unbound [sg_s1Rr] (SpecConstr)This is a master ticket. Other dups
* #24213
* #22858
* #14270
* #10602
Here is a somewhat minimised example: https://github.com/mpickering/cuddly-fiesta
Unfortunately it still depends on `text-builder`, which is quite large and intric...This is a master ticket. Other dups
* #24213
* #22858
* #14270
* #10602
Here is a somewhat minimised example: https://github.com/mpickering/cuddly-fiesta
Unfortunately it still depends on `text-builder`, which is quite large and intricate which I attempted to inline but it caused the error to be resolved.
The core lint error is as follows:
```
src/Repro.hs:75:9: warning:
Rule "SC:$j0": unbound [sg_s1Rr]
In the RHS of $ctoSQL_s1Oh :: SQLUpdate -> TextBuilder
In the body of lambda with binder a_a13J :: SQLUpdate
In a case alternative: (TextBuilder ww_a1OX :: Action,
ww1_a1OY :: Int#,
ww2_a1OZ :: Int#)
In a case alternative: (TextBuilder ww_X2 :: Action,
ww1_X3 :: Int#,
ww2_X4 :: Int#)
In a case alternative: (SQLUpdate ds_d1Dk :: SetExp,
ds_d1Dl :: Maybe FromExp,
ds_d1Dm :: Maybe WhereFrag,
ds_d1Dn :: Maybe RetExp)
In the body of lambda with binder sc_s1Rd :: Int#
In the body of lambda with binder sc_s1Rc :: Int#
In the body of lambda with binder sg_s1Rb :: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action
```
<details><summary>Full error</summary>
```
Build profile: -w ghc-9.4.4 -O1
In order, the following will be built (use -v for more details):
- repro2-0.1.0.0 (lib) (file src/Repro.hs changed)
Preprocessing library for repro2-0.1.0.0..
Building library for repro2-0.1.0.0..
[1 of 1] Compiling Repro ( src/Repro.hs, /home/matt/graphql-engine/repro2/dist-newstyle/build/x86_64-linux/ghc-9.4.4/repro2-0.1.0.0/opt/build/Repro.o, /home/matt/graphql-engine/repro2/dist-newstyle/build/x86_64-linux/ghc-9.4.4/repro2-0.1.0.0/opt/build/Repro.dyn_o ) [Source file changed]
src/Repro.hs:32:20: warning: [-Wunused-matches]
Defined but not used: ‘be’
|
32 | toSQL (WhereFrag be) =
| ^^
src/Repro.hs:47:20: warning: [-Wunused-matches]
Defined but not used: ‘ce’
|
47 | toSQL (Extractor ce ) = undefined
| ^^
src/Repro.hs:51:10: warning: [-Wmissing-methods]
• No explicit implementation for
‘toSQL’
• In the instance declaration for ‘ToSQL FromItem’
|
51 | instance ToSQL FromItem
| ^^^^^^^^^^^^^^
src/Repro.hs:94:7: warning: [-Wunused-matches]
Defined but not used: ‘kat’
|
94 | (<+>) kat (x : xs) =
| ^^^
*** Core Lint errors : in result of Simplifier ***
src/Repro.hs:75:9: warning:
Rule "SC:$j0": unbound [sg_s1Rr]
In the RHS of $ctoSQL_s1Oh :: SQLUpdate -> TextBuilder
In the body of lambda with binder a_a13J :: SQLUpdate
In a case alternative: (TextBuilder ww_a1OX :: Action,
ww1_a1OY :: Int#,
ww2_a1OZ :: Int#)
In a case alternative: (TextBuilder ww_X2 :: Action,
ww1_X3 :: Int#,
ww2_X4 :: Int#)
In a case alternative: (SQLUpdate ds_d1Dk :: SetExp,
ds_d1Dl :: Maybe FromExp,
ds_d1Dm :: Maybe WhereFrag,
ds_d1Dn :: Maybe RetExp)
In the body of lambda with binder sc_s1Rd :: Int#
In the body of lambda with binder sc_s1Rc :: Int#
In the body of lambda with binder sg_s1Rb :: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action
In the body of letrec with binders $s$j_s1RF :: Int#
-> Int#
-> ((forall {s}.
MArray s
-> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
In the body of lambda with binder ww_X8 :: Action
In the body of lambda with binder ww1_X9 :: Int#
In the body of lambda with binder ww2_Xa :: Int#
In the body of letrec with binders $s$j_s1Rx :: Int#
-> Int#
-> ((forall {s}.
MArray s
-> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
In a rule attached to $j_s1PG :: Action
-> Int# -> Int# -> TextBuilder
Substitution: [TCvSubst
In scope: InScope {sg_s1Rb sg_s1Rr}
Type env: []
Co env: [s1Rb :-> sg_s1Rb, s1Rr :-> sg_s1Rr]]
*** Offending Program ***
$ctoSQL_a1C6 :: forall a. ToSQL a => Maybe a -> Builder
[LclId,
Arity=2,
Str=<MCM(L)><1L>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 40 0}]
$ctoSQL_a1C6
= \ (@a_a1C3)
($dToSQL_a1C4 [Dmd=MCM(L)] :: ToSQL a_a1C3)
(ds_d1DU [Dmd=1L, OS=OneShot] :: Maybe a_a1C3) ->
case ds_d1DU of {
Nothing ->
$fMonoidBuilder2
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder);
Just a_a1ay ->
($dToSQL_a1C4
`cast` (N:ToSQL[0] <a_a1C3>_N
:: ToSQL a_a1C3 ~R# (a_a1C3 -> Builder)))
a_a1ay
}
$fToSQLMaybe [InlPrag=INLINE (sat-args=0)]
:: forall a. ToSQL a => ToSQL (Maybe a)
[LclIdX[DFunId(nt)],
Arity=2,
Str=<MCM(L)><1L>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_a1C6
`cast` (forall (a :: <*>_N).
<ToSQL a>_R %<'Many>_N ->_R Sym (N:ToSQL[0] <Maybe a>_N)
:: (forall {a}. ToSQL a => Maybe a -> Builder)
~R# (forall {a}. ToSQL a => ToSQL (Maybe a)))}]
$fToSQLMaybe
= $ctoSQL_a1C6
`cast` (forall (a :: <*>_N).
<ToSQL a>_R %<'Many>_N ->_R Sym (N:ToSQL[0] <Maybe a>_N)
:: (forall {a}. ToSQL a => Maybe a -> Builder)
~R# (forall {a}. ToSQL a => ToSQL (Maybe a)))
lvl_s1Qi :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
lvl_s1Qi = "WHERE"#
lvl_s1Ok :: TextBuilder
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 60 10}]
lvl_s1Ok
= case $wgo1 (unpackCString# lvl_s1Qi) of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR
}
$ctoSQL_s1Ic :: WhereFrag -> TextBuilder
[LclId,
Arity=1,
Str=<A>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
$ctoSQL_s1Ic = \ _ [Occ=Dead, Dmd=A] -> lvl_s1Ok
$fToSQLWhereFrag [InlPrag=INLINE (sat-args=0)] :: ToSQL WhereFrag
[LclIdX[DFunId(nt)],
Arity=1,
Str=<A>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_s1Ic
`cast` (<WhereFrag>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <WhereFrag>_N)
:: (WhereFrag -> TextBuilder) ~R# ToSQL WhereFrag)}]
$fToSQLWhereFrag
= $ctoSQL_s1Ic
`cast` (<WhereFrag>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <WhereFrag>_N)
:: (WhereFrag -> TextBuilder) ~R# ToSQL WhereFrag)
lvl_s1Ol :: [Char]
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 63 0}]
lvl_s1Ol
= case quotRemInt# -9223372036854775808# 10# of
{ (# q_a1Im, r_a1In #) ->
$fShow(,)_itos'
(negateInt# q_a1Im)
($fShow(,)_itos' (negateInt# r_a1In) ([] @Char))
}
lvl_s1Om :: [Char]
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl_s1Om = : @Char $fShow(,)9 lvl_s1Ol
$ctoSQL_a1BE :: SQLExp -> Builder
[LclId,
Arity=1,
Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 242 30}]
$ctoSQL_a1BE
= \ (ds_d1DO [Dmd=1!P(L)] :: SQLExp) ->
case ds_d1DO of { SEPrep bx_d1E0 ->
case <# bx_d1E0 0# of {
__DEFAULT ->
case $wgo1 ($fShow(,)_itos' bx_d1E0 ([] @Char)) of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
(TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR)
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder)
};
1# ->
case bx_d1E0 of wild_a1Ik {
__DEFAULT ->
case $wgo1
(: @Char
$fShow(,)9
($fShow(,)_itos' (negateInt# wild_a1Ik) ([] @Char)))
of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
(TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR)
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder)
};
-9223372036854775808# ->
case $wgo1 lvl_s1Om of { (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
(TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR)
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder)
}
}
}
}
$fToSQLSQLExp [InlPrag=INLINE (sat-args=0)] :: ToSQL SQLExp
[LclIdX[DFunId(nt)],
Arity=1,
Str=<1!P(L)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_a1BE
`cast` (Sym (N:ToSQL[0] <SQLExp>_N)
:: (SQLExp -> Builder) ~R# ToSQL SQLExp)}]
$fToSQLSQLExp
= $ctoSQL_a1BE
`cast` (Sym (N:ToSQL[0] <SQLExp>_N)
:: (SQLExp -> Builder) ~R# ToSQL SQLExp)
lvl_s1Qj :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 0}]
lvl_s1Qj = "undefined"#
lvl_s1Qk :: [Char]
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=True,
WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
lvl_s1Qk = unpackCString# lvl_s1Qj
lvl_s1Ql :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 70 0}]
lvl_s1Ql = "repro2-0.1.0.0-inplace"#
lvl_s1Qm :: [Char]
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=True,
WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
lvl_s1Qm = unpackCString# lvl_s1Ql
lvl_s1Qn :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
lvl_s1Qn = "Repro"#
lvl_s1Qo :: [Char]
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=True,
WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
lvl_s1Qo = unpackCString# lvl_s1Qn
lvl_s1Qp :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 0}]
lvl_s1Qp = "src/Repro.hs"#
lvl_s1Qq :: [Char]
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=True,
WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
lvl_s1Qq = unpackCString# lvl_s1Qp
lvl_s1Qr :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl_s1Qr = I# 47#
lvl_s1Qs :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl_s1Qs = I# 27#
lvl_s1Qu :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl_s1Qu = I# 36#
lvl_s1Qv :: SrcLoc
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl_s1Qv
= SrcLoc
lvl_s1Qm lvl_s1Qo lvl_s1Qq lvl_s1Qr lvl_s1Qs lvl_s1Qr lvl_s1Qu
lvl_s1Qw :: CallStack
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl_s1Qw = PushCallStack lvl_s1Qk lvl_s1Qv EmptyCallStack
lvl_s1Ov :: Builder
[LclId,
Str=b,
Cpr=b,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=NEVER}]
lvl_s1Ov
= undefined
@LiftedRep
@Builder
(lvl_s1Qw
`cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)))
$ctoSQL_a1oA :: Extractor -> Builder
[LclId,
Arity=1,
Str=<L>b,
Cpr=b,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
$ctoSQL_a1oA
= \ (ds_d1DM [Dmd=1!B] :: Extractor) ->
case ds_d1DM of { Extractor bx_d1DZ [Dmd=B] -> lvl_s1Ov }
$fToSQLExtractor [InlPrag=INLINE (sat-args=0)] :: ToSQL Extractor
[LclIdX[DFunId(nt)],
Arity=1,
Str=<L>b,
Cpr=b,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_a1oA
`cast` (Sym (N:ToSQL[0] <Extractor>_N)
:: (Extractor -> Builder) ~R# ToSQL Extractor)}]
$fToSQLExtractor
= $ctoSQL_a1oA
`cast` (Sym (N:ToSQL[0] <Extractor>_N)
:: (Extractor -> Builder) ~R# ToSQL Extractor)
lvl_s1Qx :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 80 0}]
lvl_s1Qx = "src/Repro.hs:51:10-23|toSQL"#
$ctoSQL_a1ov :: FromItem -> Builder
[LclId,
Str=b,
Cpr=b,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=NEVER}]
$ctoSQL_a1ov
= noMethodBindingError @LiftedRep @(FromItem -> Builder) lvl_s1Qx
$fToSQLFromItem [InlPrag=INLINE (sat-args=0)] :: ToSQL FromItem
[LclIdX[DFunId(nt)],
Str=b,
Cpr=b,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=False, ConLike=False,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_a1ov
`cast` (Sym (N:ToSQL[0] <FromItem>_N)
:: (FromItem -> Builder) ~R# ToSQL FromItem)}]
$fToSQLFromItem
= $ctoSQL_a1ov
`cast` (Sym (N:ToSQL[0] <FromItem>_N)
:: (FromItem -> Builder) ~R# ToSQL FromItem)
$fToSQLSetExpItem [InlPrag=INLINE (sat-args=0)] :: ToSQL SetExpItem
[LclIdX[DFunId(nt)],
Arity=1,
Str=<1!P(L)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_a1BE
`cast` (Sym (N:SetExpItem[0]) %<'Many>_N ->_R <Builder>_R
; Sym (N:ToSQL[0] <SetExpItem>_N)
:: (SQLExp -> Builder) ~R# ToSQL SetExpItem)}]
$fToSQLSetExpItem
= $ctoSQL_a1BE
`cast` (Sym (N:SetExpItem[0]) %<'Many>_N ->_R <Builder>_R
; Sym (N:ToSQL[0] <SetExpItem>_N)
:: (SQLExp -> Builder) ~R# ToSQL SetExpItem)
getWFBoolExp_s1II :: WhereFrag -> WhereFrag
[LclId,
Arity=1,
Str=<1!A>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
getWFBoolExp_s1II = \ (ds_d1DG [Dmd=1!A] :: WhereFrag) -> ds_d1DG
getWFBoolExp :: WhereFrag -> ()
[LclIdX[[RecSel]],
Arity=1,
Str=<1!A>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
getWFBoolExp
= getWFBoolExp_s1II
`cast` (<WhereFrag>_R %<'Many>_N ->_R N:WhereFrag[0]
:: (WhereFrag -> WhereFrag) ~R# (WhereFrag -> ()))
upRet :: SQLUpdate -> Maybe RetExp
[LclIdX[[RecSel]],
Arity=1,
Str=<1!P(A,A,A,1L)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
upRet
= \ (ds_d1DA [Dmd=1!P(A,A,A,1L)] :: SQLUpdate) ->
case ds_d1DA of
{ SQLUpdate ds_d1DC [Dmd=A] ds_d1DD [Dmd=A] ds_d1DE [Dmd=A]
ds_d1DF [Dmd=1L] ->
ds_d1DF
}
upWhere :: SQLUpdate -> Maybe WhereFrag
[LclIdX[[RecSel]],
Arity=1,
Str=<1!P(A,A,1L,A)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
upWhere
= \ (ds_d1Du [Dmd=1!P(A,A,1L,A)] :: SQLUpdate) ->
case ds_d1Du of
{ SQLUpdate ds_d1Dw [Dmd=A] ds_d1Dx [Dmd=A] ds_d1Dy [Dmd=1L]
ds_d1Dz [Dmd=A] ->
ds_d1Dy
}
upFrom :: SQLUpdate -> Maybe FromExp
[LclIdX[[RecSel]],
Arity=1,
Str=<1!P(A,1L,A,A)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
upFrom
= \ (ds_d1Do [Dmd=1!P(A,1L,A,A)] :: SQLUpdate) ->
case ds_d1Do of
{ SQLUpdate ds_d1Dq [Dmd=A] ds_d1Dr [Dmd=1L] ds_d1Ds [Dmd=A]
ds_d1Dt [Dmd=A] ->
ds_d1Dr
}
upSet :: SQLUpdate -> SetExp
[LclIdX[[RecSel]],
Arity=1,
Str=<1!P(1L,A,A,A)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
upSet
= \ (ds_d1Di [Dmd=1!P(1L,A,A,A)] :: SQLUpdate) ->
case ds_d1Di of
{ SQLUpdate ds_d1Dk [Dmd=1L] ds_d1Dl [Dmd=A] ds_d1Dm [Dmd=A]
ds_d1Dn [Dmd=A] ->
ds_d1Dk
}
upTable :: SQLUpdate -> ()
[LclIdX[[RecSel]],
Arity=1,
Str=<1!A>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
upTable
= \ (ds_d1Dc [Dmd=1!A] :: SQLUpdate) ->
case ds_d1Dc of
{ SQLUpdate ds_d1De [Dmd=A] ds_d1Df [Dmd=A] ds_d1Dg [Dmd=A]
ds_d1Dh [Dmd=A] ->
()
}
(<+>) [InlPrag=INLINE (sat-args=2)]
:: forall a. ToSQL a => Text -> [a] -> Builder
[LclIdX,
Arity=3,
Str=<L><A><1L>,
Cpr=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False)
Tmpl= \ (@a_a1mD)
($dToSQL_a1mE :: ToSQL a_a1mD)
_ [Occ=Dead]
(ds_d1D2 [Occ=Once1!] :: [a_a1mD]) ->
case ds_d1D2 of {
[] ->
$fMonoidBuilder2
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder);
: x_a1bk [Occ=Once1] xs_a1bl [Occ=Once1] ->
($fIsStringTextBuilder_$c<>
((($dToSQL_a1mE
`cast` (N:ToSQL[0] <a_a1mD>_N
:: ToSQL a_a1mD ~R# (a_a1mD -> Builder)))
x_a1bk)
`cast` (N:Builder[0] :: Builder ~R# TextBuilder))
($fMonoidBuilder1
((build
@Builder
(\ (@a_d1D7)
(c_d1D8 [Occ=OnceL1!, OS=OneShot] :: Builder -> a_d1D7 -> a_d1D7)
(n_d1D9 [Occ=Once1, OS=OneShot] :: a_d1D7) ->
foldr
@a_a1mD
@a_d1D7
(\ (ds_d1Db [Occ=Once1] :: a_a1mD)
(ds_d1Da [Occ=Once1, OS=OneShot] :: a_d1D7) ->
c_d1D8
(($dToSQL_a1mE
`cast` (N:ToSQL[0] <a_a1mD>_N
:: ToSQL a_a1mD ~R# (a_a1mD -> Builder)))
ds_d1Db)
ds_d1Da)
n_d1D9
xs_a1bl))
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))))
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder)
}}]
(<+>)
= \ (@a_a1mD)
($dToSQL_a1mE :: ToSQL a_a1mD)
_ [Occ=Dead, Dmd=A]
(ds_d1D2 [Dmd=1L] :: [a_a1mD]) ->
case ds_d1D2 of {
[] ->
$fMonoidBuilder2
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder);
: x_a1bk xs_a1bl [Dmd=1L] ->
case (($dToSQL_a1mE
`cast` (N:ToSQL[0] <a_a1mD>_N
:: ToSQL a_a1mD ~R# (a_a1mD -> Builder)))
x_a1bk)
`cast` (N:Builder[0] :: Builder ~R# TextBuilder)
of
{ TextBuilder ww_a1OX [Dmd=LCL(C1(C1(!P(L,A))))] ww1_a1OY
ww2_a1OZ ->
letrec {
go1_a1Qb [Occ=LoopBreaker] :: [a_a1mD] -> [Builder]
[LclId,
Arity=1,
Str=<1L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 70 20}]
go1_a1Qb
= \ (ds_a1Qc [Dmd=1L] :: [a_a1mD]) ->
case ds_a1Qc of {
[] -> [] @Builder;
: y_a1Qf ys_a1Qg [Dmd=ML] ->
: @Builder
(($dToSQL_a1mE
`cast` (N:ToSQL[0] <a_a1mD>_N
:: ToSQL a_a1mD ~R# (a_a1mD -> Builder)))
y_a1Qf)
(go1_a1Qb ys_a1Qg)
}; } in
case $wgo2
((go1_a1Qb xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(L)))], ww1_a1Pl, ww2_a1Pm #) ->
(TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2
array_a1P3
(case offset_a1P4 of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OY) }))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY ww1_a1Pl)
(+# ww2_a1OZ ww2_a1Pm))
`cast` (Sym (N:Builder[0]) :: TextBuilder ~R# Builder)
}
}
}
lvl_s1Qy :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 0}]
lvl_s1Qy = "RETURNING"#
lvl_s1Oz :: TextBuilder
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 60 10}]
lvl_s1Oz
= case $wgo1 (unpackCString# lvl_s1Qy) of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR
}
$ctoSQL_s1Ob :: RetExp -> TextBuilder
[LclId,
Arity=1,
Str=<1L>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [40] 130 10}]
$ctoSQL_s1Ob
= \ (ds_d1DI [Dmd=1L] :: RetExp) ->
case lvl_s1Oz of
{ TextBuilder ww_a1OX [Dmd=LCL(C1(C1(!P(L,A))))] ww1_a1OY
ww2_a1OZ ->
case ds_d1DI `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(# ipv_a1Pb, () #)
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
ww1_a1OY
ww2_a1OZ;
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
$fToSQLRetExp [InlPrag=INLINE (sat-args=0)] :: ToSQL RetExp
[LclIdX[DFunId(nt)],
Arity=1,
Str=<1L>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_s1Ob
`cast` (<RetExp>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <RetExp>_N)
:: (RetExp -> TextBuilder) ~R# ToSQL RetExp)}]
$fToSQLRetExp
= $ctoSQL_s1Ob
`cast` (<RetExp>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <RetExp>_N)
:: (RetExp -> TextBuilder) ~R# ToSQL RetExp)
lvl_s1Qz :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
lvl_s1Qz = "SET"#
lvl_s1OC :: TextBuilder
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 60 10}]
lvl_s1OC
= case $wgo1 (unpackCString# lvl_s1Qz) of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR
}
Rec {
go1_s1QB [Occ=LoopBreaker] :: [SetExpItem] -> [Builder]
[LclId,
Arity=1,
Str=<1L>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 70 20}]
go1_s1QB
= \ (ds_a1Qc [Dmd=1L] :: [SetExpItem]) ->
case ds_a1Qc of {
[] -> [] @Builder;
: y_a1Qf [Dmd=M!P(L)] ys_a1Qg [Dmd=ML] ->
: @Builder
($ctoSQL_a1BE
(y_a1Qf `cast` (N:SetExpItem[0] :: SetExpItem ~R# SQLExp)))
(go1_s1QB ys_a1Qg)
}
end Rec }
$ctoSQL_s1Oc :: SetExp -> TextBuilder
[LclId,
Arity=1,
Str=<1L>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER}]
$ctoSQL_s1Oc
= \ (ds_d1DJ [Dmd=1L] :: SetExp) ->
case lvl_s1OC of
{ TextBuilder ww_a1OX [Dmd=LCL(C1(C1(!P(L,A))))] ww1_a1OY
ww2_a1OZ ->
case ds_d1DJ `cast` (N:SetExp[0] :: SetExp ~R# [SetExpItem]) of {
[] ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(# ipv_a1Pb, () #)
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
ww1_a1OY
ww2_a1OZ;
: x_a1bk [Dmd=1!P(L)] xs_a1bl [Dmd=1L] ->
case x_a1bk `cast` (N:SetExpItem[0] :: SetExpItem ~R# SQLExp) of
{ SEPrep bx_d1E0 ->
case <# bx_d1E0 0# of {
__DEFAULT ->
case $wgo1 ($fShow(,)_itos' bx_d1E0 ([] @Char)) of
{ (# ww_a1OP [Dmd=1CL(C1(C1(!P(L,A))))], ww1_a1OQ, ww2_a1OR #) ->
case ww_a1OP
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PN [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
case $wgo2
((go1_s1QB xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(L)))], ww1_a1Pl, ww2_a1Pm #) ->
TextBuilder
((\ (@s_X8)
(array_X9 :: MArray s_X8)
(offset_Xa :: Int)
(s1_Xb :: State# s_X8) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_X8 array_X9 offset_Xa)
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
s1_Xb
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_Xd :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 21 10}]
offset_Xd
= case offset_Xa of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OY) } } in
case ((nt_s1PN @s_X8 array_X9 offset_Xd)
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
ipv_a1Pb
of
{ (# ipv_Xf, ipv1_Xg [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_X8
array_X9
(case offset_Xd of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OQ) }))
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
ipv_Xf
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_a1OQ ww1_a1Pl))
(+# ww2_a1OZ (+# ww2_a1OR ww2_a1Pm))
}
}
};
1# ->
case bx_d1E0 of wild_a1Ik {
__DEFAULT ->
case $wgo1
(: @Char
$fShow(,)9
($fShow(,)_itos' (negateInt# wild_a1Ik) ([] @Char)))
of
{ (# ww_a1OP [Dmd=1CL(C1(C1(!P(L,A))))], ww1_a1OQ, ww2_a1OR #) ->
case ww_a1OP
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PN [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
case $wgo2
((go1_s1QB xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(L)))], ww1_a1Pl, ww2_a1Pm #) ->
TextBuilder
((\ (@s_X8)
(array_X9 :: MArray s_X8)
(offset_Xa :: Int)
(s1_Xb :: State# s_X8) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_X8 array_X9 offset_Xa)
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
s1_Xb
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_Xd :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 21 10}]
offset_Xd
= case offset_Xa of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OY) } } in
case ((nt_s1PN @s_X8 array_X9 offset_Xd)
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
ipv_a1Pb
of
{ (# ipv_Xf, ipv1_Xg [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_X8
array_X9
(case offset_Xd of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OQ) }))
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
ipv_Xf
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_a1OQ ww1_a1Pl))
(+# ww2_a1OZ (+# ww2_a1OR ww2_a1Pm))
}
}
};
-9223372036854775808# ->
case $wgo1 lvl_s1Om of
{ (# ww_a1OP [Dmd=1CL(C1(C1(!P(L,A))))], ww1_a1OQ, ww2_a1OR #) ->
case ww_a1OP
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PN [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
case $wgo2
((go1_s1QB xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(L)))], ww1_a1Pl, ww2_a1Pm #) ->
TextBuilder
((\ (@s_X8)
(array_X9 :: MArray s_X8)
(offset_Xa :: Int)
(s1_Xb :: State# s_X8) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_X8 array_X9 offset_Xa)
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
s1_Xb
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_Xd :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 21 10}]
offset_Xd
= case offset_Xa of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OY) } } in
case ((nt_s1PN @s_X8 array_X9 offset_Xd)
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
ipv_a1Pb
of
{ (# ipv_Xf, ipv1_Xg [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_X8
array_X9
(case offset_Xd of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OQ) }))
`cast` (N:ST[0] <s_X8>_N <()>_R :: ST s_X8 () ~R# STRep s_X8 ()))
ipv_Xf
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_a1OQ ww1_a1Pl))
(+# ww2_a1OZ (+# ww2_a1OR ww2_a1Pm))
}
}
}
}
}
}
}
}
$fToSQLSetExp [InlPrag=INLINE (sat-args=0)] :: ToSQL SetExp
[LclIdX[DFunId(nt)],
Arity=1,
Str=<1L>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_s1Oc
`cast` (<SetExp>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <SetExp>_N)
:: (SetExp -> TextBuilder) ~R# ToSQL SetExp)}]
$fToSQLSetExp
= $ctoSQL_s1Oc
`cast` (<SetExp>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <SetExp>_N)
:: (SetExp -> TextBuilder) ~R# ToSQL SetExp)
lvl_s1QG :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
lvl_s1QG = "FROM"#
lvl_s1OF :: TextBuilder
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 60 10}]
lvl_s1OF
= case $wgo1 (unpackCString# lvl_s1QG) of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR
}
$ctoSQL_s1Od :: FromExp -> TextBuilder
[LclId,
Arity=1,
Str=<1L>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 120 10}]
$ctoSQL_s1Od
= \ (ds_d1DL [Dmd=1L] :: FromExp) ->
case lvl_s1OF of
{ TextBuilder ww_a1OX [Dmd=LCL(C1(C1(!P(L,A))))] ww1_a1OY
ww2_a1OZ ->
case ds_d1DL `cast` (N:FromExp[0] :: FromExp ~R# [FromItem]) of {
[] ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(# ipv_a1Pb, () #)
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
ww1_a1OY
ww2_a1OZ;
: x_a1bk [Dmd=B] xs_a1bl [Dmd=B] ->
case $ctoSQL_a1ov of wild_00 { }
}
}
$fToSQLFromExp [InlPrag=INLINE (sat-args=0)] :: ToSQL FromExp
[LclIdX[DFunId(nt)],
Arity=1,
Str=<1L>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_s1Od
`cast` (<FromExp>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <FromExp>_N)
:: (FromExp -> TextBuilder) ~R# ToSQL FromExp)}]
$fToSQLFromExp
= $ctoSQL_s1Od
`cast` (<FromExp>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <FromExp>_N)
:: (FromExp -> TextBuilder) ~R# ToSQL FromExp)
lvl_s1QH :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
lvl_s1QH = "UPDATE"#
lvl_s1OJ :: TextBuilder
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 60 10}]
lvl_s1OJ
= case $wgo1 (unpackCString# lvl_s1QH) of
{ (# ww_a1OP, ww1_a1OQ, ww2_a1OR #) ->
TextBuilder ww_a1OP ww1_a1OQ ww2_a1OR
}
$ctoSQL_s1Oh :: SQLUpdate -> TextBuilder
[LclId,
Arity=1,
Str=<1!P(1L,1L,1L,1L)>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER}]
$ctoSQL_s1Oh
= \ (a_a13J [Dmd=1!P(1L,1L,1L,1L)] :: SQLUpdate) ->
case lvl_s1OJ of
{ TextBuilder ww_a1OX [Dmd=LCL(C1(C1(!P(L,A))))] ww1_a1OY
ww2_a1OZ ->
case lvl_s1OC of
{ TextBuilder ww_X2 [Dmd=LCL(C1(C1(!P(L,A))))] ww1_X3 ww2_X4 ->
case a_a13J of
{ SQLUpdate ds_d1Dk [Dmd=1L] ds_d1Dl [Dmd=1L] ds_d1Dm [Dmd=1L]
ds_d1Dn [Dmd=1L] ->
join {
$s$j_s1Rq
:: Int#
-> Int#
-> ((forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
[LclId[JoinId(3)(Just [])],
Arity=3,
Str=<L><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER}]
$s$j_s1Rq (sc_s1Rd [OS=OneShot] :: Int#)
(sc_s1Rc [OS=OneShot] :: Int#)
(sg_s1Rb
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
= join {
$s$j_s1RF
:: Int#
-> Int#
-> ((forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
[LclId[JoinId(3)(Just [])],
Arity=3,
Str=<L><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER}]
$s$j_s1RF (sc_s1RA [OS=OneShot] :: Int#)
(sc_s1Rz [OS=OneShot] :: Int#)
(sg_s1Ry
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
= join {
$j_s1PG :: Action -> Int# -> Int# -> TextBuilder
[LclId[JoinId(3)(Nothing)],
Arity=3,
Str=<1CL(C1(C1(P(L,A))))><L><L> {d1Dn->1L},
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 0 0] 654 20}]
$j_s1PG (ww_Xc [Dmd=1CL(C1(C1(P(L,A)))), OS=OneShot] :: Action)
(ww1_Xd [OS=OneShot] :: Int#)
(ww2_Xe [OS=OneShot] :: Int#)
= case ww_Xc
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PQ [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 sc_s1Rc } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
case ((nt_s1PQ
@s_a1P2
array_a1P3
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1Rz)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xl
of
{ (# ipv_Xu, ipv1_Xv [Dmd=A] #) ->
(# ipv_Xu, () #)
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1Rz ww1_Xd)))
(+# ww2_a1OZ (+# (+# ww2_X4 sc_s1Rd) (+# sc_s1RA ww2_Xe)));
Just a_a1ay [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xi [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xj ww2_Xk ->
case a_a1ay `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xm)
(array_Xn :: MArray s_Xm)
(offset_Xo :: Int)
(s1_Xp :: State# s_Xm) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_Xo)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
s1_Xp
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xo of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pz)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_a1Pb
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
let {
offset_s1Pv :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 22 10}]
offset_s1Pv
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1Rz)
} } in
case ((nt_s1PQ @s_Xm array_Xn offset_s1Pv)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xr
of
{ (# ipv_XA, ipv1_XB [Dmd=A] #) ->
case (((ww_Xi
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm
array_Xn
(case offset_s1Pv of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xd)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_XA
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1Rz (+# ww1_Xd ww1_Xj))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 sc_s1Rd) (+# sc_s1RA (+# ww2_Xe ww2_Xk))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
}
} } in
case ds_d1Dm of {
Nothing ->
let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 sc_s1Rc } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
(# ipv_Xl, () #)
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 sc_s1Rz))
(+# ww2_a1OZ (+# (+# ww2_X4 sc_s1Rd) sc_s1RA));
Just a_a1ay [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xi [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xj ww2_Xk ->
case a_a1ay `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xm)
(array_Xn :: MArray s_Xm)
(offset_Xo :: Int)
(s1_Xp :: State# s_Xm) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_Xo)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
s1_Xp
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xo of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pz)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_a1Pb
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
let {
offset_s1Pv :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 22 10}]
offset_s1Pv
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1Rz)
} } in
case (((ww_Xi
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pv)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xr
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1Rz ww1_Xj)))
(+# ww2_a1OZ (+# (+# ww2_X4 sc_s1Rd) (+# sc_s1RA ww2_Xk)));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
};
Just a_a1ay [Dmd=A] ->
case lvl_s1Ok of
{ TextBuilder ww_Xe [Dmd=1CL(C1(C1(P(L,A))))] ww1_Xf ww2_Xg ->
let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 sc_s1Rc } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
case (((ww_Xe
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2
array_a1P3
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1Rz)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xl
of
{ (# ipv_Xu, ipv1_Xv [Dmd=A] #) ->
(# ipv_Xu, () #)
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1Rz ww1_Xf)))
(+# ww2_a1OZ (+# (+# ww2_X4 sc_s1Rd) (+# sc_s1RA ww2_Xg)));
Just a_Xi [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xk [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xl ww2_Xm ->
case a_Xi `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xo)
(array_Xp :: MArray s_Xo)
(offset_Xq :: Int)
(s1_Xr :: State# s_Xo) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xo array_Xp offset_Xq)
`cast` (N:ST[0] <s_Xo>_N <()>_R
:: ST s_Xo () ~R# STRep s_Xo ()))
s1_Xr
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xq of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xo array_Xp offset_s1Pz)
`cast` (N:ST[0] <s_Xo>_N <()>_R
:: ST s_Xo () ~R# STRep s_Xo ()))
ipv_a1Pb
of
{ (# ipv_Xt, ipv1_Xu [Dmd=A] #) ->
let {
offset_s1Pv :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 22 10}]
offset_s1Pv
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1Rz)
} } in
case (((ww_Xe
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xo array_Xp offset_s1Pv)
`cast` (N:ST[0] <s_Xo>_N <()>_R
:: ST s_Xo () ~R# STRep s_Xo ()))
ipv_Xt
of
{ (# ipv_XA, ipv1_XB [Dmd=A] #) ->
case (((ww_Xk
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xo
array_Xp
(case offset_s1Pv of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xf)
}))
`cast` (N:ST[0] <s_Xo>_N <()>_R
:: ST s_Xo () ~R# STRep s_Xo ()))
ipv_XA
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1Rz (+# ww1_Xf ww1_Xl))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 sc_s1Rd) (+# sc_s1RA (+# ww2_Xg ww2_Xm))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
}
}
} } in
join {
$j_s1PH :: Action -> Int# -> Int# -> TextBuilder
[LclId[JoinId(3)(Nothing)],
Arity=3,
Str=<1CL(C1(C1(P(L,A))))><L><L> {d1Dm->1L d1Dn->1L},
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER},
RULES: "SC:$j0"
forall (sc_s1RA :: Int#)
(sc_s1Rz :: Int#)
(sg_s1Ry
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action).
$j_s1PH ($fMonoidBuilder3
`cast` (sg_s1Rb
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action))
sc_s1Rz
sc_s1RA
= jump $s$j_s1RF
sc_s1RA
sc_s1Rz
@~(sg_s1Ry
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)]
$j_s1PH (ww_X8 [Dmd=1CL(C1(C1(P(L,A)))), OS=OneShot] :: Action)
(ww1_X9 [OS=OneShot] :: Int#)
(ww2_Xa [OS=OneShot] :: Int#)
= case ww_X8
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PP [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
join {
$s$j_s1Rx
:: Int#
-> Int#
-> ((forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
[LclId[JoinId(3)(Just [])],
Arity=3,
Str=<L><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0] 643 20}]
$s$j_s1Rx (sc_s1Rt [OS=OneShot] :: Int#)
(sc_s1Rs [OS=OneShot] :: Int#)
(sg_s1Rr
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
= let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 sc_s1Rc } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
case ((nt_s1PP
@s_a1P2
array_a1P3
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xl
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
(# ipv_Xr, () #)
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_X9 sc_s1Rs)))
(+# ww2_a1OZ (+# (+# ww2_X4 sc_s1Rd) (+# ww2_Xa sc_s1Rt)));
Just a_a1ay [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xi [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xj ww2_Xk ->
case a_a1ay `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xm)
(array_Xn :: MArray s_Xm)
(offset_Xo :: Int)
(s1_Xp :: State# s_Xm) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_Xo)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
s1_Xp
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xo of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pz)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_a1Pb
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
let {
offset_s1Px :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Px
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
} } in
case ((nt_s1PP @s_Xm array_Xn offset_s1Px)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xr
of
{ (# ipv_Xx, ipv1_Xy [Dmd=A] #) ->
case (((ww_Xi
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm
array_Xn
(case offset_s1Px of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X9) sc_s1Rs)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xx
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_X9 (+# sc_s1Rs ww1_Xj))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 sc_s1Rd) (+# ww2_Xa (+# sc_s1Rt ww2_Xk))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
} } in
join {
$j_s1PG :: Action -> Int# -> Int# -> TextBuilder
[LclId[JoinId(3)(Nothing)],
Arity=3,
Str=<1CL(C1(C1(P(L,A))))><L><L> {d1Dn->1L},
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER},
RULES: "SC:$j0"
forall (sc_s1Rt :: Int#)
(sc_s1Rs :: Int#)
(sg_s1Rr
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action).
$j_s1PG ($fMonoidBuilder3
`cast` (sg_s1Rb
:: (forall {s}.
MArray s
-> Int -> State# s -> (# State# s, () #))
~R# Action))
sc_s1Rs
sc_s1Rt
= jump $s$j_s1Rx
sc_s1Rt
sc_s1Rs
@~(sg_s1Rr
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)]
$j_s1PG (ww_Xc [Dmd=1CL(C1(C1(P(L,A)))), OS=OneShot] :: Action)
(ww1_Xd [OS=OneShot] :: Int#)
(ww2_Xe [OS=OneShot] :: Int#)
= case ww_Xc
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PQ [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 sc_s1Rc } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
let {
offset_s1Px :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Px
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
} } in
case ((nt_s1PP @s_a1P2 array_a1P3 offset_s1Px)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xl
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
case ((nt_s1PQ
@s_a1P2
array_a1P3
(case offset_s1Px of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X9)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xr
of
{ (# ipv_Xu, ipv1_Xv [Dmd=A] #) ->
(# ipv_Xu, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_X9 ww1_Xd)))
(+# ww2_a1OZ (+# (+# ww2_X4 sc_s1Rd) (+# ww2_Xa ww2_Xe)));
Just a_a1ay [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xi [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xj ww2_Xk ->
case a_a1ay `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xm)
(array_Xn :: MArray s_Xm)
(offset_Xo :: Int)
(s1_Xp :: State# s_Xm) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_Xo)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
s1_Xp
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xo of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pz)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_a1Pb
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
let {
offset_s1Px :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Px
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
} } in
case ((nt_s1PP @s_Xm array_Xn offset_s1Px)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xr
of
{ (# ipv_Xx, ipv1_Xy [Dmd=A] #) ->
let {
offset_s1Pv :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pv
= case offset_s1Px of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X9)
} } in
case ((nt_s1PQ @s_Xm array_Xn offset_s1Pv)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xx
of
{ (# ipv_XA, ipv1_XB [Dmd=A] #) ->
case (((ww_Xi
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm
array_Xn
(case offset_s1Pv of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xd)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_XA
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_X9 (+# ww1_Xd ww1_Xj))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 sc_s1Rd) (+# ww2_Xa (+# ww2_Xe ww2_Xk))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
}
} } in
case ds_d1Dm of {
Nothing ->
jump $j_s1PG
($fMonoidBuilder3
`cast` (sg_s1Rb
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action))
0#
0#;
Just a_a1ay [Dmd=A] ->
case lvl_s1Ok of
{ TextBuilder ww_Xe [Dmd=1CL(C1(C1(P(L,A))))] ww1_Xf ww2_Xg ->
jump $j_s1PG ww_Xe ww1_Xf ww2_Xg
}
}
} } in
case ds_d1Dl of {
Nothing ->
jump $j_s1PH
($fMonoidBuilder3
`cast` (sg_s1Rb
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action))
0#
0#;
Just a_a1ay [Dmd=1L] ->
case lvl_s1OF of
{ TextBuilder ww_Xa [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xb ww2_Xc ->
case a_a1ay `cast` (N:FromExp[0] :: FromExp ~R# [FromItem]) of {
[] ->
jump $j_s1PH
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 [OS=OneShot] :: Int)
(s1_a1P5 [OS=OneShot] :: State# s_a1P2) ->
case (((ww_Xa
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(# ipv_a1Pb, () #)
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
ww1_Xb
ww2_Xc;
: x_a1bk [Dmd=B] xs_a1bl [Dmd=B] ->
case $ctoSQL_a1ov of wild_00 { }
}
}
} } in
join {
$j_s1PJ :: Action -> Int# -> Int# -> TextBuilder
[LclId[JoinId(3)(Nothing)],
Arity=3,
Str=<1CL(C1(C1(P(L,A))))><L><L> {d1Dl->1L d1Dm->1L d1Dn->1L},
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER},
RULES: "SC:$j0"
forall (sc_s1Rd :: Int#)
(sc_s1Rc :: Int#)
(sg_s1Rb
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action).
$j_s1PJ ($fMonoidBuilder3
`cast` (sg_s1Rb
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action))
sc_s1Rc
sc_s1Rd
= jump $s$j_s1Rq
sc_s1Rd
sc_s1Rc
@~(sg_s1Rb
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)]
$j_s1PJ (ww3_a1P6 [Dmd=1CL(C1(C1(P(L,A)))), OS=OneShot] :: Action)
(ww4_a1P7 [OS=OneShot] :: Int#)
(ww5_a1P8 [OS=OneShot] :: Int#)
= case ww3_a1P6
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PO [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
join {
$s$j_s1R3
:: Int#
-> Int#
-> ((forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
[LclId[JoinId(3)(Just [])],
Arity=3,
Str=<L><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER}]
$s$j_s1R3 (sc_s1QY [OS=OneShot] :: Int#)
(sc_s1QX [OS=OneShot] :: Int#)
(sg_s1QW
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
= join {
$s$j_s1Ra
:: Int#
-> Int#
-> ((forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
[LclId[JoinId(3)(Just [])],
Arity=3,
Str=<L><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0] 634 20}]
$s$j_s1Ra (sc_s1R6 [OS=OneShot] :: Int#)
(sc_s1R5 [OS=OneShot] :: Int#)
(sg_s1R4
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
= let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 ww4_a1P7 } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
case ((nt_s1PO
@s_a1P2
array_a1P3
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xl
of
{ (# ipv_Xo, ipv1_Xp [Dmd=A] #) ->
(# ipv_Xo, () #)
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1QX sc_s1R5)))
(+# ww2_a1OZ (+# (+# ww2_X4 ww5_a1P8) (+# sc_s1QY sc_s1R6)));
Just a_a1ay [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xi [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xj ww2_Xk ->
case a_a1ay `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xm)
(array_Xn :: MArray s_Xm)
(offset_Xo :: Int)
(s1_Xp :: State# s_Xm) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_Xo)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
s1_Xp
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xo of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pz)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_a1Pb
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
case ((nt_s1PO
@s_Xm
array_Xn
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xr
of
{ (# ipv_Xu, ipv1_Xv [Dmd=A] #) ->
case (((ww_Xi
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm
array_Xn
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# (+# x_a1Pf ww1_X7) sc_s1QX) sc_s1R5)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xu
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1QX (+# sc_s1R5 ww1_Xj))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 ww5_a1P8) (+# sc_s1QY (+# sc_s1R6 ww2_Xk))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
} } in
join {
$j_s1PG :: Action -> Int# -> Int# -> TextBuilder
[LclId[JoinId(3)(Nothing)],
Arity=3,
Str=<1CL(C1(C1(P(L,A))))><L><L> {d1Dn->1L},
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER},
RULES: "SC:$j0"
forall (sc_s1R6 :: Int#)
(sc_s1R5 :: Int#)
(sg_s1R4
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action).
$j_s1PG ($fMonoidBuilder3
`cast` (sg_s1QW
:: (forall {s}.
MArray s
-> Int -> State# s -> (# State# s, () #))
~R# Action))
sc_s1R5
sc_s1R6
= jump $s$j_s1Ra
sc_s1R6
sc_s1R5
@~(sg_s1R4
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)]
$j_s1PG (ww_Xc [Dmd=1CL(C1(C1(P(L,A)))), OS=OneShot] :: Action)
(ww1_Xd [OS=OneShot] :: Int#)
(ww2_Xe [OS=OneShot] :: Int#)
= case ww_Xc
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PQ [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 ww4_a1P7 } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 :: Int)
(s1_a1P5 :: State# s_a1P2) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_a1P4 of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_s1Pz)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
of
{ (# ipv_Xl, ipv1_Xm [Dmd=A] #) ->
case ((nt_s1PO
@s_a1P2
array_a1P3
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xl
of
{ (# ipv_Xo, ipv1_Xp [Dmd=A] #) ->
case ((nt_s1PQ
@s_a1P2
array_a1P3
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1QX)
}))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_Xo
of
{ (# ipv_Xu, ipv1_Xv [Dmd=A] #) ->
(# ipv_Xu, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1QX ww1_Xd)))
(+# ww2_a1OZ (+# (+# ww2_X4 ww5_a1P8) (+# sc_s1QY ww2_Xe)));
Just a_a1ay [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xi [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xj ww2_Xk ->
case a_a1ay `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xm)
(array_Xn :: MArray s_Xm)
(offset_Xo :: Int)
(s1_Xp :: State# s_Xm) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_Xo)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
s1_Xp
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xo of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm array_Xn offset_s1Pz)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_a1Pb
of
{ (# ipv_Xr, ipv1_Xs [Dmd=A] #) ->
case ((nt_s1PO
@s_Xm
array_Xn
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xr
of
{ (# ipv_Xu, ipv1_Xv [Dmd=A] #) ->
let {
offset_s1Pv :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 22 10}]
offset_s1Pv
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_X7) sc_s1QX)
} } in
case ((nt_s1PQ @s_Xm array_Xn offset_s1Pv)
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_Xu
of
{ (# ipv_XA, ipv1_XB [Dmd=A] #) ->
case (((ww_Xi
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xm
array_Xn
(case offset_s1Pv of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xd)
}))
`cast` (N:ST[0] <s_Xm>_N <()>_R
:: ST s_Xm () ~R# STRep s_Xm ()))
ipv_XA
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# sc_s1QX (+# ww1_Xd ww1_Xj))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 ww5_a1P8) (+# sc_s1QY (+# ww2_Xe ww2_Xk))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
}
} } in
case ds_d1Dm of {
Nothing ->
jump $j_s1PG
($fMonoidBuilder3
`cast` (sg_s1QW
:: (forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action))
0#
0#;
Just a_a1ay [Dmd=A] ->
case lvl_s1Ok of
{ TextBuilder ww_Xe [Dmd=1CL(C1(C1(P(L,A))))] ww1_Xf ww2_Xg ->
jump $j_s1PG ww_Xe ww1_Xf ww2_Xg
}
} } in
case ds_d1Dl of {
Nothing ->
jump $s$j_s1R3
0#
0#
@~(forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action);
Just a_a1ay [Dmd=1L] ->
case lvl_s1OF of
{ TextBuilder ww_Xa [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xb ww2_Xc ->
case a_a1ay `cast` (N:FromExp[0] :: FromExp ~R# [FromItem]) of {
[] ->
let {
nt_s1RV :: forall {s}. MArray s -> Int -> STRep s ()
[LclId,
Arity=3,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0] 50 10}]
nt_s1RV
= \ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 [OS=OneShot] :: Int)
(s1_a1P5 [OS=OneShot] :: State# s_a1P2) ->
case (((ww_Xa
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(# ipv_a1Pb, () #)
} } in
join {
$s$j_s1QV
:: Int#
-> Int#
-> ((forall {s}. MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
-> TextBuilder
[LclId[JoinId(3)(Just [])],
Arity=3,
Str=<L><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=NEVER}]
$s$j_s1QV (sc_s1QR [OS=OneShot] :: Int#)
(sc_s1QQ [OS=OneShot] :: Int#)
(sg_s1QP
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, () #))
~R# Action)
= let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 ww4_a1P7 } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_Xh)
(array_Xi :: MArray s_Xh)
(offset_Xj :: Int)
(s1_Xk :: State# s_Xh) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xh array_Xi offset_Xj)
`cast` (N:ST[0] <s_Xh>_N <()>_R
:: ST s_Xh () ~R# STRep s_Xh ()))
s1_Xk
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xj of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xh array_Xi offset_s1Pz)
`cast` (N:ST[0] <s_Xh>_N <()>_R
:: ST s_Xh () ~R# STRep s_Xh ()))
ipv_a1Pb
of
{ (# ipv_Xm, ipv1_Xn [Dmd=A] #) ->
case ((nt_s1PO
@s_Xh
array_Xi
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_Xh>_N <()>_R
:: ST s_Xh () ~R# STRep s_Xh ()))
ipv_Xm
of
{ (# ipv_Xp, ipv1_Xq [Dmd=A] #) ->
case (((ww_Xa
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xh
array_Xi
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
}))
`cast` (N:ST[0] <s_Xh>_N <()>_R
:: ST s_Xh () ~R# STRep s_Xh ()))
ipv_Xp
of
{ (# ipv_Xs, ipv1_Xt [Dmd=A] #) ->
(# ipv_Xs, () #)
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_Xb sc_s1QQ)))
(+# ww2_a1OZ (+# (+# ww2_X4 ww5_a1P8) (+# ww2_Xc sc_s1QR)));
Just a_Xh [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xj [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xk ww2_Xl ->
case a_Xh `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xn)
(array_Xo :: MArray s_Xn)
(offset_Xp :: Int)
(s1_Xq :: State# s_Xn) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xn array_Xo offset_Xp)
`cast` (N:ST[0] <s_Xn>_N <()>_R
:: ST s_Xn () ~R# STRep s_Xn ()))
s1_Xq
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xp of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xn array_Xo offset_s1Pz)
`cast` (N:ST[0] <s_Xn>_N <()>_R
:: ST s_Xn () ~R# STRep s_Xn ()))
ipv_a1Pb
of
{ (# ipv_Xs, ipv1_Xt [Dmd=A] #) ->
case ((nt_s1PO
@s_Xn
array_Xo
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_Xn>_N <()>_R
:: ST s_Xn () ~R# STRep s_Xn ()))
ipv_Xs
of
{ (# ipv_Xv, ipv1_Xw [Dmd=A] #) ->
let {
offset_s1Px :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Px
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
} } in
case (((ww_Xa
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xn array_Xo offset_s1Px)
`cast` (N:ST[0] <s_Xn>_N <()>_R
:: ST s_Xn () ~R# STRep s_Xn ()))
ipv_Xv
of
{ (# ipv_Xy, ipv1_Xz [Dmd=A] #) ->
case (((ww_Xj
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xn
array_Xo
(case offset_s1Px of { I# x_a1Pf ->
I# (+# (+# x_a1Pf ww1_Xb) sc_s1QQ)
}))
`cast` (N:ST[0] <s_Xn>_N <()>_R
:: ST s_Xn () ~R# STRep s_Xn ()))
ipv_Xy
of
{ (# ipv_XD, ipv1_XE [Dmd=A] #) ->
(# ipv_XD, () #)
}
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_Xb (+# sc_s1QQ ww1_Xk))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 ww5_a1P8) (+# ww2_Xc (+# sc_s1QR ww2_Xl))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
} } in
case ds_d1Dm of {
Nothing ->
jump $s$j_s1QV
0#
0#
@~(forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action);
Just a_Xf [Dmd=A] ->
case lvl_s1Ok of
{ TextBuilder ww_Xh [Dmd=1CL(C1(C1(P(L,A))))] ww1_Xi ww2_Xj ->
let {
ww1_X7 :: Int#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 1 0}]
ww1_X7 = +# ww1_X3 ww4_a1P7 } in
case ds_d1Dn of {
Nothing ->
TextBuilder
((\ (@s_Xl)
(array_Xm :: MArray s_Xl)
(offset_Xn :: Int)
(s1_Xo :: State# s_Xl) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xl array_Xm offset_Xn)
`cast` (N:ST[0] <s_Xl>_N <()>_R
:: ST s_Xl () ~R# STRep s_Xl ()))
s1_Xo
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xn of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xl array_Xm offset_s1Pz)
`cast` (N:ST[0] <s_Xl>_N <()>_R
:: ST s_Xl () ~R# STRep s_Xl ()))
ipv_a1Pb
of
{ (# ipv_Xq, ipv1_Xr [Dmd=A] #) ->
case ((nt_s1PO
@s_Xl
array_Xm
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_Xl>_N <()>_R
:: ST s_Xl () ~R# STRep s_Xl ()))
ipv_Xq
of
{ (# ipv_Xt, ipv1_Xu [Dmd=A] #) ->
let {
offset_s1Px :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Px
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
} } in
case (((ww_Xa
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xl array_Xm offset_s1Px)
`cast` (N:ST[0] <s_Xl>_N <()>_R
:: ST s_Xl () ~R# STRep s_Xl ()))
ipv_Xt
of
{ (# ipv_Xw, ipv1_Xx [Dmd=A] #) ->
case (((ww_Xh
`cast` (N:Action[0]
:: Action
~R# (forall s. MArray s -> Int -> ST s ())))
@s_Xl
array_Xm
(case offset_s1Px of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xb)
}))
`cast` (N:ST[0] <s_Xl>_N <()>_R
:: ST s_Xl () ~R# STRep s_Xl ()))
ipv_Xw
of
{ (# ipv_Xz, ipv1_XA [Dmd=A] #) ->
(# ipv_Xz, () #)
}
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_Xb ww1_Xi)))
(+# ww2_a1OZ (+# (+# ww2_X4 ww5_a1P8) (+# ww2_Xc ww2_Xj)));
Just a_Xl [Dmd=1L] ->
case lvl_s1Oz of
{ TextBuilder ww_Xn [Dmd=LCL(C1(C1(!P(L,A))))] ww1_Xo ww2_Xp ->
case a_Xl `cast` (N:RetExp[0] :: RetExp ~R# [Extractor]) of {
[] ->
TextBuilder
((\ (@s_Xr)
(array_Xs :: MArray s_Xr)
(offset_Xt :: Int)
(s1_Xu :: State# s_Xr) ->
case (((ww_a1OX
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xr array_Xs offset_Xt)
`cast` (N:ST[0] <s_Xr>_N <()>_R
:: ST s_Xr () ~R# STRep s_Xr ()))
s1_Xu
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
let {
offset_s1Pz :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pz
= case offset_Xt of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_a1OY)
} } in
case (((ww_X2
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xr array_Xs offset_s1Pz)
`cast` (N:ST[0] <s_Xr>_N <()>_R
:: ST s_Xr () ~R# STRep s_Xr ()))
ipv_a1Pb
of
{ (# ipv_Xw, ipv1_Xx [Dmd=A] #) ->
case ((nt_s1PO
@s_Xr
array_Xs
(case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X3)
}))
`cast` (N:ST[0] <s_Xr>_N <()>_R
:: ST s_Xr () ~R# STRep s_Xr ()))
ipv_Xw
of
{ (# ipv_Xz, ipv1_XA [Dmd=A] #) ->
let {
offset_s1Px :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Px
= case offset_s1Pz of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_X7)
} } in
case (((ww_Xa
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xr array_Xs offset_s1Px)
`cast` (N:ST[0] <s_Xr>_N <()>_R
:: ST s_Xr () ~R# STRep s_Xr ()))
ipv_Xz
of
{ (# ipv_XC, ipv1_XD [Dmd=A] #) ->
let {
offset_s1Pv :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False,
ConLike=False, WorkFree=False, Expandable=False,
Guidance=IF_ARGS [] 21 10}]
offset_s1Pv
= case offset_s1Px of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xb)
} } in
case (((ww_Xh
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xr array_Xs offset_s1Pv)
`cast` (N:ST[0] <s_Xr>_N <()>_R
:: ST s_Xr () ~R# STRep s_Xr ()))
ipv_XC
of
{ (# ipv_XF, ipv1_XG [Dmd=A] #) ->
case (((ww_Xn
`cast` (N:Action[0]
:: Action
~R# (forall s.
MArray s -> Int -> ST s ())))
@s_Xr
array_Xs
(case offset_s1Pv of { I# x_a1Pf ->
I# (+# x_a1Pf ww1_Xi)
}))
`cast` (N:ST[0] <s_Xr>_N <()>_R
:: ST s_Xr () ~R# STRep s_Xr ()))
ipv_XF
of
{ (# ipv_XI, ipv1_XJ [Dmd=A] #) ->
(# ipv_XI, () #)
}
}
}
}
}
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ())
~R# Action))
(+# ww1_a1OY (+# ww1_X7 (+# ww1_Xb (+# ww1_Xi ww1_Xo))))
(+#
ww2_a1OZ
(+# (+# ww2_X4 ww5_a1P8) (+# ww2_Xc (+# ww2_Xj ww2_Xp))));
: x_a1bk [Dmd=1!B] xs_a1bl [Dmd=B] ->
case x_a1bk of { Extractor bx_d1DZ [Dmd=B] ->
case lvl_s1Ov of wild_00 { }
}
}
}
}
}
};
: x_a1bk [Dmd=B] xs_a1bl [Dmd=B] ->
case $ctoSQL_a1ov of wild_00 { }
}
}
}
} } in
case ds_d1Dk `cast` (N:SetExp[0] :: SetExp ~R# [SetExpItem]) of {
[] ->
jump $s$j_s1Rq
0#
0#
@~(forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action);
: x_a1bk [Dmd=1!P(L)] xs_a1bl [Dmd=1L] ->
case x_a1bk `cast` (N:SetExpItem[0] :: SetExpItem ~R# SQLExp) of
{ SEPrep bx_d1E0 ->
case <# bx_d1E0 0# of {
__DEFAULT ->
case $wgo1 ($fShow(,)_itos' bx_d1E0 ([] @Char)) of
{ (# ww_a1OP [Dmd=1CL(C1(C1(!P(L,A))))], ww1_a1OQ, ww2_a1OR #) ->
case ww_a1OP
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PS [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
case $wgo2
((go1_s1QB xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(P(L,A))))], ww1_a1Pl, ww2_a1Pm #) ->
jump $j_s1PJ
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 [OS=OneShot] :: Int)
(s1_a1P5 [OS=OneShot] :: State# s_a1P2) ->
case ((nt_s1PS @s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2
array_a1P3
(case offset_a1P4 of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OQ) }))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OQ ww1_a1Pl)
(+# ww2_a1OR ww2_a1Pm)
}
}
};
1# ->
case bx_d1E0 of wild_a1Ik {
__DEFAULT ->
case $wgo1
(: @Char
$fShow(,)9
($fShow(,)_itos' (negateInt# wild_a1Ik) ([] @Char)))
of
{ (# ww_a1OP [Dmd=1CL(C1(C1(!P(L,A))))], ww1_a1OQ, ww2_a1OR #) ->
case ww_a1OP
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PS [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
case $wgo2
((go1_s1QB xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(P(L,A))))], ww1_a1Pl, ww2_a1Pm #) ->
jump $j_s1PJ
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 [OS=OneShot] :: Int)
(s1_a1P5 [OS=OneShot] :: State# s_a1P2) ->
case ((nt_s1PS @s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2
array_a1P3
(case offset_a1P4 of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OQ) }))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OQ ww1_a1Pl)
(+# ww2_a1OR ww2_a1Pm)
}
}
};
-9223372036854775808# ->
case $wgo1 lvl_s1Om of
{ (# ww_a1OP [Dmd=1CL(C1(C1(!P(L,A))))], ww1_a1OQ, ww2_a1OR #) ->
case ww_a1OP
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ()))
of nt_s1PS [Dmd=LCL(CS(CS(!P(L,A))))]
{ __DEFAULT ->
case $wgo2
((go1_s1QB xs_a1bl)
`cast` (([N:Builder[0]])_R :: [Builder] ~R# [TextBuilder]))
of
{ (# ww_a1Pk [Dmd=LCL(C1(C1(P(L,A))))], ww1_a1Pl, ww2_a1Pm #) ->
jump $j_s1PJ
((\ (@s_a1P2)
(array_a1P3 :: MArray s_a1P2)
(offset_a1P4 [OS=OneShot] :: Int)
(s1_a1P5 [OS=OneShot] :: State# s_a1P2) ->
case ((nt_s1PS @s_a1P2 array_a1P3 offset_a1P4)
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
s1_a1P5
of
{ (# ipv_a1Pb, ipv1_a1Pc [Dmd=A] #) ->
(((ww_a1Pk
`cast` (N:Action[0]
:: Action ~R# (forall s. MArray s -> Int -> ST s ())))
@s_a1P2
array_a1P3
(case offset_a1P4 of { I# x_a1Pf -> I# (+# x_a1Pf ww1_a1OQ) }))
`cast` (N:ST[0] <s_a1P2>_N <()>_R
:: ST s_a1P2 () ~R# STRep s_a1P2 ()))
ipv_a1Pb
})
`cast` (forall (s :: <*>_N).
<MArray s>_R
%<'Many>_N ->_R <Int>_R
%<'Many>_N ->_R Sym (N:ST[0] <s>_N <()>_R)
; Sym (N:Action[0])
:: (forall {s}. MArray s -> Int -> STRep s ()) ~R# Action))
(+# ww1_a1OQ ww1_a1Pl)
(+# ww2_a1OR ww2_a1Pm)
}
}
}
}
}
}
}
}
}
}
$fToSQLSQLUpdate [InlPrag=INLINE (sat-args=0)] :: ToSQL SQLUpdate
[LclIdX[DFunId(nt)],
Arity=1,
Str=<1!P(1L,1L,1L,1L)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= $ctoSQL_s1Oh
`cast` (<SQLUpdate>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <SQLUpdate>_N)
:: (SQLUpdate -> TextBuilder) ~R# ToSQL SQLUpdate)}]
$fToSQLSQLUpdate
= $ctoSQL_s1Oh
`cast` (<SQLUpdate>_R %<'Many>_N ->_R Sym (N:Builder[0])
; Sym (N:ToSQL[0] <SQLUpdate>_N)
:: (SQLUpdate -> TextBuilder) ~R# ToSQL SQLUpdate)
*** End of Offense ***
<no location info>: error:
Compilation had errors
<no location info>: error: ExitFailure 1
```
</details>9.4.6https://gitlab.haskell.org/ghc/ghc/-/issues/24213"Unbound RULE binders" conditions too restrictive?2023-11-29T14:00:15ZBen Gamari"Unbound RULE binders" conditions too restrictive?While debugging a client project a colleague encountered Core Lint error after simplification:
```
*** Core Lint errors : in result of Simplifier ***
<no location info>: error: [-Werror]
Rule "SC:$j0": unbound [sg_svBxD]
In the ...While debugging a client project a colleague encountered Core Lint error after simplification:
```
*** Core Lint errors : in result of Simplifier ***
<no location info>: error: [-Werror]
Rule "SC:$j0": unbound [sg_svBxD]
In the RHS of $w$ctoSQL_svxsI :: ByteArray#
-> Int#
-> Int#
-> TableName
-> SetExp
-> Maybe FromExp
-> Maybe WhereFrag
-> Maybe RetExp
-> (# ArrayWriter, Int#, Int# #)
In the body of lambda with binder ww_svxsv :: ByteArray#
In the body of lambda with binder ww_svxsw :: Int#
In the body of lambda with binder ww_svxsx :: Int#
In the body of lambda with binder ww_svxsz :: TableName
In the body of lambda with binder ww_svxsB :: SetExp
In the body of lambda with binder ww_svxsC :: Maybe FromExp
In the body of lambda with binder ww_svxsD :: Maybe WhereFrag
In the body of lambda with binder ww_svxsE :: Maybe RetExp
In a case alternative: (TextBuilder ww_av2BQ :: ArrayWriter,
ww1_av2BR :: Int#,
ww2_av2BS :: Int#)
In a case alternative: ((#,,#) ww5_iv2AG :: ArrayWriter,
ww6_iv2AH :: Int#,
ww7_iv2AI :: Int#)
In a case alternative: ((#,,#) ww_svy6c :: ArrayWriter,
ww_svy6d :: Int#,
ww_svy6e :: Int#)
In the body of lambda with binder sc_svBxy :: Int#
In the body of lambda with binder sc_svBxx :: Int#
In the body of lambda with binder sg_svBxw :: (forall {s}.
MArray s
-> Int -> State# s -> (# State# s, Int #))
~R# ArrayWriter
In the body of letrec with binders $s$j_svBxQ :: Int#
-> Int#
-> ((forall {s}.
MArray s
-> Int -> State# s -> (# State# s, Int #))
~R# ArrayWriter) =>
(# ArrayWriter, Int#, Int# #)
In the body of lambda with binder ww_XoV :: ArrayWriter
In the body of lambda with binder ww1_XoW :: Int#
In the body of lambda with binder ww2_XoX :: Int#
In the body of letrec with binders $s$j_svBxJ :: Int#
-> Int#
-> ((forall {s}.
MArray s
-> Int -> State# s -> (# State# s, Int #))
~R# ArrayWriter) =>
(# ArrayWriter, Int#, Int# #)
In a rule attached to $j_sv2DD :: ArrayWriter
-> Int# -> Int# -> (# ArrayWriter, Int#, Int# #)
Substitution: <InScope = {sg_svBxw sg_svBxD}
IdSubst = []
TvSubst = []
CvSubst = [svBxw :-> sg_svBxw, svBxD :-> sg_svBxD]
```
As seen in the relevant Core (see below), the problem is the occurrence of an coercion variable in the RHS of a spec-constr rule which is *not* bound in the rule's LHS. This coercion witnesses the equality of the `ArrayWriter` newtype and its representation:
```haskell
newtype ArrayWriter
= ArrayWriter (forall s. TextArray.MArray s -> Int -> ST s Int)
```
The coercion variable appears to have arisen from the `(N:ArrayWriter[0] :: ArrayWriter ~R# (forall s. MArray s -> Int -> ST s Int))` coercion appearing in the unspecialised binding's RHS (perhaps introduced by SpecConstr itself? we are currently checking this). If SpecConstr is indeed the source of the coercion variable then this seems like a bug; afterall, there should be no need to abstract over closed coercions.
However, this also seems quite similar to the issue observed in `Note [Unbound RULE binders]`. Specifically, that Note specifies that we allow certain (namely, reflexive) coercion variables to occur in a rule's RHS despite being not bound by the LHS. The Note says that, while such occurrences are a bit strange, they are hard to avoid as the result of simplification.
The Core Lint offense suggests to me that the reflexivity restriction of `Note [Unbound RULE binders]` may be too strict: Newtype coercions seem just as benign as reflexive coercions. Sadly, I don't have a minimal reproducer to demonstrate the issue.
<details><summary>Binding and questionable rule</summary>
```haskell
...
join {
$j_sv2DD
:: ArrayWriter -> Int# -> Int# -> (# ArrayWriter, Int#, Int# #)
[LclId[JoinId(3)(Nothing)],
Arity=3,
Str=<SC(L,C(1,C(1,L)))><L><L>,
Unf=Unf{Src=<vanilla>, TopLvl=False,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
Guidance=IF_ARGS [20 0 0] 432 10},
RULES: "SC:$j0"
forall (sc_svBxF :: Int#)
(sc_svBxE :: Int#)
(sg_svBxD
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, Int #))
~R# ArrayWriter).
$j_sv2DD ($fMonoidBuilder3
`cast` (sg_svBxw
:: (forall {s}.
MArray s
-> Int -> State# s -> (# State# s, Int #))
~R# ArrayWriter))
sc_svBxE
sc_svBxF
= jump $s$j_svBxJ
sc_svBxF
sc_svBxE
@~(sg_svBxD
:: (forall {s}.
MArray s -> Int -> State# s -> (# State# s, Int #))
~R# ArrayWriter)]
$j_sv2DD (ww3_av2BZ [Dmd=SC(L,C(1,C(1,L))), OS=OneShot]
:: ArrayWriter)
(ww4_av2C0 [OS=OneShot] :: Int#)
(ww5_av2C1 [OS=OneShot] :: Int#)
= case ww3_av2BZ
`cast` (N:ArrayWriter[0]
:: ArrayWriter ~R# (forall s. MArray s -> Int -> ST s Int))
of nt_sv85q [Dmd=LC(S,C(S,C(S,L)))]
...
```
</details>
Full error: https://gitlab.haskell.org/ghc/ghc/-/snippets/5737https://gitlab.haskell.org/ghc/ghc/-/issues/14003Allow more worker arguments in SpecConstr2023-09-14T10:25:31ZchoenerzsAllow more worker arguments in SpecConstrStarting with GHC 8.2 (rc1 -- head) I noticed that the SpecConstr pass does not always optimize completely with SpecConstr-heavy code.
Setting ```-fmax-worker-args=100``` leads to complete specialization again.
However, given that code ...Starting with GHC 8.2 (rc1 -- head) I noticed that the SpecConstr pass does not always optimize completely with SpecConstr-heavy code.
Setting ```-fmax-worker-args=100``` leads to complete specialization again.
However, given that code annotated with ```SPEC``` should be optimized until no more ```SPEC``` arguments are alive, shouldn't ```callToNewPats``` in ```compiler/specialise/SpecConstr.hs``` specialize \*irrespective\* of the size of the worker argument list?
Code that actually fails to specialize is fairly large, hence no test case -- though I have some files with core output showing insufficient specialization.
(I'd be willing to write a patch for this)
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | -------------- |
| Version | 8.2.1-rc3 |
| Type | FeatureRequest |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"Allow more worker arguments in SpecConstr","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"8.2.2","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"8.2.1-rc3","keywords":["Fusion","JoinPoints,"],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"FeatureRequest","description":"Starting with GHC 8.2 (rc1 -- head) I noticed that the SpecConstr pass does not always optimize completely with SpecConstr-heavy code.\r\nSetting ```-fmax-worker-args=100``` leads to complete specialization again.\r\n\r\nHowever, given that code annotated with ```SPEC``` should be optimized until no more ```SPEC``` arguments are alive, shouldn't ```callToNewPats``` in ```compiler/specialise/SpecConstr.hs``` specialize *irrespective* of the size of the worker argument list?\r\n\r\nCode that actually fails to specialize is fairly large, hence no test case -- though I have some files with core output showing insufficient specialization.\r\n\r\n(I'd be willing to write a patch for this)","type_of_failure":"OtherFailure","blocking":[]} -->9.10.1https://gitlab.haskell.org/ghc/ghc/-/issues/23267Core Lint error with SpecConstr + interpreter2023-07-12T13:42:42ZKrzysztof GogolewskiCore Lint error with SpecConstr + interpreterThis is a Core Lint error found during investigation of #22956.
To reproduce: compile `master` enabling optimisations for the interpreter:
```diff
diff --git a/compiler/GHC/Driver/Backend.hs b/compiler/GHC/Driver/Backend.hs
index e59f0...This is a Core Lint error found during investigation of #22956.
To reproduce: compile `master` enabling optimisations for the interpreter:
```diff
diff --git a/compiler/GHC/Driver/Backend.hs b/compiler/GHC/Driver/Backend.hs
index e59f0a51f7..4663924599 100644
--- a/compiler/GHC/Driver/Backend.hs
+++ b/compiler/GHC/Driver/Backend.hs
@@ -710,7 +710,7 @@ backendForcesOptimization0 (Named NCG) = False
backendForcesOptimization0 (Named LLVM) = False
backendForcesOptimization0 (Named ViaC) = False
backendForcesOptimization0 (Named JavaScript) = False
-backendForcesOptimization0 (Named Interpreter) = True
+backendForcesOptimization0 (Named Interpreter) = False
backendForcesOptimization0 (Named NoBackend) = False
-- | I don't understand exactly how this works. But if
```
and run `./stage1/bin/ghc --interactive -dlint -fspec-constr Internal` with:
```haskell
module Internal where
data N = Z | S N
union :: N -> ()
union Z = ()
union t = splitS t
splitS :: N -> ()
splitS Z = ()
splitS (S l) = splitS l
```
```
*** Core Lint errors : in result of SpecConstr ***
Internal.hs:10:1: warning:
Out of scope: l_aBE :: N
[LclId]
In the RHS of $ssplitS_sJ0 :: N -> ()
In the body of lambda with binder sc_sIZ :: N
Substitution: <InScope = {}
IdSubst = []
TvSubst = []
CvSubst = []>
```
At the moment, ghci does not support optimisations, but the goal of #23056 is to add that support.9.8.1Torsten SchmitsTorsten Schmitshttps://gitlab.haskell.org/ghc/ghc/-/issues/22639SpecConstr should have its own -ddump-spec-constr flag2023-06-11T21:56:15ZSebastian GrafSpecConstr should have its own -ddump-spec-constr flagIt's pretty awkward having to sift through code emitted by the type class specialiser anytime we want to look at SpecConstr code and vice versa, so I suggest SpecConstr no longer emits on `-ddump-spec` and emits on `-ddump-spec-constr` i...It's pretty awkward having to sift through code emitted by the type class specialiser anytime we want to look at SpecConstr code and vice versa, so I suggest SpecConstr no longer emits on `-ddump-spec` and emits on `-ddump-spec-constr` instead.Alex McKennaAlex McKennahttps://gitlab.haskell.org/ghc/ghc/-/issues/22934SpecConstr processes bindings in a different order between 9.4 and 9.62023-02-15T13:37:33ZAndreas KlebingerSpecConstr processes bindings in a different order between 9.4 and 9.6While looking into https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479506 @mpickering and me realized that some functions were not getting specialized by SpecConstr in 9.6 which were in 9.4
Increasing the limit `-fspec-constr-cou...While looking into https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479506 @mpickering and me realized that some functions were not getting specialized by SpecConstr in 9.6 which were in 9.4
Increasing the limit `-fspec-constr-count` made these differences disappear.
To the best of my understanding this is because https://gitlab.haskell.org/ghc/ghc/-/commit/565a8ec8fb29062827edc6999ac8dc72494ddd07 (initially in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8135) changes the order in which bindings are processed.
This means if we have a typical setup with code like:
```haskell
benchmarks = [bench f1, bench f2, bench f3, bench f4]
```
Then between 9.4 and 9.6 one version will specialise the first 3 appearances of `bench` to their arguments, and the other will specialise the last three.
I believe this is due to changes around the order in which bindings are processed inside `specConstrProgram`/`scTopBinds` https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8135/diffs#b6a5ba32bafb8fbda933538b3007e755fef6f101_765_759 but I have yet to verify that.
I believe the order in which bindinds are proccessed in 9.4 and before was initially implemented in https://gitlab.haskell.org/ghc/ghc/-/commit/8a58851150af11020140256bbd7c6d5359e020ee which alludes to the order mattering for compile times.
If it's little work we should consider moving back to the same order of considering specializations that we used in 9.4 for SpecConstr just to avoid "random" performance differences in users code.https://gitlab.haskell.org/ghc/ghc/-/issues/16473Specialization fails for program with higher rank type2023-01-30T11:40:44ZisovectorSpecialization fails for program with higher rank typeThe following program should produce identical core for `goodCore` and `badCore`. Unfortunately in 8.6.3 (untested elsewhere) it doesn't. In fact, `badCore` runs roughly 500x slower :scream:
```haskell
{-# LANGUAGE BangPatterns ...The following program should produce identical core for `goodCore` and `badCore`. Unfortunately in 8.6.3 (untested elsewhere) it doesn't. In fact, `badCore` runs roughly 500x slower :scream:
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -O2 #-}
module MVP (badCore, goodCore) where
import qualified Control.Monad.State.Strict as S
import Data.Foldable
import Data.Functor.Identity
import Data.Monoid
import Data.Tuple
goodCore :: Int -> Int
goodCore n = getSum $ snd $ flip S.runState mempty $ for_ [0..n] $ \i -> S.modify (<> Sum i)
badCore :: Int -> Int
badCore n = getSum $ fst $ run $ runState mempty $ for_ [0..n] $ \i -> modify (<> Sum i)
data Union (r :: [* -> *]) a where
Union :: e a -> Union '[e] a
decomp :: Union (e ': r) a -> e a
decomp (Union a) = a
{-# INLINE decomp #-}
absurdU :: Union '[] a -> b
absurdU = absurdU
newtype Semantic r a = Semantic
{ runSemantic
:: forall m
. Monad m
=> (forall x. Union r x -> m x)
-> m a
}
instance Functor (Semantic f) where
fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k
{-# INLINE fmap #-}
instance Applicative (Semantic f) where
pure a = Semantic $ const $ pure a
{-# INLINE pure #-}
Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k
{-# INLINE (<*>) #-}
instance Monad (Semantic f) where
return = pure
{-# INLINE return #-}
Semantic ma >>= f = Semantic $ \k -> do
z <- ma k
runSemantic (f z) k
{-# INLINE (>>=) #-}
data State s a
= Get (s -> a)
| Put s a
deriving Functor
get :: Semantic '[State s] s
get = Semantic $ \k -> k $ Union $ Get id
{-# INLINE get #-}
put :: s -> Semantic '[State s] ()
put !s = Semantic $ \k -> k $ Union $! Put s ()
{-# INLINE put #-}
modify :: (s -> s) -> Semantic '[State s] ()
modify f = do
!s <- get
put $! f s
{-# INLINE modify #-}
runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a)
runState = interpretInStateT $ \case
Get k -> fmap k S.get
Put s k -> S.put s >> pure k
{-# INLINE[3] runState #-}
run :: Semantic '[] a -> a
run (Semantic m) = runIdentity $ m absurdU
{-# INLINE run #-}
interpretInStateT
:: (forall x. e x -> S.StateT s (Semantic r) x)
-> s
-> Semantic (e ': r) a
-> Semantic r (s, a)
interpretInStateT f s (Semantic m) = Semantic $ \k ->
fmap swap $ flip S.runStateT s $ m $ \u ->
S.mapStateT (\z -> runSemantic z k) $ f $ decomp u
{-# INLINE interpretInStateT #-}
```isovectorisovectorhttps://gitlab.haskell.org/ghc/ghc/-/issues/21448CoreLint error in SpecConstr output for lateCC branch.2022-10-23T22:38:43ZAndreas KlebingerCoreLint error in SpecConstr output for lateCC branch.In !7797 I know hit a different core lint error in the output for SpecConstr.
In particular we try to specialise this function for True/False:
Input to SpecConstr:
```haskell
$wlistRest_s5qS [InlPrag=[2], Occ=LoopBreaker]...In !7797 I know hit a different core lint error in the output for SpecConstr.
In particular we try to specialise this function for True/False:
Input to SpecConstr:
```haskell
$wlistRest_s5qS [InlPrag=[2], Occ=LoopBreaker]
:: Bool
-> forall b.
([a_a23u] -> Text.ParserCombinators.ReadP.P b)
-> Text.ParserCombinators.ReadP.P b
[LclId,
Arity=1,
Str=<L>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 280 60}]
$wlistRest_s5qS
= \ (started_s4ge :: Bool) (@b1_a3fH) ->
tick<$c>>=>
\ (k1_a3fI
:: [a_a23u] -> Text.ParserCombinators.ReadP.P b1_a3fH) ->
scc<$c>>=>
let {
lvl_s5n5 :: Text.ParserCombinators.ReadP.P b1_a3fH
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}]
lvl_s5n5
= scc<$c>>=>
((((pfail @[a_a23u])
`cast` <Co:3> :: ReadPrec [a_a23u] ~R# (Prec -> P.ReadP [a_a23u]))
n_s5mY)
`cast` <Co:3> :: P.ReadP [a_a23u]
~R# (forall b.
([a_a23u] -> Text.ParserCombinators.ReadP.P b)
-> Text.ParserCombinators.ReadP.P b))
@b1_a3fH k1_a3fI } in
let {
lvl_s5na :: Text.ParserCombinators.ReadP.P b1_a3fH
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}]
lvl_s5na
= scc<$c>>=> scc<$cpure> k1_a3fI (GHC.Types.[] @a_a23u) } in
let {
lvl_s5n8 :: Text.ParserCombinators.ReadP.P b1_a3fH
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}]
lvl_s5n8
= scc<$c>>=>
(lvl_s5mZ
`cast` <Co:3> :: P.ReadP [a_a23u]
~R# (forall b.
([a_a23u] -> Text.ParserCombinators.ReadP.P b)
-> Text.ParserCombinators.ReadP.P b))
@b1_a3fH k1_a3fI } in
scctick<$c>>=>
(ds1_s5n4
`cast` <Co:2> :: P.ReadP L.Lexeme
~R# (forall b.
(L.Lexeme -> Text.ParserCombinators.ReadP.P b)
-> Text.ParserCombinators.ReadP.P b))
@b1_a3fH
(\ (a1_a3fJ [Dmd=SL] :: L.Lexeme) ->
case a1_a3fJ of {
__DEFAULT -> Text.ParserCombinators.ReadP.Fail @b1_a3fH;
L.Punc c_a1CI [Dmd=SL] ->
case c_a1CI of {
[] -> lvl_s5n5;
: ds_d2Vb [Dmd=S!P(SL)] ds_d2Vc ->
case ds_d2Vb of { C# ds_d2Vd [Dmd=SL] ->
case ds_d2Vd of {
__DEFAULT -> lvl_s5n5;
','# ->
case ds_d2Vc of {
[] ->
case started_s4ge of {
False -> lvl_s5n5;
True -> lvl_s5n8
};
: ipv_s3i2 [Dmd=A] ipv_s3i3 [Dmd=A] -> lvl_s5n5
};
']'# ->
case ds_d2Vc of {
[] -> tick<$cpure> lvl_s5na;
: ipv_s3i5 [Dmd=A] ipv_s3i6 [Dmd=A] -> lvl_s5n5
}
}
}
}
}); } in
```
But we generate a RULE mentioning a out of scope type variable:
Output of SpecConstr:
```haskell
$wlistRest_s5qS [InlPrag=[2], Occ=LoopBreaker]
:: Bool -> forall b. ([a_a23u] -> P b) -> P b
[LclId,
Arity=1,
Str=<L>,
RULES: "SC:$wlistRest1" [2]
forall. $wlistRest_s5qS True = $s$wlistRest_s5rr @b1_a3fH
"SC:$wlistRest0" [2]
forall. $wlistRest_s5qS False = $s$wlistRest_s5rq @b1_a3fH]
$wlistRest_s5qS
= \ (started_s4ge :: Bool) (@b1_a3fH) -> ...
```
Really `@b1_a3fH` should just be dropped by the rules RHS but clearly it isn't.
I think this is because we remove type arguments from the patterns we match on the rules left hand side.
I think the core issue is the SpecConstr implicitly assumes type variables come first in some places which goes awry here.Andreas KlebingerAndreas Klebingerhttps://gitlab.haskell.org/ghc/ghc/-/issues/21763SpecConstr: Better tune which patterns/arguments to specialize for.2022-08-29T08:41:18ZAndreas KlebingerSpecConstr: Better tune which patterns/arguments to specialize for.The motivation is https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8148#note_438129 where we regress (quite badly) because as far as I can tell SpecConstr is a bit *too* eager to specialize certain arguments.
The basic idea is we hav...The motivation is https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8148#note_438129 where we regress (quite badly) because as far as I can tell SpecConstr is a bit *too* eager to specialize certain arguments.
The basic idea is we have a pattern like this:
```
$j_s4qg (x_X1P [Dmd=SL, OS=OneShot] :: GHC.Prim.Int#)
(wild_X1Q [Dmd=SL, OS=OneShot] :: Int)
= case wild_X1Q of wild_X1R { GHC.Types.I# ipv_s4qk -> ... rhs -- with *boxed* uses of wild_X1Q
```
If we specialize for `wild_X1Q` being `I# <something>` we end up reboxing in the RHS which can be quite bad. In the linked comment i saw exact-reals regress by 25%!
It's a bit of a fluke. Things overall still get better in !8148 despite this one regression. But we should still try to fix this.
I think one approach would be to try and do better in distinguishing properly interesting occurances of variables from "boring" ones. For example consider these functions:
```
f maybe_x = case maybe_x of
Just x -> e1
Nothing -> e2
g maybe_x ww_unknown_function = case maybe_x of maybe_x' -> ... ww_unknown_function maybe_x' ...
h maybe_x = case maybe_x of maybe_x' -> ... f maybe_x' ...
```
`f` is obviously good to specialize. `h` can be interesting if it allows us to use a specialized `f` in it's rhs. But there is no point in specializing the argument for `g` in general.
The only benefit is that it would allow us to drop the seq. But tag inference can often already make the seq a no-op at runtime if we turn the argument into a cbv argument (which is quite likely). So I think we should try to avoid specializing for the case where the only use is a "boring" seq.9.6.1https://gitlab.haskell.org/ghc/ghc/-/issues/21489DFun call args are always saturated with term arguments2022-08-15T15:34:13ZGergő ÉrdiDFun call args are always saturated with term argumentsIn `GHC.Core.Opt.Specialise.spec_call`, when a `DFun` call is specialised, GHC extends the `call_args` so that the call is saturated. However, this saturation in general might require both type and term arguments; currently, it is assume...In `GHC.Core.Opt.Specialise.spec_call`, when a `DFun` call is specialised, GHC extends the `call_args` so that the call is saturated. However, this saturation in general might require both type and term arguments; currently, it is assumed that only term arguments are needed.9.4.3Gergő ÉrdiGergő Érdihttps://gitlab.haskell.org/ghc/ghc/-/issues/21831Specialiser problems2022-07-26T07:48:54ZSimon Peyton JonesSpecialiser problemsWhen I was working on #21286 I came across some other problems related to
specialisation:
1. In `GHC.Core.isEvaldUnfolding` we were not treating a `DFunUnfolding` as
evaluated. That's silly: it always is. And that omission in turn ...When I was working on #21286 I came across some other problems related to
specialisation:
1. In `GHC.Core.isEvaldUnfolding` we were not treating a `DFunUnfolding` as
evaluated. That's silly: it always is. And that omission in turn weakens
SpecConstr, which won't specialise on a DFun. But it *will* specialise
on lambda-values, so we get specialisation if we w/w the dictionary (which
we used to do) but not if we don't.
Anyway, making `isEvaldUnfolding` and `isValueUnfolding` return True for
`DFunUnfolding` just seems like the right thing to do.
1. It turned out (when compiling `nofib/spectral/exact-reals` that we could
get a RULE from the type-class specialiser (actually a user-written
SPECIALISE pragma)
```
RULE "SPEC:foo" forall d1 d2. foo @Int @Integer d1 d2 = $sfoo1
```
and *another* rule from SpecConstr like
```
RULE "SC:foo" forall a. foo @Int @a $fNumInteger = $sfoo2 @a
```
arising from a call to `foo` elsewhere. Note that `$fNumInteger` is a top-level binding for `Num Integer`. SpecConstr did this because of the fix to item (1).
These rules overlap, and neither appears to dominate the other.
Given a call `foo @Int @Integer $fNumInteger d`, GHC emits a trace
message `"Rules.findBest: rule overlap (Rule 1 wins)"`. It happens
that SC:foo wins and it specialises less well because it specialises
on only one type parameter. Sigh!
The actual function `foo` is exponentation `^`, but that hard to type and search for! Both RULES are generated when compiling `GHC.Real` in the libraries.https://gitlab.haskell.org/ghc/ghc/-/issues/21386Better floating and SpecConstr2022-05-24T08:04:02ZSimon Peyton JonesBetter floating and SpecConstrWhen working on #21286/!7847 I found a bad regression in
`nofib/real/eff/VSM`. It turned out to be because we had
```
foo = ...(go @T ($df @T dMonadT))...
where
dMonadT :: Monad T
go :: forall m. Monad m => blah
```
In HEAD we ...When working on #21286/!7847 I found a bad regression in
`nofib/real/eff/VSM`. It turned out to be because we had
```
foo = ...(go @T ($df @T dMonadT))...
where
dMonadT :: Monad T
go :: forall m. Monad m => blah
```
In HEAD we had worker/wrappered go, so it looked like
```
foo = ...(go @T returnT bindT)...
where
returnT :: forall b. b -> T b
bindT :: forall b c. T b -> (b -> T c) -> T c
```
in HEAD, SpecConstr then specialised `go` for the function
arguments `returnT` and `bindT`, which was good. But in my
work on !7847 I am not w/w-ing dictionaries any more. And alas
SpecConstr totally fails to specialise the call to `go` in
```
foo = ...(go @T ($df @T dMonadT))...
```
What to do? It seems bad that SpecConstr does worse on a *dictionary*
argument than on a *higher-order functional* argument. The former
should really be *easier* to handle. Can we beef up SpecConstr a bit?
* First, SpecConstr would have a better chance if we floated
the arg to top level, thus
```
lvl_dict :: Monad T
lvl_dict = $df @T dMonadT
foo = ...(go @T lvl_dict))...
```
Why doesn't this happen right now? Because FloatOut doesn't
float out constant expressions (even if they go to the top) if
the context is strict. See FloatOut `Note [Floating to the top]`,
esp this text
```
* Arguments
t = f (g True)
If f is lazy, we /do/ float (g True) because then we can allocate
the thunk statically rather than dynamically. But if f is strict
we don't (see the use of idDmdSig in lvlApp). It's not clear
if this test is worth the bother: it's only about CAFs!
```
* Second, SpecConstr would need to specialise `go` on `lvl_dict`. That
requires two things:
1. In the *call*, SpecConstr must treat `lvl_dict` as a value:
see `GHC.Core.Opt.SpecConstr.isValue`
2. In the *body of `go`*, SpecConstr must treat a use of the dict
in a class-op selection a very like a case expression. E.g.
```
go @m (d :: Monad m) = ....(bind_sel @m d @t1 @t2 e1 e2)...
```
In the body of `go` we select the bind method with `bind_sel`
(a ClassOpId). Very like
```
(case d of MD _ _ bind _ -> bind)
```Simon Peyton JonesSimon Peyton Joneshttps://gitlab.haskell.org/ghc/ghc/-/issues/20665Code bloat with -XStrictData leads to large compile time2022-03-06T10:58:36ZSebastian GrafCode bloat with -XStrictData leads to large compile time@jappeace posted the following reproducer on [reddit](https://www.reddit.com/r/haskell/comments/nxz72g/debugging_ghc_hanging_on_compile/h1kk28s/):
```hs
{-# LANGUAGE Haskell2010, OverloadedStrings, StrictData #-}
module Display where
...@jappeace posted the following reproducer on [reddit](https://www.reddit.com/r/haskell/comments/nxz72g/debugging_ghc_hanging_on_compile/h1kk28s/):
```hs
{-# LANGUAGE Haskell2010, OverloadedStrings, StrictData #-}
module Display where
import Data.Text (Text, pack)
data OpCode = OpCode OpName deriving (Eq, Show)
data OpName
= LDA | LDX | LDY | STA | STX | STY | TAX | TAY | TXA | TYA | TSX | TXS | PHA | PHP | PLA | PLP | AND | EOR | ORA | BIT | ADC
| SBC | CMP | CPX | CPY | INC | INX | INY | DEC | DEX | DEY | ASL | LSR | ROL | ROR | JMP | JSR | RTS | BCC | BCS | BEQ | BMI | BNE | BPL
| BVC | BVS | CLC | CLD | CLI | CLV | SEC | SED | SEI | BRK | NOP | RTI
deriving (Eq, Show)
class Display a where
display :: a -> Text
instance Display OpCode where
display (OpCode opn ) =
"OpCode - " <> pack (show opn)
```
Compiling this module with GHC master and `-O2` takes 6GB! (Down from 6.8 in GHC 8.10, though). 2GB alone are spent in CodeGen. Remove the `StrictData` pragma and it compiles instantaneously.
It appears that we inline `pack` and `show`, expose a Stream fusion pipeline and try to fuse it with the `Text` literal prefix. The code is **enormous**.
I can make out at least two sources for the bloat:
1. The Simplifier blows up the program from roughly 2k terms to 34k terms within one run after `FloatOut`. (That's probably phase 1 simplification, which will inline `pack`)
2. The final nail in the coffin is added by SpecConstr, which blows the program up to 110k terms
I have a hunch that (1) is related to https://gitlab.haskell.org/ghc/ghc/-/issues/20246 and #19996.Andreas KlebingerAndreas Klebingerhttps://gitlab.haskell.org/ghc/ghc/-/issues/19794mkWorkerArgs test is back to front2021-05-12T08:12:12ZSimon Peyton JonesmkWorkerArgs test is back to frontConsider this
```
f :: Int -> Int#
f x = f (x+1)
```
and compile with `ghc -O -ffun-to-thunk -dcore-lint`. We get
```
*** Core Lint errors : in result of Worker Wrapper binds ***
Foo.hs:7:1: warning:
The type of this binder is unlif...Consider this
```
f :: Int -> Int#
f x = f (x+1)
```
and compile with `ghc -O -ffun-to-thunk -dcore-lint`. We get
```
*** Core Lint errors : in result of Worker Wrapper binds ***
Foo.hs:7:1: warning:
The type of this binder is unlifted: $wf_szB
Binder's type: Int#
In the RHS of $wf_szB :: Int#
Substitution: [TCvSubst
In scope: InScope {}
Type env: []
Co env: []]
*** Offending Program ***
Rec {
$wf_szB [InlPrag=[2], Occ=LoopBreaker] :: Int#
[LclId, Str=b]
$wf_szB
= let {
w_szz [Dmd=B] :: Int
[LclId]
w_szz = RUBBISH[LiftedRep] @Int } in
let {
x_aw8 [Dmd=B] :: Int
[LclId]
x_aw8 = w_szz } in
f (case x_aw8 of { I# x_azu [Dmd=A] -> I# (+# x_azu 1#) })
f [InlPrag=[2]] :: Int -> Int#
[LclIdX,
Arity=1,
Str=<B>b,
Cpr=b,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ _ [Occ=Dead, Dmd=B] -> $wf_szB}]
f = \ (w_szz [Dmd=B] :: Int) -> $wf_szB
end Rec }
```9.4.1https://gitlab.haskell.org/ghc/ghc/-/issues/19672SpecConstr misses opportunities2021-04-20T07:56:03ZSimon Peyton JonesSpecConstr misses opportunitiesWhen working on eta-reduction I found cases where `SpecConstr` missed obvious opportunities.
Here is one:
```
f x y = case x of { True -> e1; False -> e2 }
...map (f True)....
```
Here the call to `f` isn't saturated, but we'd still lik...When working on eta-reduction I found cases where `SpecConstr` missed obvious opportunities.
Here is one:
```
f x y = case x of { True -> e1; False -> e2 }
...map (f True)....
```
Here the call to `f` isn't saturated, but we'd still like to specialise `f` for the `x=True` case.https://gitlab.haskell.org/ghc/ghc/-/issues/17623SpecConstr creates redundant many specialisations?2019-12-29T18:58:58ZBen GamariSpecConstr creates redundant many specialisations?While looking at #17619 I noticed that `SpecConstr` appears to be producing more than one specialisation/rule for each call pattern. Specifically, when looking at output from this trace:
```patch
@@ -1738,7 +1738,8 @@ spec_one env fn arg...While looking at #17619 I noticed that `SpecConstr` appears to be producing more than one specialisation/rule for each call pattern. Specifically, when looking at output from this trace:
```patch
@@ -1738,7 +1738,8 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
rule = mkRule this_mod True {- Auto -} True {- Local -}
rule_name inline_act fn_name qvars pats rule_rhs
-- See Note [Transfer activation]
- ; return (spec_usg, OS { os_pat = call_pat, os_rule = rule
+ ; pprTrace "sc-rule" (ppr rule) $
+ return (spec_usg, OS { os_pat = call_pat, os_rule = rule
, os_id = spec_id
, os_rhs = spec_rhs }) }
```
I noticed three distinct rules emitted of the form (up to alpha renaming):
```
1 sc-rule
7464 "SC:$weerr0" [2]
1 ┊ ┊ forall (sc_s3W0 :: Int#)
2 ┊ ┊ ┊ ┊ ┊ ┊(sc_s3W1 :: Int#)
3 ┊ ┊ ┊ ┊ ┊ ┊(sc_s3W2 :: Set (ErrorItem (Token [Char])))
4 ┊ ┊ ┊ ┊ ┊ ┊(sc_s3W3 :: Set (ErrorItem (Token [Char]))).
5 ┊ ┊ ┊ $weerr_Xu (TrivialError
6 ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊@ [Char]
7 ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊@ ()
8 ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊(I# sc_s3W0)
9 ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊lvl_s2Zq
10 ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊(Bin
11 ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ ┊ @ (ErrorItem (Token [Char])) sc_s3W1 lvl_s3l6 sc_s3W2 sc_s3W3))
12 ┊ ┊ ┊ = jump $s$weerr_s3W9 sc_s3W0 sc_s3W1 sc_s3W2 sc_s3W3
```Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/7865SpecConstr duplicating computations2019-07-07T18:47:46ZamosrobinsonSpecConstr duplicating computationsIn some (very rare) cases, SpecConstr can actually duplicate let bindings.
When SpecConstr sees something like
```
let tuple = (let x = expensive in x, simple)
case tuple of
(a,b) -> a + a
```
it records the value of tuple, and repl...In some (very rare) cases, SpecConstr can actually duplicate let bindings.
When SpecConstr sees something like
```
let tuple = (let x = expensive in x, simple)
case tuple of
(a,b) -> a + a
```
it records the value of tuple, and replaces the case with
```
(let x = expensive in x) + (let x = expensive in x)
```
Usually we wouldn't notice this, because the Simplifier would let-float expensive out of the tuple before SpecConstr runs.
In some cases though, the tuple constructor will only be exposed after specialisation happens.
To test, compile TSpecConstr_DoubleInline with
```
ghc TSpecConstr_DoubleInline.hs -O2 -fspec-constr -dverbose-core2core -fforce-recomp -dppr-case-as-let -dsuppress-all | less
```
and search for the SpecConstr pass. The first specialisation is
```
$srecursive_sf3
$srecursive_sf3 =
\ sc_seR sc_seS sc_seT sc_seU ->
let {
a'_sep
a'_sep =
(let { I# x_adP ~ _ <- expensive sc_seR } in I# (*# x_adP 2),
sc_seR) } in
let {
ds_seq
ds_seq =
recursive
(: sc_seR (: sc_seR (: sc_seS sc_seT)))
(sc_seR,
let { I# x_adP ~ _ <- expensive sc_seR } in I# (*# x_adP 2)) } in
(let { (p_XdA, q_Xdu) ~ _ <- ds_seq } in
let { I# x_ae7 ~ _ <- p_XdA } in
let { I# y_aeb ~ _
<- let { I# x_adP ~ _ <- expensive sc_seR } in I# (*# x_adP 2)
} in
I# (+# x_ae7 y_aeb),
let { (p_adg, q_XdA) ~ _ <- ds_seq } in
let { I# x_ae7 ~ _ <- q_XdA } in
let { I# y_aeb ~ _ <- sc_seR } in I# (+# x_ae7 y_aeb))
```
With three calls to expensive.
If you look at the -ddump-prep, one of the calls is simplified out, but there is still one too many at the end.
This is happening on at least 7.4.1 and head.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"SpecConstr duplicating computations","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"","keywords":["SpecConstr"],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"In some (very rare) cases, SpecConstr can actually duplicate let bindings.\r\n\r\nWhen SpecConstr sees something like\r\n\r\n{{{\r\nlet tuple = (let x = expensive in x, simple)\r\ncase tuple of\r\n (a,b) -> a + a\r\n}}}\r\nit records the value of tuple, and replaces the case with\r\n{{{\r\n(let x = expensive in x) + (let x = expensive in x)\r\n}}}\r\n\r\nUsually we wouldn't notice this, because the Simplifier would let-float expensive out of the tuple before SpecConstr runs.\r\nIn some cases though, the tuple constructor will only be exposed after specialisation happens.\r\n\r\n\r\nTo test, compile TSpecConstr_DoubleInline with\r\n{{{\r\nghc TSpecConstr_DoubleInline.hs -O2 -fspec-constr -dverbose-core2core -fforce-recomp -dppr-case-as-let -dsuppress-all | less\r\n}}}\r\n\r\nand search for the SpecConstr pass. The first specialisation is\r\n{{{\r\n$srecursive_sf3\r\n$srecursive_sf3 =\r\n \\ sc_seR sc_seS sc_seT sc_seU ->\r\n let {\r\n a'_sep\r\n a'_sep =\r\n (let { I# x_adP ~ _ <- expensive sc_seR } in I# (*# x_adP 2),\r\n sc_seR) } in\r\n let {\r\n ds_seq\r\n ds_seq =\r\n recursive\r\n (: sc_seR (: sc_seR (: sc_seS sc_seT)))\r\n (sc_seR,\r\n let { I# x_adP ~ _ <- expensive sc_seR } in I# (*# x_adP 2)) } in\r\n (let { (p_XdA, q_Xdu) ~ _ <- ds_seq } in\r\n let { I# x_ae7 ~ _ <- p_XdA } in\r\n let { I# y_aeb ~ _\r\n <- let { I# x_adP ~ _ <- expensive sc_seR } in I# (*# x_adP 2)\r\n } in\r\n I# (+# x_ae7 y_aeb),\r\n let { (p_adg, q_XdA) ~ _ <- ds_seq } in\r\n let { I# x_ae7 ~ _ <- q_XdA } in\r\n let { I# y_aeb ~ _ <- sc_seR } in I# (+# x_ae7 y_aeb))\r\n}}}\r\n\r\nWith three calls to expensive.\r\nIf you look at the -ddump-prep, one of the calls is simplified out, but there is still one too many at the end.\r\n\r\n\r\nThis is happening on at least 7.4.1 and head.","type_of_failure":"OtherFailure","blocking":[]} -->https://gitlab.haskell.org/ghc/ghc/-/issues/14955Musings on manual type class desugaring2019-07-07T18:14:54ZMatthew PickeringMusings on manual type class desugaringI recently wrote a short post explaining why manual type class desugaring was
different to actually writing a type class because of how they are optimised. http://mpickering.github.io/posts/2018-03-20-recordsvstypeclasses.html
I impleme...I recently wrote a short post explaining why manual type class desugaring was
different to actually writing a type class because of how they are optimised. http://mpickering.github.io/posts/2018-03-20-recordsvstypeclasses.html
I implement 4 different equivalent programs which are all optimised differently. I paste the whole file below as it is not very big.
Implementation 1 is in terms of a type class.
Implementation 2 is in terms of explicit dictionary passing.
Implementation 3 wraps a dictionary in a type class
Implementation 4 wraps a dictionary in a type class with an additional dummy argument.
Naively, a user would expect all 4 implementations to be as fast as each other.
```
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Prop where
import Prelude (Bool(..), (||), (&&))
-- Implementation 1
class Prop r where
or :: r -> r -> r
and :: r -> r -> r
true :: r
false :: r
instance Prop Bool where
or = (||)
and = (&&)
true = True
false = False
-- Implementation 2
data PropDict r = PropDict {
dor :: r -> r -> r
, dand :: r -> r -> r
, dtrue :: r
, dfalse :: r
}
boolDict = PropDict {
dor = (||)
, dand = (&&)
, dtrue = True
, dfalse = False }
-- Implementation 3
class PropProxy r where
propDict :: PropDict r
instance PropProxy Bool where
propDict = boolDict
-- Implementation 4
class PropProxy2 r where
propDict2 :: PropDict r
dummy :: ()
instance PropProxy2 Bool where
propDict2 = boolDict
dummy = ()
ors :: Prop r => [r] -> r
ors [] = true
ors (o:os) = o `or` ors os
{-# INLINABLE ors #-}
dors :: PropDict r -> [r] -> r
dors pd [] = dtrue pd
dors pd (o:os) = dor pd o (dors pd os)
pors :: PropProxy r => [r] -> r
pors [] = dtrue propDict
pors (o:os) = dor propDict o (pors os)
{-# INLINABLE pors #-}
porsProxy :: PropProxy2 r => [r] -> r
porsProxy [] = dtrue propDict2
porsProxy (o:os) = dor propDict2 o (porsProxy os)
{-# INLINABLE porsProxy #-}
```
Then using the 4 different implementations of `ors` in another module implementations 1 and 4 are fast whilst 2 and 3 are slow.
https://github.com/mpickering/rtcwrao-benchmarks/blob/master/Prop2.hs
```
benchmarking tc/Implementation 1
time 3.510 ms (3.509 ms .. 3.512 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 2.976 ms (2.886 ms .. 3.060 ms)
std dev 241.1 μs (195.4 μs .. 293.1 μs)
variance introduced by outliers: 51% (severely inflated)
benchmarking tc/Implementation 2
time 25.05 ms (21.16 ms .. 30.43 ms)
0.912 R² (0.849 R² .. 0.984 R²)
mean 19.18 ms (16.20 ms .. 21.45 ms)
std dev 5.627 ms (4.710 ms .. 6.618 ms)
variance introduced by outliers: 89% (severely inflated)
benchmarking tc/Implementation 3
time 20.06 ms (15.33 ms .. 23.57 ms)
0.856 R² (0.755 R² .. 0.934 R²)
mean 18.43 ms (16.92 ms .. 19.85 ms)
std dev 3.490 ms (3.003 ms .. 4.076 ms)
variance introduced by outliers: 74% (severely inflated)
benchmarking tc/Implementation 4
time 3.498 ms (3.484 ms .. 3.513 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 3.016 ms (2.935 ms .. 3.083 ms)
std dev 205.7 μs (162.6 μs .. 261.8 μs)
variance introduced by outliers: 42% (moderately inflated)
```
I compiled the module with `-O2`. If I turn off `-fno-worker-wrapper` and `-fno-spec-constr` then implementation 3 is also fast. Implementation 2 is always slow.
This ticket is querying what could be done to improve the robustness of these different refactorings.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 8.2.2 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"Musings on manual type class desugaring","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"8.2.2","keywords":["SpecConstr"],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"I recently wrote a short post explaining why manual type class desugaring was\r\ndifferent to actually writing a type class because of how they are optimised. http://mpickering.github.io/posts/2018-03-20-recordsvstypeclasses.html\r\n\r\nI implement 4 different equivalent programs which are all optimised differently. I paste the whole file below as it is not very big.\r\n\r\nImplementation 1 is in terms of a type class.\r\nImplementation 2 is in terms of explicit dictionary passing.\r\nImplementation 3 wraps a dictionary in a type class\r\nImplementation 4 wraps a dictionary in a type class with an additional dummy argument.\r\n\r\nNaively, a user would expect all 4 implementations to be as fast as each other.\r\n\r\n{{{\r\n{-# LANGUAGE NoImplicitPrelude #-}\r\n{-# LANGUAGE AllowAmbiguousTypes #-}\r\nmodule Prop where\r\n\r\nimport Prelude (Bool(..), (||), (&&))\r\n\r\n-- Implementation 1\r\n\r\nclass Prop r where\r\n or :: r -> r -> r\r\n and :: r -> r -> r\r\n true :: r\r\n false :: r\r\n\r\ninstance Prop Bool where\r\n or = (||)\r\n and = (&&)\r\n true = True\r\n false = False\r\n\r\n-- Implementation 2\r\n\r\ndata PropDict r = PropDict {\r\n dor :: r -> r -> r\r\n , dand :: r -> r -> r\r\n , dtrue :: r\r\n , dfalse :: r\r\n }\r\n\r\nboolDict = PropDict {\r\n dor = (||)\r\n , dand = (&&)\r\n , dtrue = True\r\n , dfalse = False }\r\n\r\n-- Implementation 3\r\n\r\nclass PropProxy r where\r\n propDict :: PropDict r\r\n\r\ninstance PropProxy Bool where\r\n propDict = boolDict\r\n\r\n-- Implementation 4\r\n\r\nclass PropProxy2 r where\r\n propDict2 :: PropDict r\r\n dummy :: ()\r\n\r\ninstance PropProxy2 Bool where\r\n propDict2 = boolDict\r\n dummy = ()\r\n\r\n\r\nors :: Prop r => [r] -> r\r\nors [] = true\r\nors (o:os) = o `or` ors os\r\n{-# INLINABLE ors #-}\r\n\r\ndors :: PropDict r -> [r] -> r\r\ndors pd [] = dtrue pd\r\ndors pd (o:os) = dor pd o (dors pd os)\r\n\r\npors :: PropProxy r => [r] -> r\r\npors [] = dtrue propDict\r\npors (o:os) = dor propDict o (pors os)\r\n{-# INLINABLE pors #-}\r\n\r\nporsProxy :: PropProxy2 r => [r] -> r\r\nporsProxy [] = dtrue propDict2\r\nporsProxy (o:os) = dor propDict2 o (porsProxy os)\r\n{-# INLINABLE porsProxy #-}\r\n}}}\r\n\r\nThen using the 4 different implementations of `ors` in another module implementations 1 and 4 are fast whilst 2 and 3 are slow. \r\n\r\nhttps://github.com/mpickering/rtcwrao-benchmarks/blob/master/Prop2.hs\r\n\r\n\r\n{{{\r\nbenchmarking tc/Implementation 1\r\ntime 3.510 ms (3.509 ms .. 3.512 ms)\r\n 1.000 R² (1.000 R² .. 1.000 R²)\r\nmean 2.976 ms (2.886 ms .. 3.060 ms)\r\nstd dev 241.1 μs (195.4 μs .. 293.1 μs)\r\nvariance introduced by outliers: 51% (severely inflated)\r\n\r\nbenchmarking tc/Implementation 2\r\ntime 25.05 ms (21.16 ms .. 30.43 ms)\r\n 0.912 R² (0.849 R² .. 0.984 R²)\r\nmean 19.18 ms (16.20 ms .. 21.45 ms)\r\nstd dev 5.627 ms (4.710 ms .. 6.618 ms)\r\nvariance introduced by outliers: 89% (severely inflated)\r\n\r\nbenchmarking tc/Implementation 3\r\ntime 20.06 ms (15.33 ms .. 23.57 ms)\r\n 0.856 R² (0.755 R² .. 0.934 R²)\r\nmean 18.43 ms (16.92 ms .. 19.85 ms)\r\nstd dev 3.490 ms (3.003 ms .. 4.076 ms)\r\nvariance introduced by outliers: 74% (severely inflated)\r\n\r\nbenchmarking tc/Implementation 4\r\ntime 3.498 ms (3.484 ms .. 3.513 ms)\r\n 1.000 R² (1.000 R² .. 1.000 R²)\r\nmean 3.016 ms (2.935 ms .. 3.083 ms)\r\nstd dev 205.7 μs (162.6 μs .. 261.8 μs)\r\nvariance introduced by outliers: 42% (moderately inflated)\r\n}}}\r\n\r\n\r\nI compiled the module with `-O2`. If I turn off `-fno-worker-wrapper` and `-fno-spec-constr` then implementation 3 is also fast. Implementation 2 is always slow. \r\n\r\nThis ticket is querying what could be done to improve the robustness of these different refactorings. ","type_of_failure":"OtherFailure","blocking":[]} -->