diff --git a/graph-lib/graph/__DEBUG_graph6.rkt b/graph-lib/graph/__DEBUG_graph6.rkt
index 431e3f9..0547c18 100644
--- a/graph-lib/graph/__DEBUG_graph6.rkt
+++ b/graph-lib/graph/__DEBUG_graph6.rkt
@@ -52,7 +52,7 @@
   : (Listof Street)
   (map Street snames)])
 
-(super-define-graph/rich-return
+#;(super-define-graph/rich-return
  grr3
  ([City [streets : (~> m-streets)]]
   [Street [sname : String]])
diff --git a/graph-lib/graph/graph-6-rich-returns.lp2.rkt b/graph-lib/graph/graph-6-rich-returns.lp2.rkt
index f5b7276..c9e2d47 100644
--- a/graph-lib/graph/graph-6-rich-returns.lp2.rkt
+++ b/graph-lib/graph/graph-6-rich-returns.lp2.rkt
@@ -55,6 +55,7 @@ mapping declarations from the node definitions:
 
 @chunk[<signature>
        (define-graph/rich-return name:id id-~>
+         (~optional (~and #:debug debug))
          ((~commit [node:id <field-signature> …])
           …)
          (~commit <mapping-declaration>)
@@ -98,15 +99,19 @@ for the temporary node type which encapsulates the result
 of @tc[m-streets], while the latter would normally expect a
 plain list.
 
-@chunk[<graph-rich-return>
+@CHUNK[<graph-rich-return>
        (define-syntax/parse <signature>
          (define-temp-ids "first-step" name)
          (define-temp-ids "first-step-expander2" name)
          (define-temp-ids "~a/simple-mapping" (node …))
          (define-temp-ids "~a/node" (mapping …))
+         (define-temp-ids "~a/extract/mapping" (node …))
+         (define-temp-ids "~a/extract" (node …) #:first-base root)
+         (define-temp-ids "~a/node-marker" (mapping …))
+         (define-temp-ids "~a/from-first-pass" (node …))
          ;(define/with-syntax id-~> (datum->syntax #'name '~>))
-         (template
-          ;(debug
+         <inline-temp-nodes>
+         (quasitemplate/debug debug
            (begin
              (define-graph first-step
                #:definitions [<first-pass-type-expander>]
@@ -119,7 +124,108 @@ plain list.
                  (mapping/node
                   (let ([node node/simple-mapping] …)
                     . body))]]
-               …))))]
+               …)
+             ;; TODO: how to return something else than a node??
+             ;; Possibility 1: add a #:main function to define-graph, which can
+             ;; call (make-root).
+             ;; Possibility 2: use the "(name node)" type outside as the return
+             ;; type of functions
+             (define-graph name
+               #:definitions [<second-pass-type-expander>]
+               [node [field c field-type] …
+                [(node/extract/mapping [from : (first-step node)])
+                 (node (<replace-in-instance> (get from field))
+                       …)
+                 …]]
+               …)
+             (begin
+               (: node/extract (→ (first-step node) root))
+               (define (node/extract from)
+                 (meta-eval
+                  (#,inline-temp-nodes/instance mapping/result-type
+                                                #,(immutable-free-id-set)))))
+             …
+             (root/extract (first-step ???)) ;; choice based on #:root argument
+             )))]
+
+@chunk[<replace-in-instance>
+       (tmpl-replace-in-instance
+        (Let ~> second-step-marker-expander field-type)
+        <second-pass-replace>)]
+
+@chunk[<second-pass-type-expander>
+       (define-type-expander (id-~> stx)
+         (syntax-parse stx
+           ;; TODO: should be ~literal
+           [(_ (~datum mapping)) #'result-type] …
+           ;; TODO: should fall-back to outer definition of ~>, if any?
+           ))
+       (define-type-expander (second-step-marker-expander stx)
+         (syntax-parse stx
+           ;; TODO: should be ~literal
+           [(_ (~datum mapping)) #'mapping/node-marker] …
+           ;; TODO: should fall-back to outer definition of ~>, if any?
+           ))]
+
+@chunk[<second-pass-replace>
+       [mapping/node-marker
+        <fully-replaced-mapping/result-type>
+        (graph #:? mapping/node)
+        (λ ([m : (first-graph mapping/node)])
+          (get m val))]
+       …]
+
+The result of recursively inlining the temporary mapping nodes may be a
+recursive type:
+
+@chunk[<example-recursive-inlining>
+       ;; TODO
+       (m-a : (Listof (~> m-b)) …)
+       (m-b : (Listof (~> m-a)) …)]
+
+Since we prefer to not deal with infinite recursive structures (they could be
+built using @tc[make-reader-graph], but this would not fit well with the rest of
+our framework), we do not allow type cycles unless they go through a
+user-defined node like @tc[a] or @tc[b] (by opposition to first-pass mapping
+nodes like @tc[ma/node] or @tc[mb/node]).
+
+The result type of inlining the temporary mapping nodes can be obtained by
+inlining the types in the same way:
+
+@CHUNK[<inline-temp-nodes>
+       (define (inline-temp-nodes/type t seen)
+         (quasitemplate
+          (tmpl-replace-in-type (Let ~> second-step-marker-expander t)
+            [mapping/node-marker
+             (meta-eval
+              (if (free-id-set-member? #,t #,seen)
+                  (raise-syntax-error "Cycle in types!")
+                  (#,inline-temp-nodes/type result-type
+                                            #,(free-id-set-add t seen))))]
+            …)))
+       
+       (define (inline-temp-nodes/instance t seen)
+         (quasitemplate
+          (tmpl-fold-instance (Let ~> second-step-marker-expander t)
+            [mapping/node-marker
+             (meta-eval
+              (#,inline-temp-nodes/type result-type
+                                        (free-id-set-add #,t #,seen)))
+             (first-pass #:? mapping/node)
+             (if (free-id-set-member? t seen)
+                 (raise-syntax-error "Cycle in types!")
+                 (inline-temp-nodes/instance result-type
+                                             (free-id-set-add t seen)))]
+            …
+            [node/from-first-pass
+             (name #:placeholder node) ; new type
+             (first-pass #:? node)
+             node] ;; call constructor
+            …)))]
+
+
+----------------------
+
 
 As explained above, during the first pass, the field types
 of nodes will allow placeholders for the temporary nodes
@@ -134,8 +240,8 @@ encapsulating the result types of mappings.
             (template
              (U (first-step #:placeholder mapping/node)
                 (tmpl-replace-in-type result-type
-                                      [node (first-step #:placeholder node)]
-                                      …)))]
+                  [node (first-step #:placeholder node)]
+                  …)))]
            …
            ;; TODO: should fall-back to outer definition of ~>, if any.
            ))
@@ -147,13 +253,13 @@ encapsulating the result types of mappings.
            ;; TODO: should fall-back to outer definition of ~>, if any.
            )
          #;(U (first-step #:placeholder m-streets4/node)
-            (Listof (first-step #:placeholder Street))))]
+              (Listof (first-step #:placeholder Street))))]
 
 @; TODO: replace-in-type doesn't work wfell here, we need to define a
 @; type-expander.
 @chunk[<first-pass-field-type>
        (tmpl-replace-in-type field-type
-                             [(~> mapping) (U mapping/node result-type)] …)]
+         [(~> mapping) (U mapping/node result-type)] …)]
 
 @section{Conclusion}
 
@@ -163,7 +269,8 @@ encapsulating the result types of mappings.
                               syntax/parse/experimental/template
                               racket/syntax
                               (submod "../lib/low.rkt" untyped)
-                              "rewrite-type.lp2.rkt" #|debug|#)
+                              "rewrite-type.lp2.rkt" #|debug|#
+                              syntax/id-set)
                   (rename-in "../lib/low.rkt" [~> threading:~>])
                   "graph.lp2.rkt"
                   "get.lp2.rkt"
@@ -177,126 +284,10 @@ encapsulating the result types of mappings.
                   racket/stxparam
                   racket/splicing)
          (provide define-graph/rich-return); ~>)
-
+         
          ;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
          
          (require (for-syntax racket/pretty))
-         (define-syntax (debug stx)
-           (syntax-case stx ()
-             [(_ body)
-              ;; syntax->string
-              (pretty-print (syntax->datum #'body))
-              #'body]))
-
-
-
-
-
-
-#;(begin
-   (define-graph
-    first-step
-    #:definitions
-    ((define-type-expander
-      (~> stx)
-      (syntax-parse
-       stx
-       ((_ (~datum m-cities))
-        (template
-         (U
-          (first-step #:placeholder m-cities3/node)
-          (Listof (first-step #:placeholder City)))))
-       ((_ (~datum m-streets))
-        (template
-         (U
-          (first-step #:placeholder m-streets4/node)
-          (Listof (first-step #:placeholder Street)))))))
-     (define-type-expander
-      (first-step-expander2 stx)
-      (syntax-parse
-       stx
-       ((_ (~literal m-cities))
-        (template
-         (U m-streets4/node (Listof Street))))
-       ((_ (~literal m-streets))
-        (template
-         (U m-streets4/node (Listof Street)))))))
-    (City
-     (streets : (Let [~> first-step-expander2] (~> m-streets))#;(~> m-streets))
-     ((City1/simple-mapping (streets : (~> m-streets))) (City streets)))
-    (Street
-     (sname : String)
-     ((Street2/simple-mapping (sname : String)) (Street sname)))
-    (m-cities3/node
-     (returned : (Listof City))
-     ((m-cities (cnames : (Listof (Listof String))))
-      (m-cities3/node
-       (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
-         (define (strings→city (s : (Listof String))) (City (m-streets s)))
-         (map strings→city cnames)))))
-    (m-streets4/node
-     (returned : (Listof Street))
-     ((m-streets (snames : (Listof String)))
-      (m-streets4/node
-       (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
-         (map Street snames)))))))
-
-
-
-         
-
-
-
-
-#;(begin
-   (define-graph
-    first-step
-    #:definitions
-    ((define-type-expander
-      (~> stx)
-      (syntax-parse
-       stx
-       ((_ (~datum m-cities))
-        (template
-         (U
-          (first-step #:placeholder m-cities3/node)
-          (Listof (first-step #:placeholder City)))))
-       ((_ (~datum m-streets))
-        (template
-         (U
-          (first-step #:placeholder m-streets4/node)
-          (Listof (first-step #:placeholder Street)))))))
-     (define-type-expander
-      (first-step-expander2 stx)
-      (syntax-parse
-       stx
-       ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City)))
-       ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))))
-    (City
-     (streets : (Let (~> first-step-expander2) (~> m-streets)))
-     ((City1/simple-mapping (streets : (~> m-streets))) (City streets)))
-    (Street
-     (sname : (Let (~> first-step-expander2) String))
-     ((Street2/simple-mapping (sname : String)) (Street sname)))
-    (m-cities3/node
-     (returned : (Listof City))
-     ((m-cities (cnames : (Listof (Listof String))))
-      (m-cities3/node
-       (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
-         (define (strings→city (s : (Listof String))) (City (m-streets s)))
-         (map strings→city cnames)))))
-    (m-streets4/node
-     (returned : (Listof Street))
-     ((m-streets (snames : (Listof String)))
-      (m-streets4/node
-       (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
-         (map Street snames)))))))
-         
-
-
-         
-         
-         
          
          <graph-rich-return>)]
 
diff --git a/graph-lib/graph/graph.lp2.rkt b/graph-lib/graph/graph.lp2.rkt
index 5a3fe73..6bfe926 100644
--- a/graph-lib/graph/graph.lp2.rkt
+++ b/graph-lib/graph/graph.lp2.rkt
@@ -202,6 +202,7 @@ We derive identifiers for these based on the @tc[node] name:
 
 @chunk[<define-ids/first-step>
        (define-temp-ids "~a/constructor" (node …) #:first-base root)
+       (define-temp-ids "~a?" (node …))
        
        (define-temp-ids "~a/make-placeholder" (node …))
        (define-temp-ids "~a/make-placeholder-type" (node …))
@@ -221,6 +222,7 @@ We derive identifiers for these based on the @tc[node] name:
 @chunk[<pass-to-second-step>
        (node/constructor …)
        root/constructor
+       (node? …)
        
        (node/make-placeholder …)
        (node/make-placeholder-type …)
@@ -294,6 +296,8 @@ The graph name will be used in several ways:
                     [(_ #:root (~datum node) . rest)
                      (syntax/loc stx (node/constructor . rest))]
                     …
+                    [(_ #:? (~datum node))
+                     (syntax/loc stx node?)]
                     [(_ . rest)
                      (syntax/loc stx (root/constructor . rest))]))
          #:id (λ (stx) #'root/constructor))]
diff --git a/graph-lib/graph/rewrite-type.lp2.rkt b/graph-lib/graph/rewrite-type.lp2.rkt
index 32e7c1f..cadbf7c 100644
--- a/graph-lib/graph/rewrite-type.lp2.rkt
+++ b/graph-lib/graph/rewrite-type.lp2.rkt
@@ -39,9 +39,9 @@ relies on the lower-level utilities provided by this module, namely
             #`(begin
                 (: name (→ type #,(replace-in-type #'type #'([from to] ...))))
                 (define (name v)
-                  #,(replace-in-instance #'v
-                                         #'type
-                                         #'([from to pred? fun] ...))))]))]
+                  (#,(replace-in-instance #'type
+                                          #'([from to pred? fun] ...))
+                   v)))]))]
 
 @subsection{A bigger example}
 
@@ -88,8 +88,8 @@ calls itself on the components of the type.
          (define (recursive-replace new-t) (replace-in-type new-t r))
          (define/with-syntax ([from to] ...) r)
          #;(displayln (format "~a\n=> ~a"
-                            (syntax->datum t)
-                            (syntax->datum (expand-type t))))
+                              (syntax->datum t)
+                              (syntax->datum (expand-type t))))
          (syntax-parse (expand-type t)
            #:context #'(replace-in-type t r)
            <replace-in-type-substitute>
@@ -144,10 +144,12 @@ offloaded to a separate subroutine.
 
 @CHUNK[<replace-in-instance>
        (define-for-syntax (replace-in-instance val t r)
-         (define/with-syntax ([from to fun] ...) r)
-         <recursive-replace-in-instance>
-         <replace-in-union>
-         (recursive-replace val t))]
+         (parameterize-push-stx ([current-replacement
+                              `(replace-in-instance ,val ,t ,r)])
+           (define/with-syntax ([from to fun] ...) r)
+           <recursive-replace-in-instance>
+           <replace-in-union>
+           (recursive-replace val t)))]
 
 The @tc[recursive-replace] internal function defined below takes a type
 @tc[type] and produces an expression that transforms instances of that type
@@ -170,54 +172,57 @@ The other cases are similarly defined:
 
 @CHUNK[<recursive-replace-in-instance>
        (define (recursive-replace stx-val type)
-         (define/with-syntax val stx-val)
-         (define/with-syntax (v-cache) (generate-temporaries #'(val-cache)))
-         (syntax-parse type
-           #:context 'recursive-replace-2
-           [x:id
-            #:attr assoc-from-to (cdr-stx-assoc #'x #'((from . (to . fun)) ...))
-            #:when (attribute assoc-from-to)
-            #:with (to-type . to-fun) #'assoc-from-to
-            (define/with-syntax (tmp) (generate-temporaries #'(x)))
-            ;; TODO: Add predicate for to-type in the pattern.
-            #`(to-fun val)]
-           [((~literal List) a ...)
-            (define/with-syntax (tmp ...) (generate-temporaries #'(a ...)))
-            #`(let-values ([(tmp ...) (apply values val)])
-                (list #,@(stx-map recursive-replace #'(tmp ...) #'(a ...))))]
-           <replace-in-instance-case-pairof>
-           [((~literal Listof) a)
-            (define/with-syntax (tmp) (generate-temporaries #'(a)))
-            #`(map (λ ([tmp : a]) #,(recursive-replace #'tmp #'a))
-                   val)]
-           [((~literal Vector) a ...)
-            (define/with-syntax (tmp ...) (generate-temporaries #'(a ...)))
-            (define/with-syntax (idx ...) (generate-indices #'(a ...)))
-            #`(let ([v-cache val])
-                (let ([tmp (vector-ref v-cache idx)]
-                      ...)
-                  (vector-immutable #,@(stx-map recursive-replace
-                                                #'(tmp ...)
-                                                #'(a ...)))))]
-           [((~literal Vectorof) a)
-            (define/with-syntax (tmp) (generate-temporaries #'(a)))
-            ;; Inst because otherwise it won't widen the inferred mutable vector
-            ;; elements' type.
-            #`((inst vector->immutable-vector
-                     #,(replace-in-type #'a #'([from to] ...)))
-               (list->vector
-                (map (λ ([tmp : a]) #,(recursive-replace #'tmp #'a))
-                     (vector->list val))))]
-           [((~literal U) a ...)
-            #`(let ([v-cache val])
-                (cond
-                  #,@(stx-map (λ (ta)
-                                (replace-in-union #'v-cache ta r))
-                              #'(a ...))))]
-           [((~literal quote) a)
-            #'val]
-           [x:id
-            #'val]))]
+         (parameterize-push-stx ([current-replacement
+                              `(recursive-replace ,stx-val ,type)])
+           (define/with-syntax val stx-val)
+           (define/with-syntax (v-cache) (generate-temporaries #'(val-cache)))
+           (syntax-parse type
+             #:context `(recursive-replace-2 ,(current-replacement))
+             [x:id
+              #:attr assoc-from-to (cdr-stx-assoc #'x
+                                                  #'((from . (to . fun)) ...))
+              #:when (attribute assoc-from-to)
+              #:with (to-type . to-fun) #'assoc-from-to
+              (define/with-syntax (tmp) (generate-temporaries #'(x)))
+              ;; TODO: Add predicate for to-type in the pattern.
+              #`(to-fun val)]
+             [((~literal List) a ...)
+              (define/with-syntax (tmp ...) (generate-temporaries #'(a ...)))
+              #`(let-values ([(tmp ...) (apply values val)])
+                  (list #,@(stx-map recursive-replace #'(tmp ...) #'(a ...))))]
+             <replace-in-instance-case-pairof>
+             [((~literal Listof) a)
+              (define/with-syntax (tmp) (generate-temporaries #'(a)))
+              #`(map (λ ([tmp : a]) #,(recursive-replace #'tmp #'a))
+                     val)]
+             [((~literal Vector) a ...)
+              (define/with-syntax (tmp ...) (generate-temporaries #'(a ...)))
+              (define/with-syntax (idx ...) (generate-indices #'(a ...)))
+              #`(let ([v-cache val])
+                  (let ([tmp (vector-ref v-cache idx)]
+                        ...)
+                    (vector-immutable #,@(stx-map recursive-replace
+                                                  #'(tmp ...)
+                                                  #'(a ...)))))]
+             [((~literal Vectorof) a)
+              (define/with-syntax (tmp) (generate-temporaries #'(a)))
+              ;; Inst because otherwise it won't widen the inferred mutable
+              ;; vector elements' type.
+              #`((inst vector->immutable-vector
+                       #,(replace-in-type #'a #'([from to] ...)))
+                 (list->vector
+                  (map (λ ([tmp : a]) #,(recursive-replace #'tmp #'a))
+                       (vector->list val))))]
+             [((~literal U) a ...)
+              #`(let ([v-cache val])
+                  (cond
+                    #,@(stx-map (λ (ta)
+                                  (replace-in-union #'v-cache ta r))
+                                #'(a ...))))]
+             [((~literal quote) a)
+              #'val]
+             [x:id
+              #'val])))]
 
 For unions, we currently support only tagged unions, that is unions where each
 possible type is a @tc[List] with a distinct @tc[tag] in its first element.
@@ -227,7 +232,7 @@ TODO: we currently don't check that each @tc[tag] is distinct.
        (define (replace-in-union stx-v-cache t r)
          (define/with-syntax v-cache stx-v-cache)
          (syntax-parse t
-           #:context 'replace-in-union-3
+           #:context `(replace-in-union-3 ,(current-replacement))
            [((~literal List) ((~literal quote) tag:id) b ...)
             <replace-in-tagged-union-instance>]
            [_ (raise-syntax-error
@@ -395,17 +400,19 @@ functions is undefined.
 
 @CHUNK[<fold-instance>
        (define-for-syntax (fold-instance whole-type stx-acc-type r)
-         (define/with-syntax acc-type stx-acc-type)
-         (define/with-syntax ([from to pred? fun] ...) r)
-         <recursive-replace-fold-instance>
-         (recursive-replace whole-type))]
+         (parameterize-push-stx ([current-replacement
+                              `(fold-instance ,whole-type ,stx-acc-type ,r)])
+           (define/with-syntax acc-type stx-acc-type)
+           (define/with-syntax ([from to pred? fun] ...) r)
+           <recursive-replace-fold-instance>
+           (recursive-replace whole-type)))]
 
 @CHUNK[<recursive-replace-fold-instance>
        (define (new-type-for stx) (replace-in-type stx #'([from to] ...)))
        (define (recursive-replace type)
          (define/with-syntax (v-cache) (generate-temporaries #'(val-cache)))
-         (syntax-parse type
-           #:context 'recursive-replace-4
+         (syntax-parse (expand-type type)
+           #:context `(recursive-replace-4 ,(current-replacement))
            [x:id
             #:attr assoc-from-to-fun (stx-assoc #'x #'((from to fun) ...))
             #:when (attribute assoc-from-to-fun)
@@ -518,7 +525,7 @@ functions is undefined.
 
 @CHUNK[<replace-fold-union>
        (syntax-parse ta
-         #:context 'replace-fold-union-5
+         #:context `(replace-fold-union-5 ,(current-replacement))
          [((~literal List) ((~literal quote) tag:id) b ...)
           <replace-fold-union-tagged-list>]
          [((~literal Pairof) ((~literal quote) tag:id) b)
@@ -530,8 +537,8 @@ functions is undefined.
           <replace-fold-union-predicate>]
          [_
           #:when last?
-          #`[#t ;; Hope type occurrence will manage here.
-             (#,(recursive-replace ta) val acc)]]
+          ;; Hope type occurrence will manage here.
+          #`[#t (#,(recursive-replace ta) val acc)]]
          [s:id
           #:when (begin (printf "~a ~a\n" (meta-struct? #'s) #'s)
                         (meta-struct? #'s))
@@ -569,16 +576,17 @@ better consistency between the behaviour of @tc[replace-in-instance] and
 efficient than the separate implementation.
 
 @CHUNK[<replace-in-instance2>
-       (define-for-syntax (replace-in-instance2 val t r)
+       (define-for-syntax (replace-in-instance2 t r)
          (define/with-syntax ([from to pred? fun] ...) r)
-         #`(first-value
-            (#,(fold-instance t
-                              #'Void
-                              #'([from to pred? (λ ([x : from] [acc : Void])
-                                                  (values (fun x) acc))]
-                                 ...))
-             #,val
-             (void))))]
+         #`(λ ([val : #,t])
+             (first-value
+              (#,(fold-instance t
+                                #'Void
+                                #'([from to pred? (λ ([x : from] [acc : Void])
+                                                    (values (fun x) acc))]
+                                   ...))
+               val
+               (void)))))]
 
 @section{Conclusion}
 
@@ -590,41 +598,45 @@ one for @tc[replace-in-type]:
 
 @CHUNK[<template-metafunctions>
        (define-template-metafunction (tmpl-replace-in-type stx)
-         (syntax-parse stx
-           #:context 'tmple-replace-in-type-6
-           [(_ (~optional (~and debug? #:debug)) type:expr [from to] …)
-            (when (attribute debug?)
-              (displayln (format "~a" stx)))
-            (let ([res #`#,(replace-in-type #'type
-                                            #'([from to] …))])
+         (parameterize-push-stx ([current-replacement stx])
+           (syntax-parse stx
+             #:context `(tmpl-replace-in-type-6 ,(current-replacement))
+             [(_ (~optional (~and debug? #:debug)) type:expr [from to] …)
               (when (attribute debug?)
-                (displayln (format "=> ~a" res)))
-              res)]))]
+                (displayln (format "~a" stx)))
+              (let ([res #`#,(replace-in-type #'type
+                                              #'([from to] …))])
+                (when (attribute debug?)
+                  (displayln (format "=> ~a" res)))
+                res)])))]
 
 And one each for @tc[fold-instance] and @tc[replace-in-instance2]:
 
 @CHUNK[<template-metafunctions>
        (define-template-metafunction (tmpl-fold-instance stx)
-         (syntax-parse stx
-           #:context 'tmpl-fold-instance-7
-           [(_ type:expr acc-type:expr [from to pred? fun] …)
-            #`(begin
-                "fold-instance expanded code below. Initially called with:"
-                '(fold-instance type acc-type [from to pred? λ…] …)
-                #,(fold-instance #'type
-                                 #'acc-type
-                                 #'([from to pred? fun] …)))]))
+         (parameterize-push-stx ([current-replacement stx])
+           (syntax-parse stx
+             #:context `(tmpl-fold-instance-7 ,(current-replacement))
+             [(_ type:expr acc-type:expr [from to pred? fun] …)
+              #`(begin
+                  "fold-instance expanded code below. Initially called with:"
+                  '(fold-instance type acc-type [from to pred? λ…] …)
+                  #,(fold-instance #'type
+                                   #'acc-type
+                                   #'([from to pred? fun] …)))])))
        
        (define-template-metafunction (tmpl-replace-in-instance stx)
-         (syntax-parse stx
-           #:context 'tmpl-replace-in-instance-8
-           [(_ type:expr [from to fun] …)
-            #`#,(replace-in-instance2 #'type #'([from to fun] …))]))]
+         (parameterize-push-stx ([current-replacement stx])
+           (syntax-parse stx
+             #:context `(tmpl-replace-in-instance-8 ,(current-replacement))
+             [(_ type:expr [from to pred? fun] …)
+              #`#,(replace-in-instance2 #'type #'([from to pred? fun] …))]
+             [_ (error (format "~a" `(tmpl-replace-in-instance-8 ,(continuation-mark-set->context (current-continuation-marks)) ,(syntax->datum (current-replacement)))))])))]
 
 These metafunctions just extract the arguments for @tc[replace-in-type] and
 @tc[replace-in-instance2], and pass them to these functions.
 
-@chunk[<*>
+@CHUNK[<*>
        (begin
          (module main typed/racket
            (require
@@ -651,6 +663,15 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and
                                       tmpl-fold-instance
                                       tmpl-replace-in-instance))
            
+           (begin-for-syntax
+             (define current-replacement (make-parameter #'()))
+             ;; TODO: move to lib
+             (require (for-syntax racket/base))
+             (define-syntax-rule (parameterize-push ([p val] ...) . body)
+               (parameterize ([p (cons val (p))] ...) . body))
+             (define-syntax-rule (parameterize-push-stx ([p val] ...) . body)
+               (parameterize ([p #`(#,val . #,(p))] ...) . body)))
+           
            <replace-in-type>
            <replace-in-instance>
            <replace-in-instance2>