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

Correction for setup-plt error

Browse Source 
svn: r11791
This commit is contained in:
Kathy Gray 2008-09-17 14:54:11 +00:00
parent 064eb9a147
commit a454479345
3 changed files with 51 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/profj/compile.ss
View File

@ -93,12 +93,12 @@
(let ((names (compilation-unit-contains dependents)) (let ((names (compilation-unit-contains dependents))
(syntaxes (compilation-unit-code dependents)) (syntaxes (compilation-unit-code dependents))
(locations (compilation-unit-locations dependents))) (locations (compilation-unit-locations dependents)))
;(print-struct #t) (print-struct #t)
;(printf "names ~a~n" names) #;(printf "names ~a~n" names)
;(printf "depends ~a~n~n" (compilation-unit-depends dependents)) #;(printf "depends ~a~n~n" (compilation-unit-depends dependents))
(unless (= (length names) (length syntaxes)) (unless (= (length names) (length syntaxes))
;(printf "Writing a composite file out~n") #;(printf "Writing a composite file out~n")
;(printf "~a~n~n" (syntax-object->datum (car syntaxes))) #;(printf "~a~n~n" (syntax->datum (car syntaxes)))
(call-with-output-zo-file* location (call-with-output-zo-file* location
(build-path (send type-recs get-compilation-location) (build-path (send type-recs get-compilation-location)
(file-name-from-path (file-name-from-path
@ -108,7 +108,8 @@
(unless (= (length names) (length syntaxes) (length locations)) (unless (= (length names) (length syntaxes) (length locations))
(error 'compile-to-file "Internal error: compilation unit not represented as expected")) (error 'compile-to-file "Internal error: compilation unit not represented as expected"))
(for-each (lambda (name code location) (for-each (lambda (name code location)
;(printf "~a~n~n" (syntax-object->datum code)) #;(printf "writing out ~a~n" name)
#;(printf "~a~n~n" (syntax->datum code))
(send type-recs set-location! location) (send type-recs set-location! location)
(let ((directory (send type-recs get-compilation-location))) (let ((directory (send type-recs get-compilation-location)))
(unless (directory-exists? directory) (make-directory directory)) (unless (directory-exists? directory) (make-directory directory))

9
collects/profj/types.ss
View File

@ -863,8 +863,10 @@
(lambda (input) (lambda (input)
(and (= (length input) type-length) (and (= (length input) type-length)
(equal? type-version (list-ref input 9)) (equal? type-version (list-ref input 9))
(or (equal? (version) (list-ref input 10)) (or (equal? "ignore" (list-ref input 10))
(equal? "ignore" (list-ref input 10))) (and (equal? (version) (list-ref input 10))
(>= (file-or-directory-modify-seconds (build-path filename))
(file-or-directory-modify-seconds (build-path (collection-path "mzlib") "contract.ss")))))
(make-class-record (list-ref input 1) (make-class-record (list-ref input 1)
(list-ref input 2) (list-ref input 2)
(symbol=? 'class (car input)) (symbol=? 'class (car input))
@ -904,6 +906,9 @@
(make-array-type (parse-type (cadr input)) (car input))) (make-array-type (parse-type (cadr input)) (car input)))
(else (else
(make-ref-type (car input) (cdr input))))))) (make-ref-type (car input) (cdr input)))))))
#;(printf "~a ~a ~n" filename
(>= (file-or-directory-modify-seconds (build-path filename))
(file-or-directory-modify-seconds (build-path (collection-path "mzlib") "contract.ss"))))
(parse-class/iface (call-with-input-file filename read)))) (parse-class/iface (call-with-input-file filename read))))
;; write-record: class-record port-> ;; write-record: class-record port->