commit d8d881a4f32ea30e4893ffecc45820b93ef3553f
parent 85cddd3cf0a0b5371c41078f4c1ee89cb2052219
Author: Jan Pobrislo <ccx@te2000.cz>
Date: Fri, 30 May 2025 18:35:18 +0000
Error handling, eval tests, fix quotation.
Diffstat:
| M | interpreter.pl | | | 52 | +++++++++++++++++++++++++++++++++++++--------------- |
| M | tests.pl | | | 33 | +++++++++++++++++++++++++++++++-- |
2 files changed, 68 insertions(+), 17 deletions(-)
diff --git a/interpreter.pl b/interpreter.pl
@@ -5,6 +5,8 @@
, sexp/4
, interp_apply/3
, interp_eval/4
+ , the_global_environment/1
+ , primitive_arity/2
]).
:- use_module(library(debug), [assertion/1]).
:- use_module(library(dcg/basics), [blanks//0, number//1]).
@@ -51,7 +53,10 @@ extend_environment(OldEnv, VarNames, Values, [NewFrame|OldEnv]) :-
pairs_keys_values(NewFrame, VarNames, Values).
lookup_variable_value(Env, VarName, Value) :-
- lookup_variable_value_aux(Env, VarName, Value) -> true ; assertion(false). % unbound variable
+ Here=lookup_variable_value/3,
+ ( lookup_variable_value_aux(Env, VarName, Value) -> true
+ ; throw(error(interp_error(unbound_var(VarName)), context(Here, 'Unbound variable.')))).
+
lookup_variable_value_aux([Frame|Env], VarName, Value) :-
lookup_variable_from_frame(Frame, VarName, Value) -> true ; lookup_variable_value_aux(Env, VarName, Value).
lookup_variable_from_frame([K-V|Rest], VarName, Value) :-
@@ -79,7 +84,9 @@ eval_definition([define, VarName, Definition], Value, OldEnv, NewEnv) :-
is_assignment(['set!'|_]).
set_variable_value(VarName, Value, OldEnv, NewEnv) :-
- set_variable_value_aux(VarName, Value, OldEnv, NewEnv) -> true ; assertion(false).
+ Here=set_variable_value/4,
+ ( set_variable_value_aux(VarName, Value, OldEnv, NewEnv) -> true
+ ; throw(error(interp_error(unbound_var(VarName)), context(Here, 'Unbound variable.')))).
set_variable_value_aux(VarName, Value, [OldFrame|OldE], [NewFrame|NewE]) :-
( set_variable_in_frame(VarName, Value, OldFrame, NewFrame)
@@ -142,7 +149,7 @@ rest_operands([_,_|X], X).
interp_eval(Expression, Expression, Env, Env) :-
self_evaluating(Expression), !.
-interp_eval([quoted|Rest], Rest, Env, Env) :- !.
+interp_eval([quote, Text], Text, Env, Env) :- !.
interp_eval(VarName, Result, Env, Env) :-
variable(VarName),
!,
@@ -155,15 +162,22 @@ interp_eval(Expression, void, Env, NewEnv) :-
!,
eval_assignment(Expression, Env, NewEnv).
interp_eval([lambda, Parameters|Body], Result, Env, Env) :-
+ !,
make_procedure(Parameters, Body, Env, Result).
interp_eval([Operator|Operands], Result, Env, NewEnv) :-
!,
interp_eval(Operator, Procedure, Env, NewEnv),
list_of_values(Operands, Env, Arguments),
interp_apply(Procedure, Arguments, Result).
-interp_eval(_, _, _, _) :- assertion(false).
-
-interp_apply(primitive(Name), Arguments, Result) :-
+interp_eval(Expression, _, _, _) :-
+ Here=interp_eval/4,
+ throw(error(interp_error(eval, Expression), context(Here, 'Don\'t know how to evaluate this expression.'))).
+
+interp_apply(primitive(Name, Arity), Arguments, Result) :-
+ Here = interp_apply/3,
+ length(Arguments, ALength),
+ ( Arity = ALength -> true
+ ; throw(error(interp_error(arity, Name), context(Here, 'Arity error.')))),
primitive_apply(Name, Arguments, Result).
interp_apply(proc(Parameters, Body, Env), Arguments, Result) :-
extend_environment(Env, Parameters, Arguments, NewEnv),
@@ -181,7 +195,7 @@ eval_sequence_aux([H|T], Env, _, Result) :-
list_of_values([], _, []).
list_of_values([Name|NameTail], Env, [Value|ValueTail]) :-
interp_eval(Name, Value, Env, Env), % enforces environment does not change
- list_of_values(NameTail, ValueTail).
+ list_of_values(NameTail, Env, ValueTail).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Environment Setup
@@ -192,14 +206,13 @@ primitive_apply(cons, [H,T], [H|T]).
primitive_apply(+, [A, B], Result) :- Result is A + B.
% primitive_apply('[]', [], []).
-setup_environment([[
- car-primitive(car),
- cdr-primitive(cdr),
- cons-primitive(cons),
- (+)-primitive(+),
- true-true,
- false-false
-]]).
+primitive_arity(car, 1).
+primitive_arity(cdr, 1).
+primitive_arity(cons, 2).
+primitive_arity(+, 2).
+
+setup_environment([[true-true, false-false|PrimitiveProcs]]) :-
+ findall(Name-primitive(Name, Arity), primitive_arity(Name, Arity), PrimitiveProcs).
the_global_environment(Env) :- setup_environment(Env).
@@ -236,6 +249,15 @@ prolog:error_message(parse_error(Codes)) -->
prolog:error_message(evaluation_error(Codes)) -->
[ 'Failed to evaluate expression: "~s".' - [Codes] ].
+prolog:error_message(interp_error(eval, Expression)) -->
+ [ 'Don\'t know how to evaluate: "~w".' - [Expression] ].
+
+prolog:error_message(interp_error(arity, Func)) -->
+ [ 'Invalid amount of arguments for function: "~w".' - [Func] ].
+
+prolog:error_message(interp_error(unbound_var, VarName)) -->
+ [ 'No such variable: "~w".' - [VarName] ].
+
% grammar {{{1
parse_input_expression(Codes, Expression) :-
diff --git a/tests.pl b/tests.pl
@@ -50,7 +50,6 @@ test(sexp_qq) :-
assertion(Expression =@= [define, proc, [lambda, [e, f, g], [lambda, [], e]]]).
:- end_tests(sexp).
-:- begin_tests(primitive_apply).
apply_example(car, [{|sexp||(a b c)|}], {|sexp||a|}).
apply_example(car, [{|sexp||((a b c) x y z)|}], {|sexp||(a b c)|}).
@@ -78,8 +77,38 @@ apply_example(`(cons (a b (c)) ())`, `((a b (c)))`).
apply_example(`(+ 0 0)`, `0`).
apply_example(`(+ 3 2)`, `5`).
+:- begin_tests(primitive_apply).
test(apply_example, [forall(apply_example(Func, Args, ExpectedResult))]) :-
- interp_apply(primitive(Func), Args, Result),
+ primitive_arity(Func, Arity),
+ interp_apply(primitive(Func, Arity), Args, Result),
assertion(Result =@= ExpectedResult).
+test(apply_arity_error, [error(interp_error(arity, car))]) :-
+ Func=car,
+ primitive_arity(Func, Arity),
+ interp_apply(primitive(Func, Arity), [[a], [b]], _).
+
:- end_tests(primitive_apply).
+:- begin_tests(eval).
+
+quoted_args([], []).
+quoted_args([H|T], [[quote, H]|QT]) :- quoted_args(T, QT).
+
+test_eval(Call, ExpectedResult) :-
+ format('testing call: ~w → expecting ~w~n', [Call, ExpectedResult]),
+ the_global_environment(Env),
+ interp_eval(Call, Result, Env, _),
+ assertion(Result =@= ExpectedResult).
+
+test(eval_quote) :-
+ test_eval({|sexp||(quote a)|}, a).
+
+test(eval_quote2) :-
+ test_eval({|sexp||(quote ())|}, []).
+
+test(eval_apply_example, [forall(apply_example(Func, Args, ExpectedResult))]) :-
+ quoted_args(Args, QArgs),
+ Call = [Func|QArgs],
+ test_eval(Call, ExpectedResult).
+
+:- end_tests(eval).
