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

Macro stepper:

Browse Source 
added option to force letrec transformation
  made macro hiding slightly more resilient in presence of local actions

svn: r5932
This commit is contained in:
Ryan Culpepper 2007-04-13 21:26:49 +00:00
parent bdd53d5f3c
commit d29f1d82fc
2 changed files with 26 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/macro-debugger/model/hide.ss
View File

@ -11,6 +11,7 @@
(provide hide/policy (provide hide/policy
macro-policy macro-policy
force-letrec-transformation
seek-syntax seek-syntax
current-hiding-warning-handler current-hiding-warning-handler
(struct nonlinearity (message paths)) (struct nonlinearity (message paths))
@ -473,18 +474,23 @@
;; for-bderiv : BlockDerivation -> (values BlockDerivation (list-of syntax)) ;; for-bderiv : BlockDerivation -> (values BlockDerivation (list-of syntax))
(define (for-bderiv bd) (define (for-bderiv bd)
(match bd (if (force-letrec-transformation)
[(IntQ bderiv (es1 es2 pass1 trans pass2)) (match bd
(let ([pass2 (bderiv->lderiv bd)]) [(IntQ bderiv (es1 es2 pass1 trans pass2))
(recv [(pass2 es2) (for-lderiv pass2)] (recv [(pass2 es2) (for-lderiv pass2)]
(values (rewrap/nt bd (make-bderiv es1 es2 null 'list pass2)) (values (rewrap/nt bd (make-bderiv es1 es2 pass1 trans pass2))
es2)))] es2))])
[#f (values #f #f)])) (match bd
[(IntQ bderiv (es1 es2 pass1 trans pass2))
(let ([pass2 (bderiv->lderiv bd)])
(recv [(pass2 es2) (for-lderiv pass2)]
(values (rewrap/nt bd (make-bderiv es1 es2 null 'list pass2))
es2)))]
[#f (values #f #f)])))
(for-deriv deriv)) (for-deriv deriv))
; ;
; ;; ; ;;
; ;; ; ;;
@ -728,9 +734,15 @@
(define (for-local-action local) (define (for-local-action local)
(match local (match local
[(struct local-expansion (e1 e2 me1 me2 for-stx? deriv)) [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
(raise (make-localactions))] (let-values ([(rename-subtersm2 table2) (do-rename me1 e1)])
(let ([subterms (for-deriv deriv)])
(when (pair? (filter s:subterm? subterms))
(raise (make-localactions)))))]
[(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv)) [(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
(raise (make-localactions))] (let-values ([(rename-subtersm2 table2) (do-rename me1 e1)])
(let ([subterms (for-deriv deriv)])
(when (pair? (filter s:subterm? subterms))
(raise (make-localactions)))))]
[(struct local-lift (expr id)) [(struct local-lift (expr id))
;; FIXME: seek in the lifted deriv, transplant subterm expansions *here* ;; FIXME: seek in the lifted deriv, transplant subterm expansions *here*
(extract/remove-unvisited-lift id)] (extract/remove-unvisited-lift id)]

4
collects/macro-debugger/model/synth-engine.ss
View File

@ -11,6 +11,7 @@
>>Prim >>Prim
>>Seek >>Seek
macro-policy macro-policy
force-letrec-transformation
subterms-table subterms-table
lifts-available lifts-available
lifts-retained lifts-retained
@ -20,6 +21,9 @@
;; macro-policy : parameter of (identifier -> boolean) ;; macro-policy : parameter of (identifier -> boolean)
(define macro-policy (make-parameter (lambda (id) #t))) (define macro-policy (make-parameter (lambda (id) #t)))
;; force-letrec-transformation : parameter of boolean
(define force-letrec-transformation (make-parameter #f))
;; subterms-table : parameter of hashtable[syntax => (list-of Path)] ;; subterms-table : parameter of hashtable[syntax => (list-of Path)]
(define subterms-table (make-parameter #f)) (define subterms-table (make-parameter #f))