rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add catch/throw support, make exceptions and arithmetic tests pass.

Browse Source
This commit is contained in:
Mark Thom
2018-05-10 01:43:36 -06:00
parent bae107f8cd
commit 954c29b103
9 changed files with 314 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
src/prolog/lib/builtins.pl
View File

@@ -1,8 +1,9 @@
:- op(400, yfx, /).
:- module(builtins, [(+)/2, (*)/2, (-)/2, (/)/2, (/\)/2, (\/)/2, (is)/2,
(xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2,
(rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2]).
:- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2,
(\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2,
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1,
(>=)/2, (=<)/2, (->)/2, (;)/2, catch/3, throw/1, true/0, false/0]).
% arithmetic operators.
:- op(700, xfx, is).
@@ -19,6 +20,7 @@
:- op(400, yfx, >>).
:- op(400, yfx, mod).
:- op(400, yfx, rem).
:- op(200, fy, -).
% arithmetic comparison operators.
:- op(700, xfx, >).
@@ -27,3 +29,57 @@
:- op(700, xfx, =:=).
:- op(700, xfx, >=).
:- op(700, xfx, =<).
% conditional operators.
:- op(1050, xfy, ->).
:- op(1100, xfy, ;).
% unify.
:- op(700, xfx, =).
% unify.
X = X.
true.
false :- '$fail'.
% conditions.
/*
','(G1, G2) :- get_cp(B), ','(G1, G2, B).
','(!, ','(G1, G2), B) :- set_cp(B), ','(G1, G2, B).
','(!, !, B) :- set_cp(B).
','(!, G, B) :- set_cp(B), G.
','(G, ','(G2, G3), B) :- !, G, ','(G2, G3, B).
','(G, !, B) :- !, G, set_cp(B).
','(G1, G2, _) :- G1, G2.
;(G1, G2) :- get_cp(B), ;(G1, G2, B).
;(G1 -> G2, _, B) :- ->(G1, G2, B).
;(_ -> _ , G, B) :- set_cp(B), G.
;(!, _, B) :- set_cp(B).
;(_, !, B) :- set_cp(B).
;(G, _, _) :- G.
;(_, G, _) :- G.
G1 -> G2 :- get_cp(B), ->(G1, G2, B).
->(G1, !, B) :- call(G1), set_cp(B).
->(G1, G2, B) :- call(G1), set_cp(B), call(G2).
*/
% exceptions.
catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb).
catch(G,C,R,Bb) :- '$install_new_block'(NBb), call(G), end_block(Bb, NBb).
catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), handle_ball(Ball, C, R).
end_block(Bb, NBb) :- '$clean_up_block'(NBb), '$reset_block'(Bb).
end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'.
handle_ball(Ball, C, R) :- Ball = C, !, '$erase_ball', call(R).
handle_ball(_, _, _) :- '$unwind_stack'.
throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.