improving iinterleave

parent b75cfc1c
......@@ -8,6 +8,7 @@
#:use-module (logic guile-log guile-prolog fluid)
#:use-module (logic guile-log guile-prolog attribute)
#:use-module (logic guile-log vlist)
#:use-module (logic guile-log iinterleave)
#:use-module (ice-9 match)
#:use-module (ice-9 readline)
#:use-module (ice-9 rdelim)
......@@ -388,6 +389,7 @@ conversation1(X,All) :-
scm[-n-], scm[-nsol-], scm[-all-], scm[-mute?-],
scm[*user-data*],scm[*globals-map*]),
wrap_frame,
'new-machine',
conversation2(X,All).
tree :- when[(fluid-ref -rec?-)]
......
......@@ -99,10 +99,13 @@
(<lambda> ()
(<let*>
((pack (lambda (stop-depth)
(define stop?
(if (and (pair? head) (vector? (car head)))
#f
0))
(define not-stop?
(if (pair? head)
(vector? (car head))
(if (pair? tail)
(vector? (car (reverse tail)))
#f)))
(let lp ((h head) (t tail) (p path) (v pot) (d depth))
(if (or (null? p) (<= d stop-depth))
(begin
......@@ -116,15 +119,7 @@
(hnew (vector-ref x 0))
(tnew (vector-ref x 1)))
(if (or (pair? h) (pair? t))
(if stop?
(if (= stop? 0)
(let ((l (vector h t v)))
(set! stop? 1)
(lp (cdr hnew)
(cons* l tnew) (cdr p)
(sum v hnew tnew)
(- d 1)))
'fast-track)
(if not-stop?
(let ((l (vector h t v)))
(lp (cdr hnew)
(cons* l tnew) (cdr p)
......
......@@ -735,12 +735,13 @@ floor(x) (floor x)
(<if> (<once-ii> (goal-eval if)) (goal-eval then) (goal-eval y))
(<or-ii> (goal-eval x) (goal-eval y)))))
(set-object-property! #{;}# 'goal-compile-stub
(set-object-property! #{;;}# 'goal-compile-stub
(lambda (a b)
`((@ (logic guile-log) <or>) ,a ,b)))
(set-object-property! #{;}# 'goal-compile-types
'(g g))
`((@ (logic guile-log iinterleave) <or-ii>) ,a ,b)))
(set-object-property! #{;;}# 'goal-compile-types
'(g g))
(define-goal-transformer #{;;}# (tr-disjunction-ii stx n m x y)
(match x
((('xfy _ "-i>" _) i t n m)
......
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