shithub: pprolog

ref: 43f65cbe02b3a2512c3a797862196d693b3a9f11
dir: /repl.pl/

View raw version
:- module(repl, []).

repl([_ProgName|Args]) :-
	handle_args(Args),
	( member('--no-repl', Args)
	-> halt
	; repl_loop
	).

handle_arg('-d') :-
	set_prolog_flag(debug, on).
handle_arg('--no-repl').
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 :-
	'$collect_garbage',
	catch(read_eval_print, E, print_exception(E)),
	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(_, _, _) :-
	\+ 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
	).