Hi everyone,
I finally got around to implementing my port of the tiny lisp
implementation from here:
http://www.defmacro.org/ramblings/lisp-in-haskell.html
It's pretty fun. While it doesn't actually parse syntax yet, it does let
you do this:
////////////////////////////////////////////
// (set i 5)
val ctx, e = print_expr initial_ctx$
LispList (list$ LispSymbol "set", LispSymbol "i", LispInt 5);
// (+ i 1) = 6
val ctx', e' = print_expr ctx$
LispList (list$ LispSymbol "+", LispSymbol "i", LispInt 1);
// (set j (+ i 5)) = 10
val ctx'', e'' = print_expr ctx'$
LispList (list$ LispSymbol "set", LispSymbol "j", LispList (list$
LispSymbol "+", LispSymbol "i", LispInt 5));
// (set j (+ j 1)) = 11
val ctx''', e''' = print_expr ctx''$
LispList (list$ LispSymbol "set", LispSymbol "j", LispList (list$
LispSymbol "+", LispSymbol "j", LispInt 1));
////////////////////////////////////////////
Eventually I'd like to implement the monadic form from this tutorial,
but that requires monads :)
A couple comments. First off, it takes a surprisingly long time to
compile this code. If implemented in ocaml, I would imagine this would
have compiled in a trivially short amount of time. On my mac it takes
about 9 seconds to compile and run.
Second, I got hit by the classic "if you don't use the output of a
function it can get optimized away" bug/feature. I wish there was a
better way to tell when that was happening, but then again it's probably
similar to when using Haskell and you assume strict semantics. What was
interesting though was that this didn't appear until I changed the
"print_expr" function to use the new ljust function. Odd that that would
have tickled the optimizer.
Third, typeclasses rule. I really like the show typeclass, and I can't
wait to add it to the standard library, once we resolve some of the
surrounding issues.
Forth, hitting compiler exceptions really can make things difficult. I
wonder if there's a better approach we can take to handle error
messages. Might be worthwhile seeing how the ocaml compiler organizes
their error handling.
I'm sure there's more, but it's late, so goodnight!
-e
fun map_accum_left [T,U,V] (f:T->U->(T*V)) (s:T) (xs:list[U]): T*list[V] =>
match xs with
| Empty[U] => s, Empty[V]
| Cons (?x, ?xs) =>
let ?s', ?y = f s x in
let ?s'', ?ys = map_accum_left f s' xs in
s'', Cons (y, ys)
endmatch
;
fun map_accum_right [T,U,V] (f:T->U->(T*V)) (s:T) (xs:list[U]): T*list[V] =>
match xs with
| Empty[U] => s, Empty[V]
| Cons (?x, ?xs) =>
let ?s', ?ys = map_accum_right f s xs in
let ?s'', ?y = f s' x in
s'', Cons (y, ys)
endmatch
;
////
fun eval (ctx:Context) (expr:Expr):(Context*Expr) =>
match expr with
| LispInt ?n => ctx, LispInt n
| LispFn ?f => ctx, LispFn f
| LispSpecial ?f => ctx, LispSpecial f
| LispSymbol ?s =>
match find (fun (x:string, e:Expr):bool => x == s) ctx with
| Some (_, ?x) => ctx, x
endmatch
| LispList Cons (?x, ?xs) =>
match eval ctx x with
| (?ctx', LispFn ?f) =>
let ?ctx'', ?es = map_accum_left (the eval) ctx' xs in
f ctx es
| ?ctx', LispSpecial ?f =>
f ctx' xs
endmatch
endmatch
;
typedef Context = list[string*Expr];
union Expr =
| LispInt of int
| LispSymbol of string
| LispFn of Context->list[Expr]->Context*Expr
| LispSpecial of Context->list[Expr]->Context*Expr
| LispList of list[Expr]
;
////
instance Show[Expr] {
fun show (expr:Expr) =>
match expr with
| LispInt ?x => show x
| LispSymbol ?x => x
| LispFn ?x => "<function>"
| LispSpecial ?x => "<special>"
| LispList ?x => "(" + (cat " " (map (the show) x)) + ")"
endmatch
;
}
open Show[Expr];
#import <flx.flxh>
#include "show.flx"
#include "expr.flx"
#include "eval.flx"
#include "functions.flx"
open List;
////
fun print_expr (ctx:Context) (expr:Expr) =
{
print$ ljust(show(expr), 10);
print "\t\t";
val ctx', result = eval ctx expr;
print$ show$ (ctx', result);
return ctx', result;
}
print$ show initial_ctx;
endl; endl;
val ctx, e = print_expr initial_ctx$
LispList (list$ LispSymbol "set", LispSymbol "i", LispInt 5);
endl; endl;
val ctx', e' = print_expr ctx$
LispList (list$ LispSymbol "+", LispSymbol "i", LispInt 1);
endl; endl;
val ctx'', e'' = print_expr ctx'$
LispList (list$ LispSymbol "set", LispSymbol "j", LispList (list$ LispSymbol
"+", LispSymbol "i", LispInt 5));
endl; endl;
val ctx''', e''' = print_expr ctx''$
LispList (list$ LispSymbol "set", LispSymbol "j", LispList (list$ LispSymbol
"+", LispSymbol "j", LispInt 1));
endl; endl;
print$ show ctx'''; endl;
#import <flx.flxh>
open List;
typeclass Show[t] {
virtual fun show: t -> string;
}
instance Show[string] {
fun show (x:string) => x;
}
open Show[string];
instance Show[int] {
fun show (x:int) => str x;
}
open Show[int];
instance[T with Show[T]] Show[List::list[T]] {
fun show (xs:list[T]) =>
'[' +
match xs with
| Empty[T] => ''
| Cons(?o, ?os) =>
fold_left (
fun (a:string) (b:T):string => a + ', ' + (show b)
) (show o) os
endmatch
+ ']'
;
}
open[T] Show[List::list[T]];
instance[T,U with Show[T], Show[U]] Show[T*U] {
fun show (x:T, y:U):string =>
'(' + (show x) + ', ' + (show y) + ')'
;
}
open[T,U] Show[T*U];
/*
instance[T,N with Show[T]] Show[Array::array[T,N]] {
fun show (xs:array[T,N]) = {
var o = '[|' + show xs.[0];
var i : int;
forall i in 1 upto len(xs) - 1 do
o += ', ' + show xs.[i];
done;
return o + '|]';
}
}
open[T,N] Show[Array::array[T,N]];
*/
fun lispBinary (op:int*int->int) (init:int) (x:list[Expr]):Expr =>
LispInt$
fold_left (fun (i:int) (j:Expr):int =>
match j with
| LispInt ?j => op (i, j)
endmatch
) init x;
;
fun lispArithmetic (op:int*int->int) (init:int):Expr =>
LispFn$ (fun (ctx:Context) (args:list[Expr]) => (ctx, lispBinary op init
args))
;
fun lispSet (ctx:Context) (es:list[Expr]):Context*Expr =>
match es with
| Cons (LispSymbol ?s, Cons (?e, ?xs)) =>
let ?ctx', ?e' = eval ctx e in
ctx' + (s, e'), e'
endmatch
;
val initial_ctx = list (
('+', lispArithmetic (add of (int*int)) 0),
('-', lispArithmetic (sub of (int*int)) 0),
('*', lispArithmetic (mul of (int*int)) 1),
('/', lispArithmetic (div of (int*int)) 1),
('set', LispSpecial (the lispSet))
)
;
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys - and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
Felix-language mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/felix-language
