Revert "Combine debug.rkt and render.rkt." to make Travis happy. This…

… requires a window server to run. This reverts commit 1868f89.
emina · Feb 29, 2016 · c8043ea · c8043ea
1 parent 1868f89
commit c8043ea
Show file tree

Hide file tree

Showing 3 changed files with 75 additions and 70 deletions.
diff --git a/rosette/lib/render.rkt b/rosette/lib/render.rkt
@@ -0,0 +1,71 @@
+#lang racket
+
+(require rosette/solver/solution 
+         (only-in rosette symbolics) (only-in rosette/query/debug debug-origin)
+         rosette/lib/util/syntax (only-in racket/syntax format-id)
+         slideshow/code (only-in slideshow vl-append current-font-size))
+
+(provide render)
+
+(define (render sol [font-size 16])
+  (unless (unsat? sol)
+    (error 'render "expected an unsatisfiable solution, given ~a" sol))
+  (let* ([core (filter-map location (remove-duplicates (filter-map debug-origin (symbolics (core sol)))))]
+         [debugged (debugged-forms (remove-duplicates (map location-source core)) core)]
+         [core (apply set core)])
+    (parameterize ([code-colorize-enabled #t]
+                   [current-font-size font-size])
+      (apply vl-append (for/list ([stx debugged])
+                         (eval #`(code #,(colorize-code stx core))))))))
+
+(define (debugged-forms paths core)
+  (define (debugged? loc)
+    (for/or ([core-loc core])
+      (location-contains? loc core-loc)))
+  (apply 
+   append
+   (for/list ([source (map read-module paths)])
+     (syntax-case source () 
+       [(mod id lang (mod-begin forms ...))
+        (for/list ([form (syntax->list #'(forms ...))]
+                   #:when (debugged? (location form)))
+          form)]
+       [_ (error 'debugged-forms "expected a module, given ~a" source)]))))
+
+
+(define (colorize-code stx core)
+  (syntax-case stx ()
+    [(id rest ...)
+     (and (identifier? #'id) (free-label-identifier=? #'id #'quote))
+     stx]
+    [(expr rest ...)
+     (let* ([children (for/list ([e (syntax->list stx)]) (colorize-code e core))]
+            [children (datum->syntax stx children stx)]
+            [color (if (or (set-member? core (location #'expr)) 
+                           (set-member? core (location stx))) 
+                       "red" "gray")])
+       (quasisyntax/loc stx (colorize #,color #,children)))]
+    [_ (let ([leaf (if (identifier? stx) (reformat-identifier stx) stx)])
+         (if (set-member? core (location stx)) 
+             (quasisyntax/loc stx (colorize "red" #,leaf))
+             leaf))]))
+
+
+(define-syntax colorize 
+  (make-code-transformer 
+   (syntax-rules () 
+     [(_ color e) 
+      (parameterize ([code-colorize-enabled #t]
+                     [current-base-color color]
+                     [current-comment-color color]
+                     [current-keyword-color color]
+                     [current-id-color color]
+                     [current-literal-color color]
+                     [current-const-color color])
+        (code e))])))
+
+(define (reformat-identifier stx)
+  (format-id stx "~a" 
+             (string->symbol (~s (syntax->datum stx)))
+             #:source stx
+             #:props stx))
diff --git a/rosette/query/debug.rkt b/rosette/query/debug.rkt
@@ -1,17 +1,13 @@
 #lang racket
 
-(require (for-syntax racket/syntax) racket/stxparam
-         (only-in racket/syntax format-id)
-         slideshow/code (only-in slideshow vl-append current-font-size)
+(require (for-syntax racket/syntax) racket/stxparam 
          (only-in "core.rkt" current-solver ∃-debug eval/asserts)
-         "../lib/util/syntax-properties.rkt" "../lib/util/syntax.rkt"
+         "../lib/util/syntax-properties.rkt"
          (only-in "../base/form/app.rkt" app)
-         (only-in "../base/core/reflect.rkt" symbolics)
-         (only-in "../solver/solution.rkt" unsat? core)
          "../base/core/bool.rkt"  "../base/form/state.rkt" 
          "../base/core/equality.rkt" "../base/core/term.rkt")
 
-(provide relax? relate debug define/debug protect assert true false render)
+(provide relax? relate debug-origin debug define/debug protect assert true false)
 
 (define-syntax debug
   (syntax-rules ()
@@ -94,67 +90,5 @@
     [(constant (list (== relaxer) origin) _) origin]
     [_ #f]))
 
-(define (render sol [font-size 16])
-  (unless (unsat? sol)
-    (error 'render "expected an unsatisfiable solution, given ~a" sol))
-  (let* ([core (filter-map location (remove-duplicates (filter-map debug-origin (symbolics (core sol)))))]
-         [debugged (debugged-forms (remove-duplicates (map location-source core)) core)]
-         [core (apply set core)])
-    (parameterize ([code-colorize-enabled #t]
-                   [current-font-size font-size])
-      (apply vl-append (for/list ([stx debugged])
-                         (eval #`(code #,(colorize-code stx core))))))))
-
-(define (debugged-forms paths core)
-  (define (debugged? loc)
-    (for/or ([core-loc core])
-      (location-contains? loc core-loc)))
-  (apply 
-   append
-   (for/list ([source (map read-module paths)])
-     (syntax-case source () 
-       [(mod id lang (mod-begin forms ...))
-        (for/list ([form (syntax->list #'(forms ...))]
-                   #:when (debugged? (location form)))
-          form)]
-       [_ (error 'debugged-forms "expected a module, given ~a" source)]))))
-
-
-(define (colorize-code stx core)
-  (syntax-case stx ()
-    [(id rest ...)
-     (and (identifier? #'id) (free-label-identifier=? #'id #'quote))
-     stx]
-    [(expr rest ...)
-     (let* ([children (for/list ([e (syntax->list stx)]) (colorize-code e core))]
-            [children (datum->syntax stx children stx)]
-            [color (if (or (set-member? core (location #'expr)) 
-                           (set-member? core (location stx))) 
-                       "red" "gray")])
-       (quasisyntax/loc stx (colorize #,color #,children)))]
-    [_ (let ([leaf (if (identifier? stx) (reformat-identifier stx) stx)])
-         (if (set-member? core (location stx)) 
-             (quasisyntax/loc stx (colorize "red" #,leaf))
-             leaf))]))
-
-
-(define-syntax colorize 
-  (make-code-transformer 
-   (syntax-rules () 
-     [(_ color e) 
-      (parameterize ([code-colorize-enabled #t]
-                     [current-base-color color]
-                     [current-comment-color color]
-                     [current-keyword-color color]
-                     [current-id-color color]
-                     [current-literal-color color]
-                     [current-const-color color])
-        (code e))])))
-
-(define (reformat-identifier stx)
-  (format-id stx "~a" 
-             (string->symbol (~s (syntax->datum stx)))
-             #:source stx
-             #:props stx))
 
 
diff --git a/sdsl/fsm/query.rkt b/sdsl/fsm/query.rkt
@@ -2,7 +2,7 @@
 
 (require 
  "automaton.rkt" "lib.rkt"
- rosette/query/debug 
+ rosette/query/debug rosette/lib/render 
  rosette/lib/synthax)
 
 (provide define/debug debug-automaton