GHC issueshttps://gitlab.haskell.org/ghc/ghc/-/issues2023-07-12T13:42:42Zhttps://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/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/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/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/10346Cross-module SpecConstr2022-05-12T20:34:01ZSimon Peyton JonesCross-module SpecConstrType-class specialisation now happens flawlessly across modules. That is, if I define
```
module DefineF where
f :: Num a => a -> a
{-# INLINEABLE f #-}
f x = ...f x'....
```
then modules that import `DefineF` and call `f` at ...Type-class specialisation now happens flawlessly across modules. That is, if I define
```
module DefineF where
f :: Num a => a -> a
{-# INLINEABLE f #-}
f x = ...f x'....
```
then modules that import `DefineF` and call `f` at some particular type (say `Int`) will generate a specialised copy of `f`'s code.
But this does not happen for `SpecConstr`; we only specialise a function for calls made in the same module. For example:
```
module M where
{-# INLINABLE foo #-}
foo True y = y
foo False (a,b) = foo True (a+b,b)
module X where
import M
bar = ...(foo (x,y))...
```
Here `foo` is called with an explicit `(x,y)` argument in module `X`, and we'd like to !SpecConstr it, as it would be if the call was in module `M`.
All the infrastructure is in place to allow cross-module `SpecConstr`; it just hasn't been done yet. This ticket is to record the idea.8.6.1https://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/22657SpecConstr reboxes inside loops2023-09-07T09:22:08ZSebastian GrafSpecConstr reboxes inside loopsCompile the following program with `-O2 -fno-liberate-case`:
```hs
f :: (Int, Int) -> Int -> Int
f _ 0 = 0
f p n = length (go n) + f p (n-1)
where
go 0 = []
go n = case p of (x,y) -> (p,x+y) : go (n-1)
main = print $ f (1,2) ...Compile the following program with `-O2 -fno-liberate-case`:
```hs
f :: (Int, Int) -> Int -> Int
f _ 0 = 0
f p n = length (go n) + f p (n-1)
where
go 0 = []
go n = case p of (x,y) -> (p,x+y) : go (n-1)
main = print $ f (1,2) 10000
```
For me, it takes about 6.8GB of memory to run the resulting binary. If I also pass `-fno-spec-constr`, it only takes 5.6GB and is a bit faster.
(No liberate case is material, otherwise the `case` will just be floated out.)
Here's the simplified Core with SpecConstr:
```
Rec {
-- RHS size: {terms: 44, types: 36, coercions: 0, joins: 0/1}
Main.main_$s$wf [Occ=LoopBreaker]
:: Int -> Int -> GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=3, Str=<L><L><1L>, Unf=OtherCon []]
Main.main_$s$wf
= \ (sc_s2dV :: Int)
(sc1_s2dW :: Int)
(ww_s2dz :: GHC.Prim.Int#) ->
case ww_s2dz of ds_X1 {
__DEFAULT ->
letrec {
$wgo_s2du [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)]
:: GHC.Prim.Int# -> [((Int, Int), Int)]
[LclId, Arity=1, Str=<1L>, Unf=OtherCon []]
$wgo_s2du
= \ (ww1_s2dr :: GHC.Prim.Int#) ->
case ww1_s2dr of wild_X1F {
__DEFAULT ->
GHC.Types.:
@((Int, Int), Int)
((sc_s2dV, sc1_s2dW), GHC.Num.$fNumInt_$c+ sc_s2dV sc1_s2dW)
($wgo_s2du (GHC.Prim.-# wild_X1F 1#));
0# -> GHC.Types.[] @((Int, Int), Int)
}; } in
case GHC.List.$wlenAcc @((Int, Int), Int) ($wgo_s2du ds_X1) 0#
of ww1_a2dn
{ __DEFAULT ->
case Main.main_$s$wf sc_s2dV sc1_s2dW (GHC.Prim.-# ds_X1 1#)
of ww2_s2dH
{ __DEFAULT ->
GHC.Prim.+# ww1_a2dn ww2_s2dH
}
};
0# -> 0#
}
end Rec }
```
Note the reboxing of `(sc_s2dV, sc1_s2dW)` inside the loop `$wgo`. Bad bad bad!
It's all due to SpecConstr *substituting* `(sc_s2dV, sc1_s2dW)` for the pair `p` instead of merely binding let-binding it in `$s$wf`.
It would be reasonable for SpecConstr to do the latter. It can still do case-of-known-con via its `sc_val` env, I think.9.10.1https://gitlab.haskell.org/ghc/ghc/-/issues/20321SpecConstr increasing allocation. Maybe by triggering reboxing2022-05-17T14:59:44ZAndreas KlebingerSpecConstr increasing allocation. Maybe by triggering reboxingI noticed that nofib/real/ben-raytrace seems to increase allocations quite significantly with -fspec-constr compared to without.
In nofib/real/ben-raytracer we have this function:
```haskell
hitTestMany :: [Figure] -> Ray3 -> Interval ...I noticed that nofib/real/ben-raytrace seems to increase allocations quite significantly with -fspec-constr compared to without.
In nofib/real/ben-raytracer we have this function:
```haskell
hitTestMany :: [Figure] -> Ray3 -> Interval -> Maybe Hit
hitTestMany figs ray = go_hit figs Nothing
where
go_hit :: [Figure] -> Maybe Hit -> Interval -> Maybe Hit
go_hit [] accum !_ = accum
go_hit (fig:rest) accum int =
case hitTest fig ray int of
Nothing -> go_hit rest accum int
Just hit ->
case accum of
Nothing
-> go_hit rest (Just hit) (int {iUpper=hitDistance hit})
Just oldHit
| hitDistance hit < hitDistance oldHit
-> go_hit rest (Just hit) (int {iUpper=hitDistance hit})
| otherwise
-> go_hit rest accum int
```
Without spec-constr we get somewhat straight forward core:
```haskell
joinrec {
$wgo_hit_s2L4 [InlPrag=[2],
Occ=LoopBreaker,
Dmd=SCS(C1(C1(C1(L))))]
:: [Figure]
-> Maybe Hit -> GHC.Prim.Double# -> GHC.Prim.Double# -> Maybe Hit
[LclId[JoinId(4)], Arity=4, Str=<1L><1L><L><L>, Unf=OtherCon []]
$wgo_hit_s2L4 (ds_s2KW :: [Figure])
(accum_s2KX :: Maybe Hit)
(ww9_X2 :: GHC.Prim.Double#)
(ww10_X3 :: GHC.Prim.Double#)
= case ds_s2KW of {
[] -> accum_s2KX;
: fig_aSB rest_aSC ->
case fig_aSB of { Figure ds1_d27m ds2_d27n ->
case ds2_d27n ray_aSy (Interval.Interval ww9_X2 ww10_X3)
of wild4_X6 {
Nothing -> jump $wgo_hit_s2L4 rest_aSC accum_s2KX ww9_X2 ww10_X3;
Just hit_aSF ->
case accum_s2KX of wild5_X7 {
Nothing ->
case hit_aSF of
{ Hit bx_d2f3 ds3_d27x ds4_d27y ds5_d27z ds6_d27A ->
jump $wgo_hit_s2L4 rest_aSC wild4_X6 ww9_X2 bx_d2f3
};
Just oldHit_aSG ->
case hit_aSF of
{ Hit bx_d2f3 ds3_d27x ds4_d27y ds5_d27z ds6_d27A ->
case oldHit_aSG of { Hit bx1_Xa ds7_Xb ds8_Xc ds9_Xd ds10_Xe ->
case GHC.Prim.<## bx_d2f3 bx1_Xa of {
__DEFAULT -> jump $wgo_hit_s2L4 rest_aSC wild5_X7 ww9_X2 ww10_X3;
1# -> jump $wgo_hit_s2L4 rest_aSC wild4_X6 ww9_X2 bx_d2f3
}
}
}
}
}
}
}; } in
```
Not that we case on the accumulator `accum_s2KX` but pass it along boxed and as-is.
However if we enable SpecConstr instead then we get the code hidden below the spoiler tag:
<details>
```haskell
joinrec {
$s$wgo_hit_s2Pr [Occ=LoopBreaker,
Dmd=LCL(C1(C1(C1(C1(C1(C1(C1(L))))))))]
:: GHC.Prim.Double#
-> GHC.Prim.Double#
-> GHC.Prim.Double#
-> Pt Vec3
-> Vec3
-> Pt Vec2
-> Material
-> [Figure]
-> Maybe Hit
[LclId[JoinId(8)],
Arity=8,
Str=<L><L><L><L><L><L><L><1L>,
Unf=OtherCon []]
$s$wgo_hit_s2Pr (sc_s2Pp :: GHC.Prim.Double#)
(sc1_s2Po :: GHC.Prim.Double#)
(sc2_s2Pj :: GHC.Prim.Double#)
(sc3_s2Pk :: Pt Vec3)
(sc4_s2Pl :: Vec3)
(sc5_s2Pm :: Pt Vec2)
(sc6_s2Pn :: Material)
(sc7_s2Pi :: [Figure])
= case sc7_s2Pi of {
[] ->
GHC.Maybe.Just
@Hit (Figure.Hit sc2_s2Pj sc3_s2Pk sc4_s2Pl sc5_s2Pm sc6_s2Pn);
: fig_aSC rest_aSD ->
case fig_aSC of { Figure ds_d27n ds1_d27o ->
case ds1_d27o ray_aSz (Interval.Interval sc1_s2Po sc_s2Pp) of {
Nothing ->
jump $s$wgo_hit_s2Pr
sc_s2Pp
sc1_s2Po
sc2_s2Pj
sc3_s2Pk
sc4_s2Pl
sc5_s2Pm
sc6_s2Pn
rest_aSD;
Just hit_aSG ->
case hit_aSG of
{ Hit bx_d2f4 ds2_d27y ds3_d27z ds4_d27A ds5_d27B ->
case GHC.Prim.<## bx_d2f4 sc2_s2Pj of {
__DEFAULT ->
jump $s$wgo_hit_s2Pr
sc_s2Pp
sc1_s2Po
sc2_s2Pj
sc3_s2Pk
sc4_s2Pl
sc5_s2Pm
sc6_s2Pn
rest_aSD;
1# ->
jump $s$wgo_hit_s2Pr
bx_d2f4
sc1_s2Po
bx_d2f4
ds2_d27y
ds3_d27z
ds4_d27A
ds5_d27B
rest_aSD
}
}
}
}
}; } in
joinrec {
$s$wgo_hit1_s2Pq [Occ=LoopBreaker, Dmd=LCL(C1(C1(L)))]
:: GHC.Prim.Double# -> GHC.Prim.Double# -> [Figure] -> Maybe Hit
[LclId[JoinId(3)], Arity=3, Str=<L><L><1L>, Unf=OtherCon []]
$s$wgo_hit1_s2Pq (sc_s2Ph :: GHC.Prim.Double#)
(sc1_s2Pg :: GHC.Prim.Double#)
(sc2_s2Pf :: [Figure])
= case sc2_s2Pf of {
[] -> GHC.Maybe.Nothing @Hit;
: fig_aSC rest_aSD ->
case fig_aSC of { Figure ds_d27n ds1_d27o ->
case ds1_d27o ray_aSz (Interval.Interval sc1_s2Pg sc_s2Ph) of {
Nothing -> jump $s$wgo_hit1_s2Pq sc_s2Ph sc1_s2Pg rest_aSD;
Just hit_aSG ->
case hit_aSG of
{ Hit bx_d2f4 ds2_d27y ds3_d27z ds4_d27A ds5_d27B ->
jump $s$wgo_hit_s2Pr
bx_d2f4
sc1_s2Pg
bx_d2f4
ds2_d27y
ds3_d27z
ds4_d27A
ds5_d27B
rest_aSD
}
}
}
}; } in
case figs_s2L7 of { :| a1_a28j as_a28k ->
case a1_a28j of { Figure ds_d27n ds1_d27o ->
case ds1_d27o ray_aSz wild1_X1 of {
Nothing -> jump $s$wgo_hit1_s2Pq ww8_s2L2 ww7_s2L1 figs1_s2CL;
Just hit_aSG ->
case hit_aSG of
{ Hit bx_d2f4 ds2_d27y ds3_d27z ds4_d27A ds5_d27B ->
jump $s$wgo_hit_s2Pr
bx_d2f4
ww7_s2L1
bx_d2f4
ds2_d27y
ds3_d27z
ds4_d27A
ds5_d27B
figs1_s2CL
}
}
```
</details>
SpecConstr seems to specialise on the accumulator and in the `Just` case also unboxes the Hit constructor.
However we eventually want to return the boxed `Just (Hit ...)` constructor just the way we got it. So we eventually end up reboxing it (and the Just it's contained in).
This is quite annoying. I guess this could eventually be tied into the boxity analysis @sgraf812 mentions in #19871.Research neededhttps://gitlab.haskell.org/ghc/ghc/-/issues/16017ghc-8.6.1 and ghc-8.6.2 use a lot of memory2019-08-27T08:57:19ZJohn Kyghc-8.6.1 and ghc-8.6.2 use a lot of memoryCurrently GHC uses a lot of memory to build a relatively small module and causes my CI to fail due to there being a 4G memory limit.
The source code can be found here:
https://github.com/haskell-works/hw-json/tree/73368cee21dc72eedd529...Currently GHC uses a lot of memory to build a relatively small module and causes my CI to fail due to there being a 4G memory limit.
The source code can be found here:
https://github.com/haskell-works/hw-json/tree/73368cee21dc72eedd5291ba689f9abf10e7fcd2
The problem module is here:
https://github.com/haskell-works/hw-json/blob/73368cee21dc72eedd5291ba689f9abf10e7fcd2/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs
The build output follows:
```
cabal new-build --enable-tests --enable-benchmarks --project-file="cabal.project" -j${CABAL_THREADS:-4} all
Build profile: -w ghc-8.6.2 -O2
In order, the following will be built (use -v for more details):
- hw-json-0.9.0.1 (lib) (first run)
- hw-json-0.9.0.1 (test:hw-json-test) (first run)
- hw-json-0.9.0.1 (exe:hw-json) (first run)
- hw-json-0.9.0.1 (bench:bench) (first run)
Configuring library for hw-json-0.9.0.1..
Preprocessing library for hw-json-0.9.0.1..
Building library for hw-json-0.9.0.1..
[ 1 of 32] Compiling HaskellWorks.Data.Json.DecodeError ( src/HaskellWorks/Data/Json/DecodeError.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/DecodeError.o )
[ 2 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.o )
[ 3 of 32] Compiling HaskellWorks.Data.Json.Internal.Index ( src/HaskellWorks/Data/Json/Internal/Index.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Index.o )
[ 4 of 32] Compiling HaskellWorks.Data.Json.Internal.PartialIndex ( src/HaskellWorks/Data/Json/Internal/PartialIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/PartialIndex.o )
[ 5 of 32] Compiling HaskellWorks.Data.Json.Internal.Token.Types ( src/HaskellWorks/Data/Json/Internal/Token/Types.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Token/Types.o )
[ 6 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.o )
[ 7 of 32] Compiling HaskellWorks.Data.Json.Internal.Token ( src/HaskellWorks/Data/Json/Internal/Token.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Token.o )
[ 8 of 32] Compiling HaskellWorks.Data.Json.Internal.Value ( src/HaskellWorks/Data/Json/Internal/Value.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Value.o )
[ 9 of 32] Compiling HaskellWorks.Data.Json.Internal.Word8 ( src/HaskellWorks/Data/Json/Internal/Word8.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Word8.o )
[10 of 32] Compiling HaskellWorks.Data.Json.Internal.Word64 ( src/HaskellWorks/Data/Json/Internal/Word64.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Word64.o )
[11 of 32] Compiling HaskellWorks.Data.Json.Internal.CharLike ( src/HaskellWorks/Data/Json/Internal/CharLike.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/CharLike.o )
[12 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.Blank ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.o )
[13 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.o )
[14 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.o )
[15 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.o )
[16 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.o )
[17 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.SemiIndex ( src/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.o )
[18 of 32] Compiling HaskellWorks.Data.Json.Backend.Simple.SemiIndex ( src/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.o )
[19 of 32] Compiling HaskellWorks.Data.Json.LightJson ( src/HaskellWorks/Data/Json/LightJson.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/LightJson.o )
[20 of 32] Compiling HaskellWorks.Data.Json.PartialValue ( src/HaskellWorks/Data/Json/PartialValue.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/PartialValue.o )
[21 of 32] Compiling HaskellWorks.Data.Json.Type ( src/HaskellWorks/Data/Json/Type.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Type.o )
[22 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.Cursor ( src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/Cursor.o )
[23 of 32] Compiling HaskellWorks.Data.Json.Cursor ( src/HaskellWorks/Data/Json/Cursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Cursor.o )
[24 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.o )
[25 of 32] Compiling HaskellWorks.Data.Json.Value ( src/HaskellWorks/Data/Json/Value.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Value.o )
[26 of 32] Compiling HaskellWorks.Data.Json.FromValue ( src/HaskellWorks/Data/Json/FromValue.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/FromValue.o )
[27 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.LoadCursor ( src/HaskellWorks/Data/Json/Backend/Standard/LoadCursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/LoadCursor.o )
[28 of 32] Compiling HaskellWorks.Data.Json.LoadCursor ( src/HaskellWorks/Data/Json/LoadCursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/LoadCursor.o )
[29 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.Load ( src/HaskellWorks/Data/Json/Backend/Standard/Load.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/Load.o )
[30 of 32] Compiling HaskellWorks.Data.Json.Load ( src/HaskellWorks/Data/Json/Load.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Load.o )
[31 of 32] Compiling HaskellWorks.Data.Json ( src/HaskellWorks/Data/Json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json.o )
[32 of 32] Compiling Paths_hw_json ( /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/autogen/Paths_hw_json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/Paths_hw_json.o )
Configuring test suite 'hw-json-test' for hw-json-0.9.0.1..
Configuring benchmark 'bench' for hw-json-0.9.0.1..
Configuring executable 'hw-json' for hw-json-0.9.0.1..
Preprocessing test suite 'hw-json-test' for hw-json-0.9.0.1..
Building test suite 'hw-json-test' for hw-json-0.9.0.1..
Preprocessing executable 'hw-json' for hw-json-0.9.0.1..
Preprocessing benchmark 'bench' for hw-json-0.9.0.1..
Building benchmark 'bench' for hw-json-0.9.0.1..
Building executable 'hw-json' for hw-json-0.9.0.1..
[ 1 of 11] Compiling HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.InterestBitsSpec ( test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/t/hw-json-test/opt/build/hw-json-test/hw-json-test-tmp/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.o )
[1 of 2] Compiling Main ( bench/Main.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/bench-tmp/Main.o )
[1 of 7] Compiling App.Commands.Types ( app/App/Commands/Types.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands/Types.o )
[2 of 7] Compiling App.Lens ( app/App/Lens.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Lens.o )
[3 of 7] Compiling App.Commands.Demo ( app/App/Commands/Demo.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands/Demo.o )
[2 of 2] Compiling Paths_hw_json ( /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/autogen/Paths_hw_json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/bench-tmp/Paths_hw_json.o )
Linking /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/bench ...
[4 of 7] Compiling App.Commands.CreateIndex ( app/App/Commands/CreateIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands/CreateIndex.o )
[5 of 7] Compiling App.Commands ( app/App/Commands.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands.o )
[ 2 of 11] Compiling HaskellWorks.Data.Json.Backend.Standard.Succinct.CursorSpec ( test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/t/hw-json-test/opt/build/hw-json-test/hw-json-test-tmp/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.o )
[6 of 7] Compiling Main ( app/Main.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/Main.o )
[7 of 7] Compiling Paths_hw_json ( /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/autogen/Paths_hw_json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/Paths_hw_json.o )
Linking /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json ...
cabal: Failed to build test:hw-json-test from hw-json-0.9.0.1. The build
process was killed (i.e. SIGKILL). The typical reason for this is that there
is not enough memory available (e.g. the OS killed a process using lots of
memory).
Exited with code 1
```
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 8.6.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":"ghc-8.6.1 and ghc-8.6.2 use a log of memory","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"8.6.3","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"8.6.2","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"Currently GHC uses a lot of memory to build a relatively small module and causes my CI to fail due to there being a 4G memory limit.\r\n\r\nThe source code can be found here:\r\n\r\nhttps://github.com/haskell-works/hw-json/tree/73368cee21dc72eedd5291ba689f9abf10e7fcd2\r\n\r\nThe problem module is here:\r\n\r\nhttps://github.com/haskell-works/hw-json/blob/73368cee21dc72eedd5291ba689f9abf10e7fcd2/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs\r\n\r\nThe build output follows:\r\n\r\n{{{\r\ncabal new-build --enable-tests --enable-benchmarks --project-file=\"cabal.project\" -j${CABAL_THREADS:-4} all\r\nBuild profile: -w ghc-8.6.2 -O2\r\nIn order, the following will be built (use -v for more details):\r\n - hw-json-0.9.0.1 (lib) (first run)\r\n - hw-json-0.9.0.1 (test:hw-json-test) (first run)\r\n - hw-json-0.9.0.1 (exe:hw-json) (first run)\r\n - hw-json-0.9.0.1 (bench:bench) (first run)\r\nConfiguring library for hw-json-0.9.0.1..\r\nPreprocessing library for hw-json-0.9.0.1..\r\nBuilding library for hw-json-0.9.0.1..\r\n[ 1 of 32] Compiling HaskellWorks.Data.Json.DecodeError ( src/HaskellWorks/Data/Json/DecodeError.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/DecodeError.o )\r\n[ 2 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.o )\r\n[ 3 of 32] Compiling HaskellWorks.Data.Json.Internal.Index ( src/HaskellWorks/Data/Json/Internal/Index.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Index.o )\r\n[ 4 of 32] Compiling HaskellWorks.Data.Json.Internal.PartialIndex ( src/HaskellWorks/Data/Json/Internal/PartialIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/PartialIndex.o )\r\n[ 5 of 32] Compiling HaskellWorks.Data.Json.Internal.Token.Types ( src/HaskellWorks/Data/Json/Internal/Token/Types.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Token/Types.o )\r\n[ 6 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.o )\r\n[ 7 of 32] Compiling HaskellWorks.Data.Json.Internal.Token ( src/HaskellWorks/Data/Json/Internal/Token.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Token.o )\r\n[ 8 of 32] Compiling HaskellWorks.Data.Json.Internal.Value ( src/HaskellWorks/Data/Json/Internal/Value.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Value.o )\r\n[ 9 of 32] Compiling HaskellWorks.Data.Json.Internal.Word8 ( src/HaskellWorks/Data/Json/Internal/Word8.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Word8.o )\r\n[10 of 32] Compiling HaskellWorks.Data.Json.Internal.Word64 ( src/HaskellWorks/Data/Json/Internal/Word64.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Word64.o )\r\n[11 of 32] Compiling HaskellWorks.Data.Json.Internal.CharLike ( src/HaskellWorks/Data/Json/Internal/CharLike.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/CharLike.o )\r\n[12 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.Blank ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.o )\r\n[13 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.o )\r\n[14 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.o )\r\n[15 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.o )\r\n[16 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.o )\r\n[17 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.SemiIndex ( src/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.o )\r\n[18 of 32] Compiling HaskellWorks.Data.Json.Backend.Simple.SemiIndex ( src/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.o )\r\n[19 of 32] Compiling HaskellWorks.Data.Json.LightJson ( src/HaskellWorks/Data/Json/LightJson.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/LightJson.o )\r\n[20 of 32] Compiling HaskellWorks.Data.Json.PartialValue ( src/HaskellWorks/Data/Json/PartialValue.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/PartialValue.o )\r\n[21 of 32] Compiling HaskellWorks.Data.Json.Type ( src/HaskellWorks/Data/Json/Type.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Type.o )\r\n[22 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.Cursor ( src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/Cursor.o )\r\n[23 of 32] Compiling HaskellWorks.Data.Json.Cursor ( src/HaskellWorks/Data/Json/Cursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Cursor.o )\r\n[24 of 32] Compiling HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token ( src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.o )\r\n[25 of 32] Compiling HaskellWorks.Data.Json.Value ( src/HaskellWorks/Data/Json/Value.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Value.o )\r\n[26 of 32] Compiling HaskellWorks.Data.Json.FromValue ( src/HaskellWorks/Data/Json/FromValue.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/FromValue.o )\r\n[27 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.LoadCursor ( src/HaskellWorks/Data/Json/Backend/Standard/LoadCursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/LoadCursor.o )\r\n[28 of 32] Compiling HaskellWorks.Data.Json.LoadCursor ( src/HaskellWorks/Data/Json/LoadCursor.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/LoadCursor.o )\r\n[29 of 32] Compiling HaskellWorks.Data.Json.Backend.Standard.Load ( src/HaskellWorks/Data/Json/Backend/Standard/Load.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Backend/Standard/Load.o )\r\n[30 of 32] Compiling HaskellWorks.Data.Json.Load ( src/HaskellWorks/Data/Json/Load.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json/Load.o )\r\n[31 of 32] Compiling HaskellWorks.Data.Json ( src/HaskellWorks/Data/Json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/HaskellWorks/Data/Json.o )\r\n[32 of 32] Compiling Paths_hw_json ( /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/autogen/Paths_hw_json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/opt/build/Paths_hw_json.o )\r\nConfiguring test suite 'hw-json-test' for hw-json-0.9.0.1..\r\nConfiguring benchmark 'bench' for hw-json-0.9.0.1..\r\nConfiguring executable 'hw-json' for hw-json-0.9.0.1..\r\nPreprocessing test suite 'hw-json-test' for hw-json-0.9.0.1..\r\nBuilding test suite 'hw-json-test' for hw-json-0.9.0.1..\r\nPreprocessing executable 'hw-json' for hw-json-0.9.0.1..\r\nPreprocessing benchmark 'bench' for hw-json-0.9.0.1..\r\nBuilding benchmark 'bench' for hw-json-0.9.0.1..\r\nBuilding executable 'hw-json' for hw-json-0.9.0.1..\r\n[ 1 of 11] Compiling HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.InterestBitsSpec ( test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/t/hw-json-test/opt/build/hw-json-test/hw-json-test-tmp/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.o )\r\n[1 of 2] Compiling Main ( bench/Main.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/bench-tmp/Main.o )\r\n[1 of 7] Compiling App.Commands.Types ( app/App/Commands/Types.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands/Types.o )\r\n[2 of 7] Compiling App.Lens ( app/App/Lens.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Lens.o )\r\n[3 of 7] Compiling App.Commands.Demo ( app/App/Commands/Demo.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands/Demo.o )\r\n[2 of 2] Compiling Paths_hw_json ( /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/autogen/Paths_hw_json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/bench-tmp/Paths_hw_json.o )\r\nLinking /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/b/bench/opt/build/bench/bench ...\r\n[4 of 7] Compiling App.Commands.CreateIndex ( app/App/Commands/CreateIndex.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands/CreateIndex.o )\r\n[5 of 7] Compiling App.Commands ( app/App/Commands.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/App/Commands.o )\r\n[ 2 of 11] Compiling HaskellWorks.Data.Json.Backend.Standard.Succinct.CursorSpec ( test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/t/hw-json-test/opt/build/hw-json-test/hw-json-test-tmp/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.o )\r\n[6 of 7] Compiling Main ( app/Main.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/Main.o )\r\n[7 of 7] Compiling Paths_hw_json ( /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/autogen/Paths_hw_json.hs, /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json-tmp/Paths_hw_json.o )\r\nLinking /root/project/dist-newstyle/build/x86_64-linux/ghc-8.6.2/hw-json-0.9.0.1/x/hw-json/opt/build/hw-json/hw-json ...\r\ncabal: Failed to build test:hw-json-test from hw-json-0.9.0.1. The build\r\nprocess was killed (i.e. SIGKILL). The typical reason for this is that there\r\nis not enough memory available (e.g. the OS killed a process using lots of\r\nmemory).\r\n\r\nExited with code 1\r\n}}}\r\n\r\n","type_of_failure":"OtherFailure","blocking":[]} -->8.6.3Alp MestanogullariAlp Mestanogullarihttps://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/13535vector test suite uses excessive memory on GHC 8.22023-06-02T11:06:30ZRyan Scottvector test suite uses excessive memory on GHC 8.2First noticed [here](https://github.com/haskell/vector/pull/161#issuecomment-292031845). I haven't managed to boil this down to a test case with no dependencies yet, so for the time being, this requires `vector`. To reproduce, follow the...First noticed [here](https://github.com/haskell/vector/pull/161#issuecomment-292031845). I haven't managed to boil this down to a test case with no dependencies yet, so for the time being, this requires `vector`. To reproduce, follow these steps:
```
$ git clone https://github.com/erikd/vector
$ cd vector/
$ cabal install --only-dependencies --enable-tests -w /opt/ghc/8.2.1/bin/ghc
$ cabal configure --enable-tests -w /opt/ghc/8.2.1/bin/ghc
$ cabal test
```
When building `vector-tests-O2`, GHC will stall when compiling the `Tests.Vector` module. On machines with modest memory allowances (e.g., [the machines used on Travis CI](https://travis-ci.org/haskell/vector/jobs/218749281#L1270)), GHC will be killed with an out-of-memory error after trying to compile `Tests.Vector` for a while.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 8.1 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | highest |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"vector test suite uses excessive memory on GHC 8.2","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"8.2.1","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"8.1","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"First noticed [https://github.com/haskell/vector/pull/161#issuecomment-292031845 here]. I haven't managed to boil this down to a test case with no dependencies yet, so for the time being, this requires `vector`. To reproduce, follow these steps:\r\n\r\n{{{\r\n$ git clone https://github.com/erikd/vector\r\n$ cd vector/\r\n$ cabal install --only-dependencies --enable-tests -w /opt/ghc/8.2.1/bin/ghc\r\n$ cabal configure --enable-tests -w /opt/ghc/8.2.1/bin/ghc\r\n$ cabal test\r\n}}}\r\n\r\nWhen building `vector-tests-O2`, GHC will stall when compiling the `Tests.Vector` module. On machines with modest memory allowances (e.g., [https://travis-ci.org/haskell/vector/jobs/218749281#L1270 the machines used on Travis CI]), GHC will be killed with an out-of-memory error after trying to compile `Tests.Vector` for a while.","type_of_failure":"OtherFailure","blocking":[]} -->⊥Ben GamariBen Gamarihttps://gitlab.haskell.org/ghc/ghc/-/issues/4941SpecConstr generates functions that do not use their arguments2023-11-20T10:27:26ZSimon Peyton JonesSpecConstr generates functions that do not use their argumentsSee also
* #5302
Consider this function:
```
f :: Int -> (Bool,Bool) -> Bool -> Bool
f 0 x y = y
f n (p,q) y = f (n-1) (p,q) q
```
`SpecConstr` does a reasonable job, but ends up with a function like this:
```
T4908a.f_$s$wf =
...See also
* #5302
Consider this function:
```
f :: Int -> (Bool,Bool) -> Bool -> Bool
f 0 x y = y
f n (p,q) y = f (n-1) (p,q) q
```
`SpecConstr` does a reasonable job, but ends up with a function like this:
```
T4908a.f_$s$wf =
\ (sc_sp4 :: GHC.Prim.Int#)
(sc1_sp5 :: GHC.Types.Bool)
(sc2_sp6 :: GHC.Types.Bool)
(sc3_sp7 :: GHC.Types.Bool) ->
case sc_sp4 of ds_Xom {
__DEFAULT ->
T4908a.f_$s$wf (GHC.Prim.-# ds_Xom 1) sc1_sp5 sc2_sp6 sc2_sp6;
0 -> sc3_sp7
}
```
Note that `sc1_sp5` is passed around the loop but never used.
I had a quick go at trying to make `SpecConstr` cleverer, but absence info requires a fixpoint analysis, which the existing `ArgOcc` stuff doesn't do. Nor can we rely on absence analysis from earlier in the compiler, because CSE invalidates it.
A possibility would be to run strictness/absence analysis again after `SpecConstr`, which would pick this up. I'm not sure what other consequences this would have.
So there's an opportunity here, but I'm not sure how much it matters in practice.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 7.0.1 |
| Type | Task |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"SpecConstr generates functions that do not use their arguments","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"⊥","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"7.0.1","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Task","description":"Consider this function:\r\n{{{\r\nf :: Int -> (Bool,Bool) -> Bool -> Bool\r\nf 0 x y = y\r\nf n (p,q) y = f (n-1) (p,q) q\r\n}}}\r\n`SpecConstr` does a reasonable job, but ends up with a function like this:\r\n{{{\r\nT4908a.f_$s$wf =\r\n \\ (sc_sp4 :: GHC.Prim.Int#)\r\n (sc1_sp5 :: GHC.Types.Bool)\r\n (sc2_sp6 :: GHC.Types.Bool)\r\n (sc3_sp7 :: GHC.Types.Bool) ->\r\n case sc_sp4 of ds_Xom {\r\n __DEFAULT ->\r\n T4908a.f_$s$wf (GHC.Prim.-# ds_Xom 1) sc1_sp5 sc2_sp6 sc2_sp6;\r\n 0 -> sc3_sp7\r\n }\r\n}}}\r\nNote that `sc1_sp5` is passed around the loop but never used.\r\n\r\nI had a quick go at trying to make `SpecConstr` cleverer, but absence info requires a fixpoint analysis, which the existing `ArgOcc` stuff doesn't do. Nor can we rely on absence analysis from earlier in the compiler, because CSE invalidates it. \r\n\r\nA possibility would be to run strictness/absence analysis again after `SpecConstr`, which would pick this up. I'm not sure what other consequences this would have.\r\n\r\nSo there's an opportunity here, but I'm not sure how much it matters in practice.","type_of_failure":"OtherFailure","blocking":[]} -->⊥https://gitlab.haskell.org/ghc/ghc/-/issues/24229Order-sensitivity in SpecConstr2023-12-21T21:18:02ZSimon Peyton JonesOrder-sensitivity in SpecConstrConsider this code
```haskell
foo :: Int -> (a,a) -> Maybe (a,a)
foo 0 p = Just p
foo n (x,y) = foo (n-1) (y,x)
wombat1 = foo 20 ("yes", "no")
wombat2 xs ys = foo 3 (xs, ys)
```
Here `foo` is lazy in its second argument, but it does...Consider this code
```haskell
foo :: Int -> (a,a) -> Maybe (a,a)
foo 0 p = Just p
foo n (x,y) = foo (n-1) (y,x)
wombat1 = foo 20 ("yes", "no")
wombat2 xs ys = foo 3 (xs, ys)
```
Here `foo` is lazy in its second argument, but it does decompose it, so SpecConstr
should catch it. We have two calls, one of which (in `wombat2`)is polymorphic.
Ideally we would like to see
```
RULE forall a. forall n::Int, x::a, y:;a. foo n (x,y) = $sfoo n x y
```
which fires on all three calls to `foo`. And that is what happens *if the declaration of
`wombat2` appears before `wombat1`*. But as written, we get this specialisation (only):
```
RULES: "SC:$wfoo0" [2]
forall (sc_sVo :: [Char])
(sc_sVp :: [Char])
(sc_sVn :: GHC.Prim.Int#).
$wfoo_sV6 @String sc_sVn (sc_sVo, sc_sVp)
= $s$wfoo_sVt sc_sVo sc_sVp sc_sVn]
```
and indeed the call in `wombat2` is never specialise. Boo!
## Diagnosis
We discover two calls but in `callsToNewPats` we see
```haskell
-- Remove duplicates
non_dups = nubBy samePat new_pats
```
Moreover `samePat` **treats both calls (one polymorphic and one at type String) as the "same"**.
So the `nubBy` drops one of them, and which is dropped is order-dependent.
Why does it treat them the same? Because of `Note [Ignore type
differences]` which points out that we don't want lots of identical
specialisations, differing only in their type. Good point, but the consequences are bad.
## Cure
We need some form of patten-generality comparison, to make the polymorphic pattern
"beat" the monomorphic one.
This pattern-subsumption approach would then be vulnerable to generating multiple specialisations for calls
```haskell
foo 10 ("foo", "baz") -- Called at String
foo 10 (True, False) -- Called at Bool
```
Ideally we'd like to to generalise to a specialisation that works for all types, not just `String` and `Bool`.
And that must be possible, because if the function scrutinises its argument, can't be
poymorphic in it. Using `foo`'s polymorphic type, We ought to be able to generalise from a single call
```haskell
foo @Int 10 (3,4)
```
to the more general form
```haskell
foo @a n (x::a, y:;a)
```
That looks do-able, but not trivial.
Meanwhile, a simple subumption check would avoid discarding the wrong pattern. It risks generating lots of identical specialisations, while we currently arbitrarily pick one. But we have other (crude) ways of throttling lots of specialisations.https://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/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/22902Optimization opportunity: hidden identity functions.2023-03-01T16:47:38ZJaro ReindersOptimization opportunity: hidden identity functions.<!--
READ THIS FIRST: If the feature you are proposing changes the language that GHC accepts
or adds any warnings to `-Wall`, it should be written as a [GHC Proposal](https://github.com/ghc-proposals/ghc-proposals/).
Other features, appr...<!--
READ THIS FIRST: If the feature you are proposing changes the language that GHC accepts
or adds any warnings to `-Wall`, it should be written as a [GHC Proposal](https://github.com/ghc-proposals/ghc-proposals/).
Other features, appropriate for a GitLab feature request, include GHC API/plugin
innovations, new low-impact compiler flags, or other similar additions to GHC.
-->
## Motivation
See [my discourse thread for the background story](https://discourse.haskell.org/t/a-solved-benchmarking-mystery/5738?u=jaror).
I am investigating if stream fusion could replace foldr/build fusion in base. During the investigation I've encountered bad benchmark results for the streamed `drop` function: it is up to **20x slower** than `Prelude.drop`. I've looked at the core and found that the streamed `drop` boiles down to a function like this:
```haskell
drop :: Int -> [a] -> [a]
drop 0 [] = []
drop 0 (x:xs) = x : drop 0 xs -- [1]
drop n [] = []
drop n (x:xs) = drop (n - 1) xs
```
The main difference with `Prelude.drop` is that this function walks over the remainder of the list that it does not drop (see the recursive call at [1]). That is extremely inefficient. In my benchmarks it is up to 20x slower than `Prelude.drop` because of the extra allocation and subsequent copying of the remainder of the list after dropping.
## Proposal
I think this function could be optimized further. First of all, SpecConstr could split it into two:
```haskell
drop :: Int -> [a] -> [a]
drop 0 [] = []
drop 0 (x:xs) = x : drop0 xs
drop n [] = []
drop n (x:xs) = drop (n - 1) xs
drop0 :: [a] -> [a]
drop0 [] = []
drop0 (x:xs) = x : drop0 xs
```
SpecConstr doesn't do this optimization yet, but #22781 tracks that issue.
Then a special optimization pass could recognize that `drop0` is an identity function and optimize it further to:
```haskell
drop :: Int -> [a] -> [a]
drop 0 [] = []
drop 0 (x:xs) = x : drop0 xs
drop n [] = []
drop n (x:xs) = drop (n - 1) xs
drop0 :: [a] -> [a]
drop0 xs = xs
```
This optimization could simply look for the pattern:
```
<f> xs =
case xs of
[] -> []
x : xs -> x : <f> xs
```
In Core and replace that with `<f> xs = xs`.
It also shouldn't be hard to generalize that for any ADT.
Then finally the result of that optimization already simplifies to (modulo unboxing):
```haskell
drop :: Int -> [a] -> [a]
drop 0 xs = xs
drop n [] = []
drop n (x:xs) = drop (n - 1) xs
```
Which is what we want.https://gitlab.haskell.org/ghc/ghc/-/issues/22787SpecConstr and Specialise should be combined into a single pass.2024-02-27T14:22:06ZAndreas KlebingerSpecConstr and Specialise should be combined into a single pass.Structurally they do very much the same thing:
* Traverse the AST looking for function calls we can specialize for.
* Specialize the RHS of the called function.
* Looking at the specialized rhs for additional calls to specialize.
The m...Structurally they do very much the same thing:
* Traverse the AST looking for function calls we can specialize for.
* Specialize the RHS of the called function.
* Looking at the specialized rhs for additional calls to specialize.
The main difference being that one specializes for dictionary arguments, and the other for value arguments. But to me it seems odd to so strictly separate these two concerns.
I (perhaps naively) assume we could get compile time and maintenance benefits from this in the long run.
* We no longer need to traverse the AST twice.
* We would produce less code in some situations. Currently if we specialize `elem @(Eq Int) (I# 1#) xs` we will first specialise for the dictionary. And then do *another* specialization for the term argument later one. When we could do both in one go.
* We can avoid re-implementing cross-cutting concerns like https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8666 twice for both passes.
That being said doing such a refactor does seem like no small feat. And I have no plans to tackle this in the near future. But it seems like it would be the right thing to do to me.https://gitlab.haskell.org/ghc/ghc/-/issues/22786SpecConstr should fire rules and run the simple optimizer much in the same wa...2023-01-31T15:26:27ZAndreas KlebingerSpecConstr should fire rules and run the simple optimizer much in the same way we do for type class specialization.Consider this (somewhat silly) example:
```haskell
{-# OPTIONS_GHC -fspec-constr-keen -fspec-constr-count=99 -fspec-constr-threshold=90000 -fspec-constr-recursive=500 #-}
{-# LANGUAGE MagicHash #-}
module M(baz) where
import GHC.Exts
...Consider this (somewhat silly) example:
```haskell
{-# OPTIONS_GHC -fspec-constr-keen -fspec-constr-count=99 -fspec-constr-threshold=90000 -fspec-constr-recursive=500 #-}
{-# LANGUAGE MagicHash #-}
module M(baz) where
import GHC.Exts
import Data.Coerce
{-# NOINLINE baz #-}
baz = I# (goz 0# 4#)
where
goz :: Int# -> Int# -> Int#
goz 0# 1# = 1#
goz 0# x = goz 0# (f x)
goz _ (0#) = 3#
goz n x = 6#
f x = case x of
_
| isTrue# (x ># 20#) -> flarge (x -# -20#)
| otherwise -> flarge (x +# 20#)
where
flarge 1# = 2#
flarge 2# = 3#
flarge 3# = 4#
flarge 4# = 5#
flarge 5# = 6#
flarge 6# = 7#
flarge 7# = 8#
flarge 8# = 9#
flarge 9# = 10#
flarge 10# = 11#
flarge 11# = 12#
flarge 12# = 13#
flarge 13# = 14#
flarge 14# = 15#
flarge 15# = 16#
flarge x = x
```
This will eventually reduce to a single number. Naively (with the given spec-constr flags) this function should optimize down to a statically known number at *compile time*.
One blocker for this to happen is https://gitlab.haskell.org/ghc/ghc/-/issues/22781 which I have a fix for already. Applying this fix we run into another issue.
The problem is we specialize `goz` for `goz 0# 4#`.
This gives us the following specialized RHS:
```
-- RHS size: {terms: 83, types: 6, coercions: 0, joins: 1/1}
$sgoz_szB :: (# #) -> Int#
[LclId[StrictWorker([])], Arity=1, Str=<L>]
$sgoz_szB
= \ (void_0E :: (# #)) ->
join {
flarge_szr :: Int# -> Int#
[LclId[JoinId(1)(Nothing)], Arity=1, Str=<SL>]
flarge_szr (eta_B1 [Dmd=SL, OS=OneShot] :: Int#)
= case eta_B1 of ds_X2 {
__DEFAULT -> goz_aiQ 0# ds_X2;
1# -> goz_aiQ 0# 2#;
2# -> goz_aiQ 0# 3#;
3# -> goz_aiQ 0# 4#;
4# -> goz_aiQ 0# 5#;
5# -> goz_aiQ 0# 6#;
6# -> goz_aiQ 0# 7#;
7# -> goz_aiQ 0# 8#;
8# -> goz_aiQ 0# 9#;
9# -> goz_aiQ 0# 10#;
10# -> goz_aiQ 0# 11#;
11# -> goz_aiQ 0# 12#;
12# -> goz_aiQ 0# 13#;
13# -> goz_aiQ 0# 14#;
14# -> goz_aiQ 0# 15#;
15# -> goz_aiQ 0# 16#
} } in
case ># 4# 20# of {
__DEFAULT -> jump flarge_szr (+# 4# 20#);
1# -> jump flarge_szr (-# 4# -20#)
}
```
But that's pretty silly. As it will occur specializations of `goz_aiQ 0# 1#` `goz_aiQ 0# 2#` ... and so on.
If we were to run the simple optimizer on the specialized rhs instead I imagine we would do a lot better.
The case should constant fold away:
```haskell
case ># 4# 20# of {
__DEFAULT -> jump flarge_szr (+# 4# 20#);
1# -> jump flarge_szr (-# 4# -20#)
=>
jump flarge_szr (+# 4# 20#);
```
With now just a single occurence of the join point it should inline. Allowing more case of case, resulting in just a constant integer.
I think we should just do the same as we do for the type class specializer. As I understand it there when we specialize a rhs we run the simple optimizer on it in order to discover additional opportunities for specialization.https://gitlab.haskell.org/ghc/ghc/-/issues/22781SpecConstr does not specialise for literal arguments.2023-09-07T11:00:35ZAndreas KlebingerSpecConstr does not specialise for literal arguments.I would expect this code to specialize:
```
{-# NOINLINE bar #-}
bar = goo 0 1
where
goo :: Int -> Int -> Int
goo 0 1 = 1
goo _ (0) = 3
goo n x = goo n (x-1)
```
But after worker-wrapper the go function takes literal ...I would expect this code to specialize:
```
{-# NOINLINE bar #-}
bar = goo 0 1
where
goo :: Int -> Int -> Int
goo 0 1 = 1
goo _ (0) = 3
goo n x = goo n (x-1)
```
But after worker-wrapper the go function takes literal ints for which SpecConstr currently doesn't create specializations.Andreas KlebingerAndreas Klebinger