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

Merge remote branch 'origin/master' into samth/new-logic2

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-12 10:59:29 -04:00
commit ec942b6dab
26 changed files with 642 additions and 543 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored Normal file
View File

@ -0,0 +1,2 @@
.git* export-ignore
/.mailmap export-ignore

3
collects/redex/gui.rkt
View File

@ -35,6 +35,7 @@
(any/c term-node? . -> . any))
#:pp pp-contract
#:colors (listof (list/c string? string?))
#:racket-colors? boolean?
#:scheme-colors? boolean?
#:layout (-> any/c any/c)
#:edge-label-font (or/c #f (is-a?/c font%))
@ -51,6 +52,8 @@
(any/c term-node? . -> . any))
#:pp pp-contract
#:colors (listof any/c)
#:racket-colors? boolean?
#:scheme-colors? boolean?
#:layout (-> any/c any/c)
#:edge-label-font (or/c #f (is-a?/c font%))
#:edge-labels? boolean?

22
collects/redex/private/traces.rkt
View File

@ -131,7 +131,8 @@
#:multiple? [multiple? #f]
#:pred [pred (λ (x) #t)]
#:pp [pp default-pretty-printer]
#:scheme-colors? [scheme-colors? #t]
#:racket-colors? [racket-colors? #t]
#:scheme-colors? [scheme-colors? racket-colors?]
#:colors [colors '()]
#:layout [layout void]
#:edge-label-font [edge-label-font #f]
@ -147,6 +148,7 @@
#:multiple? multiple?
#:pred pred
#:pp pp
#:racket-colors? racket-colors?
#:scheme-colors? scheme-colors?
#:colors colors
#:layout layout
@ -241,7 +243,8 @@
#:pred [pred (λ (x) #t)]
#:pp [pp default-pretty-printer]
#:colors [colors '()]
#:scheme-colors? [scheme-colors? #t]
#:racket-colors? [racket-colors? #t]
#:scheme-colors? [scheme-colors? racket-colors?]
#:layout [layout void]
#:edge-label-font [edge-label-font #f]
#:edge-labels? [edge-labels? #t]
@ -353,7 +356,8 @@
(define default-colors (list (dark-pen-color) (light-pen-color)
(dark-text-color) (light-text-color)
(dark-brush-color) (light-brush-color)))
(define code-colors? (and racket-colors? scheme-colors?))
;; only changed on the reduction thread
;; frontier : (listof (is-a?/c graph-editor-snip%))
@ -361,7 +365,7 @@
(filter
(λ (x) x)
(map (lambda (expr) (apply build-snip
snip-cache #f expr pred pp #f scheme-colors?
snip-cache #f expr pred pp #f code-colors?
(get-user-char-width user-char-width expr)
default-colors))
exprs)))
@ -432,7 +436,7 @@
dark-pen-color
light-pen-color)
(red->colors name)])
(build-snip snip-cache snip sexp pred pp name scheme-colors?
(build-snip snip-cache snip sexp pred pp name code-colors?
(get-user-char-width user-char-width sexp)
light-arrow-color dark-arrow-color dark-label-color light-label-color
dark-pen-color light-pen-color)))))))
@ -788,7 +792,7 @@
;; returns #f if a snip corresponding to the expr has already been created.
;; also adds in the links to the parent snip
;; =eventspace main thread=
(define (build-snip cache parent-snip expr pred pp name scheme-colors? cw
(define (build-snip cache parent-snip expr pred pp name code-colors? cw
light-arrow-color dark-arrow-color dark-label-color light-label-color
dark-brush-color light-brush-color)
(let-values ([(snip new?)
@ -797,7 +801,7 @@
cache
expr
(lambda ()
(let ([new-snip (make-snip parent-snip expr pred pp scheme-colors? cw)])
(let ([new-snip (make-snip parent-snip expr pred pp code-colors? cw)])
(hash-set! cache expr new-snip)
(k new-snip #t))))
#f))])
@ -844,7 +848,7 @@
;; -> (is-a?/c graph-editor-snip%)
;; unconditionally creates a new graph-editor-snip
;; =eventspace main thread=
(define (make-snip parent-snip expr pred pp scheme-colors? cw)
(define (make-snip parent-snip expr pred pp code-colors? cw)
(let* ([text (new program-text%)]
[es (instantiate graph-editor-snip% ()
(char-width cw)
@ -855,7 +859,7 @@
(send text set-autowrap-bitmap #f)
(send text set-max-width 'none)
(send text freeze-colorer)
(unless scheme-colors?
(unless code-colors?
(send text stop-colorer #t))
(send es format-expr)
es))

883
collects/redex/redex.scrbl
View File

File diff suppressed because it is too large Load Diff

1
collects/repo-time-stamp/.gitattributes vendored Normal file
View File

@ -0,0 +1 @@
/stamp.rkt ident export-subst

39
collects/repo-time-stamp/stamp.rkt
View File

@ -1 +1,38 @@
#lang scheme/base (provide stamp) (define stamp "17apr2010")
#lang racket/base
(provide stamp)
(define archive-id "$Format:%ct|%h|a$")
;; when exported through `git archive', the above becomes something like
;; "1273562690|cabd414|a"
(require racket/system racket/runtime-path)
(define-runtime-path this "stamp.rkt")
(define stamp
(let ([rx:secs+id #rx"^([0-9]+)\\|([0-9a-f]+)\\|(.*?)[ \r\n]*$"])
(for*/or ([x (list
;; info from an archive (incl. nightly builds)
(lambda () archive-id)
;; try to run git to get the current info
(lambda ()
(let ([exe (or (find-executable-path "git")
(find-executable-path "git.exe"))])
(and exe
(let ([out (open-output-string)])
(parameterize ([current-output-port out])
(system* exe "log" "-1"
"--pretty=format:%ct|%h|g")
(get-output-string out))))))
;; fallback: get the date of this file, no id
(lambda ()
(format "~a|0|f"
(file-or-directory-modify-seconds this))))])
(let* ([x (x)]
[m (and (string? x) (regexp-match rx:secs+id x))]
[d (and m (seconds->date (string->number (cadr m))))])
(define (pad02 f) (let ([n (f d)]) (if (< n 10) (format "0~a" n) n)))
(and d (apply format "~a-~a-~a(~a/~a)"
(date-year d) (pad02 date-month) (pad02 date-day)
(cddr m)))))))

5
collects/tests/racket/benchmarks/common/dynamic2.sch
View File

@ -7,6 +7,7 @@
; 970215 / wdc Removed most i/o and added dynamic-benchmark.
; 990707 / lth Added a quote and changed the call to run-benchmark.
; 010404 / wdc Changed the input file path name to "dynamic-input.sch".
; 100404 / Vincent St-Amour Got rid of one-armed ifs
;; Fritz's dynamic type inferencer, set up to run on itself
;; (see the end of this file).
@ -1034,7 +1035,9 @@
(let ((tv-def (tvar-def tv-rep)))
(asymm-link! tv-rep dynamic)
(if (not (null? tv-def))
(map equiv-with-dynamic! (type-args tv-def))))))
(map equiv-with-dynamic! (type-args tv-def))
#f))
#f))
'())
;----------------------------------------------------------------------------
; Polymorphic type management

50
collects/tests/racket/benchmarks/common/earley.sch
View File

@ -2,6 +2,7 @@
; $Id: earley.sch,v 1.2 1999/07/12 18:05:19 lth Exp $
; 990708 / lth -- changed 'main' to 'earley-benchmark'.
; 100404 / Vincent St-Amour -- got rid of one-armed ifs
;
; (make-parser grammar lexer) is used to create a parser from the grammar
; description `grammar' and the lexer function `lexer'.
@ -199,7 +200,8 @@
(vector-set! steps i (- i nb-nts))
(vector-set! names i (list (vector-ref nts i) 0))
(vector-set! enders i (list i))
(nt-loop (- i 1)))))
(nt-loop (- i 1)))
#f))
(let def-loop ((defs grammar) (conf (vector-length nts)))
(if (pair? defs)
@ -220,7 +222,8 @@
(vector-set! steps conf (- (ind head nts) nb-nts))
(add-conf conf head nts enders)
(rule-loop (cdr rules) (+ conf 1) (+ rule-num 1))))))
(def-loop (cdr defs) conf))))))))
(def-loop (cdr defs) conf))))
#f))))
; Now, for each non-terminal, compute the starters, enders and predictors and
; the names and steps tables.
@ -309,7 +312,8 @@
(if (< tail 0)
(begin
(vector-set! conf-set 0 (vector-ref state 0))
(vector-set! state 0 conf)))))
(vector-set! state 0 conf))
#f)))
(define (conf-set-adjoin* states state-num l i)
(let ((state (vector-ref states state-num)))
@ -321,7 +325,8 @@
(begin
(conf-set-adjoin state conf-set conf i)
(loop (cdr l1)))
(loop (cdr l1))))))))
(loop (cdr l1))))
#f))))
(define (conf-set-adjoin** states states* state-num conf i)
(let ((state (vector-ref states state-num)))
@ -329,7 +334,8 @@
(let* ((state* (vector-ref states* state-num))
(conf-set* (conf-set-get* state* state-num conf)))
(if (not (conf-set-next conf-set* i))
(conf-set-adjoin state* conf-set* conf i))
(conf-set-adjoin state* conf-set* conf i)
#f)
#t)
#f)))
@ -340,7 +346,8 @@
(begin
(conf-set-adjoin state conf-set conf i)
(loop (conf-set-next other-set i)))
(loop (conf-set-next other-set i))))))
(loop (conf-set-next other-set i)))
#f)))
(define (forw states state-num starters enders predictors steps nts)
@ -357,7 +364,8 @@
(begin
(conf-set-adjoin state starter-set starter state-num)
(loop1 (cdr l)))
(loop1 (cdr l))))))
(loop1 (cdr l))))
#f))
; check for possible completion of the non-terminal `nt' to the
; right of the dot
@ -370,7 +378,8 @@
(next-set (conf-set-get* state state-num next)))
(conf-set-union state next-set next conf-set)
(loop2 (cdr l)))
(loop2 (cdr l)))))))
(loop2 (cdr l))))
#f)))
(define (reduce states state state-num conf-set head preds)
@ -386,9 +395,11 @@
(if pred-set
(let* ((next (+ pred 1))
(next-set (conf-set-get* state state-num next)))
(conf-set-union state next-set next pred-set)))
(conf-set-union state next-set next pred-set))
#f)
(loop2 (conf-set-next conf-set i)))
(loop1 (cdr l))))))))
(loop1 (cdr l)))))
#f)))
(let ((state (vector-ref states state-num))
(nb-nts (vector-length nts)))
@ -404,7 +415,8 @@
(predict state state-num conf-set conf step starters enders)
(let ((preds (vector-ref predictors (+ step nb-nts))))
(reduce states state state-num conf-set head preds)))
(loop)))))))
(loop))
#f)))))
(define (forward starters enders predictors steps nts toks)
(let* ((nb-toks (vector-length toks))
@ -418,7 +430,8 @@
(let ((tok-nts (cdr (vector-ref toks i))))
(conf-set-adjoin* states (+ i 1) tok-nts i) ; scan token
(forw states (+ i 1) starters enders predictors steps nts)
(loop (+ i 1)))))
(loop (+ i 1)))
#f))
states))
(define (produce conf i j enders steps toks states states* nb-nts)
@ -438,7 +451,9 @@
(conf-set-adjoin** states states* j ender k))
(loop2 (conf-set-next ender-set k)))
(loop1 (cdr l))))
(loop1 (cdr l)))))))))
(loop1 (cdr l))))
#f))
#f)))
(define (back states states* state-num enders steps nb-nts toks)
(let ((state* (vector-ref states* state-num)))
@ -455,7 +470,8 @@
(produce conf i state-num enders steps
toks states states* nb-nts)
(loop2 (conf-set-next conf-set i)))
(loop1)))))))))
(loop1))))
#f)))))
(define (backward states enders steps nts toks)
(let* ((nb-toks (vector-length toks))
@ -467,12 +483,14 @@
(if (pair? l)
(let ((conf (car l)))
(conf-set-adjoin** states states* nb-toks conf 0)
(loop1 (cdr l)))))
(loop1 (cdr l)))
#f))
(let loop2 ((i nb-toks))
(if (>= i 0)
(begin
(back states states* i enders steps nb-nts toks)
(loop2 (- i 1)))))
(loop2 (- i 1)))
#f))
states*))
(define (parsed? nt i j nts enders states)

4
collects/tests/racket/benchmarks/common/fft.sch
View File

@ -5,6 +5,7 @@
; Created: 8-Apr-85
; Modified: 6-May-85 09:29:22 (Bob Shaw)
; 11-Aug-87 (Will Clinger)
; 4-May-10 (Vincent St-Amour)
; Language: Scheme
; Status: Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -51,7 +52,8 @@
(if (< i n)
(begin (set! m (+ m 1))
(set! i (+ i i))
(loop))))
(loop))
#t))
(cond ((not (= n (expt 2 m)))
(error "array size not a power of two.")))
;; interchange elements in bit-reversed order

10
collects/tests/racket/benchmarks/common/graphs.sch
View File

@ -2,6 +2,7 @@
; and to expand the four macros below.
; Modified 11 June 1997 by Will Clinger to eliminate assertions
; and to replace a use of "recur" with a named let.
; Modified 4 May 2010 by Vincent St-Amour to get rid of one-armed ifs
;
; Performance note: (graphs-benchmark 7) allocates
; 34509143 pairs
@ -70,8 +71,9 @@
(let ((x (make-vector size (f 0))))
(let loop ((i 1))
(if (< i size) (begin ; [wdc - was when]
(vector-set! x i (f i))
(loop (+ i 1)))))
(vector-set! x i (f i))
(loop (+ i 1)))
#t))
x))))
(define vector-fold
@ -616,7 +618,9 @@
(lambda (t)
(if (vector-ref from-m t)
(begin ; [wdc - was when]
(vector-set! from-f t #t)))))))))))))
(vector-set! from-f t #t))
#t))))
#t)))))))
res)))

42
collects/tests/racket/benchmarks/common/maze2.sch
View File

@ -12,6 +12,7 @@
; By Ozan Yigit
;;; Rehacked by Olin 4/1995.
;;; One-armed ifs removed by Vincent St-Amour 5/5/2010
(define (random-state n)
(vector n))
@ -125,7 +126,8 @@
(let ((next (vector-ref x 1)))
(cond ((not (eq? r next))
(vector-set! x 1 r)
(lp next))))))
(lp next)))))
#t)
r))))) ; Then return r.
(define (set-equal? s1 s2) (eq? (get-set-root s1) (get-set-root s2)))
@ -238,7 +240,8 @@
(wall-mask (bitwise-not (wall:bit wall))))
(union! set1 set2)
(set-cell:walls c1 (bitwise-and walls wall-mask))
(if (= (set-size set1) ncells) (quit #f))))))
(if (= (set-size set1) ncells) (quit #f) #t))
#t)))
walls))))
@ -255,7 +258,8 @@
(set-cell:parent node parent)
(do-children (lambda (child)
(if (not (eq? child parent))
(search child node)))
(search child node)
#t))
maze node)))
;;; Move the root to NEW-ROOT.
@ -264,7 +268,7 @@
(let lp ((node new-root) (new-parent #f))
(let ((old-parent (cell:parent node)))
(set-cell:parent node new-parent)
(if old-parent (lp old-parent node)))))
(if old-parent (lp old-parent node) #t))))
;;; How far from CELL to the root?
@ -436,10 +440,12 @@
((<= y 1)) ; Don't do bottom row.
(let ((hex (href harr x y)))
(if (not (zero? x))
(add-wall hex (href harr (- x 3) (- y 1)) south-west))
(add-wall hex (href harr (- x 3) (- y 1)) south-west)
#t)
(add-wall hex (href harr x (- y 2)) south)
(if (< x xmax)
(add-wall hex (href harr (+ x 3) (- y 1)) south-east)))))
(add-wall hex (href harr (+ x 3) (- y 1)) south-east)
#t))))
;; Do the SE and SW walls of the odd columns on the bottom row.
;; If the rightmost bottom hex lies in an odd column, however,
@ -449,14 +455,16 @@
;; Do rightmost odd col.
(let ((rmoc-hex (href harr rmoc-x 1)))
(if (< rmoc-x xmax) ; Not a corner -- do E wall.
(add-wall rmoc-hex (href harr xmax 0) south-east))
(add-wall rmoc-hex (href harr xmax 0) south-east)
#t)
(add-wall rmoc-hex (href harr (- rmoc-x 3) 0) south-west))
(do ((x (- rmoc-x 6) ; Do the rest of the bottom row's odd cols.
(- x 6)))
((< x 3)) ; 3 is X coord of leftmost odd column.
(add-wall (href harr x 1) (href harr (- x 3) 0) south-west)
(add-wall (href harr x 1) (href harr (+ x 3) 0) south-east))))
(add-wall (href harr x 1) (href harr (+ x 3) 0) south-east)))
#t)
(list->vector walls)))
@ -504,28 +512,31 @@
(nc (harr:ncols harr))
(maxy (* 2 (- nr 1)))
(maxx (* 3 (- nc 1))))
(if (not (bit-test walls south-west)) (proc (href harr (- x 3) (- y 1))))
(if (not (bit-test walls south)) (proc (href harr x (- y 2))))
(if (not (bit-test walls south-east)) (proc (href harr (+ x 3) (- y 1))))
(if (not (bit-test walls south-west)) (proc (href harr (- x 3) (- y 1))) #t)
(if (not (bit-test walls south)) (proc (href harr x (- y 2))) #t)
(if (not (bit-test walls south-east)) (proc (href harr (+ x 3) (- y 1))) #t)
;; NW neighbor, if there is one (we may be in col 1, or top row/odd col)
(if (and (> x 0) ; Not in first column.
(or (<= y maxy) ; Not on top row or
(zero? (modulo x 6)))) ; not in an odd column.
(let ((nw (href harr (- x 3) (+ y 1))))
(if (not (bit-test (cell:walls nw) south-east)) (proc nw))))
(if (not (bit-test (cell:walls nw) south-east)) (proc nw) #t))
#t)
;; N neighbor, if there is one (we may be on top row).
(if (< y maxy) ; Not on top row
(let ((n (href harr x (+ y 2))))
(if (not (bit-test (cell:walls n) south)) (proc n))))
(if (not (bit-test (cell:walls n) south)) (proc n) #t))
#t)
;; NE neighbor, if there is one (we may be in last col, or top row/odd col)
(if (and (< x maxx) ; Not in last column.
(or (<= y maxy) ; Not on top row or
(zero? (modulo x 6)))) ; not in an odd column.
(let ((ne (href harr (+ x 3) (+ y 1))))
(if (not (bit-test (cell:walls ne) south-west)) (proc ne))))))
(if (not (bit-test (cell:walls ne) south-west)) (proc ne) #t))
#t)))
@ -612,7 +623,8 @@
(write-ch (dot/space harr (- nrows 1) (+ c 1)))
(write-ch #\\))
(if (odd? ncols)
(write-ch (if (= entrance (- ncols 1)) #\space #\_)))
(write-ch (if (= entrance (- ncols 1)) #\space #\_))
#t)
; (newline)
(write-ch #\newline)

3
collects/tests/racket/benchmarks/common/nqueens.sch
View File

@ -1,5 +1,6 @@
;;; NQUEENS -- Compute number of solutions to 8-queens problem.
;; 2006/08 -- renamed `try' to `try-it' to avoid Bigloo collision (mflatt)
;; 2010/04 -- got rid of the one-armed id (stamourv)
(define trace? #f)
@ -12,7 +13,7 @@
(define (try-it x y z)
(if (null? x)
(if (null? y)
(begin (if trace? (begin (write z) (newline))) 1)
(begin (if trace? (begin (write z) (newline)) #t) 1)
0)
(+ (if (ok? (car x) 1 z)
(try-it (append (cdr x) y) '() (cons (car x) z))

18
collects/tests/racket/benchmarks/common/scheme2.sch
View File

@ -85,9 +85,11 @@
(define (variable x)
(if (not (symbol? x))
(scheme-error "Identifier expected" x))
(scheme-error "Identifier expected" x)
#t)
(if (memq x scheme-syntactic-keywords)
(scheme-error "Variable name can not be a syntactic keyword" x)))
(scheme-error "Variable name can not be a syntactic keyword" x)
#t))
(define (shape form n)
(let loop ((form form) (n n) (l form))
@ -137,7 +139,8 @@
(comp-quasiquotation-list form (- level 1) env)))
((eq? (car form) 'unquote-splicing)
(if (= level 1)
(scheme-error "Ill-placed 'unquote-splicing'" form))
(scheme-error "Ill-placed 'unquote-splicing'" form)
#t)
(comp-quasiquotation-list form (- level 1) env))
(else
(comp-quasiquotation-list form level env))))
@ -268,7 +271,8 @@
(let ((pattern (cadr expr)))
(let ((name (if (pair? pattern) (car pattern) pattern)))
(if (not (symbol? name))
(scheme-error "Identifier expected" name))
(scheme-error "Identifier expected" name)
#t)
name)))
(define (definition-value expr)
@ -672,7 +676,8 @@
(vector-set! x 3 c)
(let loop ((n nb-vars) (x x) (i 4) (l d))
(if (<= i n)
(begin (vector-set! x i (car l)) (loop n x (+ i 1) (cdr l)))))
(begin (vector-set! x i (car l)) (loop n x (+ i 1) (cdr l)))
#t))
(body x)))))
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -769,7 +774,8 @@
(vector-set! x 0 rte)
(let loop ((x x) (i 1) (l vals))
(if (pair? l)
(begin (vector-set! x i ((car l) x)) (loop x (+ i 1) (cdr l)))))
(begin (vector-set! x i ((car l) x)) (loop x (+ i 1) (cdr l)))
#t))
(body x))))
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

3
collects/tests/racket/benchmarks/common/triangle.sch
View File

@ -29,7 +29,8 @@
(cond ((= depth 14)
(let ((lp (last-position)))
(if (not (member lp *final*))
(set! *final* (cons lp *final*))))
(set! *final* (cons lp *final*))
#t))
(set! *answer*
(cons (cdr (vector->list *sequence*)) *answer*))
#t)

6
collects/tests/racket/benchmarks/common/wrap.rkt
View File

@ -1,8 +1,8 @@
(module wrap mzscheme
(provide (rename module-begin #%module-begin))
(module wrap racket
(provide (rename-out (module-begin #%module-begin)))
(require (lib "include.ss"))
(define-syntax (module-begin stx)
(let ([name (syntax-property stx 'enclosing-module-name)])
#`(#%plain-module-begin
#`(#%module-begin
(include #,(format "~a.sch" name))))))

26
src/.gitattributes vendored
View File

@ -7,20 +7,20 @@
*.manifest -crlf
*.rc -crlf
*.bat -crlf
worksp/README -crlf
racket/gc/BCC_MAKEFILE -crlf
racket/gc/digimars.mak -crlf
worksp/README -crlf
worksp/extradlls/README.TXT -crlf
worksp/gracket/gracket.manifest -crlf
worksp/mzcom/mzcom.def -crlf
worksp/mzcom/mzcom.rgs -crlf
worksp/mzcom/mzcomps.def -crlf
worksp/mzcom/mzobj.rgs -crlf
/worksp/README -crlf
/racket/gc/BCC_MAKEFILE -crlf
/racket/gc/digimars.mak -crlf
/worksp/README -crlf
/worksp/extradlls/README.TXT -crlf
/worksp/gracket/gracket.manifest -crlf
/worksp/mzcom/mzcom.def -crlf
/worksp/mzcom/mzcom.rgs -crlf
/worksp/mzcom/mzcomps.def -crlf
/worksp/mzcom/mzobj.rgs -crlf
# These files seem to be generated. Maybe they shouldn't be
# in the repository; in any case, they are generated with
# CRLF, so let's keep them that way.
worksp/mzcom/mzcom.h -crlf
worksp/racket/resource.h -crlf
worksp/starters/resource.h -crlf
/worksp/mzcom/mzcom.h -crlf
/worksp/racket/resource.h -crlf
/worksp/starters/resource.h -crlf

15
src/racket/gc2/Makefile.in
View File

@ -137,7 +137,7 @@ xobjects: $(OBJS) main.@LTO@
XFORMDEP = $(srcdir)/gc2.h $(srcdir)/gc2_obj.h $(srcdir)/xform.rkt $(srcdir)/xform-mod.rkt \
$(srcdir)/precomp.c $(srcdir)/../src/schpriv.h $(srcdir)/../include/scheme.h \
$(srcdir)/../sconfig.h $(srcdir)/../uconfig.h $(srcdir)/../src/schemef.h \
$(srcdir)/../sconfig.h ../mzconfig.h $(srcdir)/../uconfig.h $(srcdir)/../src/schemef.h \
$(srcdir)/../src/stypes.h $(srcdir)/../include/schthread.h $(srcdir)/../src/mzrt.h
LIGHTNINGDEP = $(srcdir)/../src/lightning/i386/core.h $(srcdir)/../src/lightning/i386/core-common.h \
@ -333,12 +333,13 @@ gc2.@LTO@: \
$(srcdir)/immobile_boxes.c \
$(srcdir)/../include/scheme.h \
$(srcdir)/../include/schthread.h \
$(srcdir)/../include/../sconfig.h \
$(srcdir)/../include/../uconfig.h \
$(srcdir)/../include/../src/stypes.h \
$(srcdir)/../include/../src/schexn.h \
$(srcdir)/../include/../gc2/gc2.h \
$(srcdir)/../include/../src/schemef.h \
$(srcdir)/../sconfig.h \
../mzconfig.h \
$(srcdir)/../uconfig.h \
$(srcdir)/../src/stypes.h \
$(srcdir)/../src/schexn.h \
$(srcdir)/../gc2/gc2.h \
$(srcdir)/../src/schemef.h \
$(builddir)/../mzconfig.h \
$(srcdir)/../src/mzrt.h \
$(srcdir)/../src/schpriv.h \

5
src/racket/mzconfig.h.in
View File

@ -4,7 +4,6 @@
#ifndef __MZSCHEME_CONFIGURATION_INFO__
#define __MZSCHEME_CONFIGURATION_INFO__
/* The size of a `char', as computed by sizeof. */
#undef SIZEOF_CHAR
@ -38,9 +37,11 @@
/* Whether pthread_rwlock is availabale: */
#undef HAVE_PTHREAD_RWLOCK
/* Enable futures and/or places: */
/* Enable futures and/or places (but not with sgc): */
#if !defined(USE_SENORA_GC) || defined(NEWGC_BTC_ACCOUNT)
#undef MZ_USE_FUTURES
#undef MZ_USE_PLACES
#endif
/* Configure use of pthreads for the user-thread timer: */
#undef USE_PTHREAD_INSTEAD_OF_ITIMER

6
src/racket/sconfig.h
View File

@ -1,6 +1,5 @@
/*
Configuration for compiling MzScheme
Configuration for compiling Racket
If you want to set all the flags externally (on the command line
with -D or some other compiler-dependent way), then define
@ -9,12 +8,11 @@
The best flag settings are already provided for some auto-detected
architecture/system/compilers. Otherwise, the default settings
are generic Unix. Send other architecture/system/compiler-specific
info to "plt-bugs@cs.rice.edu".
info to "racket@racket-lang.org".
*/
#ifndef FLAGS_ALREADY_SET
/******** (BEGIN KNOWN ARCHITECTURE/SYSTEM CONFIGURATIONS) ********/
/* First, use configure-generated information */

2
src/racket/src/Makefile.in
View File

@ -236,7 +236,7 @@ vector.@LTO@: $(srcdir)/vector.c
gmp_alpha_gcc.@LTO@: $(srcdir)/gmp/gmp_alpha_gcc.s
$(AS) -o gmp_alpha_gcc.@LTO@ $(srcdir)/gmp/gmp_alpha_gcc.s
SCONFIG = $(srcdir)/../sconfig.h $(srcdir)/../uconfig.h
SCONFIG = $(srcdir)/../sconfig.h $(srcdir)/../uconfig.h ../mzconfig.h
# More dependencies

2
src/worksp/gracket/gracket.manifest
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="4.2.5.15"
version="4.2.5.16"
processorArchitecture="X86"
name="Org.PLT-Scheme.GRacket"
type="win32"

8
src/worksp/gracket/gracket.rc
View File

@ -20,8 +20,8 @@ APPLICATION ICON DISCARDABLE "gracket.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,15
PRODUCTVERSION 4,2,5,15
FILEVERSION 4,2,5,16
PRODUCTVERSION 4,2,5,16
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -39,11 +39,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "Racket GUI application\0"
VALUE "InternalName", "GRacket\0"
VALUE "FileVersion", "4, 2, 5, 15\0"
VALUE "FileVersion", "4, 2, 5, 16\0"
VALUE "LegalCopyright", "Copyright © 1995-2010\0"
VALUE "OriginalFilename", "GRacket.exe\0"
VALUE "ProductName", "Racket\0"
VALUE "ProductVersion", "4, 2, 5, 15\0"
VALUE "ProductVersion", "4, 2, 5, 16\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/mzcom/mzcom.rc
View File

@ -53,8 +53,8 @@ END
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,15
PRODUCTVERSION 4,2,5,15
FILEVERSION 4,2,5,16
PRODUCTVERSION 4,2,5,16
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -70,12 +70,12 @@ BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "MzCOM Module"
VALUE "FileVersion", "4, 2, 5, 15"
VALUE "FileVersion", "4, 2, 5, 16"
VALUE "InternalName", "MzCOM"
VALUE "LegalCopyright", "Copyright 2000-2010 PLT (Paul Steckler)"
VALUE "OriginalFilename", "MzCOM.EXE"
VALUE "ProductName", "MzCOM Module"
VALUE "ProductVersion", "4, 2, 5, 15"
VALUE "ProductVersion", "4, 2, 5, 16"
END
END
BLOCK "VarFileInfo"

6
src/worksp/mzcom/mzobj.rgs
View File

@ -1,19 +1,19 @@
HKCR
{
MzCOM.MzObj.4.2.5.15 = s 'MzObj Class'
MzCOM.MzObj.4.2.5.16 = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
}
MzCOM.MzObj = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
CurVer = s 'MzCOM.MzObj.4.2.5.15'
CurVer = s 'MzCOM.MzObj.4.2.5.16'
}
NoRemove CLSID
{
ForceRemove {A3B0AF9E-2AB0-11D4-B6D2-0060089002FE} = s 'MzObj Class'
{
ProgID = s 'MzCOM.MzObj.4.2.5.15'
ProgID = s 'MzCOM.MzObj.4.2.5.16'
VersionIndependentProgID = s 'MzCOM.MzObj'
ForceRemove 'Programmable'
LocalServer32 = s '%MODULE%'

8
src/worksp/racket/racket.rc
View File

@ -29,8 +29,8 @@ APPLICATION ICON DISCARDABLE "racket.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,15
PRODUCTVERSION 4,2,5,15
FILEVERSION 4,2,5,16
PRODUCTVERSION 4,2,5,16
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -48,11 +48,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "Racket application\0"
VALUE "InternalName", "Racket\0"
VALUE "FileVersion", "4, 2, 5, 15\0"
VALUE "FileVersion", "4, 2, 5, 16\0"
VALUE "LegalCopyright", "Copyright <20>© 1995-2010\0"
VALUE "OriginalFilename", "racket.exe\0"
VALUE "ProductName", "Racket\0"
VALUE "ProductVersion", "4, 2, 5, 15\0"
VALUE "ProductVersion", "4, 2, 5, 16\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/starters/start.rc
View File

@ -22,8 +22,8 @@ APPLICATION ICON DISCARDABLE "mzstart.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,15
PRODUCTVERSION 4,2,5,15
FILEVERSION 4,2,5,16
PRODUCTVERSION 4,2,5,16
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -45,7 +45,7 @@ BEGIN
#ifdef MZSTART
VALUE "FileDescription", "Racket Launcher\0"
#endif
VALUE "FileVersion", "4, 2, 5, 15\0"
VALUE "FileVersion", "4, 2, 5, 16\0"
#ifdef MRSTART
VALUE "InternalName", "mrstart\0"
#endif
@ -60,7 +60,7 @@ BEGIN
VALUE "OriginalFilename", "MzStart.exe\0"
#endif
VALUE "ProductName", "Racket\0"
VALUE "ProductVersion", "4, 2, 5, 15\0"
VALUE "ProductVersion", "4, 2, 5, 16\0"
END
END
BLOCK "VarFileInfo"