On 12/26/07, Cristian Baboi <[EMAIL PROTECTED]> wrote: > > The reason I want to build functions of type String -> (a -> b) is because > I want to see how far I can get with "functions are first class citizens" > in Haskell. I thought that if I read the function from an external source, > there is no way the compiler could know what I'll read. I want to see if I > can build a Haskell function at runtime, not a data structure that I can > interpret.
Those two questions are intimately related, though. Consider the following simple program: > {-# LANGUAGE GADTs #-} > module Compile where > > data Term a where > App :: Term (a -> b) -> Term a -> Term b > Prim :: a -> Term a Implementation of lambda-abstractions is left as an exercise for the reader. > compile :: Term a -> a > compile (Prim x) = x > compile (App x y) = compile x $ compile y While "compile" looks like an interpreter (and it is), there is no reason why "a" has to be a concrete data type; it could be a function type, as demonstrated here: > uncompiled_func :: Term (Int -> Int) > uncompiled_func = App (Prim (+)) (Prim 1) > > compiled_func :: Int -> Int > compiled_func = compile uncompiled_func The first time you evaluate "compiled_func", you'll run the "compiler" which will create a function for you. Consider the lazy evaluation order of this program: > result :: Int > result = compiled_func 3 + compiled_func 4 I'll use "let" to represent sharing and "plus#" to represent the primitive operation of adding two numbers which (+) is defined in terms of. That is, (+) = \x y -> plus# x y result => compiled_func 3 + compiled_func 4 => (\x y -> plus# x y) (compiled_func 3) (compiled_func 4) => plus# (compiled_func 3) (compiled_func 4) => let compiled_func = compile uncompiled_func in plus# (compiled_func 3) (compiled_func 4) (evaluating compiled_func) compile (App (Prim (+)) (Prim 1)) => compile (Prim (+)) (compile (Prim 1)) => (+) (compile (Prim 1)) => (\x y -> plus# x y) (compile (Prim 1)) => (\y -> plus# (compile (Prim 1)) y) which is WHNF => let compiled_func = (\y -> plus# (compile (Prim 1)) y) in plus# (compiled_func 3) (compiled_func 4) => let inner = (compile (Prim 1)); compiled_func = \y -> plus# inner y in plus# (compiled_func 3) (compiled_func 4) => let inner = (compile (Prim 1)) in plus# (plus# inner 3) ((\y -> plus# inner y) 4) => let inner = 1 in plus# (plus# inner 3) ((\y -> plus# inner y) 4) => plus# 4 ((\y -> plus# 1 y) 4) => plus# 4 (plus# 1 4) => plus# 4 5 => 9 Note that "compile" only gets run once on each subexpression; the end result is that you end up with a regular Haskell function which does no interpretation at all! All that remains is creation of something of type "Term a" from an untyped representation. Oleg's done the work here and you can see a full implementation in this message: http://www.haskell.org/pipermail/haskell-cafe/2007-October/032591.html -- ryan
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe