commit 99e39537127dbdfb7a94dcd048af14e3ab471fe7
parent b87864f34e921beea292d5e3c679ad406242bfde
Author: Jan Pobrislo <ccx@te2000.cz>
Date: Fri, 6 Jun 2025 00:22:55 +0000
Convert predicates to DCG format
Diffstat:
| M | interpreter.pl | | | 74 | +++++++++++++++++++++++++++++++++++++++++++------------------------------- |
1 file changed, 43 insertions(+), 31 deletions(-)
diff --git a/interpreter.pl b/interpreter.pl
@@ -25,6 +25,14 @@ interp_check(Condition, Kind, ErrorData, Message) :-
parent_name(Caller),
validate_and_conditional_throw(Condition, interp_error(Kind, ErrorData), Caller, Message).
+interp_check(Condition, Kind, ErrorData, StateIn, StateOut) :-
+ parent_name(Caller),
+ validate_and_conditional_throw(call(Condition, StateIn, StateOut), interp_error(Kind, ErrorData), Caller, _).
+
+interp_check(Condition, Kind, ErrorData, Message, StateIn, StateOut) :-
+ parent_name(Caller),
+ validate_and_conditional_throw(call(Condition, StateIn, StateOut), interp_error(Kind, ErrorData), Caller, Message).
+
validate_and_conditional_throw(Condition, Error, Caller, Message) :-
validate_error(Error, Caller),
( call(Condition) -> true ; throw(error(Error, context(Caller, Message)))).
@@ -96,8 +104,8 @@ define_variable(VarName, Value, StateIn, StateOut) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Assignments
-set_variable_value(VarName, Value, StateIn, StateOut) :-
- interp_check(set_variable_value_aux(VarName, Value, StateIn, StateOut), unbound_var, VarName).
+set_variable_value(VarName, Value) -->
+ interp_check(set_variable_value_aux(VarName, Value), unbound_var, VarName).
set_variable_value_aux(VarName, Value, [OldFrame|OldE], [NewFrame|NewE]) :-
( set_variable_in_frame(VarName, Value, OldFrame, NewFrame)
@@ -115,7 +123,7 @@ set_variable_in_frame(VarName, Value, [K-_OldV|OldT], [K-NewV|NewT]) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Procedure Construction
-make_procedure(Parameters, Body, State, proc(Parameters, Body, State.env)).
+make_procedure(Parameters, Body, proc(Parameters, Body, State.env), State, State).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Application Expressions
@@ -139,12 +147,12 @@ 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_(selfeval, Expression, Expression) --> { true }.
+interp_eval_(quote, [quote, Text], Text) --> { true }.
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_(special, [Special|Tail], Result) -->
+ interp_check(interp_eval_special(Special, Tail, Result), eval, [Special|Tail]).
interp_eval_(operator, [Operator|Operands], Result) -->
interp_eval(Operator, Procedure),
list_of_values(Operands, Arguments),
@@ -154,8 +162,8 @@ interp_eval_special('set!', [VarName, Expression], '#void') -->
interp_eval(Expression, Result),
set_variable_value(VarName, Result).
-interp_eval_special(lambda, [Parameters|Body], Result, State, State) :-
- make_procedure(Parameters, Body, State, Result).
+interp_eval_special(lambda, [Parameters|Body], Result) -->
+ make_procedure(Parameters, Body, Result).
interp_eval_special(define, [VarName, Definition], '#void') -->
interp_eval(Definition, Value),
@@ -164,17 +172,19 @@ interp_eval_special(define, [VarName, Definition], '#void') -->
interp_eval_special(cond, Conditions, Result) -->
eval_cond(Conditions, Result).
-eval_cond([], '#void', State, State).
-eval_cond([[else|ThenBody]], Result, StateIn, StateOut) :-
+eval_cond([], '#void') --> { true }.
+eval_cond([[else|ThenBody]], Result) -->
!,
- 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, State1, StateOut)
- ; ( TestResult =@= '#f'
- -> eval_cond(Rest, Result, State1, StateOut)
- ; interp_error(type, bool))).
+ eval_sequence(ThenBody, Result).
+eval_cond([[TestExpr|ThenBody]|Rest], Result) -->
+ interp_eval(TestExpr, TestResult),
+ { interp_check((TestResult =@= '#t' ; TestResult =@= '#f'), type, bool) },
+ eval_cond_aux(TestResult, ThenBody, Rest, Result).
+
+eval_cond_aux('#t', ThenBody, _Rest, Result) -->
+ eval_sequence(ThenBody, Result).
+eval_cond_aux('#f', _ThenBody, Rest, Result) -->
+ eval_cond(Rest, Result).
interp_eval(Expression, Result) -->
check_state,
@@ -184,10 +194,12 @@ interp_eval(Expression, Result) -->
},
interp_eval_(Type, Expression, 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, StateIn, StateOut), primitive, Name).
+interp_apply_(primitive(Name, Arity), Arguments, Result) -->
+ {
+ 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, StateIn, StateOut) :-
State1 = StateIn.put(env, Env),
extend_environment(Parameters, Arguments, State1, State2),
@@ -199,16 +211,16 @@ interp_apply(Proc, Arguments, Result) -->
{ assertion(ground(Proc)), assertion(ground(Arguments)) },
interp_apply_(Proc, Arguments, Result).
-eval_sequence([H|T], Result, StateIn, StateOut) :-
- interp_eval(H, FirstResult, StateIn, State1),
- eval_sequence_aux(T, FirstResult, Result, State1, StateOut).
+eval_sequence([H|T], Result) -->
+ interp_eval(H, FirstResult),
+ eval_sequence_aux(T, FirstResult, Result).
-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).
+eval_sequence_aux([], Result, Result) --> { true }.
+eval_sequence_aux([H|T], _, Result) -->
+ interp_eval(H, ThisResult),
+ eval_sequence_aux(T, ThisResult, Result).
-list_of_values([], [], State, State).
+list_of_values([], []) --> { true }.
list_of_values([Name|NameTail], [Value|ValueTail]) -->
interp_eval(Name, Value),
list_of_values(NameTail, ValueTail).
