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

Rackety

Browse Source
This commit is contained in:
Robby Findler 2012-03-05 08:12:02 -06:00
parent b7caf411ae
commit 4a304643d3
18 changed files with 55 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/redex/main.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require "reduction-semantics.rkt" (require "reduction-semantics.rkt"
"gui.rkt" "gui.rkt"
"pict.rkt") "pict.rkt")

8
collects/redex/private/arrow.rkt
View File

@ -1,13 +1,13 @@
#lang scheme/base #lang racket/base
(require texpict/mrpict (require texpict/mrpict
racket/draw racket/draw
scheme/class racket/class
scheme/contract) racket/contract)
(provide/contract (provide/contract
[make-arrow-pict [make-arrow-pict
(-> string? (-> string?
(symbols 'curvy 'straight 'straight-double 'map) (or/c 'curvy 'straight 'straight-double 'map)
symbol? symbol?
number? number?
(-> pict?))]) (-> pict?))])

10
collects/redex/private/core-layout.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require "loc-wrapper.rkt" (require "loc-wrapper.rkt"
"matcher.rkt" "matcher.rkt"
@ -7,14 +7,14 @@
texpict/utils texpict/utils
texpict/mrpict texpict/mrpict
scheme/match racket/match
racket/draw racket/draw
scheme/class) racket/class
(for-syntax racket/base))
(define pink-code-font 'modern) (define pink-code-font 'modern)
(require (for-syntax scheme/base))
(provide find-enclosing-loc-wrapper (provide find-enclosing-loc-wrapper
render-lw render-lw
lw->pict lw->pict

2
collects/redex/private/error.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(define-struct (exn:fail:redex exn:fail) ()) (define-struct (exn:fail:redex exn:fail) ())
(define (redex-error name fmt . args) (define (redex-error name fmt . args)
(define suffix (apply format fmt args)) (define suffix (apply format fmt args))

4
collects/redex/private/loc-wrapper-ct.rkt
View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require (for-template scheme/base) (require (for-template racket/base)
(for-template "loc-wrapper-rt.rkt") (for-template "loc-wrapper-rt.rkt")
"term-fn.rkt") "term-fn.rkt")
(provide to-lw/proc to-lw/uq/proc) (provide to-lw/proc to-lw/uq/proc)

6
collects/redex/private/loc-wrapper.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require scheme/contract (require racket/contract
(for-syntax scheme/base) (for-syntax racket/base)
(for-syntax "loc-wrapper-ct.rkt") (for-syntax "loc-wrapper-ct.rkt")
"loc-wrapper-rt.rkt") "loc-wrapper-rt.rkt")

4
collects/redex/private/red-sem-macro-helpers.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang racket/base
(provide extract-names) (provide extract-names)
(require scheme/match) (require racket/match)
(define (extract-names stx) (define (extract-names stx)
(let ([dup-names (let ([dup-names

14
collects/redex/private/sexp-diffs.rkt
View File

@ -1,9 +1,9 @@
#lang scheme/base #lang racket/base
(require scheme/gui/base (require racket/gui/base
scheme/contract racket/contract
mrlib/graph mrlib/graph
scheme/pretty racket/pretty
scheme/class racket/class
framework framework
"size-snip.rkt") "size-snip.rkt")
@ -101,7 +101,7 @@
((pretty-print-parameters) ((pretty-print-parameters)
(λ () (λ ()
(parameterize ([pretty-print-columns columns]) (parameterize ([pretty-print-columns columns])
(pretty-print sexp (open-output-text-editor text))))) (pretty-write sexp (open-output-text-editor text)))))
(for-each (for-each
(λ (p) (send text highlight-range (car p) (cdr p) (send the-color-database find-color "NavajoWhite"))) (λ (p) (send text highlight-range (car p) (cdr p) (send the-color-database find-color "NavajoWhite")))
to-color) to-color)
@ -160,7 +160,7 @@
(flush-output port) (flush-output port)
(set! to-color (cons (cons (car start) position) to-color)) (set! to-color (cons (cons (car start) position) to-color))
(set! start (cdr start))))]) (set! start (cdr start))))])
(pretty-print sexp counting-port)))) (pretty-write sexp counting-port))))
to-color)) to-color))
;; does a map-like operation, but if the list is dotted, flattens the results into an actual list. ;; does a map-like operation, but if the list is dotted, flattens the results into an actual list.

10
collects/redex/private/size-snip.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang racket/base
(require scheme/gui/base (require racket/gui/base
scheme/class racket/class
framework framework
scheme/pretty racket/pretty
"matcher.rkt") "matcher.rkt")
(provide reflowing-snip<%> (provide reflowing-snip<%>
@ -32,7 +32,7 @@
[pretty-print-print-hook default-pretty-printer-print-hook]) [pretty-print-print-hook default-pretty-printer-print-hook])
((pretty-print-parameters) ((pretty-print-parameters)
(λ () (λ ()
(pretty-print v port))))) (pretty-write v port)))))
(define (default-pretty-printer-size-hook val display? op) (define (default-pretty-printer-size-hook val display? op)
(cond (cond

2
collects/redex/private/term-fn.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require (for-template racket/base "defined-checks.rkt")) (require (for-template racket/base "defined-checks.rkt"))
(provide make-term-fn (provide make-term-fn

4
collects/redex/private/term.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require (for-syntax scheme/base (require (for-syntax racket/base
"term-fn.rkt" "term-fn.rkt"
syntax/boundmap syntax/boundmap
syntax/parse syntax/parse

2
collects/redex/private/underscore-allowed.rkt
View File

@ -1,3 +1,3 @@
#lang scheme/base #lang racket/base
(provide underscore-allowed) (provide underscore-allowed)
(define underscore-allowed '(any number string variable variable-not-otherwise-mentioned natural integer real)) (define underscore-allowed '(any number string variable variable-not-otherwise-mentioned natural integer real))

4
collects/redex/reduction-semantics.rkt
View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/contract) (require racket/contract)
(require "private/reduction-semantics.rkt" (require "private/reduction-semantics.rkt"
"private/judgment-form.rkt" "private/judgment-form.rkt"

5
collects/redex/tests/bitmap-test-util.rkt
View File

@ -1,7 +1,10 @@
#lang scheme/gui #lang racket/base
(require framework (require framework
slideshow/pict slideshow/pict
racket/runtime-path racket/runtime-path
racket/gui/base
(for-syntax racket/base)
racket/class
"../pict.rkt" "../pict.rkt"
"../reduction-semantics.rkt") "../reduction-semantics.rkt")

8
collects/redex/tests/color-test.rkt
View File

@ -1,3 +1,5 @@
#lang racket/base
#| #|
tests the color setting ability during a reduction sequence. tests the color setting ability during a reduction sequence.
@ -8,10 +10,10 @@ In the other window, you expect to see the currently unreducted terms in green a
|# |#
#lang scheme/gui
(require "../reduction-semantics.rkt" (require "../reduction-semantics.rkt"
"../gui.rkt") "../gui.rkt"
racket/gui/base
racket/class)
(reduction-steps-cutoff 1) (reduction-steps-cutoff 1)

7
collects/redex/tests/core-layout-test.rkt
View File

@ -1,10 +1,9 @@
#lang scheme/base #lang racket/base
(require "../private/core-layout.rkt" (require "../private/core-layout.rkt"
"../private/loc-wrapper.rkt" "../private/loc-wrapper.rkt"
"lw-test-util.rkt" "lw-test-util.rkt"
"test-util.rkt" "test-util.rkt")
mzlib/struct)
(require texpict/mrpict mred/mred mzlib/class) (require texpict/mrpict mred/mred mzlib/class)
(dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))) (dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1)))
@ -30,7 +29,7 @@
[(pair? x) (cons (loop (car x)) [(pair? x) (cons (loop (car x))
(loop (cdr x)))] (loop (cdr x)))]
[(pict-token? x) [(pict-token? x)
(copy-struct pict-token x [pict-token-pict 'pict])] (struct-copy pict-token x [pict 'pict])]
[else x]))) [else x])))
(test (replace-pict-tokens (test (replace-pict-tokens

9
collects/redex/tests/run-tests.rkt
View File

@ -1,9 +1,10 @@
#lang racket/base
;; require this file to run all of the test suites for redex. ;; require this file to run all of the test suites for redex.
#lang racket/base (require racket/runtime-path
(require scheme/runtime-path racket/cmdline
scheme/cmdline racket/match
scheme/match
"test-util.rkt") "test-util.rkt")
(define test-bitmaps? #t) (define test-bitmaps? #t)

3
collects/redex/tests/stepper-test.rkt
View File

@ -1,6 +1,7 @@
#lang racket #lang racket/base
(require framework (require framework
racket/class
"test-util.rkt" "test-util.rkt"
"../reduction-semantics.rkt" "../reduction-semantics.rkt"
"../private/stepper.rkt" "../private/stepper.rkt"