www

commit 78a294d8ee25acac805b2c83c1c101a13a11c8ef
parent 0f119f61a4c33111a4470986a4ac7724756cd220
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date:   Thu, 30 Aug 2007 21:44:10 +0000

Macro stepper: fail gracefully on frontier-computation errors

svn: r7231

original commit: da4c99f2318ee34b4ac9b764d05a605ba02e1698

Diffstat:
M
collects/macro-debugger/model/reductions-engine.ss
 | 
35
++++++++++++++++++++---------------

1 file changed, 20 insertions(+), 15 deletions(-)
diff --git a/collects/macro-debugger/model/reductions-engine.ss b/collects/macro-debugger/model/reductions-engine.ss
@@ -66,16 +66,18 @@
   (define (learn-definites ids)
     (current-definites (append ids (current-definites))))
 
+  (define (get-frontier) (or (current-frontier) null))
+  
   (define (add-frontier stxs)
-    (current-frontier (append stxs (current-frontier)))
-    #;(printf "new frontier: ~s~n" (current-frontier)))
-
+    (current-frontier
+     (let ([frontier0 (current-frontier)])
+       (and frontier0 (append stxs frontier0)))))
+  
   (define (blaze-frontier stx)
-    #;(unless (memq stx (current-frontier))
-      (fprintf (current-error-port) "frontier does not contain term: ~s~n" stx)
-      (error 'blaze-frontier))
-    (current-frontier (remq stx (current-frontier)))
-    #;(printf "new frontier (blazed): ~s~n" (current-frontier)))
+    (current-frontier
+     (let ([frontier0 (current-frontier)])
+       (and frontier0
+            (remq stx frontier0)))))
 
   ;; -----------------------------------
 
@@ -212,8 +214,11 @@
 
   (define (rename-frontier from to)
     (current-frontier
-     (apply append (map (make-rename-mapping from to) (current-frontier)))))
-
+     (with-handlers ([exn:fail? (lambda _ #f)])
+       (apply append
+              (map (make-rename-mapping from to)
+                   (current-frontier))))))
+  
   (define (make-rename-mapping from0 to0)
     (define table (make-hash-table))
     (let loop ([from from0] [to to0])
@@ -262,31 +267,31 @@
   ;; Lifts a local step into a term step.
   (define (walk e1 e2 type)
     (make-step (current-derivation) (big-context) type (context)
-               (current-definites) (current-frontier)
+               (current-definites) (get-frontier)
                (foci e1) (foci e2) e1 e2))
   
   ;; walk/foci : syntaxes syntaxes syntax syntax StepType -> Reduction
   (define (walk/foci foci1 foci2 Ee1 Ee2 type)
     (make-step (current-derivation) (big-context) type (context)
-               (current-definites) (current-frontier)
+               (current-definites) (get-frontier)
                (foci foci1) (foci foci2) Ee1 Ee2))
 
   ;; walk/mono : syntax StepType -> Reduction
   (define (walk/mono e1 type)
     (make-mono (current-derivation) (big-context) type (context)
-               (current-definites) (current-frontier)
+               (current-definites) (get-frontier)
                (foci e1) e1))
   
   ;; stumble : syntax exception -> Reduction
   (define (stumble stx exn)
     (make-misstep (current-derivation) (big-context) 'error (context)
-                  (current-definites) (current-frontier)
+                  (current-definites) (get-frontier)
                   (foci stx) stx exn))
   
   ;; stumble/E : syntax(s) syntax exn -> Reduction
   (define (stumble/E focus Ee1 exn)
     (make-misstep (current-derivation) (big-context) 'error (context)
-                  (current-definites) (current-frontier)
+                  (current-definites) (get-frontier)
                   (foci focus) Ee1 exn))
   
   ;; ------------------------------------