commit fea60c9f6d0178599bcbedfac82c91103a92eeec
parent e8801aabd39c10a484b1bc6c00a3b0814c9357ea
Author: Jan Pobrislo <ccx@te2000.cz>
Date: Fri, 30 May 2025 22:54:11 +0000
Fix tests, groundedness check for eval and apply.
Diffstat:
2 files changed, 22 insertions(+), 12 deletions(-)
diff --git a/interpreter.pl b/interpreter.pl
@@ -147,40 +147,50 @@ rest_operands([_,_|X], X).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Eval/Apply
-interp_eval(Expression, Expression, Env, Env) :-
+interp_eval_(Expression, Expression, Env, Env) :-
self_evaluating(Expression), !.
-interp_eval([quote, Text], Text, Env, Env) :- !.
-interp_eval(VarName, Result, Env, Env) :-
+interp_eval_([quote, Text], Text, Env, Env) :- !.
+interp_eval_(VarName, Result, Env, Env) :-
variable(VarName),
!,
lookup_variable_value(Env, VarName, Result).
-interp_eval([define|Tail], Result, Env, NewEnv) :-
+interp_eval_([define|Tail], Result, Env, NewEnv) :-
!,
eval_definition([define|Tail], Result, Env, NewEnv).
-interp_eval(Expression, void, Env, NewEnv) :-
+interp_eval_(Expression, void, Env, NewEnv) :-
is_assignment(Expression),
!,
eval_assignment(Expression, Env, NewEnv).
-interp_eval([lambda, Parameters|Body], Result, Env, Env) :-
+interp_eval_([lambda, Parameters|Body], Result, Env, Env) :-
!,
make_procedure(Parameters, Body, Env, Result).
-interp_eval([Operator|Operands], Result, Env, NewEnv) :-
+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(Expression, _, _, _) :-
+interp_eval_(Expression, _, _, _) :-
interp_error(eval, Expression).
-interp_apply(primitive(Name, Arity), Arguments, Result) :-
+interp_eval(Expression, Result, Env, NewEnv) :-
+ assertion(ground(Expression)),
+ assertion(ground(Env)),
+ interp_eval_(Expression, Result, Env, NewEnv).
+
+interp_apply_(primitive(Name, Arity), Arguments, Result) :-
length(Arguments, ALength),
( Arity = ALength -> true
; interp_error(arity, Name)),
primitive_apply(Name, Arguments, Result).
-interp_apply(proc(Parameters, Body, Env), Arguments, Result) :-
+interp_apply_(proc(Parameters, Body, Env), Arguments, Result) :-
extend_environment(Env, Parameters, Arguments, NewEnv),
eval_sequence(Body, NewEnv, Result).
+interp_apply(Proc, Arguments, Result) :-
+ assertion(ground(Proc)),
+ assertion(ground(Arguments)),
+ interp_apply_(Proc, Arguments, Result).
+
eval_sequence([H|T], Env, Result) :-
interp_eval(H, FirstResult, Env, Env1),
eval_sequence_aux(T, Env1, FirstResult, Result).
diff --git a/tests.pl b/tests.pl
@@ -106,8 +106,8 @@ test_eval(Call, ExpectedResult) :-
interp_eval(Call, Result, Env, _),
assertion(Result =@= ExpectedResult).
-eval_example(`(car (cdr quote(((b) (x y) ((c))))))`, `(x y)`).
-eval_example(`(cdr (cdr quote(((b) (x y) ((c))))))`, `(((c)))`).
+eval_example(`(car (cdr (quote ((b) (x y) ((c))))))`, `(x y)`).
+eval_example(`(cdr (cdr (quote ((b) (x y) ((c))))))`, `(((c)))`).
eval_example_decoded(Call, ExpectedResult) :-
eval_example(CallCodes, ResultCodes),
