Switching to Racket

This commit is contained in:
Jay McCarthy 2010-11-10 09:13:36 -07:00
parent 7a2005811e
commit 765d30f121
38 changed files with 62 additions and 66 deletions

View File

@ -1,5 +1,5 @@
#lang scheme #lang racket
(require scheme/file (require racket/file
"diff.rkt" "diff.rkt"
"scm.rkt" "scm.rkt"
"list-count.rkt" "list-count.rkt"

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "path-utils.rkt" (require "path-utils.rkt"
"archive.rkt" "archive.rkt"
tests/eli-tester) tests/eli-tester)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "path-utils.rkt") (require "path-utils.rkt")
(define (value->bytes v) (define (value->bytes v)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "path-utils.rkt") (require "path-utils.rkt")
; (symbols 'always 'cache 'no-cache) ; (symbols 'always 'cache 'no-cache)

View File

@ -1,9 +1,9 @@
#lang scheme #lang racket
(require "path-utils.rkt" (require "path-utils.rkt"
"run-collect.rkt" "run-collect.rkt"
"replay.rkt" "replay.rkt"
scheme/runtime-path racket/runtime-path
scheme/system) racket/system)
(match-define (match-define
(list* command real-args) (list* command real-args)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "cache.rkt" (require "cache.rkt"
"dirstruct.rkt" "dirstruct.rkt"

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "status.rkt") (require "status.rkt")
(define (timing? bs) (define (timing? bs)

View File

@ -1,5 +1,5 @@
#lang scheme #lang racket
(require scheme/system (require racket/system
"dirstruct.rkt" "dirstruct.rkt"
"status.rkt" "status.rkt"
(except-in "diff.rkt" (except-in "diff.rkt"

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "path-utils.rkt") (require "path-utils.rkt")
(define number-of-cpus (define number-of-cpus

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(define (formats v u) (define (formats v u)
(if (equal? v -inf.0) (if (equal? v -inf.0)
"ε" "ε"

View File

@ -2,7 +2,7 @@
export PLTSTDERR="info" export PLTSTDERR="info"
PLTROOT="/opt/plt/plt" PLTROOT="/opt/plt/plt"
LOGS="/opt/plt/logs" LOGS="/opt/plt/logs"
MZ="$PLTROOT/bin/racket" R="$PLTROOT/bin/racket"
DRDR="/opt/svn/drdr" DRDR="/opt/svn/drdr"
cd "$DRDR" cd "$DRDR"

View File

@ -1,5 +1,5 @@
#lang scheme #lang racket
(require scheme/system (require racket/system
"config.rkt" "config.rkt"
"path-utils.rkt" "path-utils.rkt"
"dirstruct.rkt") "dirstruct.rkt")

View File

@ -1,4 +1,4 @@
#lang scheme/gui #lang racket/gui
(require xml) (require xml)
(require "constants.rkt") (require "constants.rkt")

View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide (all-defined-out)) (provide (all-defined-out))
(define total-width 800) (define total-width 800)
(define before-and-after-image-width 18) (define before-and-after-image-width 18)

View File

@ -1,4 +1,4 @@
#lang scheme/gui #lang racket/gui
(require 2htdp/image (require 2htdp/image
"constants.rkt") "constants.rkt")

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(define list/count (define list/count
(or/c exact-nonnegative-integer? (listof bytes?))) (or/c exact-nonnegative-integer? (listof bytes?)))

View File

@ -1,6 +1,6 @@
#lang scheme #lang racket
(require scheme/system (require racket/system
"dirstruct.rkt" "dirstruct.rkt"
"analyze.rkt" "analyze.rkt"
"monitor-scm.rkt" "monitor-scm.rkt"
@ -35,7 +35,7 @@
(lambda () (lambda ()
(system*/exit-code (system*/exit-code
(path->string (path->string
(build-path (plt-directory) "plt" "bin" "mzscheme")) (build-path (plt-directory) "plt" "bin" "racket"))
"-t" "-t"
(path->string (build-path (drdr-directory) "time.rkt")) (path->string (build-path (drdr-directory) "time.rkt"))
"--" "--"
@ -47,7 +47,7 @@
(lambda () (lambda ()
(system*/exit-code (system*/exit-code
(path->string (path->string
(build-path (plt-directory) "plt" "bin" "mzscheme")) (build-path (plt-directory) "plt" "bin" "racket"))
"-t" "-t"
(path->string (build-path (drdr-directory) "make-archive.rkt")) (path->string (build-path (drdr-directory) "make-archive.rkt"))
"--" "--"

View File

@ -1,5 +1,5 @@
#lang scheme #lang racket
(require scheme/system (require racket/system
"config.rkt" "config.rkt"
"archive.rkt" "archive.rkt"
"path-utils.rkt" "path-utils.rkt"

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "path-utils.rkt" (require "path-utils.rkt"
"dirstruct.rkt" "dirstruct.rkt"
"scm.rkt") "scm.rkt")

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "scm.rkt" (require "scm.rkt"
"retry.rkt") "retry.rkt")

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(define (notify! fmt . args) (define (notify! fmt . args)
(log-info (format "[~a] ~a" (current-seconds) (apply format fmt args)))) (log-info (format "[~a] ~a" (current-seconds) (apply format fmt args))))

View File

@ -1,5 +1,5 @@
#lang scheme #lang racket
(require scheme/file) (require racket/file)
(define current-temporary-directory (define current-temporary-directory
(make-parameter #f)) (make-parameter #f))

View File

@ -1,6 +1,6 @@
#lang scheme #lang racket
(require scheme/file (require racket/file
scheme/runtime-path racket/runtime-path
(planet jaymccarthy/job-queue) (planet jaymccarthy/job-queue)
"metadata.rkt" "metadata.rkt"
"run-collect.rkt" "run-collect.rkt"
@ -150,16 +150,12 @@
(rebase-path trunk-dir log-dir)) (rebase-path trunk-dir log-dir))
(define racket-path (define racket-path
(path->string (build-path trunk-dir "bin" "racket"))) (path->string (build-path trunk-dir "bin" "racket")))
; XXX fix (define raco-path
(define mzc-path (path->string (build-path trunk-dir "bin" "raco")))
(path->string (build-path trunk-dir "bin" "mzc")))
(define gracket-text-path (define gracket-text-path
(path->string (build-path trunk-dir "bin" "gracket-text"))) (path->string (build-path trunk-dir "bin" "gracket-text")))
(define gracket-path (define gracket-path
(path->string (build-path trunk-dir "bin" "gracket"))) (path->string (build-path trunk-dir "bin" "gracket")))
; XXX fix
(define planet-path
(path->string (build-path trunk-dir "bin" "planet")))
(define collects-pth (define collects-pth
(build-path trunk-dir "collects")) (build-path trunk-dir "collects"))
(define test-workers (make-job-queue (number-of-cpus))) (define test-workers (make-job-queue (number-of-cpus)))
@ -192,7 +188,7 @@
[(list-rest (or 'mzscheme 'racket) rst) [(list-rest (or 'mzscheme 'racket) rst)
(lambda () (list* racket-path rst))] (lambda () (list* racket-path rst))]
[(list-rest 'mzc rst) [(list-rest 'mzc rst)
(lambda () (list* mzc-path rst))] (lambda () (list* raco-path "make" rst))]
[(list-rest (or 'mred 'mred-text [(list-rest (or 'mred 'mred-text
'gracket 'gracket-text) 'gracket 'gracket-text)
rst) rst)
@ -235,8 +231,8 @@
#:timeout (current-make-install-timeout-seconds) #:timeout (current-make-install-timeout-seconds)
#:env (current-env) #:env (current-env)
(build-path log-dir "planet" auth pkg maj min) (build-path log-dir "planet" auth pkg maj min)
planet-path raco-path
(list "install" auth pkg maj min))])) (list "planet" "install" auth pkg maj min))]))
(run/collect/wait/log (run/collect/wait/log
#:timeout (current-subprocess-timeout-seconds) #:timeout (current-subprocess-timeout-seconds)
#:env (current-env) #:env (current-env)

View File

@ -1,6 +1,6 @@
#lang at-exp scheme #lang at-exp racket
(require scheme/date (require racket/date
scheme/runtime-path racket/runtime-path
xml xml
"config.rkt" "config.rkt"
"diff.rkt" "diff.rkt"

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "list-count.rkt") (require "list-count.rkt")
(define-struct rendering (start end duration timeout? unclean-exit? stderr? responsible changed?) #:prefab) (define-struct rendering (start end duration timeout? unclean-exit? stderr? responsible changed?) #:prefab)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "replay.rkt" (require "replay.rkt"
"cache.rkt" "cache.rkt"
"status.rkt") "status.rkt")

View File

@ -1,5 +1,5 @@
#lang scheme #lang racket
(require (prefix-in scheme: scheme) (require (prefix-in racket: racket)
"formats.rkt" "formats.rkt"
"status.rkt") "status.rkt")
@ -22,7 +22,7 @@
(define (replay-exit-code s) (define (replay-exit-code s)
(when (exit? s) (when (exit? s)
(scheme:exit (exit-code s)))) (racket:exit (exit-code s))))
(provide/contract (provide/contract
[replay-exit-code (status? . -> . void)] [replay-exit-code (status? . -> . void)]

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "notify.rkt") (require "notify.rkt")
(define-syntax-rule (retry-until-success msg expr ...) (define-syntax-rule (retry-until-success msg expr ...)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "status.rkt") (require "status.rkt")
(define (rewrite-status #:rewrite rewrite-string s) (define (rewrite-status #:rewrite rewrite-string s)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "status.rkt" (require "status.rkt"
"notify.rkt" "notify.rkt"
"rewriting.rkt" "rewriting.rkt"

View File

@ -1,9 +1,9 @@
#lang scheme #lang racket
(require "svn.rkt" (require "svn.rkt"
"path-utils.rkt" "path-utils.rkt"
"dirstruct.rkt" "dirstruct.rkt"
net/url net/url
scheme/system) racket/system)
(provide (provide
(all-from-out "svn.rkt")) (all-from-out "svn.rkt"))

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(define (semaphore-wait* sema how-many) (define (semaphore-wait* sema how-many)
(unless (zero? how-many) (unless (zero? how-many)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(printf "Setting the default browser to something safe...\n") (printf "Setting the default browser to something safe...\n")

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(define-struct event () #:prefab) (define-struct event () #:prefab)
(define-struct (stdout event) (bytes) #:prefab) (define-struct (stdout event) (bytes) #:prefab)
(define-struct (stderr event) (bytes) #:prefab) (define-struct (stderr event) (bytes) #:prefab)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(define-struct svn-rev () #:prefab) (define-struct svn-rev () #:prefab)
(define-struct (svn-rev-nolog svn-rev) () #:prefab) (define-struct (svn-rev-nolog svn-rev) () #:prefab)

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require "config.rkt" (require "config.rkt"
"dirstruct.rkt" "dirstruct.rkt"
"cache.rkt" "cache.rkt"

View File

@ -1,6 +1,6 @@
#lang scheme #lang racket
(require (planet jaymccarthy/job-queue) (require (planet jaymccarthy/job-queue)
scheme/system racket/system
(prefix-in graph-one: "graph.rkt") (prefix-in graph-one: "graph.rkt")
"config.rkt" "config.rkt"
"notify.rkt" "notify.rkt"
@ -39,7 +39,7 @@
(apply (apply
system*/exit-code system*/exit-code
(path->string (path->string
(build-path (plt-directory) "plt" "bin" "mzscheme")) (build-path (plt-directory) "plt" "bin" "racket"))
"-t" "-t"
(path->string (build-path (drdr-directory) "time-file.rkt")) (path->string (build-path (drdr-directory) "time-file.rkt"))
"--" "--"

View File

@ -1,4 +1,4 @@
#lang scheme #lang racket
(require (planet jaymccarthy/dbm) (require (planet jaymccarthy/dbm)
"wrap-dict.rkt") "wrap-dict.rkt")