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

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