ref: 463f3b41ac6a17f6fe88f6c114aa849876bfcf4e
dir: /repl.pl/
:- module(repl, []).
repl([ProgName|Args]) :-
write('Welcome to p-prolog version 1.'),
nl,
write('Started with args: '),
write(Args),
nl,
flush_output,
handle_args(Args),
repl_loop.
handle_arg('-d') :-
set_prolog_flag(debug, on).
handle_arg(Arg) :-
loader:load_module_from_file(Arg).
handle_args([Arg|Rest]) :- catch(handle_arg(Arg), E, handle_arg_error(E)), !, handle_args(Rest).
handle_args([]).
handle_arg_error(E) :-
write('Could not handle arg: '),
print_exception(E).
repl_loop :-
catch(read_eval_print, E, print_exception(E)),
'$collect_garbage',
repl_loop.
read_eval_print :-
write('?- '),
asserta(found_a_solution :- (!, fail)),
read_term(Term, [variable_names(Vars)]),
'$choicestack_size'(Choicecount),
eval_and_print(Term, Vars, Choicecount),
!,
abolish(found_a_solution/0).
eval_and_print(Goal, Vars0, Choicecount) :-
user:call(Goal),
rewrite_equations(Vars0, Vars),
abolish(found_a_solution/0),
asserta(found_a_solution :- !),
'$choicestack_size'(ChoicecountNew),
( ChoicecountNew > Choicecount + 1
-> write_result(Vars, more),
get_raw_char(Char),
( Char = ';'
-> put_char(Char),
nl,
'$collect_garbage',
asserta(found_a_solution :- (!, fail)),
fail % backtrack and call G again
; put_char('.'), nl
)
; write_result(Vars, end)
).
eval_and_print(Goal, _, _) :-
\+ found_a_solution,
write('false .'),
nl.
rewrite_equations(Eqs0, Eqs) :-
apply_bindings(Eqs0),
remove_identities(Eqs0, Eqs).
apply_bindings([]).
apply_bindings([A = B|Rest]) :-
( var(B)
-> call(B = A)
; true
),
apply_bindings(Rest).
remove_identities([], []).
remove_identities([A = B|Rest0], Result) :-
remove_identities(Rest0, Rest),
( A == B
-> Result = Rest
; Result = [A = B|Rest]
).
write_state(end) :- write('.'), nl.
write_state(more).
write_result([], State) :- write('true'), write(' '), write_state(State).
write_result([B|Bs], State) :- write_bindings([B|Bs]), write(' '), write_state(State).
write_bindings([]).
write_bindings([Var = Val|Bs]) :-
write(Var),
write(' = '),
write(Val),
( Bs = []
-> true
; put_char(','), nl
),
write_bindings(Bs).
print_exception(error(E, _)) :-
write('Unhandled error:
'), % \n\t
print_error(E),
nl.
print_exception(E) :-
E \= error(_,_),
write('Unhandled exception: '),
write(E),
nl.
print_error(instantiation_error) :-
write('instantiation error').
print_error(type_error(ValidType, Culprit)) :-
write('type error, expected '),
write(ValidType),
write(': '),
write(Culprit).
print_error(domain_error(ValidDomain, Culprit)) :-
write('domain error, expected '),
write(ValidDomain),
write(': '),
write(Culprit).
print_error(existence_error(ObjectType, Culprit)) :-
write('existence error, '),
write(Culprit),
write(' is not an existing object of type: '),
write(ObjectType).
print_error(permission_error(Operation, Type, Culprit)) :-
write('permission error, cannot '),
write(Operation),
write(' '),
write(Type),
write(': '),
write(Culprit).
print_error(representation_error(Flag)) :-
write('representation error: '),
write(Flag).
print_error(evaluation_error(Error)) :-
write('evaluation error: '),
write(Error).
print_error(resource_error(Res)) :-
write('resource error: '),
write(Res).
print_error(syntax_error(E)) :-
write('syntax error: '),
write(E).
print_error(system_error) :-
write('system error').
print_error(E) :-
write(E).
whitespace(' ').
whitespace(' ').
whitespace('
').
get_raw_char(Char) :-
open('/dev/consctl', write, S),
write(S, rawon),
get_one_char(Char),
write(S, rawoff),
close(S).
get_one_char(Char) :-
get_char(C),
( whitespace(C)
-> get_one_char(Char)
; Char = C
).