Topics:SICP in other languages:Erlang:Chapter 4
From CTMWiki
| Table of contents |
[edit]
About SICP
The following Erlang code is derived from the examples provided in the book:
"Structure and Interpretation of Computer Programs, Second Edition"
by Harold Abelson and Gerald Jay Sussman with Julie Sussman.
http://mitpress.mit.edu/sicp/
[edit]
SICP Chapter #04 Examples in Erlang
-module(sicp04).
-import(scheme).
-export([start/0]).
print(X) ->
io:write(X),
io:format("~n").
start() ->
section_4_1_4(),
section_4_1_5(),
section_4_1_6().
</pre>
[edit]% 4.1.1 - The Metacircular Evaluator - The Core of the Evaluator
<pre>
section_4_1_1() ->
print ("").
eval({tm_unit}, Env) -> {val_unit};
eval({tm_bool, Exp}, Env) -> {val_bool, Exp};
eval({tm_int, Exp}, Env) -> {val_int, Exp};
eval({tm_real, Exp}, Env) -> {val_real, Exp};
eval({tm_string, Exp}, Env) -> {val_string, Exp};
eval({tm_quoted, Exp}, Env) -> {val_quoted, Exp};
eval({tm_if, Exp, E1, E2}, Env) -> case eval(Exp, Env) =:= {val_bool, true} of true -> eval(E1, Env); false -> eval(E2, Env) end;
eval({tm_cond, Exp}, Env) -> eval(cond2if(Exp), Env);
eval({tm_begin, Exp}, Env) -> lists:foldl(fun (X, _) -> eval(X, Env) end, {val_unit}, Exp);
eval({tm_symbol, Exp}, Env) -> lookup_variable_value(Exp, Env);
eval({tm_definition, E1, E2}, Env) -> define_variable(E1, eval(E2, Env), Env);
eval({tm_assignment, E1, E2}, Env) -> set_variable_value(E1, eval(E2, Env), Env);
eval({tm_lambda, Parms, Body}, Env) -> {val_closure, Parms, Body, Env};
eval({tm_application, F, Args}, Env) -> apply_(eval(F, Env), lists:map(fun (X) -> eval(X, Env) end, Args)).
apply_({val_primitive, Sym, F}, Args) -> F(Args);
apply_({val_closure, Parameters, Body, Env}, Args) ->
case length(Parameters) =/= length(Args) of
true ->
case length(Parameters) < length(Args) of
true -> throw({evaluator, "Too many arguments supplied"});
false -> throw({evaluator, "Too few arguments supplied"})
end;
false ->
% create the closure environment
NewEnv = [new_dictionary()|Env],
% pair up the parameters and arguments into a list
Pairs = list_pair_zip(Parameters, Args),
% push the parameters/arguments into the closure environment
lists:map(fun ({X, Y}) -> define_variable(X, Y, NewEnv) end, Pairs),
% evaluate the body of the closure
X = eval(Body, NewEnv),
% garbage collect the dictionary (note: this will kill tail-recursion)
ets:delete(hd(NewEnv)),
X
end;
apply_(F, Args) -> print(F), print(Args), throw ({evaluator, "Unknown procedure type -- APPLY"}).
[edit]
% 4.1.3 - The Metacircular Evaluator - Evaluator Data Structures
new_dictionary() -> ets:new(frame, [ordered_set]).
lookup_variable_value(Var, [Frame|EnclosingEnvironment]) ->
case ets:member(Frame, Var) of
true ->
L = ets:lookup(Frame, Var),
case L of
[{Key, Val}] -> Val
end;
false -> lookup_variable_value(Var, EnclosingEnvironment)
end;
lookup_variable_value(Var, []) ->
print (Var),
throw ({evaluator, "Unbound variable ", Var}).
set_variable_value(Var, Val, [Frame|EnclosingEnvironment]) ->
case ets:contains(Frame, Var) of
true -> ets:insert(Frame, {Var, Val}), Val;
false -> set_variable_value(Var, Val, EnclosingEnvironment)
end;
set_variable_value(Var, Val, []) ->
throw ({evaluator, "Unbound variable -- SET! ", Var}).
define_variable(Var, Val, [Frame|_]) -> ets:insert(Frame, {Var, Val}), Val;
define_variable(Var, Val, []) -> throw ({evaluator, "Empty Environment ", Var}).
cond2if([{Pred, Exp}|Xs]) -> {tm_if, Pred, Exp, cond2if(Xs)};
cond2if([]) -> {tm_unit}.
list_pair_zip([H1|T1], [H2|T2]) -> [{H1, H2}|list_pair_zip(T1, T2)];
list_pair_zip([], []) -> [].
[edit]
% 4.1.4 - The Metacircular Evaluator - Running the Evaluator as a Program
eval_print(TheGlobalEnvironment, Code) ->
Val = eval(Code, TheGlobalEnvironment),
print (Val),
Val.
section_4_1_4() ->
TheGlobalEnvironment = scheme:make_global_environment(),
eval_print(TheGlobalEnvironment, {tm_int, 123}),
% 1 + 6.
eval_print(TheGlobalEnvironment, {tm_application, {tm_symbol, '+'}, [{tm_int, 1}, {tm_int, 6}]}),
% 1 + (2 * 3).
eval_print(TheGlobalEnvironment,
{tm_application,
{tm_symbol, '+'},
[
{tm_int, 1},
{tm_application,{tm_symbol, '*'}, [{tm_int, 2}, {tm_int, 3}]}
]}),
% X = 6.
eval_print(TheGlobalEnvironment, {tm_definition, 'X', {tm_int, 6}}),
% (1 + X).
eval_print(TheGlobalEnvironment,
{tm_application,
{tm_symbol, '+'},
[
{tm_int, 1},
{tm_symbol, 'X'}
]}),
% Pi = 3.14.
eval_print(TheGlobalEnvironment, {tm_definition, 'Pi', {tm_real, 3.14}}),
% 27.0 / (13.0 - Pi).
eval_print(TheGlobalEnvironment,
{tm_application,
{tm_symbol, '/'},
[
{tm_real, 27.0},
{tm_application,
{tm_symbol, '-'},
[
{tm_real, 13.0},
{tm_symbol, 'Pi'}
]}
]}),
% square() -> fun (X) -> X * X end.
eval_print(TheGlobalEnvironment,
{tm_definition,
'square',
{tm_lambda,
['X'],
{tm_application,
{tm_symbol, '*'},
[
{tm_symbol, 'X'},
{tm_symbol, 'X'}
]}}}),
% Z = square(5.0).
eval_print(TheGlobalEnvironment,
{tm_definition,
'Z',
{tm_application,
{tm_symbol, 'square'},
[
{tm_real, 5.0}
]}}),
% append(Xs, Ys) ->
% case Xs =:= [] of
% true -> Ys;
% false -> [hd(Xs) | append(tl(Xs), Ys)
% end.
eval_print(TheGlobalEnvironment,
{tm_definition,
'append',
{tm_lambda,
['Xs', 'Ys'],
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'Xs'}, {tm_unit}]},
{tm_symbol, 'Ys'},
{tm_application,
{tm_symbol, 'cons'},
[
{tm_application, {tm_symbol, 'car'}, [{tm_symbol, 'Xs'}]},
{tm_application,
{tm_symbol, 'append'},
[
{tm_application, {tm_symbol, 'cdr'}, [{tm_symbol, 'Xs'}]},
{tm_symbol, 'Ys'}
]}
]}}}}),
% Xs = [a, b, c].
eval_print(TheGlobalEnvironment,
{tm_definition,
'Xs',
{tm_application,
{tm_symbol, 'cons'},
[
{tm_string, a},
{tm_application,
{tm_symbol, 'cons'},
[
{tm_string, b},
{tm_application, {tm_symbol, 'cons'}, [{tm_string, c}, {tm_unit}]}
]}
]}}),
% Ys = [d, e, f].
eval_print(TheGlobalEnvironment,
{tm_definition,
'Ys',
{tm_application,
{tm_symbol, 'cons'},
[
{tm_string, d},
{tm_application,
{tm_symbol, 'cons'},
[
{tm_string, e},
{tm_application, {tm_symbol, 'cons'}, [{tm_string, f}, {tm_unit}]}
]}
]}}),
% Zs = append(Xs, Ys).
eval_print(TheGlobalEnvironment, {tm_application, {tm_symbol, 'append'}, [{tm_symbol, 'Xs'}, {tm_symbol, 'Ys'}]}),
% if
% X > 0 -> X;
% X == 0 -> print('zero'), 0;
% true -> -X
% end.
eval_print(TheGlobalEnvironment,
{tm_cond,
[
{{tm_application, {tm_symbol, '>'}, [{tm_symbol, 'X'}, {tm_int, 0}]}, {tm_symbol, 'X'}},
{
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'X'}, {tm_int, 0}]},
{tm_begin,
[
{tm_application, {tm_symbol, 'display'}, [{tm_string, "zero"}]},
{tm_int, 0}
]
}
},
{{tm_bool, true}, {tm_application, {tm_symbol, '-'}, [{tm_symbol, 'X'}]}}
]}),
% case X > 0 of
% true -> X;
% false ->
% case X =:= 0 of
% true -> print("zero"), 0;
% false -> -X
% end
% end.
eval_print(TheGlobalEnvironment,
{tm_if,
{tm_application, {tm_symbol, '>'}, [{tm_symbol, 'X'}, {tm_int, 0}]},
{tm_symbol, 'X'},
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'X'}, {tm_int, 0}]},
{tm_begin,
[
{tm_application, {tm_symbol, 'display'}, [{tm_string, "zero"}]},
{tm_int, 0}
]},
{tm_application, {tm_symbol, '-'}, [{tm_symbol, 'X'}]}}}),
% begin
% X = 3,
% Y = X + 2,
% Z = X + Y + 5,
% x * z
% end.
eval_print(TheGlobalEnvironment,
{tm_application,
{tm_lambda,
[],
{tm_begin,
[
{tm_definition, 'X', {tm_int, 3}},
{tm_definition, 'Y', {tm_application, {tm_symbol, '+'}, [{tm_symbol, 'X'}, {tm_int, 2}]}},
{tm_definition,
'Z',
{tm_application,
{tm_symbol, '+'},
[
{tm_symbol, 'X'},
{tm_application, {tm_symbol, '+'}, [{tm_symbol, 'Y'}, {tm_int, 5}]}
]}},
{tm_application, {tm_symbol, '*'}, [{tm_symbol, 'X'}, {tm_symbol, 'Z'}]}
]}},
[]}),
% The "and" is not working properly for val.
% The answer given is 5, but it should be 3.
% X = 1.
% begin
% X = 3
% Y = X + 2
% Y
% end.
eval_print(TheGlobalEnvironment, {tm_definition, 'X', {tm_int, 1}}),
eval_print(TheGlobalEnvironment,
{tm_application,
{tm_lambda,
[],
{tm_begin,
[
{tm_definition, 'X', {tm_int, 3}},
{tm_definition, 'Y', {tm_application, {tm_symbol, '+'}, [{tm_symbol, 'X'}, {tm_int, 2}]}},
{tm_symbol, 'Y'}
]}},
[]}),
% An extension to the eval function should address this problem:
% ((let? exp) (m-eval (let->combination exp) env))
% (define (let->combination let-exp)
% (let ((names (let-bound-variables let-exp))
% (values (let-values let-exp))
% (body (let-body let-exp)))
% (cons (list 'lambda names body) values)))
% fib(N) ->
% FibIter =
% fun (Self, A, B, Count) ->
% case Count of
% 0 -> B;
% true -> Self(Self, A+B, A, Count-1)
% end,
% FibIter(FibIter, 1, 0, N).
eval_print(TheGlobalEnvironment,
{tm_definition,
'fib',
{tm_lambda,
['N'],
{tm_begin,
[
{tm_definition,
'FibIter',
{tm_lambda,
['A', 'B', 'Count'],
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'Count'}, {tm_int, 0}]},
{tm_symbol, 'B'},
{tm_application,
{tm_symbol, 'FibIter'},
[
{tm_application, {tm_symbol, '+'}, [{tm_symbol, 'A'}, {tm_symbol, 'B'}]},
{tm_symbol, 'A'},
{tm_application, {tm_symbol, '-'}, [{tm_symbol, 'Count'}, {tm_int, 1}]}
]}}}},
{tm_application, {tm_symbol, 'FibIter'}, [{tm_int, 1}, {tm_int, 0}, {tm_symbol, 'N'}]}
]}}}),
% fib(10).
eval_print(TheGlobalEnvironment, {tm_application, {tm_symbol, 'fib'}, [{tm_int, 10}]}).
[edit]
% 4.1.5 - The Metacircular Evaluator - Data as Programs
section_4_1_5() ->
TheGlobalEnvironment = scheme:make_global_environment(),
% factorial(N) ->
% case N =:= 1 of
% true -> 1;
% false -> N * factorial(N-1)
% end.
eval_print(TheGlobalEnvironment,
{tm_definition,
'factorial',
{tm_lambda,
['N'],
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'N'}, {tm_int, 1}]},
{tm_int, 1},
{tm_application,
{tm_symbol, '*'},
[
{tm_symbol, 'N'},
{tm_application,
{tm_symbol, 'factorial'},
[
{tm_application, {tm_symbol, '-'}, [{tm_symbol, 'N'}, {tm_int, 1}]}
]}
]}}}}),
% factorial(5}
eval_print(TheGlobalEnvironment, {tm_application, {tm_symbol, 'factorial'}, [{tm_int, 5}]}).
% Exercise 4.15
run_forever() -> run_forever().
halts(P, Q) -> true.
try_(P) ->
case halts(P, P) of
true -> run_forever();
false -> throw({halted})
end.
[edit]
% 4.1.6 - The Metacircular Evaluator - Internal Definitions
section_4_1_6() ->
TheGlobalEnvironment = scheme:make_global_environment(),
% f(X) ->
% IsEven =
% fun (Self, IsOdd, 0) -> true;
% (Self, IsOdd, N) -> IsOdd(IsOdd, Self, N-1)
% end,
% IsOdd =
% fun (Self, IsEven, 0) -> false;
% (Self, IsEven, N) -> IsEven(IsEven, Self, N-1)
% end,
% ... rest of body of f ...,
% IsEven(IsEven, IsOdd, X).
eval_print(TheGlobalEnvironment,
{tm_definition,
'f',
{tm_lambda,
['X'],
{tm_begin,
[
{tm_definition,
'IsEven',
{tm_lambda,
['N'],
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'N'}, {tm_int, 0}]},
{tm_bool, true},
{tm_application,
{tm_symbol, 'IsOdd'},
[{tm_application, {tm_symbol, '-'}, [{tm_symbol, 'N'}, {tm_int, 1}]}]
}
}
}
},
{tm_definition,
'IsOdd',
{tm_lambda,
['N'],
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'N'}, {tm_int, 0}]},
{tm_bool, false},
{tm_application,
{tm_symbol, 'IsEven'},
[{tm_application, {tm_symbol, '-'}, [{tm_symbol, 'N'}, {tm_int, 1}]}]
}
}
}
},
{tm_application, {tm_symbol, 'IsEven'}, [{tm_symbol, 'X'}]}
]
}
}
}),
% f(3).
eval_print(TheGlobalEnvironment, {tm_application, {tm_symbol, 'f'}, [{tm_int, 3}]}),
% Exercise 4.19
% begin
% A = 1,
% F =
% fun (X) ->
% B = A + X,
% A = 5,
% A + B
% end,
% F(10)
% end.
eval_print(TheGlobalEnvironment,
{tm_begin,
[
{tm_definition, 'A', {tm_int, 1}},
{tm_definition,
'F',
{tm_lambda,
['X'],
{tm_begin,
[
{tm_definition, 'B', {tm_application, {tm_symbol, '+'}, [{tm_symbol, 'A'}, {tm_symbol, 'X'}]}},
{tm_definition, 'A', {tm_int, 5}},
{tm_application, {tm_symbol, '+'}, [{tm_symbol, 'A'}, {tm_symbol, 'B'}]}
]
}
}
},
{tm_application, {tm_symbol, 'F'}, [{tm_int, 10}]}
]
}),
% factorial(N) ->
% case N =:= 1 of
% true -> 1;
% false -> N * factorial(N-1)
% end.
eval_print(TheGlobalEnvironment,
{tm_definition,
'factorial',
{tm_lambda,
['N'],
{tm_if,
{tm_application, {tm_symbol, '='}, [{tm_symbol, 'N'}, {tm_int, 1}]},
{tm_int, 1},
{tm_application,
{tm_symbol, '*'},
[
{tm_symbol, 'N'},
{tm_application,
{tm_symbol, 'factorial'},
[
{tm_application, {tm_symbol, '-'}, [{tm_symbol, 'N'}, {tm_int, 1}]}
]}
]}}}}).
[edit]
Scheme Primitives in Erlang
-module(scheme).
%-export([value_to_string/1, make_global_environment/0]).
-compile(export_all).
% primitive implementations for source language
value_to_string({val_unit}) -> "unit";
value_to_string({val_bool, V}) -> atom_to_list(V);
value_to_string({val_int, V}) -> integer_to_list(V);
value_to_string({val_real, V}) -> float_to_list(V);
value_to_string({val_string, V}) -> string:concat("\"", string:concat(V, "\""));
value_to_string({val_tuple, X, Y}) -> string:concat("Pair(",
string:concat(value_to_string(X),
string:concat(", ",
string:concat(value_to_string(Y), ")"))));
value_to_string({val_quoted, V}) -> "Quote";
value_to_string({val_symbol, V}) -> V;
value_to_string({val_primitive, V, F}) -> string:concat("<Primitive: ", string:concat(V, ">"));
value_to_string({val_closure, P, B, E}) -> "<Closure>".
is_val_true({val_bool, X}) -> X.
primitive_eq(Args) ->
CompEq =
fun (Self, {val_bool, A}, {val_bool, B}) -> A =:= B;
(Self, {val_int, A}, {val_int, B}) -> A =:= B;
(Self, {val_int, A}, B) -> Self(Self, {val_real, float(A)}, B);
(Self, {val_real, A}, {val_real, B}) -> A =:= B;
(Self, {val_string, A}, {val_string, B}) -> A =:= B;
(Self, {val_unit}, {val_unit}) -> true;
(Self, {val_unit}, {val_tuple, _, _}) -> false;
(Self, {val_tuple, _, _}, {val_unit}) -> false;
(Self, {val_tuple, A, B}, {val_tuple, C, D}) -> Self(Self, A, C) andalso Self(Self, B, D);
(_, _, _) -> throw ({evaluator, "Invalid Compare"})
end,
case length(Args) of
0 -> throw ({evaluator, "Invalid Number of arguments for compare"});
1 -> throw ({evaluator, "Invalid Number of arguments for compare"});
2 -> {val_bool, CompEq(CompEq, hd(Args), hd(tl(Args)))};
true -> {val_bool, CompEq(CompEq, hd(Args), hd(tl(Args))) andalso is_val_true(primitive_eq(tl(Args)))}
end.
primitive_neq(Args) ->
{val_bool, not(is_val_true(primitive_eq(Args)))}.
primitive_gt(Args) ->
CompGt =
fun (Self, {val_int, A}, {val_int, B}) -> A > B;
(Self, {val_int, A}, B) -> Self(Self, {val_real, float(A)}, B);
(Self, {val_real, A}, {val_real, B}) -> A > B;
(_, _, _) -> throw ({evaluator, "Invalid Compare"})
end,
case length(Args) of
0 -> throw ({evaluator, "Invalid Number of arguments for compare"});
1 -> throw ({evaluator, "Invalid Number of arguments for compare"});
2 -> {val_bool, CompGt(CompGt, hd(Args), hd(tl(Args)))};
true -> {val_bool, CompGt(CompGt, hd(Args), hd(tl(Args))) andalso is_val_true(primitive_gt(tl(Args)))}
end.
primitive_lt(Args) ->
{val_bool, not(is_val_true(primitive_eq(Args))) andalso not(is_val_true(primitive_gt(Args)))}.
primitive_gte(Args) ->
{val_bool, is_val_true(primitive_eq(Args)) orelse is_val_true(primitive_gt(Args))}.
primitive_lte(Args) ->
{val_bool, is_val_true(primitive_eq(Args)) orelse not(is_val_true(primitive_gt(Args)))}.
primitive_plus([]) -> {val_int, 0};
primitive_plus([{val_int, X}|T]) ->
case primitive_plus(T) of
{val_int, Y} -> {val_int, X + Y};
{val_real, Y} -> {val_real, float(X) + Y};
true -> throw ({evaluator, "Unexpected error for plus"})
end;
primitive_plus([{val_real, X}|T]) ->
case primitive_plus(T) of
{val_int, Y} -> {val_real, X + float(Y)};
{val_real, Y} -> {val_real, X + Y};
true -> throw ({evaluator, "Unexpected error for plus"})
end;
primitive_plus(_) -> throw ({evaluator, "Invalid argument for plus"}).
primitive_minus([]) -> throw ({evaluator, "Invalid argument for minus"});
primitive_minus([{val_int, X}]) -> {val_int, -X};
primitive_minus([{val_int, X}|T]) ->
case primitive_plus(T) of
{val_int, Y} -> {val_int, X - Y};
{val_real, Y} -> {val_real, float(X) - Y};
true -> throw ({evaluator, "Unexpected error for minus"})
end;
primitive_minus([{val_real, X}]) -> {val_real -X};
primitive_minus([{val_real, X}|T]) ->
case primitive_plus(T) of
{val_int, Y} -> {val_real, X - float(Y)};
{val_real, Y} -> {val_real, X - Y};
true -> throw ({evaluator, "Unexpected error for minus"})
end;
primitive_minus(_) -> throw ({evaluator, "Invalid argument for plus"}).
primitive_multiply([]) -> {val_int, 1};
primitive_multiply([{val_int, X}]) -> {val_int, X};
primitive_multiply([{val_real, X}]) -> {val_real, X};
primitive_multiply([{val_int, X}|T]) ->
case primitive_multiply(T) of
{val_int, Y} -> {val_int, X * Y};
{val_real, Y} -> {val_real, float(X) * Y};
true -> throw ({evaluator, "Unexpected error for multiply"})
end;
primitive_multiply([{val_real, X}|T]) ->
case primitive_multiply(T) of
{val_int, Y} -> {val_real, X * float(Y)};
{val_real, Y} -> {val_real, X * Y};
true -> throw ({evaluator, "Unexpected error for multiply"})
end;
primitive_multiply(_) -> throw ({evaluator, "Invalid argument for multiply"}).
% Note: not currently supporting scheme's rational fractions
primitive_divide([]) -> throw ({evaluator, "Invalid argument for minus"});
primitive_divide([{val_int, X}]) -> {val_real, 1.0 / float(X)};
primitive_divide([{val_real, X}]) -> {val_real, 1.0 / X};
primitive_divide([{val_int, X}|T]) ->
case primitive_multiply(T) of
{val_int, 0} -> throw ({evaluator, "Divide by zero error"});
{val_real, 0.0} -> throw ({evaluator, "Divide by zero error"});
{val_int, Y} -> {val_real, float(X) / float(Y)};
{val_real, Y} -> {val_real, float(X) / Y};
true -> throw ({evaluator, "Unexpected error for divide"})
end;
primitive_divide([{val_real, X}|T]) ->
case primitive_multiply(T) of
{val_int, Y} -> {val_real, X / float(Y)};
{val_real, Y} -> {val_real, X / Y};
true -> throw ({evaluator, "Unexpected error for divide"})
end;
primitive_divide(_) -> throw ({evaluator, "Invalid argument for divide"}).
primitive_null([{val_unit}]) -> {val_bool, true};
primitive_null([_|_]) -> {val_bool, false};
primitive_null([]) -> {val_bool, false}.
primitive_cons([Car, Cdr]) -> {val_tuple, Car, Cdr};
primitive_cons(_) -> throw ({evaluator, "Invalid arguments for cons"}).
primitive_car([{val_tuple, Car, Cdr}]) -> Car;
primitive_car(_) -> throw ({evaluator, "Invalid arguments for car"}).
primitive_cdr([{val_tuple, Car, Cdr}]) -> Cdr;
primitive_cdr(_) -> throw ({evaluator, "Invalid arguments for cdr"}).
primitive_and([]) -> {val_bool, true};
primitive_and([H]) -> H;
primitive_and([{val_bool, false}|_]) -> {val_bool, false};
primitive_and([H|T]) -> primitive_and(T).
primitive_or([]) -> {val_bool, false};
primitive_or([H]) -> H;
primitive_or([{val_bool, true}|_]) -> {val_bool, true};
primitive_or([{val_bool, false}|T]) -> primitive_or(T);
primitive_or([H|T]) -> H.
primitive_not([{val_bool, false}]) -> {val_bool, true};
primitive_not([_]) -> {val_bool, false};
primitive_not(_) -> throw ({evaluator, "Invalid number of arguments for not"}).
primitive_display([H]) ->
io:write(H),
io:format("~n"),
{val_unit};
primitive_display([X, Y]) ->
primitive_display([X|nil]);
primitive_display(_) -> throw ({evaluator, "Invalid number of arguments for display"}).
primitive_string_append(Args) ->
Iter =
fun (Self, S, []) -> {val_string, S};
(Self, S, [{val_string, X}|T]) -> Self(Self, string:concat(S, X), T);
(_, _, _) -> throw ({evaluator, "Invalid arguments for string-append"})
end,
Iter(Iter, "", Args).
make_global_environment() ->
Frame = ets:new(frame, [ordered_set]),
ets:insert(Frame, {'=' , {val_primitive, '=' , fun primitive_eq/1 }}),
ets:insert(Frame, {'<>' , {val_primitive, '<>' , fun primitive_neq/1 }}),
ets:insert(Frame, {'>' , {val_primitive, '>' , fun primitive_gt/1 }}),
ets:insert(Frame, {'<' , {val_primitive, '<' , fun primitive_lt/1 }}),
ets:insert(Frame, {'>=' , {val_primitive, '>=' , fun primitive_gte/1 }}),
ets:insert(Frame, {'<=' , {val_primitive, '<=' , fun primitive_lte/1 }}),
ets:insert(Frame, {'+' , {val_primitive, '+' , fun primitive_plus/1 }}),
ets:insert(Frame, {'-' , {val_primitive, '-' , fun primitive_minus/1 }}),
ets:insert(Frame, {'*' , {val_primitive, '*' , fun primitive_multiply/1 }}),
ets:insert(Frame, {'/' , {val_primitive, '/' , fun primitive_divide/1 }}),
ets:insert(Frame, {'null?' , {val_primitive, 'null?' , fun primitive_null/1 }}),
ets:insert(Frame, {'cons' , {val_primitive, 'cons' , fun primitive_cons/1 }}),
ets:insert(Frame, {'car' , {val_primitive, 'car' , fun primitive_car/1 }}),
ets:insert(Frame, {'cdr' , {val_primitive, 'cdr' , fun primitive_cdr/1 }}),
ets:insert(Frame, {'and' , {val_primitive, 'and' , fun primitive_and/1 }}),
ets:insert(Frame, {'or' , {val_primitive, 'or' , fun primitive_or/1 }}),
ets:insert(Frame, {'not' , {val_primitive, 'not' , fun primitive_not/1 }}),
ets:insert(Frame, {'display' , {val_primitive, 'display' , fun primitive_display/1 }}),
ets:insert(Frame, {'string_append', {val_primitive, 'string_append', fun primitive_string_append/1}}),
[Frame].
![[Main Page]](/wiki/stylesheets/images/wiki.png)