shithub: pprolog

ref: 6b3d59a3256a292b582e4313325ca14154211671
dir: /repl.pl/

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

repl([ProgName|Args]) :-
	write('Welcome to p-prolog version 1'),
	nl,
	write('Started with args: '),
	write(Args),
	nl,
	handle_args(Args),
	repl_loop.

handle_arg('-d') :-
	set_prolog_flag(debug, on).
handle_arg(Arg) :-
	( '$load_module_from_file'(Arg)
	-> write('Loaded module from file: ')
	; write('Failed to load module from file: ')
	),
	write(Arg), nl.

handle_args([Arg|Rest]) :- handle_arg(Arg), !, handle_args(Rest).
handle_args([]).

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, Vars, Choicecount) :-
	user:call(Goal),
	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.

write_state(end) :- write('.'), nl.
write_state(more).

write_result([], State) :- write('true'), write_state(State).
write_result([B|Bs], State) :- write_bindings([B|Bs]), write_state(State).

write_bindings([]).
write_bindings([Var = Val|Bs]) :-
	write(Var),
	write(' = '),
	writeq(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
	).