A core => core +0 -0
A env/env.ha => env/env.ha +44 -0
@@ 0,0 1,44 @@
+use expr;
+use sort;
+use strings;
+
+export type binding = (expr::symbol, expr::expr);
+
+export type env = struct {
+ parent: nullable *env,
+ bindings: []binding,
+};
+
+export fn init(parent: nullable *env) env = env {
+ parent = parent,
+ bindings = [],
+};
+
+fn compare(a: const *void, b: const *void) int = {
+ const a = a: const *binding, b = b: const *binding;
+ return strings::compare(a.0, b.0);
+};
+
+export fn search(e: *env, s: expr::symbol) (*binding | lookup) = {
+ match (sort::search(e.bindings: []const void, size(binding), &(s, void: expr::expr), &compare)) {
+ case void =>
+ match (e.parent) {
+ case null =>
+ return s: lookup;
+ case let e: *env =>
+ return search(e, s);
+ };
+ case let i: size =>
+ return &e.bindings[i];
+ };
+};
+
+export fn bind(e: *env, b: binding) void = {
+ let i = sort::lbisect(e.bindings: []const void, size(binding), &b, &compare);
+ if (len(e.bindings) > i && e.bindings[i].0 == b.0) e.bindings[i] = b
+ else insert(e.bindings[i], b);
+};
+
+export fn mutate(e: *env, b: binding) (void | lookup) = {
+ *search(e, b.0)? = b;
+};
A env/error.ha => env/error.ha +6 -0
@@ 0,0 1,6 @@
+use expr;
+
+export type lookup = !expr::symbol;
+export type error = !lookup;
+
+export fn strerror(e: error) str = "lookup error"; //TODO symbol name
A eval/eval.ha => eval/eval.ha +38 -0
@@ 0,0 1,38 @@
+use env;
+use expr;
+use os;
+use unparse;
+
+export type error = !void;
+
+export fn evlist(list: (*expr::cons | void), en: *env::env) (*expr::cons | void | error) = match (list) {
+case let list: *expr::cons =>
+ let head = eval(list.0, en)?;
+ let tail = evlist(list.1 as (*expr::cons | void), en)?;
+ return alloc((head, tail): expr::cons);
+case void =>
+ return void;
+};
+
+export fn eval(ex: expr::expr, en: *env::env) (expr::expr | error ) = match (ex) {
+case let list: *expr::cons =>
+ let args = evlist(list, en)? as *expr::cons;
+ match (args.0) {
+ case expr::symbol =>
+ return args;
+ case =>
+ return error; //TODO more specific
+ };
+case let s: expr::symbol =>
+ match (env::search(en, s)) {
+ case env::lookup =>
+ return s;
+ case let bind: *env::binding =>
+ return bind.1;
+ };
+case let p: expr::param =>
+ //TODO do better once you do the changes to parse
+ return p;
+case let ex: (void | str | expr::builtin) =>
+ return ex: expr::expr;
+};
M expr/expr.ha => expr/expr.ha +4 -1
@@ 1,4 1,7 @@
+use eval;
+
export type cons = (expr, expr);
export type symbol = str;
export type param = (str, str);
-export type expr = (*cons | str | symbol | param | void);
+export type builtin = *fn(args: expr, en: *env::env) (expr | eval::error);
+export type expr = (*cons | str | symbol | param | builtin | void);
M main.ha => main.ha +5 -2
@@ 3,10 3,13 @@ use expr;
use unparse;
use os;
use fmt;
+use env;
+use eval;
export fn main() void = {
- let e = parse::parse(os::stdin)!;
- unparse::expr(e, os::stdout)!;
+ let en = env::init(null);
+ let e = eval::eval(parse::parse(os::stdin)!, &en)!;
+ unparse::expr(e, os::stderr)!;
fmt::println()!;
unparse::html(e, os::stdout)!;
fmt::println()!;
M unparse/expr.ha => unparse/expr.ha +2 -0
@@ 31,4 31,6 @@ case let c: *expr::cons =>
fmt::fprint(o, ')')?;
case void =>
fmt::fprint(o, "()")?;
+case let fp: expr::builtin =>
+ fmt::fprint(o, fp)?;
};
M unparse/html.ha => unparse/html.ha +2 -0
@@ 31,4 31,6 @@ case let c: *expr::cons =>
fmt::fprint(o, '>')?;
case void =>
fmt::fprint(o, "void")?;
+case let fp: expr::builtin =>
+ fmt::fprintf(o, "(builtin {})", fp)?;
};