summaryrefslogtreecommitdiff
path: root/repl.pl
diff options
context:
space:
mode:
authorPeter Mikkelsen <peter@pmikkelsen.com>2021-07-16 15:25:01 +0000
committerPeter Mikkelsen <peter@pmikkelsen.com>2021-07-16 15:25:01 +0000
commit480de114963ecee700ece5b8793916726c04b9ab (patch)
tree9c1543307aef92c1c88289a4d07ad4dcbae6b38c /repl.pl
parentee65a81ee5b0112ba4480619ca672c569fb28b45 (diff)
Replace the C repl with one written in prolog :)
Diffstat (limited to 'repl.pl')
-rw-r--r--repl.pl77
1 files changed, 77 insertions, 0 deletions
diff --git a/repl.pl b/repl.pl
new file mode 100644
index 0000000..eb272a9
--- /dev/null
+++ b/repl.pl
@@ -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
+ ).