我模拟了一个来自On Lisp的状态编程解决方案,以解决树变平:
#lang racket
(define (flat-tree-generator tr)
(define initial? #t)
(define state '())
(define (resume)
(if (null? state)
'()
(let ((cont (car state)))
(set! state (cdr state))
(cont))))
(define (recur tr)
(cond
((null? tr) (resume))
((not (pair? tr)) tr)
(else (call/cc
(lambda (k)
(set! state
(cons
(lambda () (k (recur (cdr tr))))
state))
(recur (car tr)))))))
(define (dispatch)
(if initial?
(begin (set! initial? #f) (recur tr))
(resume)))
dispatch)
(define g1 (flat-tree-generator '((0 (1 2)) (3 4))))
(define g2 (flat-tree-generator '(0 1 2 3 4)))
好的,现在如果你尝试:
(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2)
它将按预期工作(输出行0011223344)。但是,如果您尝试这样做:
(for ([e1 (in-producer g1 '())]
[e2 (in-producer g2 '())])
(printf "e1: ~a e2: ~a\n" e1 e2))
你会得到:
e1: 0 e2: 0
e1: 0 e2: 1
e1: 0 e2: 2
e1: 0 e2: 3
e1: 0 e2: 4
或者你试试:
(define (test)
(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2)(g1)(g2))
(test)
你会得到:
'()
我真的很困惑..为什么?
答案 0 :(得分:4)
当您在REPL中执行call-with-current-continuation
时,每个语句之间都有警卫,而在test
中,您将在执行第二个(g2)
之后结束,除非tr
为空。例如。它将在循环中执行第二个(g2)
和(g1)
,因为您在刚刚执行的代码之前结束,直到您点击(not (pair? tr))
然后您执行g2
和{{1用emty列表3次。
你根本不需要打电话/抄本来做这件事。关闭时已经足够了:
g1
或者您真的可以使用球拍生成器功能。此代码的工作方式相同:
(define (flat-tree-generator tr)
(define initial? #t)
(define state '())
(define (resume)
(if (null? state)
'()
(let ((cont (car state)))
(set! state (cdr state))
(cont))))
(define (recur tr)
(cond
((null? tr) (resume))
((not (pair? tr)) tr)
(else (set! state
(cons
(lambda () (recur (cdr tr)))
state))
(recur (car tr)))))
(define (dispatch)
(if initial?
(begin (set! initial? #f) (recur tr))
(resume)))
dispatch)
两者都得到预期的行为:
(require racket/generator)
(define (flat-tree-generator tr)
(generator ()
(let rec ((tr tr))
(cond ((null? tr) tr)
((pair? (car tr)) (rec (car tr))
(rec (cdr tr)))
(else (yield (car tr))
(rec (cdr tr)))))))
答案 1 :(得分:1)
为了通过continuation解决这个问题,我发现在生产者和调度程序中使用continuation是有帮助的;这样你就可以在两者之间翻转。但它有点令人费解,基于非cc的解决方案肯定更容易理解。
下面是一个示例实现。我建议逐步使用Racket调试器来完全理解执行流程。
(define (flat-tree lst)
; main procedure
(define (go lst k-dp)
(cond
((null? lst) k-dp)
((pair? lst) (go (cdr lst) (go (car lst) k-dp)))
(else (let/cc k-go (k-dp (cons lst k-go))))))
; saved continuation
(define k-go #f)
; dispatcher
(thunk
(define ret (let/cc k-dp (if k-go (k-go k-dp) (go lst k-dp))))
(if (pair? ret)
(begin
(set! k-go (cdr ret))
(car ret))
null)))
测试:
(define g1 (flat-tree '((a (b c)) (d e (f (g (h)))))))
(define g2 (flat-tree '(0 1 2 3 4 (5 (6 . 7)))))
(for ([e1 (in-producer g1 null)] [e2 (in-producer g2 null)])
(printf "e1: ~a e2: ~a\n" e1 e2))
产量
e1: a e2: 0
e1: b e2: 1
e1: c e2: 2
e1: d e2: 3
e1: e e2: 4
e1: f e2: 5
e1: g e2: 6
e1: h e2: 7
答案 2 :(得分:0)
仅供参考。在我的解决方案中,当我将整个dispatch
正文包装在一个续集中并将其保存在yield
中,并在recur
中强制其返回值转到dispatch
&# 39; s继续即yield
,每件事情都很好:
(define (flat-tree-generator tr)
(define initial? #t)
(define state '())
(define yield #f) ; here is change 1
(define (resume)
(if (null? state)
'()
(let ((cont (car state)))
(set! state (cdr state))
(cont))))
(define (recur tr)
(cond
((null? tr) (resume))
((not (pair? tr)) tr)
(else (call/cc
(lambda (k)
(set! state
(cons
(lambda () (k (recur (cdr tr))))
state))
(yield (recur (car tr)))))))) ;here is the change 2
(define (dispatch)
(call/cc (lambda (cc) ;here is the change 3
(set! yield cc)
(if initial?
(begin (set! initial? #f) (recur tr))
(resume)))))
dispatch)
这是灵感来自于Fixnum Days中的 Teach Yourself Scheme 的更优雅的解决方案,(我也推荐这本书给计划初学者,它易于理解和示例很好):
(define tree->generator
(lambda (tree)
(let ((caller '*))
(letrec
((generate-leaves
(lambda ()
(let loop ((tree tree))
(cond ((null? tree) 'skip)
((pair? tree)
(loop (car tree))
(loop (cdr tree)))
(else
(call/cc
(lambda (rest-of-tree)
(set! generate-leaves
(lambda ()
(rest-of-tree 'resume)))
(caller tree))))))
(caller '()))))
(lambda ()
(call/cc
(lambda (k)
(set! caller k)
(generate-leaves))))))))
最后,这是我在这个问题上的经验:如果程序A(例如dispatch
)将进入前一个续集(通过调用resume
)来获取某些数据,那么你就是这样了更好地确保你可以将这些数据带回到A的继续。