[Haskell-cafe] Using multiplate to get free variables from a syntax tree

Matt Brown matt at softmechanics.net
Mon Feb 27 01:05:03 CET 2012


Thanks everyone! This has been interesting and helpful.  I for one had
not seen multirec, but will check it out.  Is the implication that
multirec is more or less complicated than multiplate?

Cheers,
-matt

On Sun, Feb 26, 2012 at 3:28 PM, Sjoerd Visscher <sjoerd at w3future.com> wrote:
> Here's the same code but with a variation on Multiplate that doesn't use records, but a GADT:
> https://gist.github.com/1919528
>
> It is easier on the eyes I think, but probably not any easier to decipher. But hey, this is generic programming for mutually recursive datatypes, that's a complicated subject! (Have you tried multirec?)
>
> Sjoerd
>
> On Feb 26, 2012, at 12:21 AM, Thomas Schilling wrote:
>
>> No that's correct.  I have to say the multiplate code is incredibly
>> hard to decipher.
>>
>> On 25 February 2012 19:47, Sjoerd Visscher <sjoerd at w3future.com> wrote:
>>> I don't understand what you mean.
>>>
>>>>>> ($[]) . foldFor expr freeVariablesPlate $ Add (Let ("x" := Con 1) (Add (EVar "x") (EVar "y"))) (EVar "x")
>>> (["y","x"],[])
>>>
>>> I.e. free variables y and x, no bound variables. Is that not correct?
>>>
>>> Sjoerd
>>>
>>> On Feb 25, 2012, at 7:15 PM, Thomas Schilling wrote:
>>>
>>>> That will give you the wrong answer for an expression like:
>>>>
>>>>  (let x = 1 in x + y) + x
>>>>
>>>> Unless you do a renaming pass first, you will end up both with a bound
>>>> "x" and a free "x".
>>>>
>>>> On 25 February 2012 16:29, Sjoerd Visscher <sjoerd at w3future.com> wrote:
>>>>>
>>>>> On Feb 24, 2012, at 10:09 PM, Stephen Tetley wrote:
>>>>>
>>>>>> I'm not familiar with Multiplate either, but presumably you can
>>>>>> descend into the decl - collect the bound vars, then descend into the
>>>>>> body expr.
>>>>>
>>>>>> Naturally you would need a monadic traversal
>>>>>> rather than an applicative one...
>>>>>
>>>>>
>>>>> It turns out the traversal is still applicative. What we want to collect are the free and the declared variables, given the bound variables. ('Let' will turn the declared variables into bound variables.) So the type is [Var] -> ([Var], [Var]). Note that this is a Monoid, thanks to the instances for ((->) r), (,) and []. So we can use the code from preorderFold, but add an exception for the 'Let' case.
>>>>>
>>>>> freeVariablesPlate :: Plate (Constant ([Var] -> ([Var], [Var])))
>>>>> freeVariablesPlate = handleLet (varPlate `appendPlate` multiplate freeVariablesPlate)
>>>>>  where
>>>>>    varPlate = Plate {
>>>>>      expr = \x -> Constant $ \bounded -> ([ v | EVar v <- [x], v `notElem` bounded], []),
>>>>>      decl = \x -> Constant $ const ([], [ v | v := _ <- [x]])
>>>>>    }
>>>>>    handleLet plate = plate { expr = exprLet }
>>>>>      where
>>>>>        exprLet (Let d e) = Constant $ \bounded ->
>>>>>          let
>>>>>            (freeD, declD) = foldFor decl plate d bounded
>>>>>            (freeE, _)     = foldFor expr plate e (declD ++ bounded)
>>>>>          in
>>>>>            (freeD ++ freeE, [])
>>>>>        exprLet x = expr plate x
>>>>>
>>>>> freeVars :: Expr -> [Var]
>>>>> freeVars = fst . ($ []) . foldFor expr freeVariablesPlate
>>>>>
>>>>>>>> freeVars $ Let ("x" := Con 42) (Add (EVar "x") (EVar "y"))
>>>>> ["y"]
>>>>>
>>>>> --
>>>>> Sjoerd Visscher
>>>>> https://github.com/sjoerdvisscher/blog
>>>>>
>>>>>
>>>>>
>>>>>
>>>>>
>>>>> _______________________________________________
>>>>> Haskell-Cafe mailing list
>>>>> Haskell-Cafe at haskell.org
>>>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>>
>>>>
>>>>
>>>> --
>>>> Push the envelope. Watch it bend.
>>>>
>>>
>>> --
>>> Sjoerd Visscher
>>> https://github.com/sjoerdvisscher/blog
>>>
>>>
>>>
>>>
>>>
>>>
>>> _______________________________________________
>>> Haskell-Cafe mailing list
>>> Haskell-Cafe at haskell.org
>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>>
>>
>> --
>> Push the envelope. Watch it bend.
>>
>
> --
> Sjoerd Visscher
> https://github.com/sjoerdvisscher/blog
>
>
>
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list