diff options
author | Peter Mikkelsen <peter@pmikkelsen.com> | 2021-07-16 15:25:01 +0000 |
---|---|---|
committer | Peter Mikkelsen <peter@pmikkelsen.com> | 2021-07-16 15:25:01 +0000 |
commit | 480de114963ecee700ece5b8793916726c04b9ab (patch) | |
tree | 9c1543307aef92c1c88289a4d07ad4dcbae6b38c /repl.pl | |
parent | ee65a81ee5b0112ba4480619ca672c569fb28b45 (diff) |
Replace the C repl with one written in prolog :)
Diffstat (limited to 'repl.pl')
-rw-r--r-- | repl.pl | 77 |
1 files changed, 77 insertions, 0 deletions
@@ -0,0 +1,77 @@ +:- module(repl, []). + +repl :- + catch(read_eval_print, E, print_exception(E)), + '$collect_garbage', + repl. + +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([B|Bs]) :- + write(B), + ( Bs = [] + -> true + ; put_char(','), nl + ), + write_bindings(Bs). + +print_exception(E) :- + write('Unhandled exception: '), + write(E), + nl. + +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 + ). |