[Haskell-cafe] Transformation sequence

Stefan O'Rear stefanor at cox.net
Sat Oct 20 15:34:01 EDT 2007


On Sat, Oct 20, 2007 at 08:05:37PM +0100, Andrew Coppin wrote:
> Brent Yorgey wrote:
>>
>> Hmm... I'm having trouble understanding exactly what you want.  In 
>> particular, I don't understand what this statement:
>>
>> "But what I *really* want is to print out the transformation *sequence*."
>>
>> has to do with the pseudocode that you exhibit later.  Could you perhaps 
>> clarify a bit more, or give a specific example?
>
> I want to construct a program that prints out something like this:
>
> [\fx -> f(fx)]
> [\f -> [\x -> f(fx)]]
> [\f -> S[\x -> f][\x -> fx]]
> [\f -> S(Kf)[\x -> fx]]
> [\f -> S(Kf)f]
> S[\f -> S(Kf)][\f -> f]
> S(S[\f -> S][\f -> Kf])[\f -> f]
> S(S(KS)[\f -> Kf])[\f -> f]
> S(S(KS)K)[\f -> f]
> S(S(KS)K)I
>
> I can quite happily construct a program which, given the first line, yields 
> the last line. But getting it to print all the intermediate steps is 
> harder. And, like I said, when something is "hard" in Haskell, it usually 
> means you're doing it the wrong way... ;-)

Thought it sounded fun, so I did it:


data Term = Lam String Term | Term :$ Term | Var String

paren act = if act then \ a -> ('(':) . a . (')':) else id

ppr i (Lam s t) = paren (i > 0) $ (:) '\\' . (++) s . (++) ". " . ppr 0 t
ppr i (a :$ b)  = paren (i > 1) $ ppr 1 a . (:) ' ' . ppr 2 b
ppr i (Var s)   = paren (i > 2) $ (++) s

reduce (Lam nm bd :$ obj) = Just (subst bd) where
    subst (Lam nm' bd') = Lam nm' (if nm == nm' then bd' else subst bd')
    subst (a :$ b)      = subst a :$ subst b
    subst (Var nm')     = if nm == nm' then obj else Var nm'
reduce (left :$ right)    = fmap (:$ right) (reduce left)
reduce other              = Nothing

trail' ob = ppr 0 ob "\n" : maybe [] trail' (reduce ob)
trail = concat . trail'

The important part is the co-recursive trail, which produces a value
using (:) before calling itself.  No monads necessary.

Stefan
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20071020/8f4adbb4/attachment.bin


More information about the Haskell-Cafe mailing list