4
\$\begingroup\$

The code is self-contained and self-explaining. I want to improve the goal function. You can change everything below the -- My solution line as long as behaviour of goal :: Goal function is preserved and there is no explicit recursion. Basically I need to rearrange Strings from Graph in a Definition tree using children relationships from Postdominators.

I use ana from recursion-schemes, but you are free to use whatever you want to avoid the recursion. Think of it as an exercise in recursion schemes.

Below is an explanation of what the code does, all 5 lines of it. I removed inessential parts from the real code, but left names intact, so they are somewhat misleading.

I develop a source to source translator. I need to generate source text of a simple functional language with identifier scopes defined by "where" statements similar to what Haskell has.

I get an AST with scopes. Then I convert the AST to a scopeless control flow graph and optimize it. Then I restore the scopes approximately by using dominator analysis of variable references graph.

type Graph = M.Map Label (Maybe String) is the scopeless representation. Some labels point to Nothing and must be ignored.

data Definition = Definition String [Definition] is the scopeful representation - a rose tree of String.

type PostdominatorMap = M.Map Label [Label] - it shows which statements are immediate children of which. If there are no children, there is no key in the map. PostdominatorMap is essentially a tree of Label.

The real code is different, I simplified it a little to keep inessential stuff away. I can't really control the things above the --My solution line as they are dictated by the library I use.

{-# LANGUAGE TypeFamilies, DeriveFunctor, NoMonomorphismRestriction #-}

import Prelude hiding (Foldable)
import Data.Functor.Foldable
import Data.Maybe
import qualified Data.Map as M

type Label = Int

type PostdominatorMap = M.Map Label [Label]

type Graph = M.Map Label (Maybe String)

data Definition = Definition String [Definition]

type Goal = PostdominatorMap -> Graph -> Label -> Definition

-- My solution:

data DefinitionBase a = DefinitionBase String [a] deriving (Functor)

type instance Base Definition = DefinitionBase

instance Foldable Definition where
    project (Definition a b) = DefinitionBase a b

instance Unfoldable Definition where
    embed (DefinitionBase a b) = Definition a b

uncondLookup k = fromMaybe (error "uh-oh") . M.lookup k

goal :: Goal
goal pd g firstLabel = ana (mapWhere $ mapMaybe baz) $ fromJust $ baz firstLabel
    where
        baz :: Label -> Maybe (DefinitionBase Label)
        baz x = lookupValue2 g (M.findWithDefault [] x pd) x

mapWhere f (DefinitionBase a b) = DefinitionBase a (f b)

lookupValue2 g pd x = f <$> uncondLookup x g where
    f a = DefinitionBase a pd

ana offers significant freedom in choosing the seed, so a smart selection of the seed could simplify the code.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.