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" "deriv-util.ss"
"hide.ss" "hide.ss"
"hiding-policies.ss" "hiding-policies.ss"
"deriv.ss") "deriv.ss"
"steps.ss")
(provide (all-from "trace.ss") (provide (all-from "trace.ss")
(all-from "deriv.ss") (all-from "deriv.ss")
(all-from "deriv-util.ss") (all-from "deriv-util.ss")
(all-from "hiding-policies.ss") (all-from "hiding-policies.ss")
(all-from "hide.ss") (all-from "hide.ss")
(all-from "steps.ss")
(all-from (lib "plt-match.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 ;; FIXME: Missing case-lambda
(define (extract-all-fresh-names d) (define (extract-all-fresh-names d)
(define (renaming-node? x) (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:case-lambda? x)
(p:let-values? x) (p:let-values? x)
(p:letrec-values? x) (p:letrec-values? x)
@ -284,22 +288,22 @@
(p:define-syntaxes? x))) (p:define-syntaxes? x)))
(define (extract-fresh-names d) (define (extract-fresh-names d)
(match d (match d
[(struct p:lambda (e1 e2 rs renames body)) [(AnyQ p:lambda (e1 e2 rs renames body))
(if renames (if renames
(with-syntax ([(?formals . ?body) renames]) (with-syntax ([(?formals . ?body) renames])
#'?formals) #'?formals)
null)] null)]
[(struct p:let-values (e1 e2 rs renames rhss body)) [(AnyQ p:let-values (e1 e2 rs renames rhss body))
(if renames (if renames
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames]) (with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
#'(?vars ...)) #'(?vars ...))
null)] null)]
[(struct p:letrec-values (e1 e2 rs renames rhss body)) [(AnyQ p:letrec-values (e1 e2 rs renames rhss body))
(if renames (if renames
(with-syntax ([(((?vars ?rhs) ...) . ?body) renames]) (with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
#'(?vars ...)) #'(?vars ...))
null)] 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 (cons
(if srenames (if srenames
(with-syntax ([(((?svars ?srhs) ...) ((?vvars ?vrhs) ...) . ?body) (with-syntax ([(((?svars ?srhs) ...) ((?vvars ?vrhs) ...) . ?body)
@ -310,24 +314,24 @@
(with-syntax ([(((?vvars ?vrhs) ...) . ?body) vrenames]) (with-syntax ([(((?vvars ?vrhs) ...) . ?body) vrenames])
#'(?vvars ...)) #'(?vvars ...))
null))] null))]
[(struct b:defvals (rename head)) [(AnyQ b:defvals (rename head))
(let ([head-e2 (lift/deriv-e2 head)]) (let ([head-e2 (lift/deriv-e2 head)])
(if head-e2 (if head-e2
(with-syntax ([(?dv ?vars ?rhs) head-e2]) (with-syntax ([(?dv ?vars ?rhs) head-e2])
#'?vars) #'?vars)
null))] null))]
[(struct b:defstx (rename head rhs)) [(AnyQ b:defstx (rename head rhs))
(let ([head-e2 (lift/deriv-e2 head)]) (let ([head-e2 (lift/deriv-e2 head)])
(if head-e2 (if head-e2
(with-syntax ([(?ds ?svars ?rhs) head-e2]) (with-syntax ([(?ds ?svars ?rhs) head-e2])
#'?svars) #'?svars)
null))] null))]
[(struct p:define-values (e1 e2 rs rhs)) [(AnyQ p:define-values (e1 e2 rs rhs))
(if rhs (if rhs
(with-syntax ([(?dv ?vars ?rhs) e1]) (with-syntax ([(?dv ?vars ?rhs) e1])
#'?vars) #'?vars)
null)] null)]
[(struct p:define-syntaxes (e1 e2 rs rhs)) [(AnyQ p:define-syntaxes (e1 e2 rs rhs))
(if rhs (if rhs
(with-syntax ([(?ds ?svars ?srhs) e1]) (with-syntax ([(?ds ?svars ?srhs) e1])
#'?svars) #'?svars)

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

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