commit b87864f34e921beea292d5e3c679ad406242bfde
parent 93ae3831b08c7608410fa4ae463fb6d33282aa3d
Author: Jan Pobrislo <ccx@te2000.cz>
Date: Thu, 5 Jun 2025 23:57:59 +0000
Use swipl dict for state instead of edcg
Diffstat:
| M | interpreter.pl | | | 191 | ++++++++++++++++++++++++++++++++++++++++++------------------------------------- |
| M | tests.pl | | | 29 | ++++++++++++++++++----------- |
2 files changed, 120 insertions(+), 100 deletions(-)
diff --git a/interpreter.pl b/interpreter.pl
@@ -3,9 +3,9 @@
[ parse_input_expression/2
, sexp//1
, sexp/4
- , interp_apply/3
+ , interp_apply/5
, interp_eval/4
- , the_global_environment/1
+ , initial_state/1
, primitive_arity/2
]).
:- use_module(library(debug), [assertion/1]).
@@ -14,9 +14,9 @@
:- use_module(library(pairs)).
:- use_module(interp_errors).
-:- use_module(edcg).
-%%%% conditionally throw errors
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% conditionally throw errors
interp_check(Condition, Kind, ErrorData) :-
parent_name(Caller),
validate_and_conditional_throw(Condition, interp_error(Kind, ErrorData), Caller, _).
@@ -29,21 +29,24 @@ validate_and_conditional_throw(Condition, Error, Caller, Message) :-
validate_error(Error, Caller),
( call(Condition) -> true ; throw(error(Error, context(Caller, Message)))).
-%%%% Extended DCG notation
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Interpreter state
+check_state(State, State) :-
+ check_state(State).
+
+check_state(State) :-
+ assertion(check_state_aux(State)).
-% Declare accumulators
-edcg:acc_info(env, _X, _Env0, _Env1, assertion(false)).
-edcg:acc_info(frames, _X, _Frames0, _Frames1, assertion(false)).
+check_state_aux(state{env:Environment}) :-
+ ground(Environment),
+ is_list(Environment).
-% Declare predicates
-edcg:pred_info(extend_environment, 2, [env]).
-edcg:pred_info(lookup_variable_value, 2, [env]).
-edcg:pred_info(define_variable, 2, [env]).
-edcg:pred_info(set_variable_value, 2, [env]).
-edcg:pred_info(interp_eval_, 2, [env]).
-edcg:pred_info(interp_eval, 2, [env]).
-edcg:pred_info(eval_cond, 2, [env]).
-edcg:pred_info(eval_sequence, 2, [env]).
+initial_state(state{env:Environment}) :-
+ setup_environment(Environment).
+
+:=(DictKey, Value, StateIn, StateOut) :-
+ assertion(is_dict(StateIn, state)),
+ put_dict(DictKey, StateIn, Value, StateOut).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Self-evaluating expressions
@@ -67,14 +70,16 @@ empty_environment([]).
% (extend-environment '(a) '(1) '())
% => '(((a) . (1)) . ())
-extend_environment(VarNames, Values, OldEnv, [NewFrame|OldEnv]) :-
+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).
-lookup_variable_value(VarName, Value, Env, Env) :-
- interp_check(lookup_variable_value_aux(Env, VarName, Value), unbound_var, VarName).
+lookup_variable_value(VarName, Value, State, State) :-
+ interp_check(lookup_variable_value_aux(State.env, VarName, Value), 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,13 +89,15 @@ lookup_variable_from_frame([K-V|Rest], VarName, Value) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Definitions
-define_variable(VarName, Value, [OldFrame|EnvTail], [[VarName-Value|OldFrame]|EnvTail]).
+define_variable(VarName, Value, StateIn, StateOut) :-
+ StateIn.env = [OldFrame|EnvTail],
+ StateOut = StateIn.put(env, [[VarName-Value|OldFrame]|EnvTail]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Assignments
-set_variable_value(VarName, Value, OldEnv, NewEnv) :-
- interp_check(set_variable_value_aux(VarName, Value, OldEnv, NewEnv), unbound_var, VarName).
+set_variable_value(VarName, Value, StateIn, StateOut) :-
+ interp_check(set_variable_value_aux(VarName, Value, StateIn, StateOut), unbound_var, VarName).
set_variable_value_aux(VarName, Value, [OldFrame|OldE], [NewFrame|NewE]) :-
( set_variable_in_frame(VarName, Value, OldFrame, NewFrame)
@@ -108,7 +115,7 @@ set_variable_in_frame(VarName, Value, [K-_OldV|OldT], [K-NewV|NewT]) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Procedure Construction
-make_procedure(Parameters, Body, Env, proc(Parameters, Body, Env)).
+make_procedure(Parameters, Body, State, proc(Parameters, Body, State.env)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Application Expressions
@@ -126,82 +133,85 @@ is_eval_special(if).
is_eval_special(cond).
is_eval_special('set!').
-interp_eval_(Expression, Expression, Env, Env) :-
- self_evaluating(Expression), !.
-interp_eval_([quote, Text], Text, Env, Env) :- !.
-interp_eval_(VarName, Result, Env, Env) :-
- variable(VarName),
- !,
- lookup_variable_value(VarName, Result, Env, Env).
-interp_eval_([Special|Tail], Result, Env, NewEnv) :-
- is_eval_special(Special),
- !,
- interp_check(interp_eval_special(Special, Tail, Result, Env, NewEnv), eval, [Special|Tail]).
-interp_eval_([Operator|Operands], Result, Env, NewEnv) :-
- !,
- interp_eval(Operator, Procedure, Env, NewEnv),
- list_of_values(Operands, Env, Arguments),
+expression_type(Expression, selfeval) :- self_evaluating(Expression), !.
+expression_type([quote|_Text], quote) :- !.
+expression_type(VarName, variable) :- variable(VarName), !.
+expression_type([Special|_Tail], special) :- is_eval_special(Special), !.
+expression_type([_Operator|_Operands], operator) :- !.
+
+interp_eval_(selfeval, Expression, Expression, State, State).
+interp_eval_(quote, [quote, Text], Text, State, State).
+interp_eval_(variable, VarName, Result) -->
+ lookup_variable_value(VarName, Result).
+interp_eval_(special, [Special|Tail], Result, StateIn, StateOut) :-
+ interp_check(interp_eval_special(Special, Tail, Result, StateIn, StateOut), eval, [Special|Tail]).
+interp_eval_(operator, [Operator|Operands], Result) -->
+ interp_eval(Operator, Procedure),
+ list_of_values(Operands, Arguments),
interp_apply(Procedure, Arguments, Result).
-interp_eval_(Expression, _, _, _) :-
- interp_error(eval, Expression).
-interp_eval_special('set!', [VarName, Expression], '#void', Env, NewEnv) :-
- interp_eval(Expression, Result, Env, Env1),
- set_variable_value(VarName, Result, Env1, NewEnv).
+interp_eval_special('set!', [VarName, Expression], '#void') -->
+ interp_eval(Expression, Result),
+ set_variable_value(VarName, Result).
-interp_eval_special(lambda, [Parameters|Body], Result, Env, Env) :-
- make_procedure(Parameters, Body, Env, Result).
+interp_eval_special(lambda, [Parameters|Body], Result, State, State) :-
+ make_procedure(Parameters, Body, State, Result).
-interp_eval_special(define, [VarName, Definition], '#void', Env, NewEnv) :-
- interp_eval(Definition, Value, Env, Env1),
- define_variable(VarName, Value, Env1, NewEnv).
+interp_eval_special(define, [VarName, Definition], '#void') -->
+ interp_eval(Definition, Value),
+ define_variable(VarName, Value).
-interp_eval_special(cond, Conditions, Result, Env, NewEnv) :-
- eval_cond(Conditions, Result, Env, NewEnv).
+interp_eval_special(cond, Conditions, Result) -->
+ eval_cond(Conditions, Result).
-eval_cond([], '#void', Env, Env).
-eval_cond([[else|ThenBody]], Result, Env, NewEnv) :-
+eval_cond([], '#void', State, State).
+eval_cond([[else|ThenBody]], Result, StateIn, StateOut) :-
!,
- eval_sequence(ThenBody, Result, Env, NewEnv).
-eval_cond([[TestExpr|ThenBody]|Rest], Result, Env, NewEnv) :-
- interp_eval(TestExpr, TestResult, Env, Env1),
+ eval_sequence(ThenBody, Result, StateIn, StateOut).
+eval_cond([[TestExpr|ThenBody]|Rest], Result, StateIn, StateOut) :-
+ interp_eval(TestExpr, TestResult, StateIn, State1),
( TestResult =@= '#t'
- -> eval_sequence(ThenBody, Result, Env1, NewEnv)
+ -> eval_sequence(ThenBody, Result, State1, StateOut)
; ( TestResult =@= '#f'
- -> eval_cond(Rest, Result, Env1, NewEnv)
+ -> eval_cond(Rest, Result, State1, StateOut)
; interp_error(type, bool))).
-interp_eval(Expression, Result, Env, NewEnv) :-
- assertion(ground(Expression)),
- assertion(ground(Env)),
- interp_eval_(Expression, Result, Env, NewEnv).
+interp_eval(Expression, Result) -->
+ check_state,
+ {
+ assertion(ground(Expression)),
+ interp_check(expression_type(Expression, Type), eval, Expression)
+ },
+ interp_eval_(Type, Expression, Result).
-interp_apply_(primitive(Name, Arity), Arguments, Result) :-
+interp_apply_(primitive(Name, Arity), Arguments, Result, StateIn, StateOut) :-
length(Arguments, ALength),
interp_check(Arity = ALength, arity, Name),
- interp_check(primitive_apply(Name, Arguments, Result), primitive, Name).
-interp_apply_(proc(Parameters, Body, Env), Arguments, Result) :-
- extend_environment(Parameters, Arguments, Env, Env1),
- eval_sequence(Body, Result, Env1, _Env2).
-
-interp_apply(Proc, Arguments, Result) :-
- assertion(ground(Proc)),
- assertion(ground(Arguments)),
+ interp_check(primitive_apply(Name, Arguments, Result, StateIn, StateOut), primitive, Name).
+interp_apply_(proc(Parameters, Body, Env), Arguments, Result, StateIn, StateOut) :-
+ State1 = StateIn.put(env, Env),
+ extend_environment(Parameters, Arguments, State1, State2),
+ eval_sequence(Body, Result, State2, State3),
+ StateOut = State3.put(env, StateIn.env).
+
+interp_apply(Proc, Arguments, Result) -->
+ check_state,
+ { assertion(ground(Proc)), assertion(ground(Arguments)) },
interp_apply_(Proc, Arguments, Result).
-eval_sequence([H|T], Result, Env, NextEnv) :-
- interp_eval(H, FirstResult, Env, Env1),
- eval_sequence_aux(T, FirstResult, Result, Env1, NextEnv).
+eval_sequence([H|T], Result, StateIn, StateOut) :-
+ interp_eval(H, FirstResult, StateIn, State1),
+ eval_sequence_aux(T, FirstResult, Result, State1, StateOut).
-eval_sequence_aux([], Result, Result, Env, Env).
-eval_sequence_aux([H|T], _, Result, Env, NextEnv) :-
- interp_eval(H, ThisResult, Env, Env1),
- eval_sequence_aux(T, ThisResult, Result, Env1, NextEnv).
+eval_sequence_aux([], Result, Result, State, State).
+eval_sequence_aux([H|T], _, Result, StateIn, StateOut) :-
+ interp_eval(H, ThisResult, StateIn, State1),
+ eval_sequence_aux(T, ThisResult, Result, State1, StateOut).
-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, Env, ValueTail).
+list_of_values([], [], State, State).
+list_of_values([Name|NameTail], [Value|ValueTail]) -->
+ interp_eval(Name, Value),
+ list_of_values(NameTail, ValueTail).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Environment Setup
@@ -209,6 +219,11 @@ list_of_values([Name|NameTail], Env, [Value|ValueTail]) :-
result_bool(Condition, Result) :-
call(Condition) -> Result = '#t' ; Result = '#f'.
+% in case we want primitive function which changes state we cand do so here
+% otherwise call stateless primitive_apply/3
+primitive_apply(Name, Arguments, Result, State, State) :-
+ primitive_apply(Name, Arguments, Result).
+
primitive_apply('atom?', [X], Result) :- result_bool(atom(X), Result).
primitive_apply('null?', [X], Result) :- result_bool(X =@= [], Result).
primitive_apply(car, [[H|_]], H).
@@ -230,8 +245,6 @@ primitive_arity(+, 2).
setup_environment([['#t'-'#t', '#f'-'#f'|PrimitiveProcs]]) :-
findall(Name-primitive(Name, Arity), primitive_arity(Name, Arity), PrimitiveProcs).
-the_global_environment(Env) :- setup_environment(Env).
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Driver
@@ -239,7 +252,7 @@ the_global_environment(Env) :- setup_environment(Env).
user_print(proc(Parameters, Body, _)) :-
format('→ proc(~w, ~w, <env>)~n', [Parameters, Body]).
-interp_loop(Env, InputStream) :-
+interp_loop(State0, InputStream) :-
write('? '),
Here=interp_loop/1,
( read_line_to_codes(InputStream, Codes) -> true
@@ -247,11 +260,11 @@ interp_loop(Env, InputStream) :-
format('got input: "~s"~n', [Codes]),
( parse_input_expression(Codes, Expression) -> true
; throw(error(parse_error(Codes), context(Here, 'Failed to parse line.')))),
- ( interp_eval(Expression, Result, Env, NewEnv) -> true
+ ( interp_eval(Expression, Result, State0, State1) -> true
; throw(error(evaluation_error(Codes), context(Here, 'Failed to evaluate expression.')))),
user_print(Result),
nl,
- interp_loop(NewEnv, InputStream).
+ interp_loop(State1, InputStream).
% grammar {{{1
@@ -300,5 +313,5 @@ sexp(Content, _, _, Result) :-
%:- initialization(main, main).
main(_Args) :-
current_stream(0, read, StdInStream),
- the_global_environment(Env),
- interp_loop(Env, StdInStream).
+ initial_state(State),
+ interp_loop(State, StdInStream).
diff --git a/tests.pl b/tests.pl
@@ -2,6 +2,11 @@
:- use_module(interpreter).
+portray_long :- portray_depth(32).
+portray_depth(Depth) :-
+ set_prolog_flag(answer_write_options, [quoted(true), portrayed(true), max_depth(Depth), spacing(next_argument)]),
+ set_prolog_flag(debugger_write_options, [quoted(true), portrayed(true), max_depth(Depth), spacing(next_argument)]).
+
test_one_result(Template, Goal, Output) :-
findall(Template, Goal, Results),
% write(Results), nl,
@@ -85,14 +90,16 @@ apply_example(`(+ 3 2)`, `5`).
:- begin_tests(primitive_apply).
test(apply_example, [forall(apply_example(Func, Args, ExpectedResult))]) :-
+ initial_state(State0),
primitive_arity(Func, Arity),
- interp_apply(primitive(Func, Arity), Args, Result),
+ interp_apply(primitive(Func, Arity), Args, Result, State0, _State1),
assertion(Result =@= ExpectedResult).
test(apply_arity_error, [error(interp_error(arity, car))]) :-
Func=car,
+ initial_state(State0),
primitive_arity(Func, Arity),
- interp_apply(primitive(Func, Arity), [[a], [b]], _).
+ interp_apply(primitive(Func, Arity), [[a], [b]], _Result, State0, _State1).
:- end_tests(primitive_apply).
:- begin_tests(eval).
@@ -101,11 +108,11 @@ quoted_args([], []).
quoted_args([H|T], [[quote, H]|QT]) :- quoted_args(T, QT).
test_eval(Call, ExpectedResult) :-
- the_global_environment(Env),
- test_eval(Call, ExpectedResult, Env).
-test_eval(Call, ExpectedResult, Env) :-
+ initial_state(State0),
+ test_eval(Call, ExpectedResult, State0, _State1).
+test_eval(Call, ExpectedResult, State0, State1) :-
format('testing call: ~w → expecting ~w~n', [Call, ExpectedResult]),
- interp_eval(Call, Result, Env, _),
+ interp_eval(Call, Result, State0, State1),
assertion(Result =@= ExpectedResult).
eval_example(`(car (cdr (quote ((b) (x y) ((c))))))`, `(x y)`).
@@ -138,14 +145,14 @@ eval_define_lat :-
((null? l) #t)
((atom? (car l)) (lat? (cdr l)))
(else #f))))|},
- the_global_environment(Env0),
- interp_eval(DefLat, _, Env0, Env1),
+ initial_state(State0),
+ interp_eval(DefLat, _, State0, State1),
Call0 = {|sexp||(lat? (quote ()))|},
- test_eval(Call0, '#t', Env1),
+ test_eval(Call0, '#t', State1, _),
Call1 = {|sexp||(lat? (quote (Jack Sprat could eat no chicken fat)))|},
- test_eval(Call1, '#t', Env1),
+ test_eval(Call1, '#t', State1, _),
Call2 = {|sexp||(lat? (quote ((Jack) Sprat could eat no chicken fat)))|},
- test_eval(Call2, '#f', Env1).
+ test_eval(Call2, '#f', State1, _).
test(eval_define_lat) :- eval_define_lat.
:- end_tests(eval).
