[Haskell-cafe] How to translate Haskell to other languages?
Derek Elkins
derek.a.elkins at gmail.com
Sat Oct 11 14:09:13 EDT 2008
On Sat, 2008-10-11 at 16:55 +0100, Matthew Naylor wrote:
> Hi Jason,
>
> I don't know Python, but let me share some thoughts that you might
> find useful.
>
> First, a few questions about your manual translations. Are your
> functions curried? For example, can I partially apply zipWith? Also,
> you put a "thunk" around things like "cons(...)" --- should it not be
> the arguments to "cons" that are thunked?
>
> Now, on to an automatic translation. As you may know already, Haskell
> programs can be transformed to "combinator programs" which are quite
> simple and easy to work with. Here is what I mean by a "combinator
> program":
>
> p ::= d* (a program is a list of combinator definitions)
> d ::= c v* = e (combinator definition)
> e ::= e e (application)
> | v (variable/argument)
> | c (constant: integer literal, combinator name, etc.)
>
> As an example of a combinator program, here is one that reverses the
> list [0,1,2].
>
> rev v acc = v acc (rev2 acc)
> rev2 acc x xs = rev xs (cons x acc)
> cons x xs n c = c x xs
> nil n c = n
>
> main = rev (cons 0 (cons 1 (cons 2 nil))) nil
>
> This program does not type-check in Haskell! But Python, being
> dynamically typed, doesn't suffer from this problem. :-)
>
> A translation scheme, D[], from a combinator definition to a Python
> definition might look as follows.
>
> D[c v* = e] = def c() : return (lambda v1: ... lambda vn: E[e])
> E[e0 e1] = E[e0] (E[e1])
> E[v] = v
> E[c] = c()
>
> Here is the result of (manually) applying D to the list-reversing program.
>
> def nil() : return (lambda n: lambda c: n)
> def cons() : return (lambda x: lambda xs: lambda n: lambda c: c(x)(xs))
> def rev2() : return (lambda acc: lambda x: lambda xs:
> rev()(xs)(cons()(x)(acc)))
> def rev() : return (lambda v: lambda acc: v(acc)(rev2()(acc)))
>
> def main() : return (rev() (cons()(0)(
> cons()(1)(
> cons()(2)(
> nil()))))(nil()))
>
> The result of main() is a partially-applied function, which python
> won't display. But using the helper
>
> def list(f) : return (f([])(lambda x: lambda xs: [x] + list(xs)))
>
> we can see the result of main():
>
> >>> list(main())
> [2, 1, 0]
>
> Of course, Python is a strict language, so we have lost Haskell's
> non-strictness during the translation. However, there exists a
> transformation which, no matter how a combinator program is evaluated
> (strictly, non-strictly, or lazily), the result will be just as if it
> had been evaluated non-strictly. Let's call it N, for "Non-strict" or
> "call-by-Name".
>
> N[e0 e1] = N[e0] (\x. N[e1])
> N[v] = v (\x. x)
> N[f] = f
>
> I've cheekily introduced lambdas on the RHS here --- they are not
> valid combinator expressions! But since Python supports lambdas, this
> is not a big worry.
>
> NOTE 1: We can't remove the lambdas above by introducing combinators
> because the arguments to the combinator would be evaluated and that
> would defeat the purpose of the transformation!
>
> NOTE 2: "i" could be replaced with anything above --- it is never
> actually inspected.
>
> For the sake of interest, there is also a "dual" transformation which
> gives a program that enforces strict evaluation, no matter how it is
> evaluated. Let's call it S for "Strict".
>
> S[e0 e1] = \k. S[e0] (\f. S[e1] (\x. k (f x)))
> S[v] = \k. k v
> S[f] = \k. k f
>
> I believe this is commonly referred to as the CPS
> (continuation-passing style) transformation.
This is indeed a CPS transform. Specifically, a call-by-value CPS
transform. There is also a call-by-name one.
N[e0 e1] = \k. N[e0] (\f. f N[e1] k)
N[v] = v
N[c] = \k. k c
More information about the Haskell-Cafe
mailing list