suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Macro stepper:

Browse Source 
- removed dead seek-syntax code
  - fixed bug related to hiding + errors
  - fixed bug finding bindings in interrrupted expansion

svn: r6182

original commit: e4e5ec407498cbe36faa26ff37c55c445a236748
This commit is contained in:
Ryan Culpepper 2007-05-08 20:56:37 +00:00
parent c9d748d3f8
commit 0b5b000078
3 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/macro-debugger/model/debug.ss
View File

@ -5,12 +5,14 @@
"deriv-util.ss"
"hide.ss"
"hiding-policies.ss"
"deriv.ss")
"deriv.ss"
"steps.ss")
(provide (all-from "trace.ss")
(all-from "deriv.ss")
(all-from "deriv-util.ss")
(all-from "hiding-policies.ss")
(all-from "hide.ss")
(all-from "steps.ss")
(all-from (lib "plt-match.ss")))
)

22
collects/macro-debugger/model/deriv-util.ss
View File

@ -272,7 +272,11 @@
;; FIXME: Missing case-lambda
(define (extract-all-fresh-names d)
(define (renaming-node? x)
(or (p:lambda? x)
(or (and (error-wrap? x)
(renaming-node? (error-wrap-inner x)))
(and (interrupted-wrap? x)
(renaming-node? (interrupted-wrap-inner x)))
(p:lambda? x)
(p:case-lambda? x)
(p:let-values? x)
(p:letrec-values? x)
@ -284,22 +288,22 @@
(p:define-syntaxes? x)))
(define (extract-fresh-names d)
(match d
[(struct p:lambda (e1 e2 rs renames body))
[(AnyQ p:lambda (e1 e2 rs renames body))
(if renames
(with-syntax ([(?formals . ?body) renames])
#'?formals)
null)]
[(struct p:let-values (e1 e2 rs renames rhss body))
[(AnyQ p:let-values (e1 e2 rs renames rhss body))
(if renames
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
#'(?vars ...))
null)]
[(struct p:letrec-values (e1 e2 rs renames rhss body))
[(AnyQ p:letrec-values (e1 e2 rs renames rhss body))
(if renames
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
#'(?vars ...))
null)]
[(struct p:letrec-syntaxes+values (e1 e2 rs srenames srhss vrenames vrhss body))
[(AnyQ p:letrec-syntaxes+values (e1 e2 rs srenames srhss vrenames vrhss body))
(cons
(if srenames
(with-syntax ([(((?svars ?srhs) ...) ((?vvars ?vrhs) ...) . ?body)
@ -310,24 +314,24 @@
(with-syntax ([(((?vvars ?vrhs) ...) . ?body) vrenames])
#'(?vvars ...))
null))]
[(struct b:defvals (rename head))
[(AnyQ b:defvals (rename head))
(let ([head-e2 (lift/deriv-e2 head)])
(if head-e2
(with-syntax ([(?dv ?vars ?rhs) head-e2])
#'?vars)
null))]
[(struct b:defstx (rename head rhs))
[(AnyQ b:defstx (rename head rhs))
(let ([head-e2 (lift/deriv-e2 head)])
(if head-e2
(with-syntax ([(?ds ?svars ?rhs) head-e2])
#'?svars)
null))]
[(struct p:define-values (e1 e2 rs rhs))
[(AnyQ p:define-values (e1 e2 rs rhs))
(if rhs
(with-syntax ([(?dv ?vars ?rhs) e1])
#'?vars)
null)]
[(struct p:define-syntaxes (e1 e2 rs rhs))
[(AnyQ p:define-syntaxes (e1 e2 rs rhs))
(if rhs
(with-syntax ([(?ds ?svars ?srhs) e1])
#'?svars)

10
collects/macro-debugger/model/reductions.ss
View File

@ -317,7 +317,8 @@
(let ([ctx (lambda (x) (path-replace term path0 x))])
(append (with-context ctx
(reductions* deriv0))
(loop (and (deriv? deriv0)
(loop (and term
(deriv? deriv0)
(path-replace term path0 (deriv-e2 deriv0)))
(cdr subterms)))))]
[(s:rename? (car subterms))
@ -326,9 +327,10 @@
;; FIXME: if so, coalesce?
(rename-frontier (s:rename-before subterm0)
(s:rename-after subterm0))
(loop (path-replace term
(s:rename-path subterm0)
(s:rename-after subterm0))
(loop (and term
(path-replace term
(s:rename-path subterm0)
(s:rename-after subterm0)))
(cdr subterms)))]))]
;; FIXME