diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 2cdf49e2..65ca89b7 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -10,7 +10,8 @@ racket/match (only-in racket/list make-list) "syntax.rkt" - "../aux-syntax.rkt") + "../aux-syntax.rkt" + macro-debugger/emit) "impl.rkt" (only-in racket/list make-list) racket/function @@ -169,11 +170,18 @@ #'(thread _0 ... fused _1 ...)] [_ this-syntax])) + ;; Applies f repeatedly to the init-val terminating the loop if the + ;; result of f is #f or the new syntax object is eq? to the previous + ;; (possibly initial) one. + ;; + ;; Caveats: + ;; * the syntax object is not inspected, only eq? is used + ;; * comparison is performed only between consecutive steps (does not handle cyclic occurences) (define ((fix f) init-val) - ;; may need to be modified to handle #f as a special terminator (let ([new-val (f init-val)]) - (if (eq? new-val init-val) - new-val + (if (or (not new-val) + (eq? new-val init-val)) + init-val ((fix f) new-val)))) (define (deforest-pass stx) @@ -270,8 +278,12 @@ ;; TODO: use syntax-parse and match ~> specifically. ;; Since macros are expanded "outside in," presumably ;; it will naturally wrap the outermost ~> - (wrap-with-scopes #`(qi0->racket #,(rewrite-all-bindings stx)) - (bound-identifiers stx)))) + (let ([stx1 (wrap-with-scopes #`(qi0->racket #,(rewrite-all-bindings stx)) + (bound-identifiers stx))]) + (emit-local-step stx stx1 #:id #'process-bindings) + stx1)) + + ) (define-syntax (qi0->racket stx) ;; this is a macro so it receives the entire expression