[GHC] #13663: Option to disable turning recursive let-bindings to recursive functions
GHC
ghc-devs at haskell.org
Mon May 8 14:22:28 UTC 2017
#13663: Option to disable turning recursive let-bindings to recursive functions
-------------------------------------+-------------------------------------
Reporter: darchon | Owner: (none)
Type: feature request | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.0.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Description changed by darchon:
@@ -49,3 +49,3 @@
- Now, when we look at the output of the desugarer (-ddump-ds), we can see
- that the core-level binder of `topEntity` basically follows the Haskell
- code.
+ Now, when we look at the output of the desugarer (-ddump-ds -dsuppress-
+ all), we can see that the core-level binder of `topEntity` basically
+ follows the Haskell code.
@@ -55,1 +55,0 @@
- [LclIdX]
@@ -59,2 +58,1 @@
- [LclId]
- ds_d2rI = gpio (decodeReq 1 req_a2pF);
+ ds_d2rI = gpio (decodeReq 1 req_a2pG);
@@ -62,9 +60,4 @@
- [LclId]
- ds_d2rS = gpio (decodeReq 2 req_a2pF);
- req_a2pF [Occ=LoopBreaker] :: [()]
- [LclId]
- req_a2pF
- = $ @ 'GHC.Types.LiftedRep
- @ [Maybe ()]
- @ [()]
- core
+ ds_d2rS = gpio (decodeReq 2 req_a2pG);
+ req_a2pG :: [()]
+ req_a2pG
+ = $ core
@@ -72,4 +65,1 @@
- @ []
- GHC.Base.$fApplicative[]
- @ (Maybe ())
- @ (Maybe ())
+ $fApplicative[]
@@ -77,6 +67,2 @@
- @ []
- @ (Maybe ())
- @ (Maybe () -> Maybe ())
- GHC.Base.$fFunctor[]
- (<|> @ Maybe GHC.Base.$fAlternativeMaybe @ ())
- (ram (decodeReq 0 req_a2pF)))
+ $fFunctor[] (<|> $fAlternativeMaybe) (ram (decodeReq 0
+ req_a2pG)))
@@ -84,4 +70,1 @@
- @ []
- GHC.Base.$fApplicative[]
- @ (Maybe ())
- @ (Maybe ())
+ $fApplicative[]
@@ -89,11 +72,6 @@
- @ []
- @ (Maybe ())
- @ (Maybe () -> Maybe ())
- GHC.Base.$fFunctor[]
- (<|> @ Maybe GHC.Base.$fAlternativeMaybe @ ())
- (case ds_d2rI of { (_ [Occ=Dead], outResp1_X2pQ) ->
- outResp1_X2pQ
- }))
- (case ds_d2rS of { (_ [Occ=Dead], outResp2_X2q2) ->
- outResp2_X2q2
- }))); } in
+ $fFunctor[]
+ (<|> $fAlternativeMaybe)
+ (case ds_d2rI of { (_, outResp1_X2pR) ->
+ outResp1_X2pR }))
+ (case ds_d2rS of { (_, outResp2_X2q3) -> outResp2_X2q3
+ }))); } in
@@ -101,4 +79,1 @@
- @ []
- GHC.Base.$fApplicative[]
- @ ()
- @ ((), ())
+ $fApplicative[]
@@ -106,11 +81,4 @@
- @ []
- @ ()
- @ (() -> ((), ()))
- GHC.Base.$fFunctor[]
- (GHC.Tuple.(,) @ () @ ())
- (case ds_d2rI of { (outport1_a2pA, _ [Occ=Dead]) ->
- outport1_a2pA
- }))
- (case ds_d2rS of { (outport2_a2pM, _ [Occ=Dead]) ->
- outport2_a2pM
- })
+ $fFunctor[]
+ (,)
+ (case ds_d2rI of { (outport1_a2pB, _) -> outport1_a2pB }))
+ (case ds_d2rS of { (outport2_a2pN, _) -> outport2_a2pN })
@@ -120,3 +88,3 @@
- transformations disabled (-O0 -ddump-ds), you will see that parts of
- `topEntity` are split into 3 different top-level, mutually recursive,
- functions.
+ transformations disabled (-O0 -ddump-simpl -dsuppress-all), you will see
+ that parts of `topEntity` are split into 3 different top-level, mutually
+ recursive, functions.
@@ -126,0 +94,1 @@
+ -- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
@@ -133,0 +102,1 @@
+ -- RHS size: {terms: 25, types: 50, coercions: 0, joins: 0/0}
@@ -137,4 +107,1 @@
- @ []
- GHC.Base.$fApplicative[]
- @ (Maybe ())
- @ (Maybe ())
+ $fApplicative[]
@@ -142,6 +109,2 @@
- @ []
- @ (Maybe ())
- @ (Maybe () -> Maybe ())
- GHC.Base.$fFunctor[]
- (<|> @ Maybe GHC.Base.$fAlternativeMaybe @ ())
- (ram (decodeReq 0 req_r2sq)))
+ $fFunctor[] (<|> $fAlternativeMaybe) (ram (decodeReq 0
+ req_r2sq)))
@@ -149,4 +112,1 @@
- @ []
- GHC.Base.$fApplicative[]
- @ (Maybe ())
- @ (Maybe ())
+ $fApplicative[]
@@ -154,7 +114,4 @@
- @ []
- @ (Maybe ())
- @ (Maybe () -> Maybe ())
- GHC.Base.$fFunctor[]
- (<|> @ Maybe GHC.Base.$fAlternativeMaybe @ ())
- (case ds_r2so of { (outport1_a2pA, outResp1_X2pQ) ->
- outResp1_X2pQ
+ $fFunctor[]
+ (<|> $fAlternativeMaybe)
+ (case ds_r2so of { (outport1_a2pB, outResp1_X2pR) ->
+ outResp1_X2pR
@@ -162,2 +119,2 @@
- (case ds1_r2sp of { (outport2_a2pM, outResp2_X2q2) ->
- outResp2_X2q2
+ (case ds1_r2sp of { (outport2_a2pN, outResp2_X2q3) ->
+ outResp2_X2q3
@@ -167,0 +124,1 @@
+ -- RHS size: {terms: 13, types: 35, coercions: 0, joins: 0/0}
@@ -170,4 +128,1 @@
- @ []
- GHC.Base.$fApplicative[]
- @ ()
- @ ((), ())
+ $fApplicative[]
@@ -175,7 +130,4 @@
- @ []
- @ ()
- @ (() -> ((), ()))
- GHC.Base.$fFunctor[]
- (GHC.Tuple.(,) @ () @ ())
- (case ds_r2so of { (outport1_a2pA, outResp1_X2pQ) ->
- outport1_a2pA
+ $fFunctor[]
+ (,)
+ (case ds_r2so of { (outport1_a2pB, outResp1_X2pR) ->
+ outport1_a2pB
@@ -183,2 +135,2 @@
- (case ds1_r2sp of { (outport2_a2pM, outResp2_X2q2) ->
- outport2_a2pM
+ (case ds1_r2sp of { (outport2_a2pN, outResp2_X2q3) ->
+ outport2_a2pN
New description:
First some context:
I'm using the GHC API to convert Haskell to digital circuit descriptions
(clash compiler).
When viewed as a structural description of a circuit, recursive let-
bindings can be turned into feedback loops.
In general, when viewed as a structural description of a circuit,
recursive functions describe infinite hierarchy, i.e. they are not
realisable as circuit.
So now my problem: the simplifier turns recursive let-bindings to
recursive functions; i.e. it is turning something which I can translate to
a circuit to something which I cannot translate to a circuit.
Next follows a reduced test case which exemplifies this behaviour:
{{{#!haskell
module Test where
import Control.Applicative
topEntity :: [((),())]
topEntity = (,) <$> outport1 <*> outport2
where
(outport1, outResp1) = gpio (decodeReq 1 req)
(outport2, outResp2) = gpio (decodeReq 2 req)
ramResp = ram (decodeReq 0 req)
req = core $ (<|>) <$> ramResp <*> ((<|>) <$> outResp1 <*> outResp2)
core :: [Maybe ()] -> [()]
core = fmap (maybe () id)
{-# NOINLINE core #-}
ram :: [()] -> [Maybe ()]
ram = fmap pure
{-# NOINLINE ram #-}
decodeReq :: Integer -> [()] -> [()]
decodeReq 0 = fmap (const ())
decodeReq 1 = id
decodeReq _ = fmap id
{-# NOINLINE decodeReq #-}
gpio :: [()] -> ([()],[Maybe ()])
gpio i = (i,pure <$> i)
{-# NOINLINE gpio #-}
}}}
Now, when we look at the output of the desugarer (-ddump-ds -dsuppress-
all), we can see that the core-level binder of `topEntity` basically
follows the Haskell code.
{{{#!haskell
topEntity :: [((), ())]
topEntity
= letrec {
ds_d2rI :: ([()], [Maybe ()])
ds_d2rI = gpio (decodeReq 1 req_a2pG);
ds_d2rS :: ([()], [Maybe ()])
ds_d2rS = gpio (decodeReq 2 req_a2pG);
req_a2pG :: [()]
req_a2pG
= $ core
(<*>
$fApplicative[]
(<$>
$fFunctor[] (<|> $fAlternativeMaybe) (ram (decodeReq 0
req_a2pG)))
(<*>
$fApplicative[]
(<$>
$fFunctor[]
(<|> $fAlternativeMaybe)
(case ds_d2rI of { (_, outResp1_X2pR) ->
outResp1_X2pR }))
(case ds_d2rS of { (_, outResp2_X2q3) -> outResp2_X2q3
}))); } in
<*>
$fApplicative[]
(<$>
$fFunctor[]
(,)
(case ds_d2rI of { (outport1_a2pB, _) -> outport1_a2pB }))
(case ds_d2rS of { (outport2_a2pN, _) -> outport2_a2pN })
}}}
However, when we look at the simplifier output, with nearly all
transformations disabled (-O0 -ddump-simpl -dsuppress-all), you will see
that parts of `topEntity` are split into 3 different top-level, mutually
recursive, functions.
{{{#!haskell
Rec {
-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
ds_r2so :: ([()], [Maybe ()])
ds_r2so = gpio (decodeReq 1 req_r2sq)
-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
ds1_r2sp :: ([()], [Maybe ()])
ds1_r2sp = gpio (decodeReq 2 req_r2sq)
-- RHS size: {terms: 25, types: 50, coercions: 0, joins: 0/0}
req_r2sq :: [()]
req_r2sq
= core
(<*>
$fApplicative[]
(<$>
$fFunctor[] (<|> $fAlternativeMaybe) (ram (decodeReq 0
req_r2sq)))
(<*>
$fApplicative[]
(<$>
$fFunctor[]
(<|> $fAlternativeMaybe)
(case ds_r2so of { (outport1_a2pB, outResp1_X2pR) ->
outResp1_X2pR
}))
(case ds1_r2sp of { (outport2_a2pN, outResp2_X2q3) ->
outResp2_X2q3
})))
end Rec }
-- RHS size: {terms: 13, types: 35, coercions: 0, joins: 0/0}
topEntity :: [((), ())]
topEntity
= <*>
$fApplicative[]
(<$>
$fFunctor[]
(,)
(case ds_r2so of { (outport1_a2pB, outResp1_X2pR) ->
outport1_a2pB
}))
(case ds1_r2sp of { (outport2_a2pN, outResp2_X2q3) ->
outport2_a2pN
})
}}}
So my question are:
- Which part of the simplifier is turning these local recursive let-
binders into global recursive functions?
- Is there some way to disable this transformation?
- If not, how much effort do you think it would be to put this behaviour
behind a dynflag? So that I, as a GHC API user, can disable it for my use-
case. I'm willing to implements this dynflag myself.
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13663#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list