macro debugger:
underline definite binders add rename/shift mapping so module final term retains binding info svn: r12843
This commit is contained in:
parent
340b193571
commit
6fdba44edc
|
@ -2,12 +2,14 @@
|
|||
#lang scheme/base
|
||||
(require scheme/match
|
||||
scheme/list
|
||||
syntax/stx
|
||||
"deriv-c.ss"
|
||||
"deriv-util.ss")
|
||||
(provide find-derivs
|
||||
find-deriv
|
||||
find-derivs/syntax
|
||||
extract-all-fresh-names
|
||||
compute-shift-table
|
||||
flatten-identifiers)
|
||||
|
||||
;; Utilities for finding subderivations
|
||||
|
@ -126,8 +128,12 @@
|
|||
(lambda _ #f)
|
||||
d))
|
||||
|
||||
;; extract-all-fresh-names : Derivation -> syntaxlike
|
||||
;; extract-all-fresh-names : Derivation -> (listof identifier)
|
||||
(define (extract-all-fresh-names d)
|
||||
(define ht (make-hasheq))
|
||||
(define (add stxish)
|
||||
(for-each (lambda (id) (hash-set! ht id #t))
|
||||
(flatten-identifiers stxish)))
|
||||
(define (renaming-node? x)
|
||||
(or (p:lambda? x)
|
||||
;;(p:case-lambda? x)
|
||||
|
@ -142,69 +148,83 @@
|
|||
(define (extract-fresh-names d)
|
||||
(match d
|
||||
[(Wrap p:lambda (e1 e2 rs ?1 renames body))
|
||||
(if renames
|
||||
(with-syntax ([(?formals . ?body) renames])
|
||||
#'?formals)
|
||||
null)]
|
||||
(when renames
|
||||
(with-syntax ([(?formals . ?body) renames])
|
||||
(add #'?formals)))]
|
||||
[(Wrap clc (_ renames _))
|
||||
(if renames
|
||||
(with-syntax ([(?formals . ?body) renames])
|
||||
#'?formals)
|
||||
null)]
|
||||
(when renames
|
||||
(with-syntax ([(?formals . ?body) renames])
|
||||
(add #'?formals)))]
|
||||
[(Wrap p:let-values (e1 e2 rs ?1 renames rhss body))
|
||||
(if renames
|
||||
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
|
||||
#'(?vars ...))
|
||||
null)]
|
||||
(when renames
|
||||
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
|
||||
(add #'(?vars ...))))]
|
||||
[(Wrap p:letrec-values (e1 e2 rs ?1 renames rhss body))
|
||||
(if renames
|
||||
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
|
||||
#'(?vars ...))
|
||||
null)]
|
||||
[(Wrap p:letrec-syntaxes+values (e1 e2 rs ?1 srenames srhss vrenames vrhss body _))
|
||||
(cons
|
||||
(if srenames
|
||||
(with-syntax ([(((?svars ?srhs) ...) ((?vvars ?vrhs) ...) . ?body)
|
||||
srenames])
|
||||
#'(?svars ... ?vvars ...))
|
||||
null)
|
||||
(if vrenames
|
||||
(with-syntax ([(((?vvars ?vrhs) ...) . ?body) vrenames])
|
||||
#'(?vvars ...))
|
||||
null))]
|
||||
(when renames
|
||||
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
|
||||
(add #'(?vars ...))))]
|
||||
[(Wrap p:letrec-syntaxes+values (e1 e2 rs ?1 srenames srhss vrenames _ _ _))
|
||||
(when srenames
|
||||
(with-syntax ([(((?svars ?srhs) ...) ((?vvars ?vrhs) ...) . ?body)
|
||||
srenames])
|
||||
(add #'(?svars ... ?vvars ...))))
|
||||
(when vrenames
|
||||
(with-syntax ([(((?vvars ?vrhs) ...) . ?body) vrenames])
|
||||
(add #'(?vvars ...))))]
|
||||
[(Wrap b:defvals (rename head ?1 rename2 ?2))
|
||||
(let ([head-e2 (wderiv-e2 head)])
|
||||
(if head-e2
|
||||
(with-syntax ([(?dv ?vars ?rhs) head-e2])
|
||||
#'?vars)
|
||||
null))]
|
||||
(when head-e2
|
||||
(with-syntax ([(?dv ?vars ?rhs) head-e2])
|
||||
(add #'?vars))))]
|
||||
[(Wrap b:defstx (rename head ?1 rename2 ?2 rhs))
|
||||
(let ([head-e2 (wderiv-e2 head)])
|
||||
(if head-e2
|
||||
(with-syntax ([(?ds ?svars ?rhs) head-e2])
|
||||
#'?svars)
|
||||
null))]
|
||||
(when head-e2
|
||||
(with-syntax ([(?ds ?svars ?rhs) head-e2])
|
||||
(add #'?svars))))]
|
||||
[(Wrap p:define-values (e1 e2 rs ?1 rhs))
|
||||
(if rhs
|
||||
(with-syntax ([(?dv ?vars ?rhs) e1])
|
||||
#'?vars)
|
||||
null)]
|
||||
(when rhs
|
||||
(with-syntax ([(?dv ?vars ?rhs) e1])
|
||||
(add #'?vars)))]
|
||||
[(Wrap p:define-syntaxes (e1 e2 rs ?1 rhs _))
|
||||
(if rhs
|
||||
(with-syntax ([(?ds ?svars ?srhs) e1])
|
||||
#'?svars)
|
||||
null)]
|
||||
[_ null]))
|
||||
(when rhs
|
||||
(with-syntax ([(?ds ?svars ?srhs) e1])
|
||||
(add #'?svars)))]
|
||||
[_ (void)]))
|
||||
(define renaming-forms
|
||||
(find-deriv/unit+join+zero renaming-node?
|
||||
(lambda (d) #f)
|
||||
d
|
||||
list
|
||||
append
|
||||
null))
|
||||
(for ([rf renaming-forms])
|
||||
(extract-fresh-names rf))
|
||||
(hash-map ht (lambda (k v) k)))
|
||||
|
||||
(let ([all-renaming-forms
|
||||
(find-deriv/unit+join+zero
|
||||
renaming-node?
|
||||
(lambda (d) #f)
|
||||
d
|
||||
list
|
||||
append
|
||||
null)])
|
||||
(flatten-identifiers (map extract-fresh-names all-renaming-forms))))
|
||||
;; compute-shift-table : deriv -> hash[id => (listof id)]
|
||||
(define (compute-shift-table d)
|
||||
(define ht (make-hasheq))
|
||||
(define module-forms
|
||||
(find-derivs p:module? (lambda _ #f) d))
|
||||
(define module-shift-renamers
|
||||
(for/list ([mf module-forms])
|
||||
(let ([shift (p:module-shift mf)]
|
||||
[body (p:module-body mf)])
|
||||
(and shift body
|
||||
(with-syntax ([(_module _name _lang shifted-body) shift])
|
||||
(add-rename-mapping ht (wderiv-e2 body) #'shifted-body))))))
|
||||
ht)
|
||||
|
||||
(define (add-rename-mapping ht from to)
|
||||
(define (loop from to)
|
||||
(cond [(and (stx-pair? from) (stx-pair? to))
|
||||
(loop (stx-car from) (stx-car to))
|
||||
(loop (stx-cdr from) (stx-cdr to))]
|
||||
[(and (identifier? from) (identifier? to))
|
||||
(hash-set! ht from (cons to (hash-ref ht from null)))]
|
||||
[else (void)]))
|
||||
(loop from to)
|
||||
(void))
|
||||
|
||||
;; flatten-identifiers : syntaxlike -> (list-of identifier)
|
||||
(define (flatten-identifiers stx)
|
||||
|
|
|
@ -75,22 +75,32 @@
|
|||
|
||||
;; get-range : -> range<%>
|
||||
(define/public (get-range) range)
|
||||
|
||||
|
||||
;; highlight-syntaxes : (list-of syntax) string -> void
|
||||
(define/public (highlight-syntaxes stxs hi-color)
|
||||
(let ([style-delta (highlight-style-delta hi-color #f)])
|
||||
(for-each (lambda (stx) (hash-set! extra-styles stx style-delta))
|
||||
stxs))
|
||||
(for ([stx stxs])
|
||||
(add-extra-styles stx (list style-delta))))
|
||||
(refresh))
|
||||
|
||||
;; underline-syntaxes : (listof syntax) -> void
|
||||
(define/public (underline-syntaxes stxs)
|
||||
(for ([stx stxs])
|
||||
(add-extra-styles stx (list underline-style-delta)))
|
||||
(refresh))
|
||||
|
||||
(define/public (add-extra-styles stx styles)
|
||||
(hash-set! extra-styles stx
|
||||
(append (hash-ref extra-styles stx null)
|
||||
styles)))
|
||||
|
||||
;; apply-extra-styles : -> void
|
||||
;; Applies externally-added styles (such as highlighting)
|
||||
(define/private (apply-extra-styles)
|
||||
(hash-for-each
|
||||
extra-styles
|
||||
(lambda (hi-stx style-delta)
|
||||
(let ([rs (send range get-ranges hi-stx)])
|
||||
(for-each (lambda (r) (restyle-range r style-delta)) rs)))))
|
||||
(for ([(stx style-deltas) extra-styles])
|
||||
(for ([r (send range get-ranges stx)])
|
||||
(for ([style-delta style-deltas])
|
||||
(restyle-range r style-delta)))))
|
||||
|
||||
;; apply-secondary-partition-styles : selected-syntax -> void
|
||||
;; If the selected syntax is an identifier, then styles all identifiers
|
||||
|
@ -243,6 +253,11 @@
|
|||
(send sd set-weight-off 'bold))
|
||||
sd))
|
||||
|
||||
(define underline-style-delta
|
||||
(let ([sd (new style-delta%)])
|
||||
(send sd set-underlined-on #t)
|
||||
sd))
|
||||
|
||||
(define selection-color "yellow")
|
||||
(define subselection-color "yellow")
|
||||
|
||||
|
|
|
@ -105,62 +105,73 @@
|
|||
(send -text change-style clickback-style a b)))))
|
||||
|
||||
(define/public (add-syntax stx
|
||||
#:alpha-table alpha-table
|
||||
#:binder-table [alpha-table #f]
|
||||
#:shift-table [shift-table #f]
|
||||
#:definites [definites null]
|
||||
#:hi-colors [hi-colors null]
|
||||
#:hi-stxss [hi-stxss null])
|
||||
(define (get-binder id)
|
||||
(module-identifier-mapping-get alpha-table id (lambda () #f)))
|
||||
(define (get-binders id)
|
||||
(define binder
|
||||
(module-identifier-mapping-get alpha-table id (lambda () #f)))
|
||||
(if shift-table
|
||||
(cons binder (hash-ref shift-table binder null))
|
||||
(list binder)))
|
||||
(let ([display (internal-add-syntax stx)]
|
||||
[definite-table (make-hasheq)])
|
||||
(for-each (lambda (hi-stxs hi-color)
|
||||
(send display highlight-syntaxes hi-stxs hi-color))
|
||||
hi-stxss
|
||||
hi-colors)
|
||||
(for-each (lambda (x) (hash-set! definite-table x #t)) definites)
|
||||
(for ([definite definites])
|
||||
(hash-set! definite-table definite #t)
|
||||
(when shift-table
|
||||
(for ([shifted-definite (hash-ref shift-table definite null)])
|
||||
(hash-set! definite-table shifted-definite #t))))
|
||||
(when alpha-table
|
||||
(let ([range (send display get-range)]
|
||||
[start (send display get-start-position)])
|
||||
(define (adjust n) (+ start n))
|
||||
(for-each
|
||||
(lambda (id)
|
||||
(when #f ;; DISABLED
|
||||
(match (identifier-binding id)
|
||||
[(list src-mod src-name nom-mod nom-name _)
|
||||
(for-each (lambda (id-r)
|
||||
(send -text add-billboard
|
||||
(adjust (car id-r))
|
||||
(adjust (cdr id-r))
|
||||
(string-append "from "
|
||||
(mpi->string src-mod))
|
||||
(if (hash-ref definite-table id #f)
|
||||
"blue"
|
||||
"purple")))
|
||||
(send range get-ranges id))]
|
||||
[_ (void)]))
|
||||
(let ([binder (get-binder id)])
|
||||
(when binder
|
||||
(for-each
|
||||
(lambda (binder-r)
|
||||
(for-each (lambda (id-r)
|
||||
(if (hash-ref definite-table id #f)
|
||||
(send -text add-arrow
|
||||
(adjust (car binder-r))
|
||||
(adjust (cdr binder-r))
|
||||
(adjust (car id-r))
|
||||
(adjust (cdr id-r))
|
||||
"blue")
|
||||
(send -text add-question-arrow
|
||||
(adjust (car binder-r))
|
||||
(adjust (cdr binder-r))
|
||||
(adjust (car id-r))
|
||||
(adjust (cdr id-r))
|
||||
"purple")))
|
||||
(send range get-ranges id)))
|
||||
(send range get-ranges binder)))))
|
||||
(send range get-identifier-list))))
|
||||
(let* ([binders0
|
||||
(module-identifier-mapping-map alpha-table (lambda (k v) k))]
|
||||
[binders
|
||||
(apply append (map get-binders binders0))])
|
||||
(send display underline-syntaxes binders))
|
||||
(for ([id (send range get-identifier-list)])
|
||||
(define definite? (hash-ref definite-table id #f))
|
||||
(when #f ;; DISABLED
|
||||
(add-binding-billboard start range id definite?))
|
||||
(for ([binder (get-binders id)])
|
||||
(for ([binder-r (send range get-ranges binder)])
|
||||
(for ([id-r (send range get-ranges id)])
|
||||
(add-binding-arrow start binder-r id-r definite?)))))))
|
||||
display))
|
||||
|
||||
(define/private (add-binding-arrow start binder-r id-r definite?)
|
||||
(if definite?
|
||||
(send -text add-arrow
|
||||
(+ start (car binder-r))
|
||||
(+ start (cdr binder-r))
|
||||
(+ start (car id-r))
|
||||
(+ start (cdr id-r))
|
||||
"blue")
|
||||
(send -text add-question-arrow
|
||||
(+ start (car binder-r))
|
||||
(+ start (cdr binder-r))
|
||||
(+ start (car id-r))
|
||||
(+ start (cdr id-r))
|
||||
"purple")))
|
||||
|
||||
(define/private (add-binding-billboard start range id definite?)
|
||||
(match (identifier-binding id)
|
||||
[(list-rest src-mod src-name nom-mod nom-name _)
|
||||
(for-each (lambda (id-r)
|
||||
(send -text add-billboard
|
||||
(+ start (car id-r))
|
||||
(+ start (cdr id-r))
|
||||
(string-append "from " (mpi->string src-mod))
|
||||
(if definite? "blue" "purple")))
|
||||
(send range get-ranges id))]
|
||||
[_ (void)]))
|
||||
|
||||
(define/public (add-separator)
|
||||
(with-unlock -text
|
||||
(send* -text
|
||||
|
|
|
@ -95,36 +95,41 @@
|
|||
(send sbview add-text "\n"))
|
||||
|
||||
(define/public (add-step step
|
||||
#:binders binders)
|
||||
#:binders binders
|
||||
#:shift-table [shift-table #f])
|
||||
(cond [(step? step)
|
||||
(show-step step binders)]
|
||||
(show-step step binders shift-table)]
|
||||
[(misstep? step)
|
||||
(show-misstep step binders)]
|
||||
(show-misstep step binders shift-table)]
|
||||
[(prestep? step)
|
||||
(show-prestep step binders)]
|
||||
(show-prestep step binders shift-table)]
|
||||
[(poststep? step)
|
||||
(show-poststep step binders)]))
|
||||
(show-poststep step binders shift-table)]))
|
||||
|
||||
(define/public (add-syntax stx
|
||||
#:binders binders
|
||||
#:shift-table [shift-table #f]
|
||||
#:definites definites)
|
||||
(send sbview add-syntax stx
|
||||
#:alpha-table binders
|
||||
#:binder-table binders
|
||||
#:shift-table shift-table
|
||||
#:definites (or definites null)))
|
||||
|
||||
(define/public (add-final stx error
|
||||
#:binders binders
|
||||
#:shift-table [shift-table #f]
|
||||
#:definites definites)
|
||||
(when stx
|
||||
(send sbview add-text "Expansion finished\n")
|
||||
(send sbview add-syntax stx
|
||||
#:alpha-table binders
|
||||
#:binder-table binders
|
||||
#:shift-table shift-table
|
||||
#:definites (or definites null)))
|
||||
(when error
|
||||
(add-error error)))
|
||||
|
||||
;; show-lctx : Step -> void
|
||||
(define/private (show-lctx step binders)
|
||||
(define/private (show-lctx step binders shift-table)
|
||||
(define state (protostep-s1 step))
|
||||
(define lctx (state-lctx state))
|
||||
(when (pair? lctx)
|
||||
|
@ -135,6 +140,7 @@
|
|||
(insert-syntax/redex (bigframe-term bf)
|
||||
(bigframe-foci bf)
|
||||
binders
|
||||
shift-table
|
||||
(state-uses state)
|
||||
(state-frontier state)))
|
||||
(reverse lctx))))
|
||||
|
@ -149,72 +155,81 @@
|
|||
(step-type->string (protostep-type step))))
|
||||
|
||||
;; show-step : Step -> void
|
||||
(define/private (show-step step binders)
|
||||
(show-state/redex (protostep-s1 step) binders)
|
||||
(define/private (show-step step binders shift-table)
|
||||
(show-state/redex (protostep-s1 step) binders shift-table)
|
||||
(separator step)
|
||||
(show-state/contractum (step-s2 step) binders)
|
||||
(show-lctx step binders))
|
||||
(show-state/contractum (step-s2 step) binders shift-table)
|
||||
(show-lctx step binders shift-table))
|
||||
|
||||
(define/private (show-state/redex state binders)
|
||||
(define/private (show-state/redex state binders shift-table)
|
||||
(insert-syntax/redex (state-term state)
|
||||
(state-foci state)
|
||||
binders
|
||||
shift-table
|
||||
(state-uses state)
|
||||
(state-frontier state)))
|
||||
|
||||
(define/private (show-state/contractum state binders)
|
||||
(define/private (show-state/contractum state binders shift-table)
|
||||
(insert-syntax/contractum (state-term state)
|
||||
(state-foci state)
|
||||
binders
|
||||
shift-table
|
||||
(state-uses state)
|
||||
(state-frontier state)))
|
||||
|
||||
;; show-prestep : Step -> void
|
||||
(define/private (show-prestep step binders)
|
||||
(define/private (show-prestep step binders shift-table)
|
||||
(separator/small step)
|
||||
(show-state/redex (protostep-s1 step) binders)
|
||||
(show-lctx step binders))
|
||||
(show-state/redex (protostep-s1 step) binders shift-table)
|
||||
(show-lctx step binders shift-table))
|
||||
|
||||
;; show-poststep : Step -> void
|
||||
(define/private (show-poststep step binders)
|
||||
(define/private (show-poststep step binders shift-table)
|
||||
(separator/small step)
|
||||
(show-state/contractum (protostep-s1 step) binders)
|
||||
(show-lctx step binders))
|
||||
(show-state/contractum (protostep-s1 step) binders shift-table)
|
||||
(show-lctx step binders shift-table))
|
||||
|
||||
;; show-misstep : Step -> void
|
||||
(define/private (show-misstep step binders)
|
||||
(define/private (show-misstep step binders shift-table)
|
||||
(define state (protostep-s1 step))
|
||||
(show-state/redex state binders)
|
||||
(show-state/redex state binders shift-table)
|
||||
(separator step)
|
||||
(send sbview add-error-text (exn-message (misstep-exn step)))
|
||||
(send sbview add-text "\n")
|
||||
(when (exn:fail:syntax? (misstep-exn step))
|
||||
(for-each (lambda (e)
|
||||
(send sbview add-syntax e
|
||||
#:alpha-table binders
|
||||
#:binder-table binders
|
||||
#:shift-table shift-table
|
||||
#:definites (or (state-uses state) null)))
|
||||
(exn:fail:syntax-exprs (misstep-exn step))))
|
||||
(show-lctx step binders))
|
||||
(show-lctx step binders shift-table))
|
||||
|
||||
;; insert-syntax/color : syntax syntaxes identifiers syntaxes string -> void
|
||||
(define/private (insert-syntax/color stx foci binders definites frontier hi-color)
|
||||
;; insert-syntax/color
|
||||
(define/private (insert-syntax/color stx foci binders shift-table
|
||||
definites frontier hi-color)
|
||||
(define highlight-foci? (send config get-highlight-foci?))
|
||||
(define highlight-frontier? (send config get-highlight-frontier?))
|
||||
(send sbview add-syntax stx
|
||||
#:definites (or definites null)
|
||||
#:alpha-table binders
|
||||
#:binder-table binders
|
||||
#:shift-table shift-table
|
||||
#:hi-colors (list hi-color
|
||||
"WhiteSmoke")
|
||||
#:hi-stxss (list (if highlight-foci? foci null)
|
||||
(if highlight-frontier? frontier null))))
|
||||
|
||||
;; insert-syntax/redex : syntax syntaxes identifiers syntaxes -> void
|
||||
(define/private (insert-syntax/redex stx foci binders definites frontier)
|
||||
(insert-syntax/color stx foci binders definites frontier "MistyRose"))
|
||||
;; insert-syntax/redex
|
||||
(define/private (insert-syntax/redex stx foci binders shift-table
|
||||
definites frontier)
|
||||
(insert-syntax/color stx foci binders shift-table
|
||||
definites frontier "MistyRose"))
|
||||
|
||||
;; insert-syntax/contractum : syntax syntaxes identifiers syntaxes -> void
|
||||
(define/private (insert-syntax/contractum stx foci binders definites frontier)
|
||||
(insert-syntax/color stx foci binders definites frontier "LightCyan"))
|
||||
;; insert-syntax/contractum
|
||||
(define/private (insert-syntax/contractum stx foci binders shift-table
|
||||
definites frontier)
|
||||
(insert-syntax/color stx foci binders shift-table
|
||||
definites frontier "LightCyan"))
|
||||
|
||||
;; insert-step-separator : string -> void
|
||||
(define/private (insert-step-separator text)
|
||||
|
|
|
@ -46,6 +46,7 @@
|
|||
(define deriv #f)
|
||||
(define deriv-hidden? #f)
|
||||
(define binders #f)
|
||||
(define shift-table #f)
|
||||
|
||||
(define raw-steps #f)
|
||||
(define raw-steps-estx #f) ;; #f if raw-steps-exn is exn
|
||||
|
@ -72,7 +73,8 @@
|
|||
(define-guarded-getters (recache-deriv!)
|
||||
[get-deriv deriv]
|
||||
[get-deriv-hidden? deriv-hidden?]
|
||||
[get-binders binders])
|
||||
[get-binders binders]
|
||||
[get-shift-table shift-table])
|
||||
(define-guarded-getters (recache-raw-steps!)
|
||||
[get-raw-steps-definites raw-steps-definites]
|
||||
[get-raw-steps-exn raw-steps-exn]
|
||||
|
@ -104,7 +106,8 @@
|
|||
(invalidate-synth!)
|
||||
(set! deriv #f)
|
||||
(set! deriv-hidden? #f)
|
||||
(set! binders #f))
|
||||
(set! binders #f)
|
||||
(set! shift-table #f))
|
||||
|
||||
;; recache! : -> void
|
||||
(define/public (recache!)
|
||||
|
@ -130,12 +133,14 @@
|
|||
(when (not d)
|
||||
(set! deriv-hidden? #t))
|
||||
(when d
|
||||
(let ([alpha-table (make-module-identifier-mapping)])
|
||||
(let ([alpha-table (make-module-identifier-mapping)]
|
||||
[binder-ids (extract-all-fresh-names d)])
|
||||
(for-each (lambda (id)
|
||||
(module-identifier-mapping-put! alpha-table id id))
|
||||
(extract-all-fresh-names d))
|
||||
binder-ids)
|
||||
(set! deriv d)
|
||||
(set! binders alpha-table))))))))
|
||||
(set! binders alpha-table)
|
||||
(set! shift-table (compute-shift-table d)))))))))
|
||||
|
||||
;; recache-synth! : -> void
|
||||
(define/private (recache-synth!)
|
||||
|
@ -277,6 +282,7 @@
|
|||
(cond [(syntax? raw-steps-estx)
|
||||
(send displayer add-syntax raw-steps-estx
|
||||
#:binders binders
|
||||
#:shift-table shift-table
|
||||
#:definites raw-steps-definites)]
|
||||
[(exn? raw-steps-exn)
|
||||
(send displayer add-error raw-steps-exn)]
|
||||
|
@ -289,9 +295,11 @@
|
|||
(let ([step (cursor:next steps)])
|
||||
(if step
|
||||
(send displayer add-step step
|
||||
#:binders binders)
|
||||
#:binders binders
|
||||
#:shift-table shift-table)
|
||||
(send displayer add-final raw-steps-estx raw-steps-exn
|
||||
#:binders binders
|
||||
#:shift-table shift-table
|
||||
#:definites raw-steps-definites)))]
|
||||
[else (display-oops #t)]))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user