haskell - Interpreting an abstract syntax graph efficiently -

take minimal language (apparently called hutton's razor):

{-# options_ghc -fno-warn-missing-methods #-}  data expr =     lit int   | add expr expr   deriving (eq, show)  instance num expr   frominteger = lit . frominteger   (+)         = add  tree 0 = 1 tree n =   let shared = tree (n - 1)   in  shared + shared 

if run tree 30 in ghci, type default integer , we'll immediate answer recursive computations of tree shared. if run tree 30 :: expr, enormous syntax tree sharing provided haskell's let doesn't transfer expressions in embedded language.

the data-reify library can used observe implicit sharing might present in expression. can add machinery enable that:

{-# language derivefunctor #-} {-# language typefamilies #-}  import control.applicative import data.reify  data exprf e =     litf int   | addf e e   deriving (eq, show, functor)  instance muref expr   type deref expr = exprf   mapderef f (add e0 e1) = add <$> f e0 <*> f e1   mapderef _ (lit d)     = pure (litf d) 

and applying reifygraph function expression tree 30 :: expr returns graph sharing explicit. here's more digestible example:

> reifygraph (tree 2 :: expr) let [(1,addf 2 2),(2,addf 3 3),(3,litf 1)] in 1 

so i'm interested in interpreting abstract syntax graph rather abstract syntax tree.

a naive evalgraph function eliminates sharing interpreting if tree:

evalgraph (graph env r) = go r   go j = case lookup j env of     (addf b) -> go + go b     (litf d)   -> d     nothing         -> 0 

as can verified trying

> evalgraph <$> reifygraph (tree 50 :: expr) 

not being experienced in sort of thing, have found surprisingly difficult come simple , efficient implementation of evalgraph.

oliveira , löh provide example in graph used build expression in proxy language sharing explicit (which can evaluated in setting), seems that's unnecessarily heavyweight approach take if want consume graph immediately.

what best approach evaluate type of graph while preserving sharing?

edit:

memoization à la data.stablememo handles right get-go, given syntax in dag structure (for whatever reason), think topological sort + memoization right way go here.

here's quick/hacky graph-based evaluator:

import data.graph import data.maybe import system.io.unsafe  grapheval :: expr -> int grapheval expr = consume reified   reified = unsafeperformio (tograph <$> reifygraph expr)   tograph (reify.graph env _) = graphfromedges . map tonode $ env   tonode (j, addf b) = (addf b, j, [a, b])   tonode (j, litf d)   = (litf d, j, [])  consume :: eq => (graph, vertex -> (exprf a, a, b), c) -> int consume (g, vmap, _) = go (reverse . topsort $ g) []   go [] acc = snd $ head acc   go (v:vs) acc =     let nacc = evalnode (vmap v) acc : acc     in  go vs nacc  evalnode :: eq => (exprf a, b, c) -> [(a, int)] -> (b, int) evalnode (litf d, k, _)   _ = (k, d) evalnode (addf b, k, _) l =   let v = fromjust ((+) <$> lookup l <*> lookup b l)   in  (k, v) 

assuming graph dag, problem quite simple:

1. order nodes topologically
2. evaluate in order, looking values go.

it work example:

reverse nodes to:

[(3,litf 1),(2,addf 3 3),(1,addf 2 2)] 

then evaluate them in order, looking previous values:

[1,2,4]