commit e8801aabd39c10a484b1bc6c00a3b0814c9357ea
parent 7ee0be1481073b9c3e490ddf8a51db6c75dcdb84
Author: Jan Pobrislo <ccx@te2000.cz>
Date: Fri, 30 May 2025 22:06:24 +0000
Library for throwing interpreter errors.
Diffstat:
3 files changed, 65 insertions(+), 29 deletions(-)
diff --git a/interp_errors.pl b/interp_errors.pl
@@ -0,0 +1,53 @@
+:- module(interp_errors,
+ [ interp_error/2
+ , interp_error/3
+ ]).
+
+%%% messages
+
+:- multifile prolog:error_message//1.
+
+prolog:error_message(read_error) -->
+ [ 'Failed to read line.' ].
+
+prolog:error_message(parse_error(Codes)) -->
+ [ 'Failed to parse line: "~s".' - [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] ].
+
+%%% exception throwing helpers
+
+validate_error(interp_error(eval, _), _) :- !.
+validate_error(interp_error(arity, _), _) :- !.
+validate_error(interp_error(unbound_var, _), _) :- !.
+validate_error(ErrorVal, Location) :-
+ throw(error(
+ domain_error(interp_error/2, ErrorVal),
+ context(Location, 'Tried to throw invalid interp_error')
+ )).
+
+validate_and_throw(Error, Location, Message) :-
+ validate_error(Error, Location),
+ throw(error(Error, context(Location, Message))).
+
+interp_error(Kind, ErrorData) :-
+ prolog_current_frame(ThisFrame),
+ prolog_frame_attribute(ThisFrame, parent, ParentFrame),
+ prolog_frame_attribute(ParentFrame, predicate_indicator, Location),
+ validate_and_throw(interp_error(Kind, ErrorData), Location, _).
+
+interp_error(Kind, ErrorData, Message) :-
+ prolog_current_frame(ThisFrame),
+ prolog_frame_attribute(ThisFrame, parent, ParentFrame),
+ prolog_frame_attribute(ParentFrame, predicate_indicator, Location),
+ validate_and_throw(interp_error(Kind, ErrorData), Location, Message).
diff --git a/interpreter.pl b/interpreter.pl
@@ -13,6 +13,8 @@
:- use_module(library(quasi_quotations), [phrase_from_quasi_quotation/2, quasi_quotation_syntax/1]).
:- use_module(library(pairs)).
+:- use_module(interp_errors).
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Self-evaluating expressions
@@ -53,9 +55,8 @@ extend_environment(OldEnv, VarNames, Values, [NewFrame|OldEnv]) :-
pairs_keys_values(NewFrame, VarNames, Values).
lookup_variable_value(Env, VarName, Value) :-
- Here=lookup_variable_value/3,
( lookup_variable_value_aux(Env, VarName, Value) -> true
- ; throw(error(interp_error(unbound_var(VarName)), context(Here, 'Unbound variable.')))).
+ ; interp_error(unbound_var, VarName)).
lookup_variable_value_aux([Frame|Env], VarName, Value) :-
lookup_variable_from_frame(Frame, VarName, Value) -> true ; lookup_variable_value_aux(Env, VarName, Value).
@@ -84,9 +85,8 @@ eval_definition([define, VarName, Definition], Value, OldEnv, NewEnv) :-
is_assignment(['set!'|_]).
set_variable_value(VarName, Value, OldEnv, NewEnv) :-
- 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.')))).
+ ; interp_error(unbound_var, VarName)).
set_variable_value_aux(VarName, Value, [OldFrame|OldE], [NewFrame|NewE]) :-
( set_variable_in_frame(VarName, Value, OldFrame, NewFrame)
@@ -170,14 +170,12 @@ interp_eval([Operator|Operands], Result, Env, NewEnv) :-
list_of_values(Operands, Env, Arguments),
interp_apply(Procedure, 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_error(eval, 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.')))),
+ ; interp_error(arity, Name)),
primitive_apply(Name, Arguments, Result).
interp_apply(proc(Parameters, Body, Env), Arguments, Result) :-
extend_environment(Env, Parameters, Arguments, NewEnv),
@@ -237,27 +235,6 @@ interp_loop(Env, InputStream) :-
nl,
interp_loop(NewEnv, InputStream).
-% errors {{{1
-
-:- multifile prolog:error_message//1.
-prolog:error_message(read_error) -->
- [ 'Failed to read line.' ].
-
-prolog:error_message(parse_error(Codes)) -->
- [ 'Failed to parse line: "~s".' - [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
@@ -11,6 +11,12 @@ test_one_result(Template, Goal, Output) :-
decode(Codes, Expression) :-
test_one_result(E, parse_input_expression(Codes, E), Expression).
+:- begin_tests(errors).
+%:- use_module('$messages', [message_to_string/2]).
+test(read_error) :-
+ message_to_string(error(read_error, _), Message),
+ assertion(Message =@= "Failed to read line.").
+:- end_tests(errors).
:- begin_tests(sexp).
test(sexp_atom) :-
