<div dir="ltr">Hello GHC Devs,<div><br></div><div>First some context:</div><div>I'm using the GHC API to convert Haskell to digital circuit descriptions (clash compiler).</div><div>When viewed as a structural description of a circuit, recursive let-bindings can be turned into feedback loops.</div><div>In general, when viewed as a structural description of a circuit, recursive functions describe infinite hierarchy, i.e. they are not realisable as circuit.</div><div><br></div><div>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.</div><div><br></div><div>Next follows a reduced test case which exemplifies this behaviour:</div><div><br></div><div>```</div><div><div>import Control.Applicative</div><div><br></div><div>topEntity :: [((),())]</div><div>topEntity = (,) <$> outport1 <*> outport2</div><div>  where</div><div>    (outport1, outResp1) = gpio (decodeReq 1 req)</div><div>    (outport2, outResp2) = gpio (decodeReq 2 req)</div><div>    ramResp              = ram  (decodeReq 0 req)</div><div><br></div><div>    req = core $ (<|>) <$> ramResp <*> ((<|>) <$> outResp1 <*> outResp2)</div><div>    {-# INLINE req #-}</div><div><br></div><div>core :: [Maybe ()] -> [()]</div><div>core = fmap (maybe () id)</div><div>{-# NOINLINE core #-}</div><div><br></div><div>ram :: [()] -> [Maybe ()]</div><div>ram = fmap pure</div><div>{-# NOINLINE ram #-}</div><div><br></div><div>decodeReq :: Integer -> [()] -> [()]</div><div>decodeReq 0 = fmap (const ())</div><div>decodeReq 1 = id</div><div>decodeReq _ = fmap id</div><div>{-# NOINLINE decodeReq #-}</div><div><br></div><div>gpio :: [()] -> ([()],[Maybe ()])</div><div>gpio i = (i,pure <$> i)</div><div>{-# NOINLINE gpio #-}</div></div><div>```</div><div><br></div><div>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.</div><div><br></div><div>However, when we look at the simplifier output, with nearly all transformations disabled (-O0 -ddump-ds), you will see that parts of `topEntity` are split into 3 different top-level, mutually recursive, functions.</div><div><br></div><div>So my question are:</div><div>- Which part of the simplifier is turning these local recursive let-binders into global recursive functions?</div><div>- Is there some way to disable this transformation?</div><div>- 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.</div><div><br></div><div>Kind regards,</div><div><br></div><div>Christiaan</div></div>