logical values in prolog, skip the raw argument in attribute unifyier and identity

parent 268f32cb
......@@ -32,14 +32,18 @@ Version 0.5, TODO
* Refined index lookup datastructure (guile-log)
* Sandboxing (prolog)
* Improved documentation (all)
* Keyword objects (prolog)
* GC of prolog variables (all)
* Keyword objects and logic values (prolog) DONE
* GC of prolog variables (all) DONE
* GC of the (almost) unreachable tail of a stream (all)
* More general functional hashmps (all)
* Attributed variables (all)
* Ordinary hash maps (all)
* Attributed variables (all) DONE
* corouttines (prolog) PARTLY
* Debugging facilities (prolog)
* Better error messages (prolog)
* Better compilation errors (prolog)
* Faster compilation (prolog)
* Improved matcher (prolog)
* Use guile variables when possible (prolog)
* vectors (prolog)
* structs (prolog)
......@@ -288,7 +288,7 @@
r)))
(gp-set-attribute-trampoline (lambda (lam val var x y s)
(gp-set-attribute-trampoline (lambda (lam val var x s)
(lam s (lambda () #f) (lambda (s . l) s)
val var x y)))
val var x)))
......@@ -12,7 +12,7 @@ do_all_atts([G|L]) :- call(G),!, do_all_atts(L).
do_all_atts([]).
% The unification algorithm
freezeId(Val, Var, _, _) :-
freezeId(Val, Var, #t) :-
var(Val);attvar(Val);
(
get_attr(Var,freezeId, Atts),
......@@ -54,7 +54,7 @@ do_all_atts_when(Val, [Id, G | L]) :-
do_all_atts_when(Val, []).
whenId(Val,Var) :-
whenId(Val,Var,#t) :-
(
var(Val);attvar(Val);
(var(scm[doWhen]) ->
......@@ -71,7 +71,7 @@ whenId(Val,Var) :-
),!.
difId(Val, Var) :-
difId(Val, Var, #t) :-
var(Val);attvar(Val);
(
get_attr(Var,whenId, Atts),
......
......@@ -17,7 +17,7 @@
s-tag s-tag! pr-tag s-clear-body pr-not
s-rpl f-rpl s-tr f-tr
f-and f-and! f-and!!
f-or f-or! f-not f-not!
f-or f-or! f-not* f-not f-not!
f-seq f-seq! f-seq!!
f* f+ f? f-tag f-tag! f-tag-pr
f-reg f-reg! f-reg-pr
......@@ -203,7 +203,7 @@
f-char f-char! pr-char f-reg f-reg! pr-reg
f-ws f-ws* pr-ws+ tok-ws* tok-ws+ parse-no-clear
s-rpl f-rpl s-tr f-tr f-1-char f-1-char! pr-1-char
f-not f-not! pr-not f-seq! f-seq!! f-deb
f-not f-not! f-not* pr-not f-seq! f-seq!! f-deb
pp do-print f-wrap)
(begin
......@@ -552,6 +552,11 @@
(.. (c) (f-1-char c))
(<p-cc> c)))
(define (f-not* f)
(<p-lambda> (c)
(<not> (<and> (.. (q) (f c))))
(<p-cc> c)))
(define (f-not! f)
(<p-lambda> (c)
(<not> (<and> (.. (q) (f c))))
......@@ -722,7 +727,7 @@
f-char f-char! pr-char f-reg f-reg! pr-reg
f-ws f-ws* pr-ws+ tok-ws* tok-ws+ parse-no-clear
s-rpl f-rpl s-tr f-tr f-1-char f-1-char! pr-1-char
f-not f-not! pr-not f-seq! f-seq!! f-deb
f-not f-not! f-not* pr-not f-seq! f-seq!! f-deb
pp do-print f-wrap)))
(define-syntax setup-parser
......
......@@ -322,7 +322,7 @@
(let* ((syms (get-syms))
(syms (union syms syms)))
(pp 'res #`(begin
(ppp 'res #`(begin
(eval-when (compile load eval)
(add-non-defined
(quote #,(datum->syntax stx syms))))
......
......@@ -13,7 +13,7 @@
#:use-module ((logic guile-log) #:select (<let> <pp> <scm> <code> <let*>
<var> <=> <fail> <match>
<cut> <and> <or> <define>
<cc> <not>
<cc> <not> <if>
(_ . GL:_)))
#:re-export (*prolog-file* get-refstr)
#:export (prolog-parse define-parser-directive add-op rem-op
......@@ -501,6 +501,18 @@
`(#:lam-term ,c1 ,(<scm> c3) ,cl ,n ,m))))))
mk-id)))
(define true/false
(let ((tag (mk-token (f-seq (f-or (f-tag! "#t") (f-tag! "#f"))
(f-not* rest-var)))))
(p-freeze 'true/false
(<p-lambda> (c)
(.. (c0) (ws c))
(<let> ((n N) (m M))
(.. (c) (tag c0))
(<p-cc>
`(#:keyword ,(if (equal? (pk 'true/false c) "#t") #t #f) ,n ,m))))
mk-id)))
(define termvar-tok
(let ((l (f-tag "("))
(r (f-tag ")")))
......@@ -528,10 +540,16 @@
(<p-lambda> (c)
(.. (c0) (ws c))
(<let> ((n N) (m M))
(xx (cx) (<and> (<not> (.. (q) (funop c0)))
(<p-cc> 1)))
(xx (cx) (<if> (<not>
(<and>
(.. (q1) (funop c0))
(.. (q2) (ws q1))
(.. (q3) (l q2))))
(<p-cc> 1)
<fail>))
(.. (c1) (symbolic c0))
(.. (c2) (l (pk c1)))
(.. (cq) (ws c1))
(.. (c2) (l c1))
(.. (c3) ((f-or expr ws) c2))
(.. (c4) (r c3))
(.. (c5) (ws c4))
......@@ -616,7 +634,8 @@
#;(define tok (f-or! list-e term-tok termvar-tok atom symbolic variable number))
(define tok (f-or! paranthesis keyword
char list-tok termvar-tok term-binop-tok termop-tok
char list-tok true/false
termvar-tok term-binop-tok termop-tok
termstring-tok term-tok scm-tok lam-tok
number qstring dstring atom variable op-tok))
......
......@@ -1398,12 +1398,7 @@ static SCM gp_unify(SCM *id1, SCM *id2, int raw, int gp_plus_unify, SCM *l, stru
{
retry_attr:
{
SCM scm_raw, scm_plus;
if(raw)
scm_raw = SCM_BOOL_T;
else
scm_raw = SCM_BOOL_F;
SCM scm_plus;
if(gp_plus_unify)
scm_plus = SCM_BOOL_T;
else
......@@ -1418,9 +1413,8 @@ static SCM gp_unify(SCM *id1, SCM *id2, int raw, int gp_plus_unify, SCM *l, stru
if(SCM_CONSP(SCM_CAR(xl)))
{
s =
scm_call_6(trampoline, SCM_CAAR(xl),
scm_call_5(trampoline, SCM_CAAR(xl),
GP_UNREF(id2), GP_UNREF(id1),
scm_raw,
scm_plus, s);
gp_format1("processing got ~a~%", s);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment