set improvements

parent 6bdb77b8
...@@ -42,7 +42,8 @@ ...@@ -42,7 +42,8 @@
interleaved interleaved
extended_interleaved extended_interleaved
make_dynamic make_generic_dynamic make_dynamic make_generic_dynamic
make-functional-dynamic-db)) make-functional-dynamic-db
mkdyn))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
...@@ -2336,3 +2337,6 @@ add/run * vlist * ...@@ -2336,3 +2337,6 @@ add/run * vlist *
f))) f)))
(end) (end)
res))) res)))
(<define> (mkdyn f)
(<=> f ,(make-dyn (current-module) 'λ)))
...@@ -35,7 +35,8 @@ ...@@ -35,7 +35,8 @@
advanced-set-printer set_unify set-lookup advanced-set-printer set_unify set-lookup
use_complex_map use_simple_map ppp use_complex_map use_simple_map ppp
n u o m c subset subseteq mk mem n u o m c subset subseteq mk mem
subset-scm subseteq-scm)) subset-scm subseteq-scm
f f fc f× f f set_to_f))
(define vsetx-empty) (define vsetx-empty)
(define mk #f) (define mk #f)
...@@ -941,6 +942,80 @@ expand(Var,V,YY,Lam) :- ...@@ -941,6 +942,80 @@ expand(Var,V,YY,Lam) :-
do[(set! ∅ (gp-lookup Z S))], do[(set! ∅ (gp-lookup Z S))],
do[(set! mk∅ (gp-lookup Q S))], do[(set! mk∅ (gp-lookup Q S))],
do[(set! Ω (gp-lookup W S))]. do[(set! Ω (gp-lookup W S))].
set_to_f(S,F) :-
mkdyn(F),
forall(_,(X∈S,asserta(F(X))),_).
doall(X,Op,[]).
doall(X,Op,[F]) :- !,F(X).
doall(X,Op,[F|L]) :- Op(F(X),doall(X,Op,L)).
findvars0([A|B],U,UU) :- !,
findvars0(A,U,U1),
findvars0(B,U1,UU).
findvars0(A,U,[A|U]) :-
var(A),\+ memq(A,U),!.
findvars0(A,U,U).
findvars(A,U) :-
findvars(A,[],UU),
reverse(UU,U).
funion0(A,B) :- (A,\\+B);(B,\\+A).
'f∪'(A,B,C) :-
findvars([A,B],W),
mkdyn(C),
asserta(C(X,W) :- doall(X,funion0,[A,B])).
'f∪'(L,C) :-
findvars(L,W),
mkdyn(C),
asserta(C(X,W) :- doall(X,funion0,L)).
fint0(A,B) :- ((A,B,!);(B,A,!)).
'f∩'(A,B,C) :-
findvars([A,B],W),
mkdyn(C),
asserta(C(X,W) :- fint0(A(X),B(X)).
'f∩'(L,C) :-
mkdyn(C),
asserta(C(X,W) :- doall(X,fint0,L)).
fsubs0(A,B) :- (A,(\\+B)).
'f∖'(A,B,C) :-
findvars([A,B],W),
mkdyn(C),
asserta(C(X,W) :- doall(X,fsub0,[A,B])).
fsum0(A,B) :- (((A),\\+(B));((B),\\+(A))).
'f⊕'(A,B,C) :-
mkdyn(C),
asserta(C(X) :- fsum(A(X),B(X))).
'f⊕'(L,C) :-
mkdyn(C),
asserta(C(X) :- doall(X,fsum0,L)).
'f×'(A,B,C) :-
mkdyn(C),
asserta(C([X|Y]) :- (A(X),B(Y))).
fc(A,C) :-
mkdyn(C),
asserta(C(X) :- \\+A(X)).
fzero([]).
'f×'([],fzero).
'f×'([X|L],C) :-
fcross(L,CC),
fcross(X,CC,C).
'f×'(X,X).
") ")
(define subset subset1) (define subset subset1)
......
...@@ -47,6 +47,7 @@ ...@@ -47,6 +47,7 @@
#:re-export (;;guile stuff #:re-export (;;guile stuff
;; profile ;; profile
mkdyn
lambda define lambda define
use-modules use-modules
new_persister new_persister
......
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