commit b579f87d26d03db6ae116c4778133bdcddecb0f7
parent 99e39537127dbdfb7a94dcd048af14e3ab471fe7
Author: Jan Pobrislo <ccx@te2000.cz>
Date: Fri, 6 Jun 2025 02:09:47 +0000
Implement mutable frames using assoc in interp_state
Diffstat:
3 files changed, 42 insertions(+), 39 deletions(-)
diff --git a/interp_errors.pl b/interp_errors.pl
@@ -21,6 +21,12 @@ prolog:error_message(evaluation_error(Codes)) -->
prolog:error_message(interp_error(eval, Expression)) -->
[ 'Don\'t know how to evaluate: "~w".' - [Expression] ].
+prolog:error_message(interp_error(eval_fail, Expression)) -->
+ [ 'Internal error evaluating: "~w".' - [Expression] ].
+
+prolog:error_message(interp_error(apply_fail, Expression)) -->
+ [ 'Internal error calling: "~w".' - [Expression] ].
+
prolog:error_message(interp_error(arity, Func)) -->
[ 'Invalid amount of arguments for function: "~w".' - [Func] ].
@@ -35,7 +41,9 @@ prolog:error_message(interp_error(type, Expected)) -->
%%% exception throwing helpers
+validate_error(interp_error(apply_fail, _), _) :- !.
validate_error(interp_error(eval, _), _) :- !.
+validate_error(interp_error(eval_fail, _), _) :- !.
validate_error(interp_error(arity, _), _) :- !.
validate_error(interp_error(unbound_var, _), _) :- !.
validate_error(interp_error(primitive, _), _) :- !.
diff --git a/interpreter.pl b/interpreter.pl
@@ -5,15 +5,18 @@
, sexp/4
, interp_apply/5
, interp_eval/4
+ , lookup_variable_value/4
, initial_state/1
, primitive_arity/2
]).
:- use_module(library(debug), [assertion/1]).
:- use_module(library(dcg/basics), [blanks//0, number//1]).
:- use_module(library(quasi_quotations), [phrase_from_quasi_quotation/2, quasi_quotation_syntax/1]).
-:- use_module(library(pairs)).
+:- use_module(library(assoc), [get_assoc/3, put_assoc/4]).
+:- use_module(library(pairs), [pairs_keys_values/3]).
:- use_module(interp_errors).
+:- use_module(interp_state).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% conditionally throw errors
@@ -39,22 +42,14 @@ validate_and_conditional_throw(Condition, Error, Caller, Message) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Interpreter state
-check_state(State, State) :-
- check_state(State).
+initial_state(State) :-
+ global_frame(Frame),
+ empty_state(Empty),
+ State = Empty.new_frame(Frame).
-check_state(State) :-
- assertion(check_state_aux(State)).
-
-check_state_aux(state{env:Environment}) :-
- ground(Environment),
- is_list(Environment).
-
-initial_state(state{env:Environment}) :-
- setup_environment(Environment).
-
-:=(DictKey, Value, StateIn, StateOut) :-
- assertion(is_dict(StateIn, state)),
- put_dict(DictKey, StateIn, Value, StateOut).
+% :=(DictKey, Value, StateIn, StateOut) :-
+% assertion(is_dict(StateIn, interp_state)),
+% put_dict(DictKey, StateIn, Value, StateOut).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Self-evaluating expressions
@@ -73,24 +68,22 @@ self_evaluating(Exp) :- string(Exp).
variable(Exp) :- atom(Exp).
-% No bindings, no enclosing environment
-empty_environment([]).
-
% (extend-environment '(a) '(1) '())
% => '(((a) . (1)) . ())
extend_environment(VarNames, Values, StateIn, StateOut) :-
- OldEnv = StateIn.env,
- StateOut = StateIn.put(env, [NewFrame|OldEnv]),
length(VarNames, VarLength),
length(Values, ValLength),
assertion(VarLength =@= ValLength),
- pairs_keys_values(NewFrame, VarNames, Values).
+ pairs_keys_values(NewFrame, VarNames, Values),
+ StateOut = StateIn.new_frame(NewFrame).
lookup_variable_value(VarName, Value, State, State) :-
- interp_check(lookup_variable_value_aux(State.env, VarName, Value), unbound_var, VarName).
+ ( lookup_variable_value_aux(State.env, State.frames, VarName, Value) -> true
+ ; 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).
+lookup_variable_value_aux([FrameNo|Env], Frames, VarName, Value) :-
+ get_assoc(FrameNo, Frames, Frame),
+ lookup_variable_from_frame(Frame, VarName, Value) -> true ; lookup_variable_value_aux(Env, Frames, VarName, Value).
lookup_variable_from_frame([K-V|Rest], VarName, Value) :-
VarName = K -> V = Value ; lookup_variable_from_frame(Rest, VarName, Value).
@@ -98,20 +91,19 @@ lookup_variable_from_frame([K-V|Rest], VarName, Value) :-
%% Definitions
define_variable(VarName, Value, StateIn, StateOut) :-
- StateIn.env = [OldFrame|EnvTail],
- StateOut = StateIn.put(env, [[VarName-Value|OldFrame]|EnvTail]).
+ StateOut = StateIn.update_current_frame([VarName-Value|StateIn.current_frame()]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Assignments
-set_variable_value(VarName, Value) -->
- interp_check(set_variable_value_aux(VarName, Value), unbound_var, VarName).
+set_variable_value(VarName, Value, StateIn, StateIn.put(frames, FramesOut)) -->
+ interp_check(set_variable_value_aux(VarName, Value, StateIn.env, StateIn.frames, FramesOut), unbound_var, VarName).
-set_variable_value_aux(VarName, Value, [OldFrame|OldE], [NewFrame|NewE]) :-
+set_variable_value_aux(VarName, Value, [EHead|ETail], FramesIn, FramesOut) :-
+ get_assoc(EHead, FramesIn, OldFrame),
( set_variable_in_frame(VarName, Value, OldFrame, NewFrame)
- -> OldE = NewE
- ; OldFrame = NewFrame,
- set_variable_value_aux(VarName, Value, OldE, NewE)).
+ -> put_assoc(EHead, FramesIn, NewFrame, FramesOut)
+ ; set_variable_value_aux(VarName, Value, ETail, FramesIn, FramesOut)).
set_variable_in_frame(VarName, Value, [K-_OldV|OldT], [K-NewV|NewT]) :-
( VarName = K
@@ -152,7 +144,7 @@ interp_eval_(quote, [quote, Text], Text) --> { true }.
interp_eval_(variable, VarName, Result) -->
lookup_variable_value(VarName, Result).
interp_eval_(special, [Special|Tail], Result) -->
- interp_check(interp_eval_special(Special, Tail, Result), eval, [Special|Tail]).
+ interp_eval_special(Special, Tail, Result).
interp_eval_(operator, [Operator|Operands], Result) -->
interp_eval(Operator, Procedure),
list_of_values(Operands, Arguments),
@@ -165,7 +157,8 @@ interp_eval_special('set!', [VarName, Expression], '#void') -->
interp_eval_special(lambda, [Parameters|Body], Result) -->
make_procedure(Parameters, Body, Result).
-interp_eval_special(define, [VarName, Definition], '#void') -->
+interp_eval_special(define, Arguments, '#void') -->
+ { interp_check(([VarName, Definition] = Arguments), arity, define) },
interp_eval(Definition, Value),
define_variable(VarName, Value).
@@ -192,7 +185,7 @@ interp_eval(Expression, Result) -->
assertion(ground(Expression)),
interp_check(expression_type(Expression, Type), eval, Expression)
},
- interp_eval_(Type, Expression, Result).
+ interp_check(interp_eval_(Type, Expression, Result), eval_fail, Expression).
interp_apply_(primitive(Name, Arity), Arguments, Result) -->
{
@@ -209,7 +202,7 @@ interp_apply_(proc(Parameters, Body, Env), Arguments, Result, StateIn, StateOut)
interp_apply(Proc, Arguments, Result) -->
check_state,
{ assertion(ground(Proc)), assertion(ground(Arguments)) },
- interp_apply_(Proc, Arguments, Result).
+ interp_check(interp_apply_(Proc, Arguments, Result), apply_fail, [Proc|Arguments]).
eval_sequence([H|T], Result) -->
interp_eval(H, FirstResult),
@@ -254,7 +247,7 @@ primitive_arity('eq?', 2).
primitive_arity(cons, 2).
primitive_arity(+, 2).
-setup_environment([['#t'-'#t', '#f'-'#f'|PrimitiveProcs]]) :-
+global_frame(['#t'-'#t', '#f'-'#f'|PrimitiveProcs]) :-
findall(Name-primitive(Name, Arity), primitive_arity(Name, Arity), PrimitiveProcs).
diff --git a/tests.pl b/tests.pl
@@ -111,7 +111,7 @@ test_eval(Call, ExpectedResult) :-
initial_state(State0),
test_eval(Call, ExpectedResult, State0, _State1).
test_eval(Call, ExpectedResult, State0, State1) :-
- format('testing call: ~w → expecting ~w~n', [Call, ExpectedResult]),
+ format('testing call: ~w → expecting ~w | ~w~n', [Call, ExpectedResult, State0]),
interp_eval(Call, Result, State0, State1),
assertion(Result =@= ExpectedResult).
@@ -147,6 +147,8 @@ eval_define_lat :-
(else #f))))|},
initial_state(State0),
interp_eval(DefLat, _, State0, State1),
+ lookup_variable_value('lat?', Proc, State1, _),
+ assertion(Proc = proc([l], _, _)),
Call0 = {|sexp||(lat? (quote ()))|},
test_eval(Call0, '#t', State1, _),
Call1 = {|sexp||(lat? (quote (Jack Sprat could eat no chicken fat)))|},
