diff --git a/collects/algol60/prims.rkt b/collects/algol60/prims.rkt index fbb43681f1..c47fabe4ba 100644 --- a/collects/algol60/prims.rkt +++ b/collects/algol60/prims.rkt @@ -94,10 +94,10 @@ (k (log (get-number 'ln v)))) (define (printsln k v) - (k (printf "~a~n" (get-string 'printsln v)))) + (k (printf "~a\n" (get-string 'printsln v)))) (define (printnln k v) - (k (printf "~a~n" (get-number 'printnln v)))) + (k (printf "~a\n" (get-number 'printnln v)))) (define (prints k v) (k (printf "~a" (get-string 'prints v)))) diff --git a/collects/algol60/tool.rkt b/collects/algol60/tool.rkt index 8f72cbc44a..67154c4198 100644 --- a/collects/algol60/tool.rkt +++ b/collects/algol60/tool.rkt @@ -95,7 +95,7 @@ (drscheme:debug:make-debug-error-display-handler (error-display-handler))) (current-compile (make-errortrace-compile-handler)) (with-handlers ([void (lambda (x) - (printf "~a~n" + (printf "~a\n" (exn-message x)))]) (namespace-attach-module n path) (namespace-require path)))))) diff --git a/collects/browser/private/html.rkt b/collects/browser/private/html.rkt index 318447aec1..e6dd126ab1 100644 --- a/collects/browser/private/html.rkt +++ b/collects/browser/private/html.rkt @@ -229,7 +229,7 @@ (with-handlers ([exn:fail? (lambda (x) (message-box "Warning" - (format "Could not delete file ~s~n~n~a" + (format "Could not delete file ~s\n\n~a" tmp-filename (if (exn? x) (exn-message x) diff --git a/collects/combinator-parser/private-combinator/combinator-parser.scm b/collects/combinator-parser/private-combinator/combinator-parser.scm index 9f21231d5b..22b2478e84 100644 --- a/collects/combinator-parser/private-combinator/combinator-parser.scm +++ b/collects/combinator-parser/private-combinator/combinator-parser.scm @@ -42,7 +42,7 @@ [(res? result) (fail-type->message (res-msg result))] [(lazy-opts? result) - #;(printf "lazy-opts ~a~n" result) + #;(printf "lazy-opts ~a\n" result) (let* ([finished? (lambda (o) (cond [(res? o) (and (not (null? (res-a o))) @@ -79,7 +79,7 @@ (cond [(pair? p-errors) (let ([fails (cons (lazy-opts-errors result) p-errors)]) - #;(printf "~nfails ~a~n~n" fails) + #;(printf "\nfails ~a\n\n" fails) (fail-type->message (make-options-fail (rank-choice (map fail-type-chance fails)) #f @@ -91,7 +91,7 @@ [(null? p-errors) (fail-type->message (lazy-opts-errors result))]))])))] [(or (choice-res? result) (pair? result)) - #;(printf "choice-res or pair? ~a~n" result) + #;(printf "choice-res or pair? ~a\n" result) (let* ([options (if (choice-res? result) (choice-res-matches result) result)] [finished-options (filter (lambda (o) (cond [(res? o) @@ -108,10 +108,10 @@ (filter res-possible-error (map (lambda (a) (if (repeat-res? a) (repeat-res-a a) a)) options))]) - #;(printf "length finished-options ~a~n" finished-options) + #;(printf "length finished-options ~a\n" finished-options) (cond [(not (null? finished-options)) - #;(printf "finished an option~n") + #;(printf "finished an option\n") (let ([first-fo (car finished-options)]) (car (cond [(res? first-fo) (res-a first-fo)] @@ -122,12 +122,12 @@ (error 'parser-internal-errorcp (format "~a" first-fo))])))] #;[(not (null? possible-repeat-errors)) - (printf "possible-repeat error~n") + (printf "possible-repeat error\n") (fail-type->message (car (repeat-res-stop (sort-repeats possible-repeat-errors))))] [(and (choice-res? result) (fail-type? (choice-res-errors result))) - #;(printf "choice res and choice res errors ~n") + #;(printf "choice res and choice res errors \n") (cond [(and (null? possible-repeat-errors) (null? possible-errors)) (fail-type->message (choice-res-errors result))] @@ -143,11 +143,11 @@ (rank-choice (map fail-type-may-use fails)) fails)))])] [(not (null? possible-errors)) - ;(printf "choice or pair fail~n") + ;(printf "choice or pair fail\n") (fail-type->message (res-possible-error (car (sort-used possible-errors))))] [else - #;(printf "result ~a~n" result) + #;(printf "result ~a\n" result) (let ([used-sort (sort-used options)]) (if (and (choice-res? result) (choice-res-errors result)) @@ -164,7 +164,7 @@ [(and (repeat-res? result) (eq? 'out-of-input (repeat-res-stop result))) (res-a (repeat-res-a result))] [(and (repeat-res? result) (fail-type? (repeat-res-stop result))) - ;(printf "repeat-fail~n") + ;(printf "repeat-fail\n") (fail-type->message (repeat-res-stop result))] [else (error 'parser (format "Internal error: received unexpected input ~a" result))])]) diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm index 662e6bab9a..e0412330cf 100644 --- a/collects/combinator-parser/private-combinator/combinator.scm +++ b/collects/combinator-parser/private-combinator/combinator.scm @@ -62,13 +62,13 @@ build)]) (opt-lambda (input [last-src (list 1 0 1 0)] [alts 1]) - #;(printf "terminal ~a~n" name) + #;(printf "terminal ~a\n" name) #;(cond - [(eq? input return-name) (printf "name requested~n")] - [(null? input) (printf "null input~n")] + [(eq? input return-name) (printf "name requested\n")] + [(null? input) (printf "null input\n")] [else (let ([token (position-token-token (car input))]) - (printf "Token given ~a, match? ~a~n" token (pred token)))]) + (printf "Token given ~a, match? ~a\n" token (pred token)))]) (cond [(eq? input return-name) name] [(eq? input terminal-occurs) (list (make-occurs name 1))] @@ -87,7 +87,7 @@ (cdr input) name (value curr-input) 1 #f curr-input)] [else - #;(printf "Incorrect input for ~a : ~a miscase? ~a misspell? ~a ~n" name + #;(printf "Incorrect input for ~a : ~a miscase? ~a misspell? ~a \n" name (cond [(token-value token) (token-value token)] [else (token-name token)]) @@ -135,7 +135,7 @@ [my-error (sequence-error-gen name sequence-length)] [my-walker (seq-walker id-position name my-error)]) (opt-lambda (input [last-src (list 1 0 1 0)] [alts 1]) - #;(unless (eq? input return-name) (printf "seq ~a~n" name)) + #;(unless (eq? input return-name) (printf "seq ~a\n" name)) (cond [(eq? input return-name) name] [(eq? input terminal-occurs) @@ -158,8 +158,8 @@ [(pair? pre-build-ans) (map builder pre-build-ans)] [else pre-build-ans])]) (weak-map-put! memo-table input ans) - #;(printf "sequence ~a returning ~n" name) - #;(printf "answer is ~a ~n" ans) + #;(printf "sequence ~a returning \n" name) + #;(printf "answer is ~a \n" ans) ans)]))))) ;seq-walker: int string error-gen -> [(list parser) (list alpha) parser result (U bool string) (list string) int int -> result @@ -198,7 +198,7 @@ (make-src-lst (position-token-start-pos (res-first-tok old-result)) (position-token-end-pos (res-first-tok old-result))) last-src))]) - #;(printf "next-call ~a ~a: ~a ~a ~a ~a~n" + #;(printf "next-call ~a ~a: ~a ~a ~a ~a\n" seq-name (length seen) old-result (res? rsts) (and (res? rsts) (res-a rsts)) (and (res? rsts) (choice-fail? (res-possible-error rsts)))) @@ -236,7 +236,7 @@ (map (lambda (rst) (next-res old-answer new-id old-used tok rst)) (flatten (correct-list rsts)))] [(choice-res? rsts) - #;(printf "next call, tail-end is choice ~a~n" rsts) + #;(printf "next call, tail-end is choice ~a\n" rsts) (map (lambda (rst) (next-res old-answer new-id old-used tok (update-possible-fail rst rsts))) (flatten (correct-list (choice-res-matches rsts))))] @@ -247,37 +247,37 @@ (cond [(null? subs) (error 'end-of-subs)] [(null? next-preds) - #;(printf "seq-walker called: last case, ~a case of ~a ~n" + #;(printf "seq-walker called: last case, ~a case of ~a \n" seq-name (curr-pred return-name)) (build-error (curr-pred input last-src) (lambda () (previous? input)) (previous? return-name) #f look-back look-back-ref used curr-id seen alts last-src)] [else - #;(printf "seq-walker called: else case, ~a case of ~a ~ath case ~n" + #;(printf "seq-walker called: else case, ~a case of ~a ~ath case \n" seq-name (curr-pred return-name) (length seen)) (let ([fst (curr-pred input last-src)]) (cond [(res? fst) - #;(printf "res case ~a ~a~n" seq-name (length seen)) + #;(printf "res case ~a ~a\n" seq-name (length seen)) (cond [(res-a fst) (next-call fst fst fst (res-msg fst) (and id-spot? (res-id fst)) (res-first-tok fst) alts)] [else - #;(printf "error situation ~a ~a~n" seq-name (length seen)) + #;(printf "error situation ~a ~a\n" seq-name (length seen)) (build-error fst (lambda () (previous? input)) (previous? return-name) (car next-preds) look-back look-back-ref used curr-id seen alts last-src)])] [(repeat-res? fst) - #;(printf "repeat-res: ~a ~a~n" seq-name (length seen)) - #;(printf "res? ~a~n" (res? (repeat-res-a fst))) + #;(printf "repeat-res: ~a ~a\n" seq-name (length seen)) + #;(printf "res? ~a\n" (res? (repeat-res-a fst))) (next-call (repeat-res-a fst) fst fst (res-msg (repeat-res-a fst)) #f (res-first-tok (repeat-res-a fst)) alts)] [(lazy-opts? fst) - #;(printf "lazy res: ~a ~a ~a~n" fst seq-name (length seen)) + #;(printf "lazy res: ~a ~a ~a\n" fst seq-name (length seen)) (let* ([opt-r (make-lazy-opts null (make-options-fail 0 last-src seq-name 0 0 null) null)] @@ -285,11 +285,11 @@ [next-c (lambda (res) (cond [(res? res) - #;(printf "lazy-choice-res, res ~a ~a~n" seq-name (length seen)) + #;(printf "lazy-choice-res, res ~a ~a\n" seq-name (length seen)) (next-call res fst res name (and id-spot? (res-id res)) (res-first-tok res) alts)] [(repeat-res? res) - #;(printf "lazy- choice-res, repeat-res ~a ~a ~a~n" + #;(printf "lazy- choice-res, repeat-res ~a ~a ~a\n" (res? (repeat-res-a res)) seq-name (length seen)) (next-call (repeat-res-a res) res (repeat-res-a res) (res-msg (repeat-res-a res)) #f @@ -313,7 +313,7 @@ (fail-res input (lazy-opts-errors opt-r)))) ] [(or (choice-res? fst) (pair? fst)) - #;(printf "choice-res: ~a ~a ~a~n" fst seq-name (length seen)) + #;(printf "choice-res: ~a ~a ~a\n" fst seq-name (length seen)) (let*-values ([(lst name curr) (cond @@ -327,12 +327,12 @@ (map (lambda (res) (cond [(res? res) - #;(printf "choice-res, res ~a ~a~n" seq-name (length seen)) + #;(printf "choice-res, res ~a ~a\n" seq-name (length seen)) (next-call res (curr res) res (name res) (and id-spot? (res-id res)) (res-first-tok res) new-alts)] [(repeat-res? res) - #;(printf "choice-res, repeat-res ~a ~a ~a~n" + #;(printf "choice-res, repeat-res ~a ~a ~a\n" (res? (repeat-res-a res)) seq-name (length seen)) (next-call (repeat-res-a res) res (repeat-res-a res) (res-msg (repeat-res-a res)) #f @@ -341,12 +341,12 @@ [else (error 'parser-internal-error4 (format "~a" res))])) (flatten lst))] [(correct-rsts) (flatten (correct-list rsts))]) - #;(printf "case ~a ~a, choice case: intermediate results are ~a~n" + #;(printf "case ~a ~a, choice case: intermediate results are ~a\n" seq-name (length seen) lst) (cond [(and (null? correct-rsts) (or (not (lazy-choice? fst)) (null? (lazy-opts-thunks fst)))) - #;(printf "correct-rsts null for ~a ~a ~n" seq-name (length seen)) + #;(printf "correct-rsts null for ~a ~a \n" seq-name (length seen)) (let ([fails (map (lambda (rst) @@ -418,7 +418,7 @@ ;update-possible-rail result result -> result (define (update-possible-fail res back) - #;(printf "update-possible-fail ~a, ~a~n" res back) + #;(printf "update-possible-fail ~a, ~a\n" res back) (cond [(and (res? res) (not (res-possible-error res))) (cond @@ -449,18 +449,18 @@ [(and (repeat-res? rpt) (res? (repeat-res-a rpt))) (let ([inn (repeat-res-a rpt)] [stop (repeat-res-stop rpt)]) - #;(printf "in repeat->res for ~a~n" name) + #;(printf "in repeat->res for ~a\n" name) #;(when (fail-type? stop) - (printf "stoped on ~a~n" (fail-type-name stop))) - #;(printf "stop ~a~n" stop) + (printf "stoped on ~a\n" (fail-type-name stop))) + #;(printf "stop ~a\n" stop) #;(when (choice-res? back) - (printf "back on ~a~n" (choice-res-name back))) - #;(when (choice-res? back) (printf "choice-res-errors back ~a~n" + (printf "back on ~a\n" (choice-res-name back))) + #;(when (choice-res? back) (printf "choice-res-errors back ~a\n" (choice-res-errors back))) #;(when (and (fail-type? stop) (choice-res? back) (choice-res-errors back)) - (printf "chances ~a > ~a -> ~a ~n" + (printf "chances ~a > ~a -> ~a \n" (fail-type-chance (choice-res-errors back)) (fail-type-chance stop) (>= (fail-type-chance (choice-res-errors back)) @@ -490,14 +490,14 @@ [(or (and (res? old-res) (res-a old-res)) (choice-res? old-res) (lazy-opts? old-res)) (update-possible-fail old-res look-back)] [(repeat-res? old-res) - #;(printf "finished on repeat-res for ~a res ~n" name #;old-res) + #;(printf "finished on repeat-res for ~a res \n" name #;old-res) (repeat->res old-res look-back)] [(pair? old-res) - #;(printf "finished on pairs of res for ~a~n" name #;old-res) + #;(printf "finished on pairs of res for ~a\n" name #;old-res) (map (lambda (r) (repeat->res r look-back)) (flatten old-res))] [else - #;(printf "There was an error for ~a~n" name) - #;(printf "length seen ~a length rest ~a~n" (length seen) (length (res-rest old-res))) + #;(printf "There was an error for ~a\n" name) + #;(printf "length seen ~a length rest ~a\n" (length seen) (length (res-rest old-res))) (fail-res (res-rest old-res) (let*-values ([(fail) (res-msg old-res)] [(possible-fail) @@ -534,35 +534,35 @@ (res-first-tok old-res))] [(seen-len) (length seen)] [(updated-len) (+ (- used seen-len) len)]) - #;(printf "sequence ~a failed.~n seen ~a~n" name (reverse seen)) + #;(printf "sequence ~a failed.\n seen ~a\n" name (reverse seen)) #;(when (repeat-res? look-back) - (printf "look-back repeat-res ~a : ~a vs ~a : ~a > ~a~n" + (printf "look-back repeat-res ~a : ~a vs ~a : ~a > ~a\n" (fail-type? (repeat-res-stop look-back)) (and (fail-type? (repeat-res-stop look-back)) (fail-type-name (repeat-res-stop look-back))) (fail-type-name (res-msg old-res)) (and (fail-type? (repeat-res-stop look-back)) (fail-type-chance (repeat-res-stop look-back))) (fail-type-chance (res-msg old-res)))) #;(when (choice-res? look-back) - (printf "look-back choice: ~a vs ~a : ~a > ~a~n" + (printf "look-back choice: ~a vs ~a : ~a > ~a\n" (choice-res-name look-back) (fail-type-name (res-msg old-res)) (and (choice-res-errors look-back) (fail-type-chance (choice-res-errors look-back))) (fail-type-chance (res-msg old-res))) - (printf "look-back choice and useds: ~a vs ~a -- ~a ~n" + (printf "look-back choice and useds: ~a vs ~a -- ~a \n" used (and (res? look-back-ref) (res-used look-back-ref)) (and (choice-res-errors look-back) (fail-type-used (choice-res-errors look-back))))) #;(when (pair? look-back) - (printf "look-back is a pair~n")) + (printf "look-back is a pair\n")) #;(when (res? look-back) - (printf "look-back res ~a : ~a vs ~a : ~a > ~a~n" + (printf "look-back res ~a : ~a vs ~a : ~a > ~a\n" (fail-type? (res-possible-error look-back)) (and (fail-type? (res-possible-error look-back)) (fail-type-name (res-possible-error look-back))) (fail-type-name (res-msg old-res)) (and (fail-type? (res-possible-error look-back)) (fail-type-chance (res-possible-error look-back))) (fail-type-chance (res-msg old-res))) - (printf "lookback ~a~n" (res-possible-error look-back))) + (printf "lookback ~a\n" (res-possible-error look-back))) (let* ([seq-fail-maker (lambda (fail used) (let-values ([(kind expected found) (get-fail-info fail)]) @@ -584,12 +584,12 @@ (res? look-back-ref)) (- used (res-used look-back-ref)) used)))] [opt-fails (list seq-fail pos-fail)]) - #;(printf "pos-fail? ~a~n" (and pos-fail #t)) - #;(printf "seq-fail ~a~n" seq-fail) + #;(printf "pos-fail? ~a\n" (and pos-fail #t)) + #;(printf "seq-fail ~a\n" seq-fail) #;(when pos-fail - (printf "used ~a look-back-ref used ~a ~n" + (printf "used ~a look-back-ref used ~a \n" used (when (res? look-back-ref) (res-used look-back-ref))) - (printf "opt-fails ~a~n" opt-fails)) + (printf "opt-fails ~a\n" opt-fails)) (if pos-fail (make-options-fail (rank-choice (map fail-type-chance opt-fails)) (map fail-type-src opt-fails) @@ -611,18 +611,18 @@ (* expected-no-sub (- 1 sub-chance))))]) #;(when (zero? used-toks) - (printf "compute-chance 0 case: ~a, ~a, ~a, ~a -> ~a~n" + (printf "compute-chance 0 case: ~a, ~a, ~a, ~a -> ~a\n" sub-chance expected-length num-alts may-use (* (/ 1 num-alts) sub-chance))) (cond #;[(zero? used-toks) (* (/ 1 num-alts) sub-chance)] [(zero? used-toks) sub-chance #;probability-with-sub] [else - #;(printf "compute-chance: args ~a ~a ~a ~a ~a ~a~n" + #;(printf "compute-chance: args ~a ~a ~a ~a ~a ~a\n" expected-length seen-length used-toks num-alts may-use sub-chance) - #;(printf "compute-chance: intermediate values: ~a ~a ~a ~a ~a ~a~n" + #;(printf "compute-chance: intermediate values: ~a ~a ~a ~a ~a ~a\n" revised-expectation possible-expectation probability-with-sub probability-without-sub expected-sub expected-no-sub) - #;(printf "compute-chance answer ~a~n" probability) + #;(printf "compute-chance answer ~a\n" probability) probability]))) ;greedy-repeat: (list 'a) -> result -> (list 'a) -> result @@ -634,7 +634,7 @@ (lambda (curr-ans rest-ans) (cond [(repeat-res? rest-ans) - #;(printf "building up the repeat answer for ~a~n" repeat-name) + #;(printf "building up the repeat answer for ~a\n" repeat-name) (cond [(res? curr-ans) (let* ([a (res-a curr-ans)] @@ -643,7 +643,7 @@ (lambda (r) (cond [(res? r) - #;(printf "rest is a res for ~a, res-a is ~a ~n" a repeat-name) + #;(printf "rest is a res for ~a, res-a is ~a \n" a repeat-name) (make-repeat-res (make-res (append a (res-a r)) (res-rest r) (repeat-name) #f (+ (res-used curr-ans) (res-used r)) @@ -653,10 +653,10 @@ (error 'parser-internal-error9 (format "~a" r))]))]) (cond [(and (pair? rest) (null? (cdr rest))) - #;(printf "rest is a one-element list for ~a~n" repeat-name) + #;(printf "rest is a one-element list for ~a\n" repeat-name) (repeat-build (car rest))] [(pair? rest) - #;(printf "rest is a pair for ~a ~a~n" repeat-name (length rest)) + #;(printf "rest is a pair for ~a ~a\n" repeat-name (length rest)) (map repeat-build (flatten rest))] [else (repeat-build rest)]))] [else (error 'parser-internal-error12 (format "~a" curr-ans))])] @@ -678,24 +678,24 @@ [else (let ([ans (let loop ([curr-input input] [curr-src start-src]) - #;(printf "length of curr-input for ~a ~a~n" repeat-name (length curr-input)) - #;(printf "curr-input ~a~n" (map position-token-token curr-input)) + #;(printf "length of curr-input for ~a ~a\n" repeat-name (length curr-input)) + #;(printf "curr-input ~a\n" (map position-token-token curr-input)) (cond [(weak-map-get inner-memo-table curr-input #f)(weak-map-get inner-memo-table curr-input)] [(null? curr-input) - #;(printf "out of input for ~a~n" (repeat-name)) + #;(printf "out of input for ~a\n" (repeat-name)) (make-repeat-res (make-res null null (repeat-name) "" 0 #f #f) 'out-of-input)] [else (let ([this-res (sub curr-input curr-src)]) - #;(printf "Repeat of ~a called it's repeated entity ~n" (repeat-name)) + #;(printf "Repeat of ~a called it's repeated entity \n" (repeat-name)) (cond [(and (res? this-res) (res-a this-res)) - #;(printf "loop again case for ~a~n" (repeat-name)) + #;(printf "loop again case for ~a\n" (repeat-name)) (process-rest this-res (loop (res-rest this-res) (update-src (res-rest this-res) curr-src)))] [(res? this-res) - #;(printf "fail for error case of ~a: ~a ~a~n" + #;(printf "fail for error case of ~a: ~a ~a\n" repeat-name (cond [(choice-fail? (res-msg this-res)) 'choice] @@ -708,7 +708,7 @@ (weak-map-put! inner-memo-table curr-input fail) fail)] [(repeat-res? this-res) - #;(printf "repeat-res case of ~a~n" repeat-name) + #;(printf "repeat-res case of ~a\n" repeat-name) (process-rest (repeat-res-a this-res) (res-rest (repeat-res-a this-res)))] [(lazy-opts? this-res) @@ -728,7 +728,7 @@ [(or (choice-res? this-res) (pair? this-res)) (let ([list-of-answer (if (choice-res? this-res) (choice-res-matches this-res) (flatten this-res))]) - #;(printf "repeat call of ~a, choice-res ~a~n" + #;(printf "repeat call of ~a, choice-res ~a\n" repeat-name (and (choice-res? this-res) (length list-of-answer))) @@ -740,7 +740,7 @@ curr-src)))] [else (map (lambda (match) - #;(printf "calling repeat loop again ~a, res-rest match ~a~n" + #;(printf "calling repeat loop again ~a, res-rest match ~a\n" (repeat-name) (length (res-rest match))) (process-rest match (loop (res-rest match) @@ -748,7 +748,7 @@ list-of-answer)]))] [else (error 'internal-parser-error8 (format "~a" this-res))]))]))]) (weak-map-put! memo-table input ans) - #;(printf "repeat of ~a ended with ans ~n" repeat-name #;ans) + #;(printf "repeat of ~a ended with ans \n" repeat-name #;ans) ans)])))) ;choice: [list [[list 'a ] -> result]] name -> result @@ -758,8 +758,8 @@ [num-choices (length opt-list)] [choice-names (lambda () (map (lambda (o) (o return-name)) opt-list))]) (opt-lambda (input [last-src (list 0 0 0 0)] [alts 1]) - #;(unless (eq? input return-name) (printf "choice ~a~n" name)) - #;(printf "possible options are ~a~n" (choice-names)) + #;(unless (eq? input return-name) (printf "choice ~a\n" name)) + #;(printf "possible options are ~a\n" (choice-names)) (let ([sub-opts (sub1 (+ alts num-choices))]) (cond [(eq? input return-name) name] @@ -772,11 +772,11 @@ terminal-counts))] [(weak-map-get memo-table input #f) (weak-map-get memo-table input)] [else - #;(printf "choice ~a~n" name) - #;(printf "possible options are ~a~n" (choice-names)) + #;(printf "choice ~a\n" name) + #;(printf "possible options are ~a\n" (choice-names)) (let*-values ([(options) (map (lambda (term) (term input last-src sub-opts)) opt-list)] - #;[a (printf "choice-options ~a ~n ~a ~n~n~n" choice-names options)] + #;[a (printf "choice-options ~a \n ~a \n\n\n" choice-names options)] [(fails) (map (lambda (x) (cond [(res? x) (res-msg x)] @@ -806,9 +806,9 @@ (cond [(null? corrects) (fail-res input (fail-builder fails))] [else (make-choice-res name corrects (fail-builder errors))])]) - #;(printf "choice ~a is returning options were ~a ~n" name (choice-names)) - #;(printf "corrects were ~a~n" corrects) - #;(printf "errors were ~a~n" errors) + #;(printf "choice ~a is returning options were ~a \n" name (choice-names)) + #;(printf "corrects were ~a\n" corrects) + #;(printf "errors were ~a\n" errors) (weak-map-put! memo-table input ans) ans)]))))) ;choice: [list [[list 'a ] -> result]] name -> result @@ -817,8 +817,8 @@ [num-choices (length opt-list)] [choice-names (lambda () (map (lambda (o) (o return-name)) opt-list))]) (opt-lambda (input [last-src (list 0 0 0 0)] [alts 1]) - #;(unless (eq? input return-name) (printf "choice ~a~n" name)) - #;(printf "possible options are ~a~n" choice-names) + #;(unless (eq? input return-name) (printf "choice ~a\n" name)) + #;(printf "possible options are ~a\n" choice-names) (let ([sub-opts (sub1 (+ alts num-choices))]) (cond [(weak-map-get memo-table input #f) (weak-map-get memo-table input)] @@ -842,7 +842,7 @@ (if (next-opt initial-ans) initial-ans (fail-res input (lazy-opts-errors initial-ans)))]) - #;(printf "choice ~a is returning options were ~a, answer is ~a ~n" name (choice-names) ans) + #;(printf "choice ~a is returning options were ~a, answer is ~a \n" name (choice-names) ans) (weak-map-put! memo-table input ans) ans)]))))) (define (flatten lst) diff --git a/collects/combinator-parser/private-combinator/errors.scm b/collects/combinator-parser/private-combinator/errors.scm index 3bfe85507f..9c27d6a9d8 100644 --- a/collects/combinator-parser/private-combinator/errors.scm +++ b/collects/combinator-parser/private-combinator/errors.scm @@ -24,7 +24,7 @@ (list? (car (fail-type-src fail-type)))) (car (fail-type-src fail-type)) (fail-type-src fail-type))))]) - #;(printf "fail-type->message ~a~n" fail-type) + #;(printf "fail-type->message ~a\n" fail-type) (cond [(terminal-fail? fail-type) (collapse-message @@ -43,7 +43,7 @@ (input->output-name (terminal-fail-found fail-type)) a name class-type a name)])) name #f message-to-date))] [(sequence-fail? fail-type) - #;(printf "sequence-fail case: kind is ~a~n" (sequence-fail-kind fail-type)) + #;(printf "sequence-fail case: kind is ~a\n" (sequence-fail-kind fail-type)) (let* ([curr-id (sequence-fail-id fail-type)] [id-name (if curr-id (string-append name " " (sequence-fail-id fail-type)) name)] @@ -54,7 +54,7 @@ [(end) (collapse-message (add-to-message - (msg (format "Expected ~a to contain ~a ~a to complete the ~a. ~nFound ~a before ~a ended." + (msg (format "Expected ~a to contain ~a ~a to complete the ~a. \nFound ~a before ~a ended." input-type a2 expected id-name (format-seen show-sequence) input-type)) name curr-id message-to-date))] [(wrong) @@ -95,7 +95,7 @@ name curr-id message-to-date))] [(sub-seq choice) (fail-type->message (sequence-fail-found fail-type) - (add-to-message (msg (format "An error occured in ~a.~n" id-name)) + (add-to-message (msg (format "An error occured in ~a.\n" id-name)) name (sequence-fail-id fail-type) message-to-date))] [(options) (let ([sorted-opts (sort (options-fail-opts (sequence-fail-found fail-type)) @@ -106,12 +106,12 @@ name (sequence-fail-id fail-type) message-to-date)) (fail-type->message (sequence-fail-found fail-type) #;(car sorted-opts) (add-to-message - (msg (format "There is an error in this ~a after ~a, the program resembles a(n) ~a here.~n" + (msg (format "There is an error in this ~a after ~a, the program resembles a(n) ~a here.\n" id-name (car (reverse show-sequence)) (fail-type-name (car sorted-opts)))) name (sequence-fail-id fail-type) message-to-date))))]))] [(options-fail? fail-type) - #;(printf "selecting for options on ~a~n" name) + #;(printf "selecting for options on ~a\n" name) (let* ([winners (select-errors (options-fail-opts fail-type))] [top-names (map fail-type-name winners)] [non-dup-tops (remove-dups top-names name)] @@ -122,7 +122,7 @@ (> (length winners) max-choice-depth)) (collapse-message (add-to-message - (msg (format "An error occurred in this ~a. Program resembles these: ~a.~n" + (msg (format "An error occurred in this ~a. Program resembles these: ~a.\n" name (nice-list non-dup-tops))) name #f message-to-date))] [(and (> (length winners) 1) @@ -138,7 +138,7 @@ [else msg])]) (collapse-message (add-to-message - (msg (format "An error occured in the ~a. Possible errors were: ~n ~a" + (msg (format "An error occured in the ~a. Possible errors were: \n ~a" name (alternate-error-list (map err-msg messages)))) name #f message-to-date)))]))] @@ -147,13 +147,13 @@ (car winners) (add-to-message (msg - (format "There is an error in this ~a~a.~n" + (format "There is an error in this ~a~a.\n" name (if (equal? top-name name) "" (format ", program resembles ~a ~a" (a/an top-name) top-name)))) name #f message-to-date))]))] [(choice-fail? fail-type) - #;(printf "selecting for ~a~n message-to-date ~a~n" name message-to-date) + #;(printf "selecting for ~a\n message-to-date ~a\n" name message-to-date) (let* ([winners (select-errors (choice-fail-messages fail-type))] [top-names (map fail-type-name winners)] [top-name (car top-names)] @@ -190,7 +190,7 @@ [else (collapse-message (add-to-message - (msg (format "An error occured in this ~a; expected ~a instead. Possible errors were:~n~a" + (msg (format "An error occured in this ~a; expected ~a instead. Possible errors were:\n~a" name (nice-list no-dup-names) (alternate-error-list (map err-msg messages)))) name #f message-to-date))]))] @@ -198,7 +198,7 @@ (> (length winners) 1)) (collapse-message (add-to-message - (msg (format "An error occured in this ~a. Possible options include ~a.~n" + (msg (format "An error occured in this ~a. Possible options include ~a.\n" name (nice-list (first-n max-choice-depth no-dup-names)))) name #f message-to-date))] @@ -206,7 +206,7 @@ (fail-type->message (car winners) (add-to-message - (msg (format "An error occured in this ~a~a.~a~n" + (msg (format "An error occured in this ~a~a.~a\n" name (if (equal? name top-name) "" (format ", it is possible you intended ~a ~a here" (a/an top-name) top-name)) @@ -233,17 +233,17 @@ (narrow-opts chance-may-use chance-used-winners)] [winners (narrow-opts chance chance-may-winners)]) - #;(printf "all options: ~a~n" opts-list) - #;(printf "~a ~a ~a ~a ~a~n" + #;(printf "all options: ~a\n" opts-list) + #;(printf "~a ~a ~a ~a ~a\n" (map fail-type-name opts-list) (map fail-type-chance opts-list) (map fail-type-used opts-list) (map fail-type-may-use opts-list) (map composite opts-list)) - #;(printf "composite round: ~a ~a ~n" + #;(printf "composite round: ~a ~a \n" (map fail-type-name composite-winners) (map composite composite-winners)) - #;(printf "final sorting: ~a~n" (map fail-type-name winners)) + #;(printf "final sorting: ~a\n" (map fail-type-name winners)) winners)) (define (first-n n lst) @@ -300,7 +300,7 @@ (let ([msg (if (equal? #\newline (string-ref (car l) (sub1 (string-length (car l))))) (substring (car l) 0 (sub1 (string-length (car l)))) (car l))]) - (string-append (format "~a~a~n" #\tab msg) + (string-append (format "~a~a\n" #\tab msg) (alternate-error-list (cdr l))))])) (define (downcase string) diff --git a/collects/combinator-parser/private-combinator/structs.scm b/collects/combinator-parser/private-combinator/structs.scm index 040c883ff8..103b07ed5d 100644 --- a/collects/combinator-parser/private-combinator/structs.scm +++ b/collects/combinator-parser/private-combinator/structs.scm @@ -82,7 +82,7 @@ (define (next-opt lc) (letrec ([next (lambda (lc update-errors) - #;(printf "next-opt ~a~n" lc) + #;(printf "next-opt ~a\n" lc) (cond [(null? (lazy-opts-thunks lc)) #f] [else diff --git a/collects/compiler/embed-unit.rkt b/collects/compiler/embed-unit.rkt index 465ed275dd..1ca92cc065 100644 --- a/collects/compiler/embed-unit.rkt +++ b/collects/compiler/embed-unit.rkt @@ -381,7 +381,7 @@ ;; First use of the module. Get code and then get code for imports. (begin (when verbose? - (fprintf (current-error-port) "Getting ~s~n" filename)) + (fprintf (current-error-port) "Getting ~s\n" filename)) (let ([code (get-module-code filename "compiled" compiler @@ -413,7 +413,7 @@ (cond [(extension? code) (when verbose? - (fprintf (current-error-port) " using extension: ~s~n" (extension-path code))) + (fprintf (current-error-port) " using extension: ~s\n" (extension-path code))) (set-box! codes (cons (make-mod filename module-path code name prefix (string->symbol @@ -850,7 +850,7 @@ (quote ,(map (lambda (m) (let ([p (extension-path (mod-code m))]) (when verbose? - (fprintf (current-error-port) "Recording extension at ~s~n" p)) + (fprintf (current-error-port) "Recording extension at ~s\n" p)) (list (path->bytes p) (mod-full-name m) ;; The program name isn't used. It just helps ensures that @@ -942,7 +942,7 @@ (unless (or (extension? (mod-code nc)) (eq? nc table-mod)) (when verbose? - (fprintf (current-error-port) "Writing module from ~s~n" (mod-file nc))) + (fprintf (current-error-port) "Writing module from ~s\n" (mod-file nc))) (write (compile-using-kernel `(current-module-declare-name (make-resolved-module-path @@ -968,7 +968,7 @@ outp)))) (for-each (lambda (f) (when verbose? - (fprintf (current-error-port) "Copying from ~s~n" f)) + (fprintf (current-error-port) "Copying from ~s\n" f)) (call-with-input-file* f (lambda (i) (copy-port i outp)))) @@ -1071,7 +1071,7 @@ (check-collects-path 'create-embedding-executable collects-path collects-path-bytes) (let ([exe (find-exe mred? variant)]) (when verbose? - (fprintf (current-error-port) "Copying to ~s~n" dest)) + (fprintf (current-error-port) "Copying to ~s\n" dest)) (let-values ([(dest-exe orig-exe osx?) (cond [(and mred? (eq? 'macosx (system-type))) @@ -1162,7 +1162,7 @@ #:exists 'append) (values start (file-size dest-exe))))]) (when verbose? - (fprintf (current-error-port) "Setting command line~n")) + (fprintf (current-error-port) "Setting command line\n")) (let ([start-s (number->string start)] [end-s (number->string end)]) (let ([full-cmdline (append @@ -1180,7 +1180,7 @@ cmdline)]) (when collects-path-bytes (when verbose? - (fprintf (current-error-port) "Setting collection path~n")) + (fprintf (current-error-port) "Setting collection path\n")) (set-collects-path dest-exe collects-path-bytes)) (cond [osx? diff --git a/collects/compiler/private/analyze.rkt b/collects/compiler/private/analyze.rkt index b2a5bff96f..29a5ff5eed 100644 --- a/collects/compiler/private/analyze.rkt +++ b/collects/compiler/private/analyze.rkt @@ -1165,9 +1165,9 @@ (begin (when (compiler:option:verbose) (compiler:warning ast "letrec will be rewritten with set!")) - (debug "rewriting letrec~n") + (debug "rewriting letrec\n") (let ([new-ast (letrec->let+set! ast)]) - (debug "reanalyzing...~n") + (debug "reanalyzing...\n") (analyze! new-ast env inlined tail? wcm-tail?))))] ;;----------------------------------------------------- @@ -1288,7 +1288,7 @@ (lambda (why) '(begin (zodiac:print-start! (current-output-port) ast) - (printf "no inlining: ~a~n" (eval why))) + (printf "no inlining: ~a\n" (eval why))) (let* ([fun (let ([v (analyze!-sv (zodiac:app-fun ast) env inlined)]) (if (zodiac:varref? v) v diff --git a/collects/compiler/private/driver.rkt b/collects/compiler/private/driver.rkt index 127e069025..fbda8d607d 100644 --- a/collects/compiler/private/driver.rkt +++ b/collects/compiler/private/driver.rkt @@ -222,7 +222,7 @@ (define s:expand-top-level-expressions! (lambda (input-directory reader verbose?) - (when verbose? (printf "~n Reading... ") (flush-output)) + (when verbose? (printf "\n Reading... ") (flush-output)) ;; During reads, errors are truly fatal (let ([exprs (let ([failed? #f]) (let loop ([n 1]) @@ -238,7 +238,7 @@ (cons sexp (loop (+ n 1))))))))]) (unless (null? compiler:messages) (when (compiler:option:verbose) (newline))) (compiler:report-messages! #t) - (when verbose? (printf " expanding...~n")) + (when verbose? (printf " expanding...\n")) (parameterize ([current-load-relative-directory input-directory]) (map (lambda (expr) (let ([expanded ((if has-prefix? @@ -314,7 +314,7 @@ max-arity) (begin - ;; (printf "~a~n" (syntax-line (zodiac:zodiac-stx (car sexps)))) + ;; (printf "~a\n" (syntax-line (zodiac:zodiac-stx (car sexps)))) (let-values ([(exp free-vars local-vars global-vars used-vars captured-vars children new-max-arity multi) @@ -492,7 +492,7 @@ [string (compiler:message-message message)]) (zodiac:print-start! (current-output-port) ast) (printf - "~a: ~a~n" + "~a: ~a\n" (cond [(compiler:error-msg? message) "Error"] [(compiler:warning-msg? message) "Warning"] @@ -503,9 +503,9 @@ (when (compiler:internal-error-msg? message) (printf (string-append - " please report the bug using Help Desk~n" - " or http://bugs.racket-lang.org/~n" - " and include a transcript in verbose mode~n"))))) + " please report the bug using DrRacket\n" + " or http://bugs.racket-lang.org/\n" + " and include a transcript in verbose mode\n"))))) msgs) (when (and stop-on-errors? @@ -521,7 +521,7 @@ (set! total-cpu-time (+ total-cpu-time cpu)) (set! total-real-time (+ total-real-time real)) (when (compiler:option:verbose) - (printf " [cpu: ~ams, real: ~ams, gc: ~ams]~n" cpu real gc)) + (printf " [cpu: ~ams, real: ~ams, gc: ~ams]\n" cpu real gc)) (apply values vals)))) ;;----------------------------------------------------------------------------- @@ -704,8 +704,8 @@ ;; Extract stateless, phaseless core, leaving the rest of bytecode ;; - (when (compiler:option:verbose) (printf " extracting core expressions~n")) - (when (compiler:option:debug) (debug " = CORE =~n")) + (when (compiler:option:verbose) (printf " extracting core expressions\n")) + (when (compiler:option:debug) (debug " = CORE =\n")) (let ([core-thunk (lambda () @@ -736,8 +736,8 @@ ;; Run a preprocessing phase on the input ;; - (when (compiler:option:verbose) (printf " pre-processing and scanning for errors~n")) - (when (compiler:option:debug) (debug " = PREPHASE =~n")) + (when (compiler:option:verbose) (printf " pre-processing and scanning for errors\n")) + (when (compiler:option:debug) (debug " = PREPHASE =\n")) (let ([prephase-thunk (lambda () @@ -758,7 +758,7 @@ (verbose-time prephase-thunk)) (compiler:report-messages! (not (compiler:option:test))) (when (compiler:option:test) - (printf "skipping over top-level expressions with errors...~n")) + (printf "skipping over top-level expressions with errors...\n")) ; (map (lambda (ast) (pretty-print (zodiac->sexp/annotate ast))) (block-source s:file-block)) @@ -766,8 +766,8 @@ ;; A-normalize input ;; - (when (compiler:option:verbose) (printf " transforming to a-normal form~n")) - (when (compiler:option:debug) (debug " = ANORM =~n")) + (when (compiler:option:verbose) (printf " transforming to a-normal form\n")) + (when (compiler:option:debug) (debug " = ANORM =\n")) (let ([anorm-thunk (lambda () @@ -784,9 +784,9 @@ ;; (when (compiler:option:verbose) - (printf " determining known bindings~n")) + (printf " determining known bindings\n")) (when (compiler:option:debug) - (debug " = KNOWN =~n")) + (debug " = KNOWN =\n")) ; analyze top level expressions (let ([known-thunk @@ -806,9 +806,9 @@ ;; (when (compiler:option:verbose) - (printf " transforming to b-normal form, analyzing, and inlining~n")) + (printf " transforming to b-normal form, analyzing, and inlining\n")) (when (compiler:option:debug) - (debug " = ANALYZE =~n")) + (debug " = ANALYZE =\n")) ; analyze top level expressions, cataloguing local variables (compiler:init-define-lists!) @@ -840,9 +840,9 @@ ;; (when (compiler:option:verbose) - (printf " finding static procedures~n")) + (printf " finding static procedures\n")) (when (compiler:option:debug) - (debug " = LIFT =~n")) + (debug " = LIFT =\n")) (let ([lift-thunk s:lift]) (verbose-time lift-thunk)) @@ -855,7 +855,7 @@ ;; (when (compiler:option:verbose) - (printf " closure conversion and explicit control transformation~n")) + (printf " closure conversion and explicit control transformation\n")) (let ([closure-thunk (lambda () @@ -871,7 +871,7 @@ ;; (when (compiler:option:verbose) - (printf " closure->vehicle mapping~n")) + (printf " closure->vehicle mapping\n")) (when (eq? (compiler:option:vehicles) 'vehicles:automatic) (for-each @@ -885,7 +885,7 @@ (when (eq? (compiler:option:vehicles) 'vehicles:units) (compiler:fatal-error #f - "unit-wise vehicle mapping not currently supported~n")) + "unit-wise vehicle mapping not currently supported\n")) (let ([vehicle-thunk (lambda () (compiler:init-vehicles!) @@ -900,7 +900,7 @@ (when (compiler:option:verbose) (printf - " choosing data representations~n")) + " choosing data representations\n")) (let ([rep-thunk (lambda () @@ -936,8 +936,8 @@ ;; we have to update the local variable set for each top-level ;; expression or code body. - (when (compiler:option:verbose) (printf " transforming to Virtual Machine form~n")) - (when (compiler:option:debug) (debug " = VMPHASE =~n")) + (when (compiler:option:verbose) (printf " transforming to Virtual Machine form\n")) + (when (compiler:option:debug) (debug " = VMPHASE =\n")) (let ([vmphase-thunk (lambda () @@ -1018,7 +1018,7 @@ ;; ;; As in the previous phase, new local variables may be created. - (when (compiler:option:verbose) (printf " optimizing Virtual Machine code~n")) + (when (compiler:option:verbose) (printf " optimizing Virtual Machine code\n")) (let ([vmopt-thunk (lambda () @@ -1064,7 +1064,7 @@ ;; Virtual Machine -> ANSI C translation ;; (when (compiler:option:verbose) - (printf " [emitting ~a C to \"~a\"]~n" + (printf " [emitting ~a C to \"~a\"]\n" "ANSI" c-output-path)) @@ -1078,38 +1078,38 @@ ;;value (lambda () - (fprintf c-port "#define MZC_SRC_FILE ~s~n" input-name) - (when (compiler:option:unsafe) (fprintf c-port "#define MZC_UNSAFE 1~n")) - (when (compiler:option:disable-interrupts) (fprintf c-port "#define MZC_DISABLE_INTERRUPTS 1~n")) - (when (compiler:option:fixnum-arithmetic) (fprintf c-port "#define MZC_FIXNUM 1~n")) + (fprintf c-port "#define MZC_SRC_FILE ~s\n" input-name) + (when (compiler:option:unsafe) (fprintf c-port "#define MZC_UNSAFE 1\n")) + (when (compiler:option:disable-interrupts) (fprintf c-port "#define MZC_DISABLE_INTERRUPTS 1\n")) + (when (compiler:option:fixnum-arithmetic) (fprintf c-port "#define MZC_FIXNUM 1\n")) - (fprintf c-port "~n#include \"~ascheme.h\"~n" + (fprintf c-port "\n#include \"~ascheme.h\"\n" (if (compiler:option:compile-for-embedded) "" "e")) (unless (null? c-declares) - (fprintf c-port "~n/* c-declare literals */~n~n") + (fprintf c-port "\n/* c-declare literals */\n\n") (for-each (lambda (c-declare) - (fprintf c-port "~a~n" c-declare)) + (fprintf c-port "~a\n" c-declare)) (reverse c-declares)) - (fprintf c-port "~n/* done with c-declare literals */~n~n")) + (fprintf c-port "\n/* done with c-declare literals */\n\n")) (unless (null? c-lambdas) - (fprintf c-port "~n/* c-lambda implementations */~n~n") + (fprintf c-port "\n/* c-lambda implementations */\n\n") (for-each (lambda (c-lambda) (let ([name (car c-lambda)] [body (cdr c-lambda)]) (fprintf c-port "Scheme_Object *~a(int argc, Scheme_Object **argv) {\n" name) - (fprintf c-port "~a~n" body) - (fprintf c-port "}~n"))) + (fprintf c-port "~a\n" body) + (fprintf c-port "}\n"))) (reverse c-lambdas)) - (fprintf c-port "~n/* done with c-lambda implementations */~n~n")) + (fprintf c-port "\n/* done with c-lambda implementations */\n\n")) - (fprintf c-port "#include \"mzc.h\"~n~n") + (fprintf c-port "#include \"mzc.h\"\n\n") (vm->c:emit-struct-definitions! (compiler:get-structs) c-port) (vm->c:emit-symbol-declarations! c-port) (vm->c:emit-inexact-declarations! c-port) @@ -1138,27 +1138,27 @@ (newline c-port) (unless (compiler:multi-o-constant-pool) - (fprintf c-port "~nstatic void make_symbols()~n{~n") + (fprintf c-port "\nstatic void make_symbols()\n{\n") (vm->c:emit-symbol-definitions! c-port) - (fprintf c-port "}~n")) + (fprintf c-port "}\n")) (unless (zero? (const:get-inexact-counter)) - (fprintf c-port "~nstatic void make_inexacts()~n{~n") + (fprintf c-port "\nstatic void make_inexacts()\n{\n") (vm->c:emit-inexact-definitions! c-port) - (fprintf c-port "}~n")) + (fprintf c-port "}\n")) - (fprintf c-port "~nstatic void gc_registration()~n{~n") + (fprintf c-port "\nstatic void gc_registration()\n{\n") (vm->c:emit-registration! c-port) - (fprintf c-port "}~n") + (fprintf c-port "}\n") - (fprintf c-port "~nstatic void init_prims(Scheme_Env * env)~n{~n") + (fprintf c-port "\nstatic void init_prims(Scheme_Env * env)\n{\n") (vm->c:emit-prim-ref-definitions! c-port) - (fprintf c-port "}~n") + (fprintf c-port "}\n") (unless (null? (compiler:get-case-lambdas)) - (fprintf c-port "~nstatic void init_cases_arities()~n{~n") + (fprintf c-port "\nstatic void init_cases_arities()\n{\n") (vm->c:emit-case-arities-definitions! c-port) - (fprintf c-port "}~n")) + (fprintf c-port "}\n")) (newline c-port) (let* ([codes (block-codes s:file-block)] @@ -1182,91 +1182,91 @@ #f #f ; no module entries c-port)]) (fprintf c-port - "static Scheme_Object * do_scheme_reload(Scheme_Env * env)~n{~n") - (fprintf c-port"~aScheme_Per_Load_Statics *PLS;~n" + "static Scheme_Object * do_scheme_reload(Scheme_Env * env)\n{\n") + (fprintf c-port"~aScheme_Per_Load_Statics *PLS;\n" vm->c:indent-spaces) (fprintf c-port - "~aPLS = (Scheme_Per_Load_Statics *)scheme_malloc(sizeof(Scheme_Per_Load_Statics));~n" + "~aPLS = (Scheme_Per_Load_Statics *)scheme_malloc(sizeof(Scheme_Per_Load_Statics));\n" vm->c:indent-spaces) (let loop ([c 0]) - (fprintf c-port "~a~atop_level_~a(env, PLS);~n" + (fprintf c-port "~a~atop_level_~a(env, PLS);\n" vm->c:indent-spaces (if (= c top-level-count) "return " "") c) (unless (= c top-level-count) (loop (add1 c)))) (fprintf c-port - "}~n~n") + "}\n\n") (fprintf c-port - "Scheme_Object * scheme_reload~a(Scheme_Env * env)~n{~n" + "Scheme_Object * scheme_reload~a(Scheme_Env * env)\n{\n" compiler:setup-suffix) - (fprintf c-port"~areturn do_scheme_reload(env);~n" + (fprintf c-port"~areturn do_scheme_reload(env);\n" vm->c:indent-spaces) (fprintf c-port - "}~n~n") + "}\n\n") (fprintf c-port - "~nstatic void do_scheme_setup(Scheme_Env * env)~n{~n") + "\nstatic void do_scheme_setup(Scheme_Env * env)\n{\n") (fprintf c-port - "~ascheme_set_tail_buffer_size(~a);~n" + "~ascheme_set_tail_buffer_size(~a);\n" vm->c:indent-spaces s:max-arity) - (fprintf c-port "~agc_registration();~n" + (fprintf c-port "~agc_registration();\n" vm->c:indent-spaces) (unless (compiler:multi-o-constant-pool) - (fprintf c-port "~amake_symbols();~n" + (fprintf c-port "~amake_symbols();\n" vm->c:indent-spaces)) (unless (zero? (const:get-inexact-counter)) - (fprintf c-port "~amake_inexacts();~n" + (fprintf c-port "~amake_inexacts();\n" vm->c:indent-spaces)) - (fprintf c-port "~ainit_prims(env);~n" + (fprintf c-port "~ainit_prims(env);\n" vm->c:indent-spaces) (unless (null? (compiler:get-case-lambdas)) - (fprintf c-port "~ainit_cases_arities();~n" + (fprintf c-port "~ainit_cases_arities();\n" vm->c:indent-spaces)) (let loop ([c 0]) (unless (> c init-constants-count) - (fprintf c-port "~ainit_constants_~a(env);~n" + (fprintf c-port "~ainit_constants_~a(env);\n" vm->c:indent-spaces c) (loop (add1 c)))) (fprintf c-port - "}~n~n") + "}\n\n") (fprintf c-port - "~nvoid scheme_setup~a(Scheme_Env * env)~n{~n" + "\nvoid scheme_setup~a(Scheme_Env * env)\n{\n" compiler:setup-suffix) (fprintf c-port - "~ado_scheme_setup(env);~n" + "~ado_scheme_setup(env);\n" vm->c:indent-spaces) (fprintf c-port - "}~n~n") + "}\n\n") (when (string=? "" compiler:setup-suffix) (fprintf c-port - "~nScheme_Object * scheme_initialize(Scheme_Env * env)~n{~n") - (fprintf c-port "~ado_scheme_setup~a(env);~n" + "\nScheme_Object * scheme_initialize(Scheme_Env * env)\n{\n") + (fprintf c-port "~ado_scheme_setup~a(env);\n" vm->c:indent-spaces compiler:setup-suffix) - (fprintf c-port "~areturn do_scheme_reload~a(env);~n" + (fprintf c-port "~areturn do_scheme_reload~a(env);\n" vm->c:indent-spaces compiler:setup-suffix) (fprintf c-port - "}~n~n")) + "}\n\n")) (fprintf c-port - "~nScheme_Object * ~ascheme_module_name()~n{~n~areturn " + "\nScheme_Object * ~ascheme_module_name()\n{\n~areturn " compiler:setup-suffix vm->c:indent-spaces) (if compiler:module-decl-name (let ([s (symbol->string compiler:module-decl-name)]) (fprintf c-port "scheme_intern_exact_symbol(~s, ~a)" s (string-length s))) (fprintf c-port "scheme_false")) - (fprintf c-port ";~n}~n")) + (fprintf c-port ";\n}\n")) (let emit-vehicles ([vehicle-number 0]) (unless (= vehicle-number (compiler:get-total-vehicles)) @@ -1288,7 +1288,7 @@ (for-each (lambda (L) (let ([code (get-annotation L)] [start (zodiac:zodiac-start L)]) - (fprintf c-port "~a/* code body ~a ~a [~a,~a] */~n" + (fprintf c-port "~a/* code body ~a ~a [~a,~a] */\n" vm->c:indent-spaces (closure-code-label code) (let ([n (closure-code-name code)]) (if n @@ -1311,11 +1311,11 @@ (vm->c:emit-case-prologue L i (lambda () (if suffix? - (fprintf c-port "~a~a/* begin case ~a */~n~a~a{~n" + (fprintf c-port "~a~a/* begin case ~a */\n~a~a{\n" vm->c:indent-spaces vm->c:indent-spaces i vm->c:indent-spaces vm->c:indent-spaces) (when (zero? i) - (fprintf c-port "~a{~n" vm->c:indent-spaces)))) + (fprintf c-port "~a{\n" vm->c:indent-spaces)))) (if suffix? (format "c~a" i) "") indent c-port)]) @@ -1327,7 +1327,7 @@ -1) (vm->c:emit-case-epilogue L i undefines indent c-port) (when suffix? - (fprintf c-port "~a~a} /* end case ~a */~n" + (fprintf c-port "~a~a} /* end case ~a */\n" vm->c:indent-spaces vm->c:indent-spaces i))) @@ -1359,9 +1359,9 @@ (when (compiler:multi-o-constant-pool) (call-with-output-file constant-pool-output-path (lambda (port) - (fprintf port "(~s~n (symbols~n" compiler:setup-suffix) + (fprintf port "(~s\n (symbols\n" compiler:setup-suffix) (vm->c:emit-symbol-list! port "" #f) - (fprintf port " )~n )~n"))))))) + (fprintf port " )\n )\n"))))))) ;;----------------------------------------------------------------------- ;; 3m xform @@ -1369,7 +1369,7 @@ (when c3m-output-path (when (compiler:option:verbose) - (printf " [xforming C to \"~a\"]~n" + (printf " [xforming C to \"~a\"]\n" c3m-output-path)) (let ([clean-up-src-c @@ -1400,14 +1400,14 @@ (if c-only? (when (compiler:option:somewhat-verbose) - (printf " [output to \"~a\"]~n" (or c3m-output-path c-output-path))) + (printf " [output to \"~a\"]\n" (or c3m-output-path c-output-path))) (begin (unless input-path (when (compiler:option:somewhat-verbose) - (printf "\"~a\": ~n" (or c3m-output-path c-output-path)))) + (printf "\"~a\": \n" (or c3m-output-path c-output-path)))) - (when (compiler:option:verbose) (printf " [compiling native code to \"~a\"]~n" + (when (compiler:option:verbose) (printf " [compiling native code to \"~a\"]\n" obj-output-path)) (let ([clean-up @@ -1440,11 +1440,11 @@ (if multi-o? (when (compiler:option:somewhat-verbose) - (printf " [output to \"~a\"]~n" obj-output-path)) + (printf " [output to \"~a\"]\n" obj-output-path)) (begin ;; Link - (when (compiler:option:verbose) (printf " [linking to \"~a\"]~n" + (when (compiler:option:verbose) (printf " [linking to \"~a\"]\n" dll-output-path)) (let ([link-thunk (lambda () @@ -1465,7 +1465,7 @@ (delete-file obj-output-path)) (when (compiler:option:somewhat-verbose) - (printf " [output to \"~a\"]~n" dll-output-path)))))) + (printf " [output to \"~a\"]\n" dll-output-path)))))) (when debug:port (close-output-port debug:port)) @@ -1477,6 +1477,6 @@ (compiler:init-structs!) (set! s:file-block #f) (when (compiler:option:verbose) - (printf " finished [cpu ~a, real ~a].~n" + (printf " finished [cpu ~a, real ~a].\n" total-cpu-time total-real-time))))))) diff --git a/collects/compiler/private/library.rkt b/collects/compiler/private/library.rkt index bab172cd03..b485a9a64b 100644 --- a/collects/compiler/private/library.rkt +++ b/collects/compiler/private/library.rkt @@ -95,7 +95,7 @@ (let ([i set-next-index]) (set! set-next-index (add1 set-next-index)) (unless (< i (vector-length index-vector)) - (printf "grow ~a~n" i) + (printf "grow ~a\n" i) (let* ([old-iv index-vector] [old-sv singleton-vector] [old-size (vector-length index-vector)] diff --git a/collects/compiler/private/vehicle.rkt b/collects/compiler/private/vehicle.rkt index 3fa529de49..f592c803ce 100644 --- a/collects/compiler/private/vehicle.rkt +++ b/collects/compiler/private/vehicle.rkt @@ -137,7 +137,7 @@ vnum (lambda () (compiler:internal-error - #f "bad hash table lookup (2)~n")))] + #f "bad hash table lookup (2)\n")))] [curr-label (vehicle-total-labels vehicle)]) (vehicle:register-max-arity! vehicle (closure-code-max-arity code)) (s:register-max-arity! (closure-code-max-arity code)) diff --git a/collects/compiler/private/vm2c.rkt b/collects/compiler/private/vm2c.rkt index 9c7110eaf7..60b09b439b 100644 --- a/collects/compiler/private/vm2c.rkt +++ b/collects/compiler/private/vm2c.rkt @@ -85,7 +85,7 @@ (vector-set! v (string->number (symbol->string (zodiac:varref-var b))) sym))) (let loop ([i 0]) (unless (= i (vector-length v)) - (fprintf port " ~s~a ~a~n" (-symbol->string (vector-ref v i)) comma + (fprintf port " ~s~a ~a\n" (-symbol->string (vector-ref v i)) comma (if c-comment? (format "/* ~a */" i) (format "; ~a" i))) @@ -109,14 +109,14 @@ (define (vm->c:emit-symbol-declarations! port) (unless (zero? (const:get-symbol-counter)) (unless (compiler:multi-o-constant-pool) - (fprintf port "static const char *SYMBOL_STRS[~a] = {~n" (const:get-symbol-counter)) + (fprintf port "static const char *SYMBOL_STRS[~a] = {\n" (const:get-symbol-counter)) (vm->c:emit-symbol-list! port "," #t) - (fprintf port "}; /* end of SYMBOL_STRS */~n~n") - (fprintf port "static const long SYMBOL_LENS[~a] = {~n" (const:get-symbol-counter)) + (fprintf port "}; /* end of SYMBOL_STRS */\n\n") + (fprintf port "static const long SYMBOL_LENS[~a] = {\n" (const:get-symbol-counter)) (vm->c:emit-symbol-length-list! port "," #t) - (fprintf port "}; /* end of SYMBOL_LENS */~n~n")) + (fprintf port "}; /* end of SYMBOL_LENS */\n\n")) - (fprintf port "~aScheme_Object * ~a[~a];~n~n" + (fprintf port "~aScheme_Object * ~a[~a];\n\n" (if (compiler:multi-o-constant-pool) "" "static ") (vm->c:SYMBOLS-name) (const:get-symbol-counter)))) @@ -135,10 +135,10 @@ (define (vm->c:emit-inexact-declarations! port) (unless (zero? (const:get-inexact-counter)) - (fprintf port "static const double INEXACT_NUMBERS[~a] = {~n" (const:get-inexact-counter)) + (fprintf port "static const double INEXACT_NUMBERS[~a] = {\n" (const:get-inexact-counter)) (vm->c:emit-inexact-list! port "," #t) - (fprintf port "}; /* end of INEXACT_NUMBERS */~n~n") - (fprintf port "static Scheme_Object * ~a[~a];~n~n" + (fprintf port "}; /* end of INEXACT_NUMBERS */\n\n") + (fprintf port "static Scheme_Object * ~a[~a];\n\n" (vm->c:INEXACTS-name) (const:get-inexact-counter)))) @@ -161,7 +161,7 @@ (substring str 0 (min len 24)) (bytes->string/latin-1 (subbytes str 0 (min len 24))))]) (fprintf port - "/* ~a */~n" + "/* ~a */\n" (list->string (map (lambda (i) (cond [(eq? i #\/) #\_] @@ -173,12 +173,12 @@ (let loop ([i 0]) (unless (= i len) (when (zero? (modulo i 20)) - (fprintf port "~n ")) + (fprintf port "\n ")) (fprintf port "~a, " (if (string? str) (char->integer (string-ref str i)) (bytes-ref str i))) (loop (add1 i))))) - (fprintf port "0 }; /* end of ~a */~n~n" name))) + (fprintf port "0 }; /* end of ~a */\n\n" name))) (define (vm->c:emit-symbol-definitions! port) (unless (zero? (const:get-symbol-counter)) @@ -193,7 +193,7 @@ (lambda (sym b) (unless (interned? sym) (let ([pos (zodiac:varref-var b)]) - (fprintf port " s = scheme_make_exact_symbol(SYMBOL_STRS[~a], SYMBOL_LENS[~a]); /* uninterned */~n" + (fprintf port " s = scheme_make_exact_symbol(SYMBOL_STRS[~a], SYMBOL_LENS[~a]); /* uninterned */\n" pos pos) (fprintf port " SYMBOLS[~a] = s;\n" pos))))))) @@ -208,24 +208,24 @@ (define vm->c:emit-prim-ref-declarations! (lambda (port) (unless (set-empty? (compiler:get-primitive-refs)) - (fprintf port "/* primitives referenced by the code */~n") - (fprintf port "static struct {~n") + (fprintf port "/* primitives referenced by the code */\n") + (fprintf port "static struct {\n") (for-each (lambda (a) - (fprintf port " Scheme_Object * ~a;~n" + (fprintf port " Scheme_Object * ~a;\n" (vm->c:convert-symbol (vm->c:bucket-name (module-path-index-join ''#%kernel #f) a)))) (set->list (compiler:get-primitive-refs))) - (fprintf port "} P;~n") + (fprintf port "} P;\n") (newline port)))) (define vm->c:emit-prim-ref-definitions! (lambda (port) (unless (set-empty? (compiler:get-primitive-refs)) - (fprintf port " /* primitives referenced by the code */~n") + (fprintf port " /* primitives referenced by the code */\n") (for-each (lambda (a) - (fprintf port "~aP.~a = scheme_module_bucket(~a, ~a, -1, env)->val;~n" + (fprintf port "~aP.~a = scheme_module_bucket(~a, ~a, -1, env)->val;\n" vm->c:indent-spaces (vm->c:convert-symbol (vm->c:bucket-name (module-path-index-join ''#%kernel #f) a)) (vm->c:make-symbol-const-string (compiler:get-symbol-const! #f '#%kernel)) @@ -234,21 +234,21 @@ (define vm->c:emit-struct-definitions! (lambda (structs port) - (fprintf port "/* compiler-written structures */~n") + (fprintf port "/* compiler-written structures */\n") (for-each (lambda (struct) - (fprintf port "struct ~a~n{~n" + (fprintf port "struct ~a\n{\n" (vm->c:convert-symbol (rep:struct-name struct))) (for-each (lambda (field) - (fprintf port "~a~a ~a;~n" + (fprintf port "~a~a ~a;\n" vm->c:indent-spaces (vm->c:convert-type-definition (rep:struct-field-rep field)) (vm->c:convert-symbol (rep:struct-field-name field)))) (rep:struct-fields struct)) - (fprintf port "};~n")) + (fprintf port "};\n")) (reverse structs)) (newline port))) @@ -259,57 +259,57 @@ (define (emit-static-variable-fields! port l) (unless (null? l) - (fprintf port "#ifndef MZ_PRECISE_GC~n") - (fprintf port " /* Write fields as an array to help C compilers */~n") - (fprintf port " /* that don't like really big records. */~n") - (fprintf port " Scheme_Object * _consts_[~a];~n" (length l)) + (fprintf port "#ifndef MZ_PRECISE_GC\n") + (fprintf port " /* Write fields as an array to help C compilers */\n") + (fprintf port " /* that don't like really big records. */\n") + (fprintf port " Scheme_Object * _consts_[~a];\n" (length l)) (let svloop ([l l][n 0]) (unless (null? l) - (fprintf port "# define ~a _consts_[~a]~n" + (fprintf port "# define ~a _consts_[~a]\n" (vm->c:convert-symbol (car l)) n) (svloop (cdr l) (add1 n)))) - (fprintf port "#else~n") + (fprintf port "#else\n") (for-each (lambda (c) - (fprintf port " Scheme_Object * ~a;~n" + (fprintf port " Scheme_Object * ~a;\n" (vm->c:convert-symbol c))) l) - (fprintf port "#endif~n"))) + (fprintf port "#endif\n"))) ;; when statics have binding information, this will look more like ;; emit-local-variable-declarations! (define vm->c:emit-static-declarations! (lambda (port) (unless (not (compiler:any-statics?)) - (fprintf port "/* compiler-written static variables */~n") - (fprintf port "static struct {~n") + (fprintf port "/* compiler-written static variables */\n") + (fprintf port "static struct {\n") (emit-static-variable-fields! port (compiler:get-static-list)) (unless (null? (compiler:get-case-lambdas)) - (fprintf port " mzshort *casesArities[~a];~n" + (fprintf port " mzshort *casesArities[~a];\n" (length (compiler:get-case-lambdas)))) (for-each (lambda (ll) - (fprintf port " Scheme_Object * ~a;~n" + (fprintf port " Scheme_Object * ~a;\n" (vm->c:convert-symbol (zodiac:varref-var ll)))) (compiler:get-lifted-lambda-vars)) - (fprintf port "} S;~n~n")) + (fprintf port "} S;\n\n")) - (fprintf port "/* compiler-written per-load static variables */~n") - (fprintf port "typedef struct Scheme_Per_Load_Statics {~n") + (fprintf port "/* compiler-written per-load static variables */\n") + (fprintf port "typedef struct Scheme_Per_Load_Statics {\n") (if (null? (compiler:get-per-load-static-list)) - (fprintf port " int dummy;~n") + (fprintf port " int dummy;\n") (emit-static-variable-fields! port (compiler:get-per-load-static-list))) - (fprintf port "} Scheme_Per_Load_Statics;~n") + (fprintf port "} Scheme_Per_Load_Statics;\n") (newline port))) ;; when statics have binding information, this need only register ;; pointer declarations (define vm->c:emit-registration! (lambda (port) - (fprintf port "~a/* register compiler-written static variables with GC */~n" + (fprintf port "~a/* register compiler-written static variables with GC */\n" vm->c:indent-spaces) (let ([register (lambda (v) - (fprintf port "~ascheme_register_extension_global(&~a, sizeof(~a));~n" + (fprintf port "~ascheme_register_extension_global(&~a, sizeof(~a));\n" vm->c:indent-spaces v v))]) (unless (or (zero? (const:get-symbol-counter)) (compiler:multi-o-constant-pool)) (register "SYMBOLS")) @@ -322,30 +322,30 @@ (newline port))) (define (vm->c:emit-case-arities-definitions! port) - (fprintf port " /* arity information for compiled case-lambdas */~n") + (fprintf port " /* arity information for compiled case-lambdas */\n") (let caloop ([l (reverse (compiler:get-case-lambdas))][pos 0]) (unless (null? l) (let* ([ast (car l)] [args (zodiac:case-lambda-form-args ast)]) (if (null? args) - (fprintf port "~aS.casesArities[~a] = NULL;~n" + (fprintf port "~aS.casesArities[~a] = NULL;\n" vm->c:indent-spaces pos) (begin - (fprintf port "~a{~n~a mzshort * arities;~n" + (fprintf port "~a{\n~a mzshort * arities;\n" vm->c:indent-spaces vm->c:indent-spaces) - (fprintf port "~a arities = (mzshort *)scheme_malloc_atomic(~a * sizeof(mzshort));~n" + (fprintf port "~a arities = (mzshort *)scheme_malloc_atomic(~a * sizeof(mzshort));\n" vm->c:indent-spaces (* 2 (length args))) (let cailoop ([l args][n 0]) (unless (null? l) (let-values ([(min-arity max-arity) (compiler:formals->arity (car l))]) - (fprintf port "~a arities[~a] = ~a;~n~a arities[~a] = ~a;~n" + (fprintf port "~a arities[~a] = ~a;\n~a arities[~a] = ~a;\n" vm->c:indent-spaces (* 2 n) min-arity vm->c:indent-spaces (add1 (* 2 n)) max-arity)) (cailoop (cdr l) (add1 n)))) - (fprintf port "~a S.casesArities[~a] = arities;~n" + (fprintf port "~a S.casesArities[~a] = arities;\n" vm->c:indent-spaces pos) - (fprintf port "~a}~n" vm->c:indent-spaces)))) + (fprintf port "~a}\n" vm->c:indent-spaces)))) (caloop (cdr l) (add1 pos))))) (define (vm->c:emit-top-levels! kind return? per-load? null-self-modidx? count vm-list locals-list @@ -357,26 +357,26 @@ [ll locals-list] [bl globals-list]) (fprintf c-port - "static ~a ~a_~a(Scheme_Env * env~a)~n{~n" + "static ~a ~a_~a(Scheme_Env * env~a)\n{\n" (if return? "Scheme_Object *" "void") kind i (if (or per-load? module) ", Scheme_Per_Load_Statics *PLS" "")) - (when null-self-modidx? (fprintf c-port "#define self_modidx NULL~n")) + (when null-self-modidx? (fprintf c-port "#define self_modidx NULL\n")) (when (> max-arity 0) (fprintf c-port - "~aScheme_Object * arg[~a];~n" + "~aScheme_Object * arg[~a];\n" vm->c:indent-spaces max-arity) - (fprintf c-port "~aScheme_Object ** tail_buf;~n" + (fprintf c-port "~aScheme_Object ** tail_buf;\n" vm->c:indent-spaces)) (let loop ([c (compiler:option:max-exprs-per-top-level-set)][n n][vml vml][ll ll][bl bl]) (if (or (zero? c) (null? vml) (= n count)) (begin (unless (or (null? vml) (= n count) (not return?)) - (fprintf c-port "~areturn NULL;~n" vm->c:indent-spaces)) - (when null-self-modidx? (fprintf c-port "#undef self_modidx~n")) + (fprintf c-port "~areturn NULL;\n" vm->c:indent-spaces)) + (when null-self-modidx? (fprintf c-port "#undef self_modidx\n")) (fprintf c-port - "} /* end of ~a_~a */~n~n" kind i) + "} /* end of ~a_~a */\n\n" kind i) (if (or (null? vml) (= n count)) i (tls-loop (add1 i) n vml ll bl))) @@ -384,7 +384,7 @@ (loop c n (cdr vml) (cdr ll) (cdr bl)) (begin (let ([start (zodiac:zodiac-start (car vml))]) - (fprintf c-port "~a{ /* [~a,~a] */~n" vm->c:indent-spaces + (fprintf c-port "~a{ /* [~a,~a] */\n" vm->c:indent-spaces (zodiac:location-line start) (zodiac:location-column start))) (vm->c:emit-local-variable-declarations! @@ -403,7 +403,7 @@ (vm->c-expression (car vml) #f c-port vm->c:indent-by #t n) - (fprintf c-port "~a}~n" vm->c:indent-spaces) + (fprintf c-port "~a}\n" vm->c:indent-spaces) (loop (sub1 c) (add1 n) (cdr vml) (cdr ll) (cdr bl)))))))) @@ -426,13 +426,13 @@ (define vm->c:emit-vehicle-declaration (lambda (port number) (vm->c:emit-vehicle-prototype port number) - (fprintf port "; /* ~a */ ~n" + (fprintf port "; /* ~a */ \n" (vehicle-total-labels (get-vehicle number))))) (define vm->c:emit-vehicle-header (lambda (port number) (vm->c:emit-vehicle-prototype port number) - (fprintf port "~n{~n"))) + (fprintf port "\n{\n"))) (define vm->c:emit-vehicle-prologue (lambda (port vehicle) @@ -442,18 +442,18 @@ 0)]) (when (> max-arity 0) ;; emit declaration of argument stack - (fprintf port "~aScheme_Object * arg[~a];~n" + (fprintf port "~aScheme_Object * arg[~a];\n" vm->c:indent-spaces max-arity)) (when (> max-args 0) ;; emit declaration of global variables for argument passing (let loop ([n 0]) (unless (= n max-args) - (fprintf port "~aregister long reg~a;~n" vm->c:indent-spaces n) + (fprintf port "~aregister long reg~a;\n" vm->c:indent-spaces n) (loop (+ n 1))))) (when (> max-arity 0) ;; tail-buffer-setup - (fprintf port "~aScheme_Object ** tail_buf;~n" + (fprintf port "~aScheme_Object ** tail_buf;\n" vm->c:indent-spaces))) (when local-vars-at-top? @@ -466,23 +466,23 @@ ;; emit jump to function... (when (> (vehicle-total-labels vehicle) 1) ;; emit switch dispatcher - (fprintf port "~aswitch(MZC_PARAM_TO_SWITCH(void_param))~n~a{ " + (fprintf port "~aswitch(MZC_PARAM_TO_SWITCH(void_param))\n~a{ " vm->c:indent-spaces vm->c:indent-spaces ) (let loop ([n 0]) (when (and (zero? (modulo n 3)) (not (= n (compiler:get-label-number)))) - (fprintf port "~n~a~a" vm->c:indent-spaces vm->c:indent-spaces)) + (fprintf port "\n~a~a" vm->c:indent-spaces vm->c:indent-spaces)) (if (= n (sub1 (vehicle-total-labels vehicle))) (fprintf port "default: goto FGN~a;" n) (begin (fprintf port "case ~a: goto FGN~a;" n n) (loop (add1 n))))) - (fprintf port "~n~a}~n" vm->c:indent-spaces)))) + (fprintf port "\n~a}\n" vm->c:indent-spaces)))) (define vm->c:emit-vehicle-epilogue (lambda (port number) - (fprintf port "} /* end of vehicle # ~a */~n" number))) + (fprintf port "} /* end of vehicle # ~a */\n" number))) ;; Will be expanded to hold environments, perhaps, etc. (define vm->c:convert-type-definition @@ -539,7 +539,7 @@ (void) (let* ([bound (car locals)] [rep (binding-rep (get-annotation bound))]) - (fprintf port "~a~a ~a;~n" + (fprintf port "~a~a ~a;\n" indent (vm->c:convert-type-definition rep) (vm->c:convert-symbol (zodiac:binding-var bound))) @@ -552,10 +552,10 @@ (cond [(const:per-load-statics-table? var) (unless top-level? - (fprintf port "~aScheme_Per_Load_Statics * PLS;~n" + (fprintf port "~aScheme_Per_Load_Statics * PLS;\n" indent))] [else - (fprintf port "~aScheme_Bucket * G~a;~n" + (fprintf port "~aScheme_Bucket * G~a;\n" indent (vm->c:convert-symbol (mod-glob-cname var)))])) (set->list globals)))) @@ -576,7 +576,7 @@ (compiler:get-module-path-constant mod))] [mod-local (and mod (not (symbol? mod)) (not modidx))] [mod-far (and mod (or (symbol? mod) modidx))]) - (fprintf port "~aG~a = scheme_~a~a~a_bucket(~a~a~a, ~a~a~a);~n" + (fprintf port "~aG~a = scheme_~a~a~a_bucket(~a~a~a, ~a~a~a);\n" indent name (if et? "exptime_" "") @@ -619,29 +619,29 @@ ;; if the binding is mutable, we need to make a box and fill it with ;; the correct value (let ([rep (get-rep n)]) - (fprintf port "~ascheme_malloc(sizeof(~a));~n" + (fprintf port "~ascheme_malloc(sizeof(~a));\n" (get-cast n #f) (vm->c:convert-type-definition (rep:pointer-to rep))) - (fprintf port "~a*(~a)~a = (~a)~a;~n" + (fprintf port "~a*(~a)~a = (~a)~a;\n" indent (vm->c:convert-type-definition rep) (get-dest n) (vm->c:convert-type-definition (rep:pointer-to rep)) (argv-n))) - (fprintf port "~a~a;~n" (get-cast n #t) (argv-n))) + (fprintf port "~a~a;\n" (get-cast n #t) (argv-n))) (loop (cdr args) (sub1 n) #f)] [else ; the rest get pulled into a list (when (dest-boxed? n) (fprintf port - "~a~a = ~ascheme_malloc(sizeof(Scheme_Object *));~n" + "~a~a = ~ascheme_malloc(sizeof(Scheme_Object *));\n" indent (get-dest n) (get-cast n #f))) (fprintf port - "~a~a~a = ~ascheme_build_list_offset(argc, argv, ~a);~n" + "~a~a~a = ~ascheme_build_list_offset(argc, argv, ~a);\n" indent (if (dest-boxed? n) "*(Scheme_Object * *)" @@ -677,7 +677,7 @@ (lambda (binding) (let* ([rep (binding-rep (get-annotation binding))] [derep (rep:pointer-to rep)]) - (fprintf port "~a~a = (~a)~a;~n~a*(~a) = scheme_undefined;~n" + (fprintf port "~a~a = (~a)~a;\n~a*(~a) = scheme_undefined;\n" indent (vm->c:convert-symbol (zodiac:binding-var binding)) (vm->c:convert-type-definition rep) @@ -691,7 +691,7 @@ (lambda (undefines indent port) (for-each (lambda (name) - (fprintf port "#~aundef ~a~n" + (fprintf port "#~aundef ~a\n" indent name)) undefines))) @@ -703,7 +703,7 @@ (values 1 #f) (begin ;; The foreign entry label - (fprintf port "FGN~a:~n" label) + (fprintf port "FGN~a:\n" label) (let loop ([args (zodiac:case-lambda-form-args L)][i 0]) (if (null? args) (begin @@ -718,27 +718,27 @@ (compiler:formals->arity (car l))]) (fprintf port ", ~a, ~a" min-arity max-arity) (loop (cdr l))))) - (fprintf port ");~n") - (fprintf port "~a~areturn NULL;~n" + (fprintf port ");\n") + (fprintf port "~a~areturn NULL;\n" vm->c:indent-spaces vm->c:indent-spaces) (values i #t)) (let ([a (car args)]) (cond [(zodiac:sym-arglist? a) - (fprintf port "~a~agoto FGN~ac~a;~n" + (fprintf port "~a~agoto FGN~ac~a;\n" vm->c:indent-spaces vm->c:indent-spaces label i) (values (add1 i) #t)] [(zodiac:list-arglist? a) - (fprintf port "~a~aif (argc == ~a) goto FGN~ac~a;~n" + (fprintf port "~a~aif (argc == ~a) goto FGN~ac~a;\n" vm->c:indent-spaces vm->c:indent-spaces (length (zodiac:arglist-vars a)) label i) (loop (cdr args) (add1 i))] [else - (fprintf port "~a~aif (argc >= ~a) goto FGN~ac~a;~n" + (fprintf port "~a~aif (argc >= ~a) goto FGN~ac~a;\n" vm->c:indent-spaces vm->c:indent-spaces (sub1 (length (zodiac:arglist-vars a))) label @@ -757,8 +757,8 @@ [name (vm->c:convert-symbol vname)] [fname (rep:find-field (closure-code-rep code) vname)]) (fprintf port (if (compiler:option:unpack-environments) - "~a~a = env->~a;~n" - "#~adefine ~a env->~a~n") + "~a~a = env->~a;\n" + "#~adefine ~a env->~a\n") indent name fname) @@ -781,8 +781,8 @@ (begin (fprintf port (if (compiler:option:unpack-environments) - "~aPLS = env->pls;~n" - "#~adefine PLS env->pls~n") + "~aPLS = env->pls;\n" + "#~adefine PLS env->pls\n") indent) (loop (cdr vars) (if (compiler:option:unpack-environments) @@ -794,8 +794,8 @@ [fname (rep:find-field (closure-code-rep code) vname)]) (fprintf port (if (compiler:option:unpack-environments) - "~aG~a = env->~a;~n" - "#~adefine G~a env->~a~n") + "~aG~a = env->~a;\n" + "#~adefine G~a env->~a\n") indent name fname) @@ -827,12 +827,12 @@ (loop (cdr l))))))))]) (set-minus free-set uncaptured-anchor-set))]) ; The foreign entry label - (fprintf port "FGN~a~a:~n" label lsuffix) + (fprintf port "FGN~a~a:\n" label lsuffix) ; Pull arguments to global registers (vm->c:pack-global-registers! L which indent port) ; The local entry label - (fprintf port "LOC~a~a:~n" label lsuffix) + (fprintf port "LOC~a~a:\n" label lsuffix) (pre-decl) (unless local-vars-at-top? (vm->c:emit-local-variable-declarations! (code-local-vars case-code) indent port)) @@ -843,8 +843,8 @@ (let ([r (closure-code-rep code)]) (when r - ;; (fprintf port "~aconst ~a * env;~n" indent (vm->c:convert-type-definition r)) - (fprintf port "#~adefine env MZC_ENV_POINTER(~a, ~a, void_param)~n" + ;; (fprintf port "~aconst ~a * env;\n" indent (vm->c:convert-type-definition r)) + (fprintf port "#~adefine env MZC_ENV_POINTER(~a, ~a, void_param)\n" indent (vm->c:convert-type-definition r) (vm->c:convert-type-definition (closure-code-alloc-rep code))))) @@ -875,7 +875,7 @@ #| (let ([r (closure-code-rep code)]) (when r - (fprintf port "~aenv = (~a *)void_param;~n" + (fprintf port "~aenv = (~a *)void_param;\n" indent (vm->c:convert-type-definition r)))) |# @@ -897,18 +897,18 @@ undefines)) (when (case-code-has-continue? case-code) - (fprintf port "~awhile(1)~n" indent)) + (fprintf port "~awhile(1)\n" indent)) undefines))) (define vm->c:emit-case-epilogue (lambda (code which undefines indent port) - (fprintf port "#~aundef env~n" indent) + (fprintf port "#~aundef env\n" indent) (vm->c:emit-undefines undefines indent port))) (define vm->c:emit-function-epilogue (lambda (code close port) - (fprintf port "~a~a /* end of function body ~a */~n" + (fprintf port "~a~a /* end of function body ~a */\n" vm->c:indent-spaces close (closure-code-label code)))) (define vm->c:convert-symbol @@ -1007,12 +1007,12 @@ ;; (%sequence V ...) -> { M; ... } [(vm:sequence? ast) (let* ([seq (vm:sequence-vals ast)]) - (when braces? (emit-indentation) (emit "{~n")) + (when braces? (emit-indentation) (emit "{\n")) (for-each (lambda (v) (process v (indent) #t #t) - (unless (vm->c:block-statement? v) (emit ";~n"))) + (unless (vm->c:block-statement? v) (emit ";\n"))) seq) - (when braces? (emit-indentation) (emit "}~n")))] + (when braces? (emit-indentation) (emit "}\n")))] ;; (if R (sequence V) (sequence V)) -> ;; if (!SCHEME_FALSEP(A)) { V ... } else { V ...} @@ -1032,7 +1032,7 @@ (emit "!SCHEME_FALSEP(") (process test indent-level #f #t) (emit ")")))) - (emit ")~n") + (emit ")\n") (process (vm:if-then ast) indent-level #t #t) (let ([else-vals (vm:sequence-vals else)]) (cond @@ -1041,7 +1041,7 @@ (emit-indentation) (emit "else ") (iloop (car else-vals))] [(not (null? else-vals)) - (emit-indentation) (emit "else~n") + (emit-indentation) (emit "else\n") (process (vm:if-else ast) indent-level #f #t)] [else (void)]))))] @@ -1056,15 +1056,15 @@ (let ([var (vm->c:convert-symbol (vm:local-varref-var (vm:begin0-setup!-var ast)))]) (emit-indentation) - (emit "if (~a.val == SCHEME_MULTIPLE_VALUES) {~n" var) + (emit "if (~a.val == SCHEME_MULTIPLE_VALUES) {\n" var) (emit-indentation) (emit " Scheme_Thread *pr = scheme_current_thread;\n") (emit-indentation) - (emit " ~a.array = pr->ku.multiple.array;~n" var) + (emit " ~a.array = pr->ku.multiple.array;\n" var) (emit-indentation) - (emit " ~a.count = pr->ku.multiple.count;~n" var) + (emit " ~a.count = pr->ku.multiple.count;\n" var) (emit-indentation) - (emit " SCHEME_DETATCH_MV_BUFFER(~a.array, pr);~n" var) + (emit " SCHEME_DETATCH_MV_BUFFER(~a.array, pr);\n" var) (emit-indentation) (emit "} else ~a.array = NULL" var))] [(vm:begin0-extract? ast) @@ -1138,12 +1138,12 @@ (emit "CHECK_MULTIPLE_VALUES(res, ~a);" num-to-set)) (emit "}") (if (not (null? vars)) - (emit "~n")) + (emit "\n")) (let aloop ([vars vars] [n 0]) (unless (null? vars) (emit-indentation) (process-set! (car vars) (format "scheme_multiple_array[~a]" n) #f) - (emit ";~n") + (emit ";\n") (aloop (cdr vars) (+ n 1)))) ))))] @@ -1183,7 +1183,7 @@ (when (and (eq? arg-type:tail-arg (vm:args-type ast)) (not (null? (vm:args-vals ast)))) (emit-indentation) - (emit "tail_buf = scheme_tail_apply_buffer_wp(~a, scheme_current_thread);~n" + (emit "tail_buf = scheme_tail_apply_buffer_wp(~a, scheme_current_thread);\n" (length (vm:args-vals ast)))) (if (null? (vm:args-vals ast)) (emit-indentation) @@ -1201,7 +1201,7 @@ (process (car args) indent-level #f #t) ;; (emit ")") ;; DEBUGGING (unless (null? (cdr args)) - (emit ";~n")) + (emit ";\n")) (arloop (add1 n) (cdr args)))))] [(vm:register-args? ast) @@ -1214,7 +1214,7 @@ (emit "~a = " (vm->c:convert-symbol (zodiac:binding-var var))) (process val indent-level #f #f) (unless (null? (cdr vars)) - (emit ";~n") + (emit ";\n") (raloop (cdr vars) (cdr vals))))))] ;; (alloc ) -> malloc @@ -1304,11 +1304,11 @@ (let ([var (vm->c:convert-symbol (vm:local-varref-var (vm:wcm-remember!-var ast)))]) (emit-indentation) - (emit "scheme_temp_dec_mark_depth();~n") + (emit "scheme_temp_dec_mark_depth();\n") (emit-indentation) (emit "~a.val = " var) (process (vm:wcm-remember!-val ast) indent-level #f #t) - (emit ";~n") + (emit ";\n") (emit-indentation) (emit "scheme_temp_inc_mark_depth()"))] [(vm:wcm-extract? ast) @@ -1319,7 +1319,7 @@ ;; (continue) -> continue; [(vm:continue? ast) (unless (compiler:option:disable-interrupts) - (emit-expr "SCHEME_USE_FUEL(1);~n")) + (emit-expr "SCHEME_USE_FUEL(1);\n")) (emit-expr "continue")] ;; use NULL instead of tail_buf if no args @@ -1337,11 +1337,11 @@ (emit-indentation) (emit "void_param = MZC_PRIM_CLS_DATA(") (process (vm:tail-call-closure ast) indent-level #f #t) - (emit ");~n")) + (emit ");\n")) ;; be nice to threads & user breaks: (unless (compiler:option:disable-interrupts) (emit-indentation) - (emit "SCHEME_USE_FUEL(1);~n")) + (emit "SCHEME_USE_FUEL(1);\n")) (emit-indentation) ; unless its to a variable arity function! ARGH (let* ([label (vm:tail-call-label ast)] diff --git a/collects/compiler/private/vmphase.rkt b/collects/compiler/private/vmphase.rkt index c8d14f53d0..8bf7fc7324 100644 --- a/collects/compiler/private/vmphase.rkt +++ b/collects/compiler/private/vmphase.rkt @@ -247,7 +247,7 @@ (lambda (ast multi? leaf tail-pos tail? used?) (when (compiler:option:debug) (zodiac:print-start! (debug:get-port) ast) - (fprintf (debug:get-port) "~a~n" ast)) + (fprintf (debug:get-port) "~a\n" ast)) (cond ;;----------------------------------------------------------------- diff --git a/collects/compiler/private/winicon.rkt b/collects/compiler/private/winicon.rkt index 37cb898017..717844298b 100644 --- a/collects/compiler/private/winicon.rkt +++ b/collects/compiler/private/winicon.rkt @@ -95,7 +95,7 @@ (bytes->string/latin-1 unistr) "")))) (value name-delta))]) - ;;(printf "Name: ~a~a = ~a~n" path name (+ rsrc-pos (value data-delta))) + ;;(printf "Name: ~a~a = ~a\n" path name (+ rsrc-pos (value data-delta))) (let ([full-name (format "~a~a" path name)]) (if (flag data-delta) (loop (value data-delta) (string-append full-name ".")) @@ -148,14 +148,14 @@ [vdelta image-base]) (file-position p pos) (let loop ([delay-pos (dword->integer p)]) - (printf "~a ~a~n" delay-pos vdelta) + (printf "~a ~a\n" delay-pos vdelta) (file-position p (+ delay-pos vdelta)) (dword->integer p) ; skip attributes (let ([name-pos (dword->integer p)]) - (printf "~a ~a~n" name-pos vdelta) + (printf "~a ~a\n" name-pos vdelta) (file-position p (+ name-pos vdelta)) (let ([name (regexp-match "^[^\0]*" p)]) - (printf "~a~n" name)))))))) + (printf "~a\n" name)))))))) (define-struct icon (desc data)) ;; desc is (list width height colors 0 planes bitcount) @@ -256,7 +256,7 @@ image (mask->alpha (cvt image) mask)) mask)))))))))]) - (unless ico-icon (printf "no! ~a~n" (icon-desc exe-icon))) + (unless ico-icon (printf "no! ~a\n" (icon-desc exe-icon))) (when ico-icon (file-position p (car (icon-data exe-icon))) (display (cdr (icon-data ico-icon)) p))))) @@ -296,7 +296,7 @@ dword->integer) p))) (loop (add1 i)))))]) - ;; (printf "~a~n" icons) + ;; (printf "~a\n" icons) (for-each (lambda (icon) (set-icon-data! icon diff --git a/collects/compiler/private/xform.rkt b/collects/compiler/private/xform.rkt index 3d40192cd2..ee3c168963 100644 --- a/collects/compiler/private/xform.rkt +++ b/collects/compiler/private/xform.rkt @@ -459,7 +459,7 @@ (let loop () (let ([l (read-bytes-line (list-ref proc 3) 'any)]) (unless (eof-object? l) - (fprintf (current-error-port) "~a~n" l) + (fprintf (current-error-port) "~a\n" l) (loop)))) (close-input-port (list-ref proc 3))))) @@ -615,14 +615,14 @@ ;; Setup GC_variable_stack macro (printf (case gc-var-stack-mode [(table) - "#define GC_VARIABLE_STACK (scheme_extension_table->GC_variable_stack)~n"] + "#define GC_VARIABLE_STACK (scheme_extension_table->GC_variable_stack)\n"] [(getspecific) - "#define GC_VARIABLE_STACK (((Thread_Local_Variables *)pthread_getspecific(scheme_thread_local_key))->GC_variable_stack_)~n"] + "#define GC_VARIABLE_STACK (((Thread_Local_Variables *)pthread_getspecific(scheme_thread_local_key))->GC_variable_stack_)\n"] [(function) - "#define GC_VARIABLE_STACK ((scheme_get_thread_local_variables())->GC_variable_stack_)~n"] + "#define GC_VARIABLE_STACK ((scheme_get_thread_local_variables())->GC_variable_stack_)\n"] [(thread-local) - "#define GC_VARIABLE_STACK ((&scheme_thread_locals)->GC_variable_stack_)~n"] - [else "#define GC_VARIABLE_STACK GC_variable_stack~n"])) + "#define GC_VARIABLE_STACK ((&scheme_thread_locals)->GC_variable_stack_)\n"] + [else "#define GC_VARIABLE_STACK GC_variable_stack\n"])) (if gc-variable-stack-through-funcs? (begin @@ -638,11 +638,11 @@ (if callee-restore? " SET_GC_VARIABLE_STACK(__gc_var_stack__);" "") - "~n")) + "\n")) ;; Same, but in a function where the number of registered variables ;; never changes within the procedure (i.e., in nested blocks): - (printf "#define PREPARE_VAR_STACK_ONCE(size) PREPARE_VAR_STACK(size); __gc_var_stack__[1] = (void *)size;~n") + (printf "#define PREPARE_VAR_STACK_ONCE(size) PREPARE_VAR_STACK(size); __gc_var_stack__[1] = (void *)size;\n") ;; Full setup to use before a function call, normally used with FUNCCALL: (printf (string-append @@ -650,7 +650,7 @@ (if callee-restore? "" "SET_GC_VARIABLE_STACK(__gc_var_stack__), ") - "__gc_var_stack__[1] = (void *)x)~n")) + "__gc_var_stack__[1] = (void *)x)\n")) ;; Debugging support: (printf "#ifdef MZ_3M_CHECK_VAR_STACK\n") @@ -662,110 +662,110 @@ ;; Call a function where the number of registered variables can change in ;; nested blocks: - (printf "#define FUNCCALL_each(setup, x) (CHECK_GC_V_S setup, x)~n") + (printf "#define FUNCCALL_each(setup, x) (CHECK_GC_V_S setup, x)\n") ;; The same, but a "tail" call: - (printf "#define FUNCCALL_EMPTY_each(x) (SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]), x)~n") + (printf "#define FUNCCALL_EMPTY_each(x) (SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]), x)\n") ;; The same, but the number of registered variables for this call is definitely ;; the same as for the previous call: (printf (if callee-restore? - "#define FUNCCALL_AGAIN_each(x) (CHECK_GC_V_S x)~n" - "#define FUNCCALL_AGAIN_each(x) FUNCCALL_each(SET_GC_VARIABLE_STACK(__gc_var_stack__), x)~n")) + "#define FUNCCALL_AGAIN_each(x) (CHECK_GC_V_S x)\n" + "#define FUNCCALL_AGAIN_each(x) FUNCCALL_each(SET_GC_VARIABLE_STACK(__gc_var_stack__), x)\n")) ;; As above, but when the number of registered variables never changes ;; within a procedure: - (printf "#define FUNCCALL_once(setup, x) FUNCCALL_AGAIN_each(x)~n") - (printf "#define FUNCCALL_EMPTY_once(x) FUNCCALL_EMPTY_each(x)~n") - (printf "#define FUNCCALL_AGAIN_once(x) FUNCCALL_AGAIN_each(x)~n") + (printf "#define FUNCCALL_once(setup, x) FUNCCALL_AGAIN_each(x)\n") + (printf "#define FUNCCALL_EMPTY_once(x) FUNCCALL_EMPTY_each(x)\n") + (printf "#define FUNCCALL_AGAIN_once(x) FUNCCALL_AGAIN_each(x)\n") ;; Register a particular variable locally: - (printf "#define PUSH(v, x) (__gc_var_stack__[x+2] = (void *)&(v))~n") + (printf "#define PUSH(v, x) (__gc_var_stack__[x+2] = (void *)&(v))\n") ;; Register a particular array variable locally: (printf (string-append "#define PUSHARRAY(v, l, x) (__gc_var_stack__[x+2] = (void *)0, __gc_var_stack__[x+3] = (void *)&(v), " - "__gc_var_stack__[x+4] = (void *)l)~n")) + "__gc_var_stack__[x+4] = (void *)l)\n")) ;; Wraps code to setup a block's variables: - (printf "#define BLOCK_SETUP_TOP(x) ~a~n" (if per-block-push? "x" "/* skipped */")) + (printf "#define BLOCK_SETUP_TOP(x) ~a\n" (if per-block-push? "x" "/* skipped */")) ;; Same, but specifically in a function where nested blocks register ;; extra variables: - (printf "#define BLOCK_SETUP_each(x) BLOCK_SETUP_TOP(x)~n") + (printf "#define BLOCK_SETUP_each(x) BLOCK_SETUP_TOP(x)\n") ;; Same, but specifically in a function where nested blocks DO NOT ;; register extra variables: - (printf "#define BLOCK_SETUP_once(x) /* no effect */~n") + (printf "#define BLOCK_SETUP_once(x) /* no effect */\n") ;; Wrap a normal return: (printf (if callee-restore? - "#define RET_VALUE_START return (__ret__val__ = ~n" - "#define RET_VALUE_START return~n")) + "#define RET_VALUE_START return (__ret__val__ = \n" + "#define RET_VALUE_START return\n")) (printf (if callee-restore? - "#define RET_VALUE_END , SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]), __ret__val__)~n" - "#define RET_VALUE_END ~n")) + "#define RET_VALUE_END , SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]), __ret__val__)\n" + "#define RET_VALUE_END \n")) ;; Wrap a return where the value is produced by a FUNCCALL_EMPTY expression: - (printf "#define RET_VALUE_EMPTY_START return~n") - (printf "#define RET_VALUE_EMPTY_END ~n") + (printf "#define RET_VALUE_EMPTY_START return\n") + (printf "#define RET_VALUE_EMPTY_END \n") ;; Replacement for non-value return: - (printf "#define RET_NOTHING { SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]); return; }~n") + (printf "#define RET_NOTHING { SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]); return; }\n") ;; A non-value return inserted at the end of a void-returning function: - (printf "#define RET_NOTHING_AT_END RET_NOTHING~n") + (printf "#define RET_NOTHING_AT_END RET_NOTHING\n") ;; Declare a temp variable to hold the return value of the indicated type: (printf (if callee-restore? - "#define DECL_RET_SAVE(type) type __ret__val__;~n" - "#define DECL_RET_SAVE(type) /**/~n")) + "#define DECL_RET_SAVE(type) type __ret__val__;\n" + "#define DECL_RET_SAVE(type) /**/\n")) ;; Value used to initialize pointer variables: - (printf "#define NULLED_OUT 0~n") + (printf "#define NULLED_OUT 0\n") ;; Macro to initialize a pointer array: - (printf "#define NULL_OUT_ARRAY(a) memset(a, 0, sizeof(a))~n") + (printf "#define NULL_OUT_ARRAY(a) memset(a, 0, sizeof(a))\n") ;; Annotation that normally disappears: - (printf "#define GC_CAN_IGNORE /**/~n") - (printf "#define __xform_nongcing__ /**/~n") + (printf "#define GC_CAN_IGNORE /**/\n") + (printf "#define __xform_nongcing__ /**/\n") ;; Another annotation to protect against GC conversion: - (printf "#define HIDE_FROM_XFORM(x) x~n") - (printf "#define XFORM_HIDE_EXPR(x) x~n") - (printf "#define HIDE_NOTHING_FROM_XFORM() /**/~n") + (printf "#define HIDE_FROM_XFORM(x) x\n") + (printf "#define XFORM_HIDE_EXPR(x) x\n") + (printf "#define HIDE_NOTHING_FROM_XFORM() /**/\n") ;; In case a conversion is unnecessary where we have this annotation: - (printf "#define START_XFORM_SKIP /**/~n") - (printf "#define END_XFORM_SKIP /**/~n") - (printf "#define START_XFORM_SUSPEND /**/~n") - (printf "#define END_XFORM_SUSPEND /**/~n") - (printf "#define XFORM_START_SKIP /**/~n") - (printf "#define XFORM_END_SKIP /**/~n") - (printf "#define XFORM_START_SUSPEND /**/~n") - (printf "#define XFORM_END_SUSPEND /**/~n") - (printf "#define XFORM_SKIP_PROC /**/~n") + (printf "#define START_XFORM_SKIP /**/\n") + (printf "#define END_XFORM_SKIP /**/\n") + (printf "#define START_XFORM_SUSPEND /**/\n") + (printf "#define END_XFORM_SUSPEND /**/\n") + (printf "#define XFORM_START_SKIP /**/\n") + (printf "#define XFORM_END_SKIP /**/\n") + (printf "#define XFORM_START_SUSPEND /**/\n") + (printf "#define XFORM_END_SUSPEND /**/\n") + (printf "#define XFORM_SKIP_PROC /**/\n") ;; For avoiding warnings: - (printf "#define XFORM_OK_PLUS +~n") - (printf "#define XFORM_OK_MINUS -~n") - (printf "#define XFORM_TRUST_PLUS +~n") - (printf "#define XFORM_TRUST_MINUS -~n") - (printf "#define XFORM_OK_ASSIGN /**/~n") - (printf "~n") + (printf "#define XFORM_OK_PLUS +\n") + (printf "#define XFORM_OK_MINUS -\n") + (printf "#define XFORM_TRUST_PLUS +\n") + (printf "#define XFORM_TRUST_MINUS -\n") + (printf "#define XFORM_OK_ASSIGN /**/\n") + (printf "\n") ;; C++ cupport: - (printf "#define NEW_OBJ(t) new (UseGC) t~n") - (printf "#define NEW_ARRAY(t, array) (new (UseGC) t array)~n") - (printf "#define NEW_ATOM(t) (new (AtomicGC) t)~n") - (printf "#define NEW_PTR(t) (new (UseGC) t)~n") - (printf "#define NEW_ATOM_ARRAY(t, array) (new (AtomicGC) t array)~n") - (printf "#define NEW_PTR_ARRAY(t, array) (new (UseGC) t* array)~n") - (printf "#define DELETE(x) (delete x)~n") - (printf "#define DELETE_ARRAY(x) (delete[] x)~n") + (printf "#define NEW_OBJ(t) new (UseGC) t\n") + (printf "#define NEW_ARRAY(t, array) (new (UseGC) t array)\n") + (printf "#define NEW_ATOM(t) (new (AtomicGC) t)\n") + (printf "#define NEW_PTR(t) (new (UseGC) t)\n") + (printf "#define NEW_ATOM_ARRAY(t, array) (new (AtomicGC) t array)\n") + (printf "#define NEW_PTR_ARRAY(t, array) (new (UseGC) t* array)\n") + (printf "#define DELETE(x) (delete x)\n") + (printf "#define DELETE_ARRAY(x) (delete[] x)\n") (printf (if callee-restore? - "#define XFORM_RESET_VAR_STACK /* empty */~n" - "#define XFORM_RESET_VAR_STACK SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]);~n")) + "#define XFORM_RESET_VAR_STACK /* empty */\n" + "#define XFORM_RESET_VAR_STACK SET_GC_VARIABLE_STACK((void **)__gc_var_stack__[0]);\n")) (unless pgc-really? - (printf "#include \"cgc2.h\"~n")) + (printf "#include \"cgc2.h\"\n")) - (printf "~n")) + (printf "\n")) (when (and pgc? precompiled-header) - (printf "#include \"~a\"~n" (let-values ([(base name dir?) (split-path precompiled-header)]) + (printf "#include \"~a\"\n" (let-values ([(base name dir?) (split-path precompiled-header)]) (path->string name)))) (when palm? - (printf "#include \"segmap.h\"~n")) + (printf "#include \"segmap.h\"\n")) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Structures and constants @@ -1279,7 +1279,7 @@ (display/indent v "));") (newline) (inc-line!)) - (printf "#~adefine ~a_COUNT (~a~a)~n" tabbing tag size prev-add) + (printf "#~adefine ~a_COUNT (~a~a)\n" tabbing tag size prev-add) (inc-line!) (printf "#~adefine SETUP_~a(x) " tabbing tag) (cond @@ -1295,20 +1295,20 @@ (make-string (sub1 indent) #\space))]) (case (tok-n v) [(nested) - (printf "#~adefine BLOCK_SETUP(x) BLOCK_SETUP_each(x)~n" tabbing) - (printf "#~adefine FUNCCALL(s, x) FUNCCALL_each(s, x)~n" tabbing) - (printf "#~adefine FUNCCALL_EMPTY(x) FUNCCALL_EMPTY_each(x)~n" tabbing) - (printf "#~adefine FUNCCALL_AGAIN(x) FUNCCALL_AGAIN_each(x)~n" tabbing)] + (printf "#~adefine BLOCK_SETUP(x) BLOCK_SETUP_each(x)\n" tabbing) + (printf "#~adefine FUNCCALL(s, x) FUNCCALL_each(s, x)\n" tabbing) + (printf "#~adefine FUNCCALL_EMPTY(x) FUNCCALL_EMPTY_each(x)\n" tabbing) + (printf "#~adefine FUNCCALL_AGAIN(x) FUNCCALL_AGAIN_each(x)\n" tabbing)] [(no-nested) - (printf "#~adefine BLOCK_SETUP(x) BLOCK_SETUP_once(x)~n" tabbing) - (printf "#~adefine FUNCCALL(s, x) FUNCCALL_once(s, x)~n" tabbing) - (printf "#~adefine FUNCCALL_EMPTY(x) FUNCCALL_EMPTY_once(x)~n" tabbing) - (printf "#~adefine FUNCCALL_AGAIN(x) FUNCCALL_AGAIN_once(x)~n" tabbing)] + (printf "#~adefine BLOCK_SETUP(x) BLOCK_SETUP_once(x)\n" tabbing) + (printf "#~adefine FUNCCALL(s, x) FUNCCALL_once(s, x)\n" tabbing) + (printf "#~adefine FUNCCALL_EMPTY(x) FUNCCALL_EMPTY_once(x)\n" tabbing) + (printf "#~adefine FUNCCALL_AGAIN(x) FUNCCALL_AGAIN_once(x)\n" tabbing)] [(undefine) - (printf "#~aundef BLOCK_SETUP~n" tabbing) - (printf "#~aundef FUNCCALL~n" tabbing) - (printf "#~aundef FUNCCALL_EMPTY~n" tabbing) - (printf "#~aundef FUNCCALL_AGAIN~n" tabbing)]) + (printf "#~aundef BLOCK_SETUP\n" tabbing) + (printf "#~aundef FUNCCALL\n" tabbing) + (printf "#~aundef FUNCCALL_EMPTY\n" tabbing) + (printf "#~aundef FUNCCALL_AGAIN\n" tabbing)]) (set! line (+ 4 line)))] [(memq (tok-n v) asm-commands) (newline/indent indent) @@ -1483,7 +1483,7 @@ [(typedef? e) (when show-info? - (printf "/* TYPEDEF */~n")) + (printf "/* TYPEDEF */\n")) (if (or (simple-unused-def? e) (unused-struc-typedef? e)) null @@ -1496,7 +1496,7 @@ (when (eq? (tok-n (car e)) '__xform_nongcing__) (hash-table-put! non-gcing-functions name #t)) (when show-info? - (printf "/* PROTO ~a */~n" name)) + (printf "/* PROTO ~a */\n" name)) (if (or precompiling-header? (> (hash-table-get used-symbols name) 1) (ormap (lambda (v) (eq? (tok-n v) 'virtual)) e)) ; can't drop virtual methods! @@ -1509,17 +1509,17 @@ (begin (when pgc? (register-struct e)) - (when show-info? (printf "/* STRUCT ~a */~n" (tok-n (cadr e))))) - (when show-info? (printf "/* STRUCT DECL */~n"))) + (when show-info? (printf "/* STRUCT ~a */\n" (tok-n (cadr e))))) + (when show-info? (printf "/* STRUCT DECL */\n"))) e] [(class-decl? e) (if (or (braces? (caddr e)) (eq? '|:| (tok-n (caddr e)))) (begin - (when show-info? (printf "/* CLASS ~a */~n" (tok-n (cadr e)))) + (when show-info? (printf "/* CLASS ~a */\n" (tok-n (cadr e)))) (register-class e)) (begin - (when show-info? (printf "/* CLASS DECL */~n")) + (when show-info? (printf "/* CLASS DECL */\n")) (let ([name (tok-n (cadr e))]) (if (assoc name c++-classes) ;; we already know this class @@ -1532,7 +1532,7 @@ (if (skip-function? e) e (begin - (when show-info? (printf "/* FUNCTION ~a */~n" name)) + (when show-info? (printf "/* FUNCTION ~a */\n" name)) (if (or (positive? suspend-xform) (not pgc?) (and where @@ -1550,7 +1550,7 @@ ;; or still in headers and probably a simple inlined function (let ([palm-static? (and palm? (eq? 'static (tok-n (car e))))]) (when palm? - (fprintf map-port "(~aimpl ~s)~n" + (fprintf map-port "(~aimpl ~s)\n" (if palm-static? "s" "") name) (call-graph name e)) @@ -1567,7 +1567,7 @@ e)) (convert-function e name)))))] [(var-decl? e) - (when show-info? (printf "/* VAR */~n")) + (when show-info? (printf "/* VAR */\n")) (if (and can-drop-vars? (simple-unused-def? e)) null @@ -1984,7 +1984,7 @@ tcp_accept_addr)))) (begin (when show-info? - (printf "/* ~a: ~a ~a*/~n" + (printf "/* ~a: ~a ~a*/\n" comment name (cond [struct-array? @@ -2022,7 +2022,7 @@ (log-error "[INST] ~a in ~a: Static instance of class ~a." (tok-line (car e)) (tok-file (car e)) base)) (when show-info? - (printf "/* NP ~a: ~a */~n" + (printf "/* NP ~a: ~a */\n" comment name)) (loop (sub1 l) #f pointers (cons (cons name (make-non-pointer-type non-ptr-base)) @@ -2060,7 +2060,7 @@ (let loop ([e e]) (cond [(null? (cdr e)) - (fprintf map-port "(decl ~s)~n" name) + (fprintf map-port "(decl ~s)\n" name) (list (make-tok (string->symbol (format "SEGOF_~a" name)) #f #f) (car e))] @@ -3449,14 +3449,14 @@ (not (or (ormap (lambda (var) (and (array-type? (cdr var)) '(fprintf (current-error-port) - "Optwarn [return] ~a in ~a: tail-push blocked by ~s[].~n" + "Optwarn [return] ~a in ~a: tail-push blocked by ~s[].\n" (tok-line (car func)) (tok-file (car func)) (car var)))) (live-var-info-vars live-vars)) (ormap (lambda (&-var) (and (assq &-var vars) '(fprintf (current-error-port) - "Optwarn [return] ~a in ~a: tail-push blocked by &~s.~n" + "Optwarn [return] ~a in ~a: tail-push blocked by &~s.\n" (tok-line (car func)) (tok-file (car func)) &-var))) &-vars))))] @@ -3854,7 +3854,7 @@ (call-graph/body name (seq->list (seq-in v)))] [(assq (tok-n v) (prototyped)) (fprintf map-port - "(call ~s ~s)~n" + "(call ~s ~s)\n" name (tok-n v))] [else (void)])) e)) @@ -4032,8 +4032,8 @@ (when precompiling-header? (let loop ([i 1]) (unless (i . > . gentag-count) - (printf "#undef XfOrM~a_COUNT~n" i) - (printf "#undef SETUP_XfOrM~a~n" i) + (printf "#undef XfOrM~a_COUNT\n" i) + (printf "#undef SETUP_XfOrM~a\n" i) (loop (add1 i))))) (close-output-port (current-output-port)) diff --git a/collects/compiler/src2src.rkt b/collects/compiler/src2src.rkt index 4cf3d606d2..61d08af080 100644 --- a/collects/compiler/src2src.rkt +++ b/collects/compiler/src2src.rkt @@ -79,7 +79,7 @@ (init-field src-stx) (when (not (syntax? src-stx)) - (printf "~a~n" src-stx) + (printf "~a\n" src-stx) (error 'stx)) (init-field [cert-stxes (list src-stx)]) (field (known-value #f)) @@ -701,7 +701,7 @@ [f (dynamic-require 'mzscheme (send rator orig-name))]) (with-handlers ([exn:fail? (lambda (x) (fprintf (current-error-port) - "constant calculation error: ~a~n" + "constant calculation error: ~a\n" (exn-message x)) this)]) (known-single-result @@ -1583,7 +1583,7 @@ (syntax-position stx))]) (fprintf (current-output-port) " ")) (fprintf (current-output-port) - "~a: ~.s~n" + "~a: ~.s\n" msg (syntax->datum (send exp sexpr))))) diff --git a/collects/deinprogramm/world.rkt b/collects/deinprogramm/world.rkt index 467532ad56..47cecb1634 100644 --- a/collects/deinprogramm/world.rkt +++ b/collects/deinprogramm/world.rkt @@ -194,7 +194,7 @@ (else #f)))) [define (end-of-time s) - (printf "end of time: ~a~n" s) + (printf "end of time: ~a\n" s) (stop-it) the-world] diff --git a/collects/dynext/compile-unit.rkt b/collects/dynext/compile-unit.rkt index e46711d87a..4d40926611 100644 --- a/collects/dynext/compile-unit.rkt +++ b/collects/dynext/compile-unit.rkt @@ -290,7 +290,7 @@ ((current-make-compile-input-strings) in) ((current-make-compile-output-strings) out))]) (unless quiet? - (printf "compile-extension: ~a~n" command)) + (printf "compile-extension: ~a\n" command)) (apply my-process* command))) quiet?) (error 'compile-extension "can't find an installed C compiler"))))) diff --git a/collects/dynext/link-unit.rkt b/collects/dynext/link-unit.rkt index bcbd348b90..5bc2db2a1d 100644 --- a/collects/dynext/link-unit.rkt +++ b/collects/dynext/link-unit.rkt @@ -350,7 +350,7 @@ libs output-strings)]) (unless quiet? - (printf "link-extension: ~a~n" command)) + (printf "link-extension: ~a\n" command)) (stdio-link (lambda (quiet?) (apply my-process* command)) quiet?) @@ -393,25 +393,25 @@ (cddr l)] [else (cons (car l) (loop (cdr l)))]))]) (unless quiet? - (printf "link-extension, dlltool phase: ~a~n" + (printf "link-extension, dlltool phase: ~a\n" (cons dlltool dll-command))) (stdio-link (lambda (quiet?) (apply my-process* dlltool dll-command)) quiet?) (unless quiet? - (printf "link-extension, re-link phase: ~a~n" + (printf "link-extension, re-link phase: ~a\n" command1)) (stdio-link (lambda (quiet?) (apply my-process* command1)) quiet?) (unless quiet? - (printf "link-extension, re-dlltool phase: ~a~n" + (printf "link-extension, re-dlltool phase: ~a\n" (cons dlltool dll-command))) (stdio-link (lambda (quiet?) (apply my-process* dlltool dll-command)) quiet?) (unless quiet? - (printf "link-extension, last re-link phase: ~a~n" + (printf "link-extension, last re-link phase: ~a\n" command2)) (stdio-link (lambda (quiet?) (apply my-process* command2)) diff --git a/collects/dynext/private/stdio.rkt b/collects/dynext/private/stdio.rkt index 02277ff576..e4f533310a 100644 --- a/collects/dynext/private/stdio.rkt +++ b/collects/dynext/private/stdio.rkt @@ -27,7 +27,7 @@ (let loop () (let ([t (read-line in 'any)]) (unless (eof-object? t) - (unless quiet? (fprintf (dest) "~a~n" t)) + (unless quiet? (fprintf (dest) "~a\n" t)) (set-box! box (string-append (unbox box) (string #\newline) t)) (loop)))))))] diff --git a/collects/eopl/private/sllgen.rkt b/collects/eopl/private/sllgen.rkt index f226548c9e..8a089bb7f4 100644 --- a/collects/eopl/private/sllgen.rkt +++ b/collects/eopl/private/sllgen.rkt @@ -677,7 +677,7 @@ (letrec ((loop (lambda (rhs) - ;; (eopl:printf "~s~%" rhs) + ;; (eopl:printf "~s\n" rhs) (if (null? rhs) 0 (let ((rhs-item (car rhs)) (rest (cdr rhs))) @@ -685,26 +685,26 @@ ((and (symbol? rhs-item) (sllgen:non-terminal? rhs-item)) - ; (eopl:printf "found nonterminal~%") + ; (eopl:printf "found nonterminal\n") (+ 1 (loop rest))) ((symbol? rhs-item) - ; (eopl:printf "found terminal~%") + ; (eopl:printf "found terminal\n") (+ 1 (loop rest))) ((sllgen:arbno? rhs-item) - ; (eopl:printf "found arbno~%") + ; (eopl:printf "found arbno\n") (+ (loop (sllgen:arbno->rhs rhs-item)) (loop rest))) ((sllgen:separated-list? rhs-item) - ; (eopl:printf "found seplist~%") + ; (eopl:printf "found seplist\n") (+ (loop (sllgen:separated-list->rhs rhs-item)) (loop rest))) ((string? rhs-item) - ; (eopl:printf "found string~%") + ; (eopl:printf "found string\n") (loop rest)) (else - ; (eopl:printf "found error~%") + ; (eopl:printf "found error\n") (report-error rhs-item "unrecognized item")))))))) (loop rhs))))) @@ -884,7 +884,7 @@ (init-loop (cdr productions)))))) (rhs-loop (lambda (lhs rhs) - ;; (eopl:printf "rhs-loop lhs=~s rhs=~s~%" lhs rhs) + ;; (eopl:printf "rhs-loop lhs=~s rhs=~s\n" lhs rhs) (cond ((null? rhs) #t) ((get-nonterminal (car rhs)) => @@ -905,7 +905,7 @@ (set! closure-rules (cons (list lhs nonterminal) closure-rules)) - ;; (eopl:printf "~s~%" (list lhs nonterminal)) + ;; (eopl:printf "~s\n" (list lhs nonterminal)) ))) first-of-rest)) ;; now keep looking @@ -1073,7 +1073,7 @@ ;; 1999, since class could be a string. ((member class (car (car others))) (error 'parser-generation - "grammar not LL(1): shift conflict detected for class ~s in nonterminal ~s:~%~s~%~s~%" + "grammar not LL(1): shift conflict detected for class ~s in nonterminal ~s:\n~s\n~s\n" class non-terminal this-production (car others))) (else (inner (cdr others)))))) (car this-production)) @@ -1495,7 +1495,7 @@ ; ) ; (case opcode ; ((skip) (sllgen:error 'sllgen:cook-token - ; "~%Internal error: skip should have been handled earlier ~s" + ; "\nInternal error: skip should have been handled earlier ~s" ; actions)) ; ((make-symbol identifier) ; (sllgen:make-token 'identifier @@ -1511,7 +1511,7 @@ ; loc)) ; (else ; (sllgen:error 'scanning - ; "~%Unknown opcode selected from action list ~s" + ; "\nUnknown opcode selected from action list ~s" ; actions)))))) @@ -1522,16 +1522,16 @@ (newstates '()) (char '()) (eos-found? #f)) ; do we need to return this too? - ;(eopl:printf "initializing sllgen:scanner-inner-loop~%") + ;(eopl:printf "initializing sllgen:scanner-inner-loop\n") (let loop ((local-states local-states)) ; local-states ; '(begin - ; (eopl:printf "sllgen:scanner-inner-loop char = ~s actions=~s local-states =~%" + ; (eopl:printf "sllgen:scanner-inner-loop char = ~s actions=~s local-states =\n" ; char actions) ; (for-each ; (lambda (local-state) ; (sllgen:pretty-print (map sllgen:unparse-regexp local-state))) ; local-states) - ; (eopl:printf "newstates = ~%") + ; (eopl:printf "newstates = \n") ; (for-each ; (lambda (local-state) ; (sllgen:pretty-print (map sllgen:unparse-regexp local-state))) @@ -1540,7 +1540,7 @@ ;; no more states to consider (begin ; '(eopl:printf - ; "sllgen:scanner-inner-loop returning with actions = ~s char = ~s newstates = ~%" + ; "sllgen:scanner-inner-loop returning with actions = ~s char = ~s newstates = \n" ; actions char) ; '(for-each ; (lambda (local-state) @@ -1548,7 +1548,7 @@ ; newstates) (k actions newstates char stream)) (let ((state (car local-states))) - ; (eopl:printf "first state:~%") + ; (eopl:printf "first state:\n") ; (sllgen:pretty-print state) (cond ((sllgen:action? (car state)) ; state should never be null @@ -1564,11 +1564,11 @@ (if (and (null? char) (not eos-found?)) (sllgen:char-stream-get! stream (lambda (ch1) - '(eopl:printf "read character ~s~%" ch1) + '(eopl:printf "read character ~s\n" ch1) (set! char ch1)) (lambda () (set! eos-found? #t)))) - '(eopl:printf "applying tester ~s to ~s~%" tester char) + '(eopl:printf "applying tester ~s to ~s\n" tester char) (if (and (not (null? char)) (sllgen:apply-tester tester char)) ;; passed the test -- shift is possible @@ -1602,7 +1602,7 @@ => (sllgen:xapply (lambda (sequents) - ;; (printf "processing concat: sequents = ~s~%" sequents) + ;; (printf "processing concat: sequents = ~s\n" sequents) (loop (cons (append sequents (cdr state)) @@ -1630,7 +1630,7 @@ ;; ok, the current buffer is a candidate token (begin (set! success-buffer buffer) - ;; (printf "success-buffer =~s~%" success-buffer) + ;; (printf "success-buffer =~s\n" success-buffer) (set! actions new-actions)) ;; otherwise leave success-buffer and actions alone ) @@ -1663,7 +1663,7 @@ ;; this really is reference equality. #t (begin - ;; (eopl:printf "pushing back ~s~%" (car buff)) + ;; (eopl:printf "pushing back ~s\n" (car buff)) (sllgen:char-stream-push-back! (car buffer) stream) (set! buffer (cdr buffer)) (push-back-loop)))) @@ -1724,9 +1724,9 @@ (define sllgen:make-stream (lambda (tag char stream) - ;(eopl:printf "sllgen:make-stream: building stream at ~s with ~s~%" tag char) + ;(eopl:printf "sllgen:make-stream: building stream at ~s with ~s\n" tag char) (lambda (fcn eos-fcn) - ;(eopl:printf "sllgen:make-stream: emitting ~s~%" char) + ;(eopl:printf "sllgen:make-stream: emitting ~s\n" char) (fcn char stream)))) (define sllgen:list->stream @@ -1778,7 +1778,7 @@ (lambda () ;; when the stream runs out, try this (let ((sentinel (sentinel-fcn))) - ; (eopl:printf "~s~%" sentinel) + ; (eopl:printf "~s\n" sentinel) (fn sentinel (sllgen:constant-stream sentinel)))))))) ; no longer used @@ -1952,13 +1952,13 @@ (if (null? token) (sllgen:stream-get! stream (lambda (next-token next-stream) - ; '(eopl:printf "find-production: filling token buffer with ~s~%" token) + ; '(eopl:printf "find-production: filling token buffer with ~s\n" token) (set! token next-token) (set! stream next-stream)) (lambda () (error 'sllgen:find-production "internal error: shouldn't run off end of stream")))) - ; '(eopl:printf "sllgen:find-production: nonterminal = ~s token = ~s~%" + ; '(eopl:printf "sllgen:find-production: nonterminal = ~s token = ~s\n" ; non-terminal token) (let loop ((alternatives (cdr (assq non-terminal parser)))) @@ -1971,7 +1971,7 @@ (sllgen:token->class token) (sllgen:token->data token))) ((member (sllgen:token->class token) (car (car alternatives))) - ; '(eopl:printf "sllgen:find-production: using ~s~%~%" + ; '(eopl:printf "sllgen:find-production: using ~s\n\n" ; (cdr (car alternatives))) (sllgen:apply-actions non-terminal (cdr (car alternatives)) parser buf token stream k)) @@ -2001,7 +2001,7 @@ (report-error (lambda (target) (error 'parsing - "at line ~s: looking for ~s, found ~s ~s in production~%~s" + "at line ~s: looking for ~s, found ~s ~s in production\n~s" (sllgen:token->location token) target (sllgen:token->class token) @@ -2009,7 +2009,7 @@ action-list)))) (let ((action (car actions)) (next-action (cdr actions))) - ; (eopl:printf "actions = ~s~%token = ~s buf = ~s~%~%" actions token buf) + ; (eopl:printf "actions = ~s\ntoken = ~s buf = ~s~%~%" actions token buf) (case (car action) ((term) (fill-token!) @@ -2077,7 +2077,7 @@ (let loop ((trees trees) (ptr ans) (ctr n)) - ; (eopl:printf "ctr = ~s trees = ~s~%" ctr trees) + ; (eopl:printf "ctr = ~s trees = ~s\n" ctr trees) (cond ((null? trees) (mlist->list ans)) ((zero? ctr) (loop trees ans n)) diff --git a/collects/errortrace/errortrace-lib.rkt b/collects/errortrace/errortrace-lib.rkt index 87152badda..43fd6a364e 100644 --- a/collects/errortrace/errortrace-lib.rkt +++ b/collects/errortrace/errortrace-lib.rkt @@ -370,7 +370,7 @@ (define (output-profile-results paths? sort-time?) (profiling-enabled #f) (error-print-width 50) - (printf "Sorting profile data...~n") + (printf "Sorting profile data...\n") (let* ([sel (if sort-time? cadr car)] [counts (sort (filter (lambda (c) (positive? (car c))) (get-profile-results)) @@ -379,8 +379,8 @@ (for-each (lambda (c) (set! total (+ total (sel c))) - (printf "=========================================================~n") - (printf "time = ~a : no. = ~a : ~e in ~s~n" + (printf "=========================================================\n") + (printf "time = ~a : no. = ~a : ~e in ~s\n" (cadr c) (car c) (caddr c) (cadddr c)) ;; print call paths (when paths? @@ -392,10 +392,10 @@ (lambda (cm) (printf " <- ~e" (car cm))) (cddr cms)) - (printf "~n"))) + (printf "\n"))) (sort (cadddr (cdr c)) (lambda (a b) (> (car a) (car b))))))) counts) - (printf "Total samples: ~a~n" total))) + (printf "Total samples: ~a\n" total))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/collects/framework/preferences.rkt b/collects/framework/preferences.rkt index 25bd438b40..9c74cff455 100644 --- a/collects/framework/preferences.rkt +++ b/collects/framework/preferences.rkt @@ -244,7 +244,7 @@ the state transitions / contracts are: (pref-can-init? p)) (let ([default-okay? (checker default-value)]) (unless default-okay? - (error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t~n" + (error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t\n" p checker default-okay? default-value))) (unless (= (length aliases) (length rewrite-aliases)) diff --git a/collects/framework/private/color-model.rkt b/collects/framework/private/color-model.rkt index 9a45c77909..a18e015204 100644 --- a/collects/framework/private/color-model.rkt +++ b/collects/framework/private/color-model.rkt @@ -192,7 +192,7 @@ (,(xyz-z xyz-white))))]) (apply values (car (transpose sigmas))))) - ;; (printf "should be equal to xyz-white: ~n~a~n" + ;; (printf "should be equal to xyz-white: \n~a\n" ;; (matrix-multiply pre-matrix `((,sigma-r) (,sigma-g) (,sigma-b)))) (define rgb->xyz-matrix @@ -203,13 +203,13 @@ (define xyz->rgb-matrix (matrix-invert rgb->xyz-matrix)) - ;;(printf "should be identity: ~n~a~n" (matrix-multiply rgb->xyz-matrix xyz->rgb-matrix)) + ;;(printf "should be identity: \n~a\n" (matrix-multiply rgb->xyz-matrix xyz->rgb-matrix)) (define (rgb->xyz r g b) (apply make-xyz (car (transpose (matrix-multiply rgb->xyz-matrix (transpose `((,r ,g ,b)))))))) ;;(print-struct #t) - ;; (printf "should be xyz-white: ~n~a~n" (rgb->xyz 255 255 255)) + ;; (printf "should be xyz-white: \n~a\n" (rgb->xyz 255 255 255)) (define (xyz->rgb x y z) (car (transpose (matrix-multiply xyz->rgb-matrix (transpose `((,x ,y ,z))))))) diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index 281844f39f..25ee0731a3 100644 --- a/collects/framework/private/color.rkt +++ b/collects/framework/private/color.rkt @@ -286,7 +286,7 @@ added get-regions (enable-suspend #t)))]) (unless (eq? 'eof type) (enable-suspend #f) - #; (printf "~a at ~a to ~a~n" lexeme (+ in-start-pos (sub1 new-token-start)) + #; (printf "~a at ~a to ~a\n" lexeme (+ in-start-pos (sub1 new-token-start)) (+ in-start-pos (sub1 new-token-end))) (let ((len (- new-token-end new-token-start))) (set-lexer-state-current-pos! ls (+ len (lexer-state-current-pos ls))) @@ -418,11 +418,11 @@ added get-regions (define/private (colorer-driver) (unless (andmap lexer-state-up-to-date? lexer-states) - #;(printf "revision ~a~n" (get-revision-number)) + #;(printf "revision ~a\n" (get-revision-number)) (unless (and tok-cor (= rev (get-revision-number))) (when tok-cor (coroutine-kill tok-cor)) - #;(printf "new coroutine~n") + #;(printf "new coroutine\n") (set! tok-cor (coroutine (λ (enable-suspend) @@ -450,19 +450,19 @@ added get-regions (format "exception in colorer thread: ~s" exn) exn)) (set! tok-cor #f)))) - #;(printf "begin lexing~n") + #;(printf "begin lexing\n") (when (coroutine-run 10 tok-cor) (for-each (lambda (ls) (set-lexer-state-up-to-date?! ls #t)) lexer-states))) - #;(printf "end lexing~n") - #;(printf "begin coloring~n") + #;(printf "end lexing\n") + #;(printf "begin coloring\n") ;; This edit sequence needs to happen even when colors is null ;; for the paren highlighter. (begin-edit-sequence #f #f) (color) (end-edit-sequence) - #;(printf "end coloring~n"))) + #;(printf "end coloring\n"))) (define/private (colorer-callback) (cond @@ -643,7 +643,7 @@ added get-regions ;; possible. (define/private match-parens (lambda ([just-clear? #f]) - ;;(printf "(match-parens ~a)~n" just-clear?) + ;;(printf "(match-parens ~a)\n" just-clear?) (when (and (not in-match-parens?) ;; Trying to match open parens while the ;; background thread is going slows it down. @@ -918,21 +918,21 @@ added get-regions (let* ((x null) (f (λ (a b c) (set! x (cons (list a b c) x))))) (send (lexer-state-tokens ls) for-each f) - (printf "tokens: ~.s~n" (reverse x)) + (printf "tokens: ~.s\n" (reverse x)) (set! x null) (send (lexer-state-invalid-tokens ls) for-each f) - (printf "invalid-tokens: ~.s~n" (reverse x)) - (printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a~n" + (printf "invalid-tokens: ~.s\n" (reverse x)) + (printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a\n" (lexer-state-start-pos ls) (lexer-state-current-pos ls) (lexer-state-invalid-tokens-start ls)) - (printf "parens: ~.s~n" (car (send (lexer-state-parens ls) test))))) + (printf "parens: ~.s\n" (car (send (lexer-state-parens ls) test))))) lexer-states)) ;; ------------------------- Callbacks to Override ---------------------- (define/override (lock x) - ;;(printf "(lock ~a)~n" x) + ;;(printf "(lock ~a)\n" x) (super lock x) (when (and restart-callback (not x)) (set! restart-callback #f) @@ -940,25 +940,25 @@ added get-regions (define/override (on-focus on?) - ;;(printf "(on-focus ~a)~n" on?) + ;;(printf "(on-focus ~a)\n" on?) (super on-focus on?) (match-parens (not on?))) (define/augment (after-edit-sequence) - ;;(printf "(after-edit-sequence)~n") + ;;(printf "(after-edit-sequence)\n") (when (has-focus?) (match-parens)) (inner (void) after-edit-sequence)) (define/augment (after-set-position) - ;;(printf "(after-set-position)~n") + ;;(printf "(after-set-position)\n") (unless (local-edit-sequence?) (when (has-focus?) (match-parens))) (inner (void) after-set-position)) (define/augment (after-change-style a b) - ;;(printf "(after-change-style)~n") + ;;(printf "(after-change-style)\n") (unless (get-styles-fixed) (unless (local-edit-sequence?) (when (has-focus?) @@ -966,19 +966,19 @@ added get-regions (inner (void) after-change-style a b)) (define/augment (on-set-size-constraint) - ;;(printf "(on-set-size-constraint)~n") + ;;(printf "(on-set-size-constraint)\n") (unless (local-edit-sequence?) (when (has-focus?) (match-parens))) (inner (void) on-set-size-constraint)) (define/augment (after-insert edit-start-pos change-length) - ;;(printf "(after-insert ~a ~a)~n" edit-start-pos change-length) + ;;(printf "(after-insert ~a ~a)\n" edit-start-pos change-length) (do-insert/delete edit-start-pos change-length) (inner (void) after-insert edit-start-pos change-length)) (define/augment (after-delete edit-start-pos change-length) - ;;(printf "(after-delete ~a ~a)~n" edit-start-pos change-length) + ;;(printf "(after-delete ~a ~a)\n" edit-start-pos change-length) (do-insert/delete edit-start-pos (- change-length)) (inner (void) after-delete edit-start-pos change-length)) diff --git a/collects/framework/private/editor.rkt b/collects/framework/private/editor.rkt index 3c0b3537f7..0c8981b620 100644 --- a/collects/framework/private/editor.rkt +++ b/collects/framework/private/editor.rkt @@ -242,10 +242,10 @@ (unless (and (procedure? t) (= 0 (procedure-arity t))) (error 'editor:basic::run-after-edit-sequence - "expected procedure of arity zero, got: ~s~n" t)) + "expected procedure of arity zero, got: ~s\n" t)) (unless (or (symbol? sym) (not sym)) (error 'editor:basic::run-after-edit-sequence - "expected second argument to be a symbol or #f, got: ~s~n" + "expected second argument to be a symbol or #f, got: ~s\n" sym)) (if (refresh-delayed?) (if in-local-edit-sequence? diff --git a/collects/framework/private/gen-standard-menus.rkt b/collects/framework/private/gen-standard-menus.rkt index 120799bb53..7e60302278 100644 --- a/collects/framework/private/gen-standard-menus.rkt +++ b/collects/framework/private/gen-standard-menus.rkt @@ -125,7 +125,7 @@ (write-docs)) (define (write-docs) - (printf "writing to ~a~n" docs-menus.ss-filename) + (printf "writing to ~a\n" docs-menus.ss-filename) (call-with-output-file docs-menus.ss-filename (λ (port) (define (pop-out sexp) @@ -203,7 +203,7 @@ #:exists 'truncate)) (define (write-standard-menus.rkt) - (printf "writing to ~a~n" standard-menus.rkt-filename) + (printf "writing to ~a\n" standard-menus.rkt-filename) (call-with-output-file standard-menus.rkt-filename (λ (port) diff --git a/collects/framework/private/panel.rkt b/collects/framework/private/panel.rkt index cfadd9d677..c2efa5306a 100644 --- a/collects/framework/private/panel.rkt +++ b/collects/framework/private/panel.rkt @@ -44,7 +44,7 @@ [(left top) 0] [(right bottom) (- total-size item-size)] [else (error 'place-children - "alignment spec is unknown ~a~n" spec)])))]) + "alignment spec is unknown ~a\n" spec)])))]) (map (λ (l) (let*-values ([(min-width min-height h-stretch? v-stretch?) (apply values l)] diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index 03de70254b..c1cddf1f44 100644 --- a/collects/framework/private/preferences.rkt +++ b/collects/framework/private/preferences.rkt @@ -528,7 +528,7 @@ the state transitions / contracts are: (cond [(string? default) string?] [(number? default) number?] - [else (error 'internal-error.set-default "unrecognized default: ~a~n" default)])) + [else (error 'internal-error.set-default "unrecognized default: ~a\n" default)])) (preferences:add-callback name (λ (p new-value) diff --git a/collects/framework/splash.rkt b/collects/framework/splash.rkt index affbc86943..0357046fb9 100644 --- a/collects/framework/splash.rkt +++ b/collects/framework/splash.rkt @@ -123,12 +123,12 @@ [(or (path? splash-draw-spec) (string? splash-draw-spec)) (unless (file-exists? splash-draw-spec) - (fprintf (current-error-port) "WARNING: bitmap path ~s not found~n" splash-draw-spec) + (fprintf (current-error-port) "WARNING: bitmap path ~s not found\n" splash-draw-spec) (no-splash)) (set! splash-bitmap (make-object bitmap% splash-draw-spec)) (unless (send splash-bitmap ok?) - (fprintf (current-error-port) "WARNING: bad bitmap ~s~n" splash-draw-spec) + (fprintf (current-error-port) "WARNING: bad bitmap ~s\n" splash-draw-spec) (no-splash)) (send splash-canvas min-width (send splash-bitmap get-width)) diff --git a/collects/framework/test.rkt b/collects/framework/test.rkt index 2fc91530a5..9129bbd70b 100644 --- a/collects/framework/test.rkt +++ b/collects/framework/test.rkt @@ -363,7 +363,7 @@ (loop (- n 1))))])))] [(number? state) (unless (send rb is-enabled? state) - (error 'test:set-radio-box! "item ~a is not enabled~n" state)) + (error 'test:set-radio-box! "item ~a is not enabled\n" state)) (send rb set-selection state)] [else (error 'test:set-radio-box! "expected a string or a number as second arg, got: ~e (other arg: ~e)" diff --git a/collects/racket/match/compiler.rkt b/collects/racket/match/compiler.rkt index 4327f2de8b..9f422e0794 100644 --- a/collects/racket/match/compiler.rkt +++ b/collects/racket/match/compiler.rkt @@ -402,7 +402,7 @@ (Row-vars-seen (car block))))) #'failkv)))] - [else (error 'compile "unsupported pattern: ~a~n" first)])) + [else (error 'compile "unsupported pattern: ~a\n" first)])) (define (compile* vars rows esc) (define (let/wrap clauses body) diff --git a/collects/racket/match/split-rows.rkt b/collects/racket/match/split-rows.rkt index 7e3fe4dce8..0499d20ea9 100644 --- a/collects/racket/match/split-rows.rkt +++ b/collects/racket/match/split-rows.rkt @@ -30,13 +30,13 @@ (cond [(Row-unmatch r) (split-rows rows (cons (reverse matched-rows) prev-mats))] [(and (Struct? p) struct-key (eq? (pat-key p) struct-key)) - ;; (printf "struct-keys were equal: ~a~n" struct-key) + ;; (printf "struct-keys were equal: ~a\n" struct-key) (loop/con (cons r matched-rows) prev-mats struct-key rs)] [(and (Struct? p) (not struct-key)) - ;; (printf "no struct-key so far: ~a~n" struct-key) + ;; (printf "no struct-key so far: ~a\n" struct-key) (loop/con (cons r matched-rows) prev-mats (pat-key p) rs)] [(and (CPat? p) (not (Struct? p))) - ;; (printf "wasn't a struct: ~a~n" p) + ;; (printf "wasn't a struct: ~a\n" p) (loop/con (cons r matched-rows) prev-mats struct-key rs)] [else (split-rows rows (cons (reverse matched-rows) prev-mats))])))) @@ -66,7 +66,7 @@ [(CPat? p) (if (Struct? p) (begin - ;; (printf "found a struct: ~a~n" (pat-key r)) + ;; (printf "found a struct: ~a\n" (pat-key r)) (loop/con (list r) acc (pat-key p) rs)) (loop/con (list r) acc #f rs))] [else (split-rows rs (cons (list r) acc))])))) diff --git a/collects/racket/private/more-scheme.rkt b/collects/racket/private/more-scheme.rkt index 482dec13f5..7f91ac1f68 100644 --- a/collects/racket/private/more-scheme.rkt +++ b/collects/racket/private/more-scheme.rkt @@ -341,7 +341,7 @@ (syntax/loc stx (let-values ([(v cpu user gc) (time-apply (lambda () expr1 expr ...) null)]) - (printf "cpu time: ~s real time: ~s gc time: ~s~n" cpu user gc) + (printf "cpu time: ~s real time: ~s gc time: ~s\n" cpu user gc) (apply values v)))]))) (define-syntax (log-it stx) diff --git a/collects/racket/trace.rkt b/collects/racket/trace.rkt index 5cc1929ff6..a0ee083616 100644 --- a/collects/racket/trace.rkt +++ b/collects/racket/trace.rkt @@ -93,9 +93,8 @@ (lambda (n port offset width) (display (if n - (if (zero? n) first - (format "~n~a" rest)) - (format "~n")) + (if (zero? n) first (format "\n~a" rest)) + "\n") port) (if n (if (zero? n) @@ -119,9 +118,8 @@ (lambda (n port offset width) (display (if n - (if (zero? n) first - (format "~n~a" rest)) - (format "~n")) + (if (zero? n) first (format "\n~a" rest)) + "\n") port) (if n (if (zero? n) @@ -139,9 +137,8 @@ (lambda (n port offset width) (display (if n - (if (zero? n) rest - (format "~n~a" rest)) - (format "~n")) + (if (zero? n) rest (format "\n~a" rest)) + "\n") port) (if n (string-length rest) diff --git a/collects/setup/parallel-build-worker.rkt b/collects/setup/parallel-build-worker.rkt index 365714d63d..001b24d514 100644 --- a/collects/setup/parallel-build-worker.rkt +++ b/collects/setup/parallel-build-worker.rkt @@ -17,7 +17,7 @@ (write msg))) (let ([cep (current-error-port)]) (define (pp x) - (fprintf cep "COMPILING ~a ~a ~a ~a~n" worker-id name file x)) + (fprintf cep "COMPILING ~a ~a ~a ~a\n" worker-id name file x)) (with-handlers ([exn:fail? (lambda (x) (send/resp (list 'ERROR (exn-message x))))]) (parameterize ( diff --git a/collects/setup/parallel-build.rkt b/collects/setup/parallel-build.rkt index d3e7f3328a..0d2d0937ca 100644 --- a/collects/setup/parallel-build.rkt +++ b/collects/setup/parallel-build.rkt @@ -25,8 +25,8 @@ ['DONE (void)]) (when (or (not (zero? (string-length out))) (not (zero? (string-length err)))) ((collects-queue-printer jobqueue) (current-error-port) "build-output" "~a ~a" cc-name file) - (eprintf "STDOUT:~n~a=====~n" out) - (eprintf "STDERR:~n~a=====~n" err)))])) + (eprintf "STDOUT:\n~a=====\n" out) + (eprintf "STDERR:\n~a=====\n" err)))])) ;; assigns a collection to each worker to be compiled ;; when it runs out of collections, steals work from other workers collections (define (get-job jobqueue workerid) @@ -53,7 +53,7 @@ (let* ([cc-name (cc-name cc)] [cc-path (cc-path cc)] [full-path (path->string (build-path cc-path file))]) - ;(printf "JOB ~a ~a ~a ~a~n" workerid cc-name cc-path file) + ;(printf "JOB ~a ~a ~a ~a\n" workerid cc-name cc-path file) (values (list cc file) (list cc-name (->bytes cc-path) (->bytes file))))) (let retry () (define (find-job-in-cc cc id) @@ -124,7 +124,7 @@ (write msg))) (let ([cep (current-error-port)]) (define (pp x) - (fprintf cep "COMPILING ~a ~a ~a ~a~n" worker-id name file x)) + (fprintf cep "COMPILING ~a ~a ~a ~a\n" worker-id name file x)) (with-handlers ([exn:fail? (lambda (x) (send/resp (list 'ERROR (exn-message x))))]) (parameterize ( diff --git a/collects/setup/parallel-do.rkt b/collects/setup/parallel-do.rkt index 359c3f59d8..cac9403426 100644 --- a/collects/setup/parallel-do.rkt +++ b/collects/setup/parallel-do.rkt @@ -54,7 +54,7 @@ (define (kill-worker wrkr) (match wrkr [(worker id process-handle out in err) - (eprintf "KILLING WORKER ~a ~a~n" id wrkr) + (eprintf "KILLING WORKER ~a ~a\n" id wrkr) (close-output-port in) (close-input-port out) (subprocess-kill process-handle #t)])) @@ -70,14 +70,14 @@ (define (error-threshold x) (if (x . >= . 4) (begin - (eprintf "Error count reached ~a, exiting~n" x) + (eprintf "Error count reached ~a, exiting\n" x) (exit 1)) #f)) (letrec ([loop (match-lambda* ;; QUEUE IDLE INFLIGHT COUNT ;; Reached stopat count STOP [(list idle inflight count (? error-threshold error-count)) (void)] - [(list idle inflight (? (lambda (x) (= x stopat))) error-count) (printf "DONE AT LIMIT~n")] + [(list idle inflight (? (lambda (x) (= x stopat))) error-count) (printf "DONE AT LIMIT\n")] ;; Send work to idle worker [(list (and (? jobs?) (cons wrkr idle)) inflight count error-count) (let-values ([(job cmd-list) (get-job jobqueue (worker-id wrkr))]) @@ -87,7 +87,7 @@ (match wrkr [(worker i s o in e) (with-handlers* ([exn:fail? (lambda (e) - (printf "MASTER WRITE ERROR - writing to worker: ~a~n" (exn-message e)) + (printf "MASTER WRITE ERROR - writing to worker: ~a\n" (exn-message e)) (kill-worker wrkr) (retry-loop (spawn i) (add1 error-count)))]) (send/msg cmd-list in))]) @@ -102,7 +102,7 @@ (handle-evt out (λ (e) (let ([msg (with-handlers* ([exn:fail? (lambda (e) - (printf "MASTER READ ERROR - reading from worker: ~a~n" (exn-message e)) + (printf "MASTER READ ERROR - reading from worker: ~a\n" (exn-message e)) (kill-worker wrkr) (loop (cons (spawn id) idle) (remove node-worker inflight) @@ -125,9 +125,9 @@ (for ([p workers]) (subprocess-wait (worker-process-handle p)))))) (define (parallel-do-default-error-handler work error-message outstr errstr) - (printf "WORKER ERROR ~a~n" error-message) - (printf "STDOUT~n~a=====~n" outstr) - (printf "STDERR~N~a=====~n" errstr)) + (printf "WORKER ERROR ~a\n" error-message) + (printf "STDOUT\n~a=====\n" outstr) + (printf "STDERR\n~a=====\n" errstr)) (define-struct list-queue (queue results create-job-thunk success-thunk failure-thunk) #:transparent #:mutable @@ -171,14 +171,14 @@ (define (pdo-send msg) (with-handlers ([exn:fail? (lambda (x) - (fprintf orig-err "WORKER SEND MESSAGE ERROR ~a~n" (exn-message x)) + (fprintf orig-err "WORKER SEND MESSAGE ERROR ~a\n" (exn-message x)) (exit 1))]) (write msg orig-out) (flush-output orig-out))) (define (pdo-recv) (with-handlers ([exn:fail? (lambda (x) - (fprintf orig-err "WORKER RECEIVE MESSAGE ERROR ~a~n" (exn-message x)) + (fprintf orig-err "WORKER RECEIVE MESSAGE ERROR ~a\n" (exn-message x)) (exit 1))]) (read))) (match (deserialize (fasl->s-exp (pdo-recv))) @@ -223,8 +223,8 @@ (with-syntax ([cmdline cmdline] [initial-stdin-data initial-stdin-data]) #`(begin - ;(printf "CMDLINE ~v~n" cmdline) - ;(printf "INITIALTHUNK ~v~n" initial-stdin-data) + ;(printf "CMDLINE ~v\n" cmdline) + ;(printf "INITIALTHUNK ~v\n" initial-stdin-data) (let ([jobqueue (make-list-queue list-of-work null create-job-thunk job-success-thunk job-failure-thunk)]) (parallel-do-event-loop initial-stdin-data initalmsg cmdline jobqueue (processor-count) 999999999) (reverse (list-queue-results jobqueue)))))) diff --git a/collects/setup/plt-installer-unit.rkt b/collects/setup/plt-installer-unit.rkt index ce18b4648c..c68a91cd5f 100644 --- a/collects/setup/plt-installer-unit.rkt +++ b/collects/setup/plt-installer-unit.rkt @@ -125,7 +125,7 @@ "Select the destination for unpacking" frame)]) (unless d - (printf ">>> Cancelled <<<~n")) + (printf ">>> Cancelled <<<\n")) (begin-busy-cursor) d)))) cleanup-thunk))))) diff --git a/collects/setup/scribble.rkt b/collects/setup/scribble.rkt index 4e2da4beb1..9135c4c9f8 100644 --- a/collects/setup/scribble.rkt +++ b/collects/setup/scribble.rkt @@ -145,7 +145,7 @@ (if subpart (format "~a: " subpart) "")]) - (printf "~a: ~a~a~n" program-name task (apply format formatstr rest)))) + (printf "~a: ~a~a\n" program-name task (apply format formatstr rest)))) (define (with-record-error cc go fail-k) (with-handlers ([exn:fail? (lambda (exn) diff --git a/collects/setup/winvers.rkt b/collects/setup/winvers.rkt index e8632359ee..f4070ec2de 100644 --- a/collects/setup/winvers.rkt +++ b/collects/setup/winvers.rkt @@ -29,7 +29,7 @@ (let ([argv (current-command-line-arguments)]) (cond [(equal? argv #()) (let ([exe (make-copy)]) - (printf "re-launching first time...~n") + (printf "re-launching first time...\n") (subprocess (current-output-port) (current-input-port) (current-error-port) exe "--collects" collects-dir @@ -37,7 +37,7 @@ [(equal? argv #("patch")) (sleep 1) ; time for other process to end (patch-files) - (printf "re-launching last time...~n") + (printf "re-launching last time...\n") (subprocess (current-output-port) (current-input-port) (current-error-port) (build-path (find-console-bin-dir) "racket.exe") @@ -46,5 +46,5 @@ (sleep 1) ; time for other process to end (delete-directory/files (build-path (find-system-path 'temp-dir) "setvers")) - (printf "done!~n")] + (printf "done!\n")] [else (error 'winvers "unknown command line: ~e" argv)])) diff --git a/collects/sirmail/pref.rkt b/collects/sirmail/pref.rkt index ea241e3bca..d9374aef69 100644 --- a/collects/sirmail/pref.rkt +++ b/collects/sirmail/pref.rkt @@ -378,8 +378,8 @@ (message-box "Preference Error" (format (string-append - "The biff delay must be an exact integer between 1 and 3600.~n" - "You provided:~n" + "The biff delay must be an exact integer between 1 and 3600.\n" + "You provided:\n" " ~a") s) tl @@ -401,8 +401,8 @@ (message-box "Preference Error" (format (string-append - "The message size must be an exact, positive integer.~n" - "You provided:~n" + "The message size must be an exact, positive integer.\n" + "You provided:\n" " ~a") s) tl diff --git a/collects/sirmail/readr.rkt b/collects/sirmail/readr.rkt index b278fa47e6..66ee977af3 100644 --- a/collects/sirmail/readr.rkt +++ b/collects/sirmail/readr.rkt @@ -485,7 +485,7 @@ (when (and size warn-size (> size warn-size)) (unless (eq? 'yes (confirm-box "Large Message" - (format "The message is ~s bytes.~nReally download?" size) + (format "The message is ~s bytes.\nReally download?" size) main-frame)) (status "") (raise-user-error "download aborted")))) @@ -1653,7 +1653,7 @@ (when (eq? 'yes (confirm-box "Error" - (format "There was an communication error.~nClose the connection?") + (format "There was an communication error.\nClose the connection?") main-frame)) (force-disconnect/status))))))]) (header-changing-action @@ -2507,7 +2507,7 @@ [slurp-stream (lambda (ent o) (with-handlers ([exn:fail? (lambda (x) (fprintf o - "~n[decode error: ~a]~n" + "\n[decode error: ~a]\n" (if (exn? x) (exn-message x) x)))]) diff --git a/collects/slatex/slatex.rkt b/collects/slatex/slatex.rkt index a296970374..37939506cc 100644 --- a/collects/slatex/slatex.rkt +++ b/collects/slatex/slatex.rkt @@ -16,7 +16,7 @@ ((eq? a 'string-ref) 'string-set!) ((eq? a 'vector-ref) 'vector-set!) ((eq? a 'slatex::of) 'slatex::the-setter-for-of) - (else (error "setf ~s ~s is ill-formed~%" l r))) + (else (error "setf ~s ~s is ill-formed\n" l r))) ,@(cdr l) ,r))))))))) diff --git a/collects/slideshow/viewer.rkt b/collects/slideshow/viewer.rkt index 33316a3a57..a87f215252 100644 --- a/collects/slideshow/viewer.rkt +++ b/collects/slideshow/viewer.rkt @@ -298,7 +298,7 @@ (send f show #f)) (send f show #f) (when config:print-slide-seconds? - (printf "Total Time: ~a seconds~n" + (printf "Total Time: ~a seconds\n" (- (current-seconds) talk-start-seconds))) ;; In case slides are still building, tell them to stop. We ;; prefer not to `exit' directly if we don't have to. @@ -380,7 +380,7 @@ (sub1 slide-count)))) (when config:print-slide-seconds? (let ([slide-end-seconds (current-seconds)]) - (printf "Slide ~a: ~a seconds~n" current-page + (printf "Slide ~a: ~a seconds\n" current-page (- slide-end-seconds slide-start-seconds)) (set! slide-start-seconds slide-end-seconds))) ;; Refresh screen, and start transitions from old, if any @@ -1144,16 +1144,16 @@ (send c-frame show #t) (message-box "Instructions" (format "Keybindings:~ - ~n {Meta,Alt}-q - quit~ - ~n Right, Space, f or n - next slide~ - ~n Left, b - prev slide~ - ~n g - last slide~ - ~n 1 - first slide~ - ~n {Meta,Alt}-g - select slide~ - ~n p - show/hide slide number~ - ~n {Meta,Alt}-c - show/hide commentary~ - ~n {Meta,Alt,Shift}-{Right,Left,Up,Down} - move window~ - ~nAll bindings work in all windows"))) + \n {Meta,Alt}-q - quit~ + \n Right, Space, f or n - next slide~ + \n Left, b - prev slide~ + \n g - last slide~ + \n 1 - first slide~ + \n {Meta,Alt}-g - select slide~ + \n p - show/hide slide number~ + \n {Meta,Alt}-c - show/hide commentary~ + \n {Meta,Alt,Shift}-{Right,Left,Up,Down} - move window~ + \nAll bindings work in all windows"))) (define (do-print) (let ([ps-dc (dc-for-text-size)]) diff --git a/collects/srpersist/doc.txt b/collects/srpersist/doc.txt index b51d25ccdf..2262db0df4 100644 --- a/collects/srpersist/doc.txt +++ b/collects/srpersist/doc.txt @@ -127,8 +127,8 @@ (with-handlers ([(lambda (exn) (exn-with-info? exn)) (lambda (exn) - (printf "Got exn-with-info exception~n") - (printf "Value: ~a~n" (exn-with-info-val exn)))]) + (printf "Got exn-with-info exception\n") + (printf "Value: ~a\n" (exn-with-info-val exn)))]) ...) Applications can call sql-error, get-diag-rec, or get-diag-field @@ -2607,6 +2607,3 @@ [ODBC 3.5 or greater] 'sql-c-guid - - - diff --git a/collects/srpersist/tutorial.txt b/collects/srpersist/tutorial.txt index 0bc176e644..2a387f55e8 100644 --- a/collects/srpersist/tutorial.txt +++ b/collects/srpersist/tutorial.txt @@ -155,10 +155,10 @@ Now we can retrieve the data and print it out: (with-handlers ([(lambda (exn) (exn-no-data? exn)) - (lambda (exn) (printf "** End of data **~n"))]) + (lambda (exn) (printf "** End of data **\n"))]) (let loop () (fetch hstmt) - (printf "Name: ~a Age: ~a~n" + (printf "Name: ~a Age: ~a\n" (read-buffer name-buffer) (read-buffer age-buffer)) (loop))) diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt index 77b7b03e95..984685dced 100644 --- a/collects/stepper/private/annotate.rkt +++ b/collects/stepper/private/annotate.rkt @@ -77,7 +77,7 @@ ; [elaborated (cadr arg-list)] ; [eval-result (caddr arg-list)] ; [collapsed (collapse-let-values (expand stx))]) -; (printf "~a~n~a~n~a~n~a~n" (syntax->datum collapsed) +; (printf "~a\n~a\n~a\n~a\n" (syntax->datum collapsed) ; elaborated ; (eval collapsed) ; eval-result) @@ -1223,4 +1223,4 @@ (define saved-code-inspector (current-code-inspector)) (define (stepper-recertify new-stx old-stx) - (syntax-recertify new-stx old-stx saved-code-inspector #f)) \ No newline at end of file + (syntax-recertify new-stx old-stx saved-code-inspector #f)) diff --git a/collects/stepper/private/marks.rkt b/collects/stepper/private/marks.rkt index 0c1695a338..adb9b966bf 100644 --- a/collects/stepper/private/marks.rkt +++ b/collects/stepper/private/marks.rkt @@ -138,7 +138,7 @@ (lookup-first-binding (lambda (id2) (free-identifier=? id id2)) mark-list (lambda () - (error 'lookup-binding "variable not found in environment: ~a~n" (if (syntax? id) + (error 'lookup-binding "variable not found in environment: ~a\n" (if (syntax? id) (syntax->datum id) id)))))) diff --git a/collects/test-engine/test-engine.scm b/collects/test-engine/test-engine.scm index c490673e70..cf29effc09 100644 --- a/collects/test-engine/test-engine.scm +++ b/collects/test-engine/test-engine.scm @@ -89,7 +89,7 @@ (define/public (display-untested-summary port) (unless (test-silence) - (fprintf port "This program should be tested.~n"))) + (fprintf port "This program should be tested.\n"))) (define/public (display-disabled-summary port) (fprintf port "Tests disabled.\n")) diff --git a/collects/test-engine/test-info.scm b/collects/test-engine/test-info.scm index 03da172221..9b55c709bb 100644 --- a/collects/test-engine/test-info.scm +++ b/collects/test-engine/test-info.scm @@ -106,7 +106,7 @@ (formatter (check-fail-format fail))) (cond [(unexpected-error? fail) - (print "check-expect encountered the following error instead of the expected value, ~F. ~n :: ~a" + (print "check-expect encountered the following error instead of the expected value, ~F. \n :: ~a" (formatter (unexpected-error-expected fail)) (unexpected-error-message fail))] [(unequal? fail) @@ -119,11 +119,11 @@ (formatter (outofrange-range fail)) (formatter (outofrange-actual fail)))] [(incorrect-error? fail) - (print "check-error encountered the following error instead of the expected ~a~n :: ~a" + (print "check-error encountered the following error instead of the expected ~a\n :: ~a" (incorrect-error-expected fail) (incorrect-error-message fail))] [(expected-error? fail) - (print "check-error expected the following error, but instead received the value ~F.~n ~a" + (print "check-error expected the following error, but instead received the value ~F.\n ~a" (formatter (expected-error-value fail)) (expected-error-message fail))] [(message-error? fail) @@ -147,8 +147,6 @@ arguments)) (result-arguments-list (property-fail-result fail)))] [(property-error? fail) - (print "check-property encountered the the following error~n:: ~a" + (print "check-property encountered the the following error\n:: ~a" (property-error-message fail))]) (print-string "\n"))) - - diff --git a/collects/tests/aligned-pasteboard/debug.rkt b/collects/tests/aligned-pasteboard/debug.rkt index 32b6b3a77e..3c18771bf4 100644 --- a/collects/tests/aligned-pasteboard/debug.rkt +++ b/collects/tests/aligned-pasteboard/debug.rkt @@ -26,12 +26,12 @@ (send snip get-margin l t r b) (printf "get-margin: ~sX~s ~sX~s\n" (unbox l) (unbox r) (unbox t) (unbox b))) - (printf "get-max-height: ~s~n" (send snip get-max-height)) - (printf "get-max-width: ~s~n" (send snip get-max-width)) - (printf "get-min-height: ~s~n" (send snip get-min-height)) - (printf "get-min-width: ~s~n" (send snip get-min-width)) - ;(printf "snip-width: ~s~n" (send pasteboard snip-width snip)) - ;(printf "snip-height: ~s~n" (send pasteboard snip-height snip)) + (printf "get-max-height: ~s\n" (send snip get-max-height)) + (printf "get-max-width: ~s\n" (send snip get-max-width)) + (printf "get-min-height: ~s\n" (send snip get-min-height)) + (printf "get-min-width: ~s\n" (send snip get-min-width)) + ;(printf "snip-width: ~s\n" (send pasteboard snip-width snip)) + ;(printf "snip-height: ~s\n" (send pasteboard snip-height snip)) )) ;;debug-pasteboard: -> (void) diff --git a/collects/tests/aligned-pasteboard/test.rktl b/collects/tests/aligned-pasteboard/test.rktl index eed9363ee4..ff89f13c95 100644 --- a/collects/tests/aligned-pasteboard/test.rktl +++ b/collects/tests/aligned-pasteboard/test.rktl @@ -22,7 +22,7 @@ ; ; ; ;;; -(printf "running test1.ss~n") +(printf "running test1.ss\n") (define frame (instantiate frame% () @@ -229,4 +229,4 @@ ) (send frame show false) -(printf "done~n") +(printf "done\n") diff --git a/collects/tests/aligned-pasteboard/test2.rktl b/collects/tests/aligned-pasteboard/test2.rktl index 76c740d834..a08e069710 100644 --- a/collects/tests/aligned-pasteboard/test2.rktl +++ b/collects/tests/aligned-pasteboard/test2.rktl @@ -23,7 +23,7 @@ ; ;;; ; -(printf "running test2.ss~n") +(printf "running test2.ss\n") (define frame (instantiate frame% () @@ -187,4 +187,4 @@ ) (send frame show false) -(printf "done~n") +(printf "done\n") diff --git a/collects/tests/compiler/zo-test.rkt b/collects/tests/compiler/zo-test.rkt index dc4f49f939..1b1279eb36 100755 --- a/collects/tests/compiler/zo-test.rkt +++ b/collects/tests/compiler/zo-test.rkt @@ -203,21 +203,21 @@ exec racket -t "$0" -- -s -t 60 -v -R $* (define succs (length (hash-ref success-ht kind-name empty))) (define all (+ fails succs)) (unless (zero? all) - (printf "~S~n" + (printf "~S\n" `(,kind-name (#f ,fails) (#t ,succs) ,all)))) (newline) - (printf "~a tests passed~n" (length (hash-ref success-ht 'everything empty))) + (printf "~a tests passed\n" (length (hash-ref success-ht 'everything empty))) (let ([common-errors (sort (filter (λ (p) ((car p) . > . 10)) (hash-map errors (λ (k v) (cons v k)))) > #:key car)]) (unless (empty? common-errors) - (printf "Common Errors:~n") + (printf "Common Errors:\n") (for ([p (in-list common-errors)]) - (printf "~a:~n~a~n~n" (car p) (cdr p))))))))) + (printf "~a:\n~a\n\n" (car p) (cdr p))))))))) -(thread-wait final-thread) \ No newline at end of file +(thread-wait final-thread) diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index 9bbbe9ce90..5e2657aa2f 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -1044,7 +1044,7 @@ the settings above should match r5rs (let* ([got (fetch-output/should-be-tested drs)]) (unless (string=? result got) (fprintf (current-error-port) - "FAILED: ~s ~s ~s test~n expected: ~s~n got: ~s~n" + "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n" (language) setting-name expression result got))))) (define (test-hash-bang) @@ -1058,7 +1058,7 @@ the settings above should match r5rs (let* ([got (fetch-output/should-be-tested drs)]) (unless (string=? "1" got) (fprintf (current-error-port) - "FAILED: ~s ~a test~n expected: ~s~n got: ~s~n" + "FAILED: ~s ~a test\n expected: ~s\n got: ~s\n" (language) expression result got))))) (define (fetch-output/should-be-tested . args) @@ -1095,7 +1095,7 @@ the settings above should match r5rs (string-length line1-got)))) (regexp-match line1-expect line1-got))) (fprintf (current-error-port) - "expected lines: ~n ~a~n ~a~ngot lines:~n ~a~n ~a~n" + "expected lines: \n ~a\n ~a\ngot lines:\n ~a\n ~a\n" line0-expect line1-expect line0-got line1-got) (error 'language-test.rkt "failed get top of repl test"))))) @@ -1144,7 +1144,7 @@ the settings above should match r5rs (define (generic-output list? quasi-quote? has-sharing? has-print-printing?) (let* ([plain-print-style (if has-print-printing? "print" "write")] [drs (wait-for-drscheme-frame)] - [expression (format "(define x (list 2))~n(list x x)")] + [expression "(define x (list 2))\n(list x x)"] [set-output-choice (lambda (option show-sharing pretty?) (set-language #f) @@ -1178,7 +1178,7 @@ the settings above should match r5rs (answer got) (whitespace-string=? answer got)) (fprintf (current-error-port) - "FAILED ~s ~a, sharing ~a pretty? ~a~n got ~s~n expected ~s~n" + "FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n" (language) option show-sharing pretty? (shorten got) (if (procedure? answer) (answer) answer)))))]) @@ -1285,11 +1285,11 @@ the settings above should match r5rs (lambda (expected) (cond [(string? expected) - "FAILED: ~s ~s expected ~s to produce:\n ~s\ngot:\n ~s\ninstead~n"] + "FAILED: ~s ~s expected ~s to produce:\n ~s\ngot:\n ~s\ninstead\n"] [(regexp? expected) - "FAILED: ~s ~s expected ~s to match ~s, got ~s instead~n"] + "FAILED: ~s ~s expected ~s to match ~s, got ~s instead\n"] [(procedure? expected) - "FAILED: ~s ~s expected ~s to pass predicate ~s, got ~s~n"]))]) + "FAILED: ~s ~s expected ~s to pass predicate ~s, got ~s\n"]))]) (clear-definitions drs) (cond [(pair? expression) (for-each handle-insertion expression)] diff --git a/collects/tests/drracket/sample-solutions-one-window.rkt b/collects/tests/drracket/sample-solutions-one-window.rkt index 9ded8235bc..255e894f6e 100644 --- a/collects/tests/drracket/sample-solutions-one-window.rkt +++ b/collects/tests/drracket/sample-solutions-one-window.rkt @@ -72,7 +72,7 @@ "teachpack" "htdp" teachpack)))]))] [teachpack-should-be (apply string-append - (map (lambda (tp) (format "Teachpack: ~a.~n" (get-full-path tp))) + (map (lambda (tp) (format "Teachpack: ~a.\n" (get-full-path tp))) (cons sample-solutions-teachpack-filename teachpacks)))] @@ -126,7 +126,7 @@ (has-error? drs-frame)) => (lambda (err-msg) - (printf "ERROR: ~a: found error, but should be no errors (section ~a):~n ~a\n teachpacks: ~a\n" + (printf "ERROR: ~a: found error, but should be no errors (section ~a):\n ~a\n teachpacks: ~a\n" filename section err-msg @@ -142,7 +142,7 @@ (unless (eof-object? sexp) (cond [(and (not last) (equal? sexp separator-sexp)) - (printf "ERROR: ~a: found = as first sexp~n" filename)] + (printf "ERROR: ~a: found = as first sexp\n" filename)] [(and last (equal? separator-sexp sexp)) (let ([after (with-handlers ([(lambda (exn) #t) (lambda (exn) exn)]) diff --git a/collects/tests/drracket/teachpack.rkt b/collects/tests/drracket/teachpack.rkt index af13156fbb..3fa2f4f070 100644 --- a/collects/tests/drracket/teachpack.rkt +++ b/collects/tests/drracket/teachpack.rkt @@ -45,13 +45,13 @@ (let ([got (fetch-output drs-frame)] [full-expectation (string-append - (apply string-append (map (lambda (x) (format "Teachpack: ~a.~n" x)) tp-names)) + (apply string-append (map (lambda (x) (format "Teachpack: ~a.\n" x)) tp-names)) expected "\nThis psorgram should be tested.")]) (unless (equal? got full-expectation) (printf - "FAILED: tp: ~s~n exp: ~s~n expected: ~s~n got: ~s~n" + "FAILED: tp: ~s\n exp: ~s\n expected: ~s\n got: ~s\n" tp-exps dr-exp full-expectation @@ -80,12 +80,12 @@ [dialog (let ([got (send dialog get-message)]) (unless (string=? got expected-error) - (printf "FAILED: tp: ~s~n expected: ~s~n got: ~s~n" + (printf "FAILED: tp: ~s\n expected: ~s\n got: ~s\n" tp-exp expected-error got)) (fw:test:button-push "Ok") (wait-for-new-frame dialog))] [else - (printf "FAILED: no error message appeared~n tp: ~s~n expected: ~s~n" + (printf "FAILED: no error message appeared\n tp: ~s\n expected: ~s\n" tp-exp expected-error)])))) (define (test-bad/execute-teachpack tp-exp expected) @@ -122,15 +122,14 @@ [dialog (let ([got (send dialog get-message)] [expected-error - (string-append (format "Invalid Teachpack: ~a~n" tp-name) - expected)]) + (format "Invalid Teachpack: ~a\n~a" tp-name expected)]) (unless (string=? got expected-error) - (printf "FAILED: tp: ~s~n expected: ~s~n got: ~s~n" + (printf "FAILED: tp: ~s\n expected: ~s\n got: ~s\n" tp-exp expected-error got)) (fw:test:button-push "Ok") (wait-for-new-frame dialog))] [else - (printf "FAILED: no error message appeared~n tp: ~s~n expected: ~s~n" + (printf "FAILED: no error message appeared\n tp: ~s\n expected: ~s\n" tp-exp error)])))) (define (generic-tests) @@ -194,7 +193,7 @@ (when (or (equal? #"ss" (filename-extension teachpack)) (equal? #"scm" (filename-extension teachpack))) (unless (equal? "graphing.ss" (path->string teachpack)) - (printf " testing ~a~n" teachpack) + (printf " testing ~a\n" teachpack) (fw:test:menu-select "Language" "Clear All Teachpacks") (fw:test:menu-select "Language" "Add Teachpack...") (wait-for-new-frame drs-frame) @@ -209,8 +208,8 @@ [expected (format "Teachpack: ~a.\n1" (path->string teachpack))]) (unless (equal? got expected) - (printf "FAILED built in teachpack test: ~a~n" (path->string teachpack)) - (printf " got: ~s~n expected: ~s~n" got expected)))))))] + (printf "FAILED built in teachpack test: ~a\n" (path->string teachpack)) + (printf " got: ~s\n expected: ~s\n" got expected)))))))] [test-teachpacks (lambda (paths) (for-each (lambda (dir) diff --git a/collects/tests/gracket/item.rkt b/collects/tests/gracket/item.rkt index f9ff3383b2..40be32ba46 100644 --- a/collects/tests/gracket/item.rkt +++ b/collects/tests/gracket/item.rkt @@ -133,7 +133,7 @@ (if (not l) win l)))]) - (when noisy? (printf "~a~n" s)) + (when noisy? (printf "~a\n" s)) (send m set-label (substring s 0 (min 200 (string-length s)))))))) (define (add-click-intercept frame panel) @@ -146,7 +146,7 @@ (make-object menu-item% (format "Click on ~a" win) m (lambda (i e) (unless (eq? (send m get-popup-target) win) - (printf "Wrong owner!~n")))) + (printf "Wrong owner!\n")))) (send win popup-menu m (inexact->exact (send e get-x)) (inexact->exact (send e get-y))) @@ -160,7 +160,7 @@ [cc (make-object cursor% 'cross)]) (make-object check-box% "Control Bullseye Cursors" panel (lambda (c e) - (printf "~a~n" e) + (printf "~a\n" e) (if (send c get-value) (set! old (map (lambda (b) @@ -200,7 +200,7 @@ (override [on-demand (lambda () - (printf "Menu item ~a demanded~n" name))]) + (printf "Menu item ~a demanded\n" name))]) (sequence (apply super-init name args)))) @@ -239,7 +239,7 @@ (memq (send e get-event-type) '(menu-popdown menu-popdown-none))) (error "bad event object")) - (printf "popdown ok~n")))] + (printf "popdown ok\n")))] [make-callback (let ([id 0]) (lambda () @@ -297,7 +297,7 @@ (sequence (apply super-init args) (unless (ok?) - (printf "bitmap failure: ~s~n" args))))) + (printf "bitmap failure: ~s\n" args))))) (define (active-mixin %) (class % @@ -312,9 +312,9 @@ [on-subwindow-char (lambda args (or (apply pre-on args) (super on-subwindow-char . args)))] - [on-activate (lambda (on?) (printf "active: ~a~n" on?))] - [on-move (lambda (x y) (printf "moved: ~a ~a~n" x y))] - [on-size (lambda (x y) (printf "sized: ~a ~a~n" x y))]) + [on-activate (lambda (on?) (printf "active: ~a\n" on?))] + [on-move (lambda (x y) (printf "moved: ~a ~a\n" x y))] + [on-size (lambda (x y) (printf "sized: ~a ~a\n" x y))]) (public* [set-info (lambda (ep) (set! pre-on (add-pre-note this ep)) @@ -331,10 +331,10 @@ (override [on-superwindow-show (lambda (on?) - (printf "~a ~a~n" name (if on? "show" "hide")))] + (printf "~a ~a\n" name (if on? "show" "hide")))] [on-superwindow-enable (lambda (on?) - (printf "~a ~a~n" name (if on? "on" "off")))]) + (printf "~a ~a\n" name (if on? "on" "off")))]) (sequence (apply super-init name args)))) @@ -952,7 +952,7 @@ (compare expect v (format "label search: ~a" string))))] [tell-ok (lambda () - (printf "ok~n"))]) + (printf "ok\n"))]) (private-field [temp-labels? #f] [use-menubar? #f] @@ -1180,7 +1180,7 @@ (unless (memq type types) (error (format "bad event type: ~a" type)))) (unless silent? - (printf "Callback Ok~n"))) + (printf "Callback Ok\n"))) (define (instructions v-panel file) (define c (make-object editor-canvas% v-panel)) @@ -1216,7 +1216,7 @@ (lambda (e) (check-callback-event b b e commands #t)) old-list) - (printf "All Ok~n")))) + (printf "All Ok\n")))) (define e (make-object button% "Disable Test" p (lambda (c e) @@ -1227,7 +1227,7 @@ (thread (lambda () (sleep 0.5) (semaphore-post sema))) (yield sema) (when hit? - (printf "un-oh~n")) + (printf "un-oh\n")) (send b enable #t))))) (instructions p "button-steps.txt") (send f show #t)) @@ -1261,7 +1261,7 @@ (lambda (e) (check-callback-event cb cb e commands #t)) old-list) - (printf "All Ok~n")))) + (printf "All Ok\n")))) (instructions p "checkbox-steps.txt") (send f show #t)) @@ -1333,7 +1333,7 @@ (lambda (rbe) (check-callback-event (car rbe) (car rbe) (cdr rbe) commands #t)) old-list) - (printf "All Ok~n"))) + (printf "All Ok\n"))) (instructions p "radiobox-steps.txt") (send f show #t)) @@ -1360,12 +1360,12 @@ (cond [(eq? (send e get-event-type) 'list-box-dclick) ; double-click - (printf "Double-click~n") + (printf "Double-click\n") (unless (send cx get-selection) (error "no selection for dclick"))] [else ; misc multi-selection - (printf "Changed: ~a~n" (if list? + (printf "Changed: ~a\n" (if list? (send cx get-selections) (send cx get-selection)))]) (check-callback-event c cx e commands #f))) @@ -1402,7 +1402,7 @@ (make-object button% "Visible Indices" p (lambda (b e) - (printf "top: ~a~nvisible count: ~a~n" + (printf "top: ~a\nvisible count: ~a\n" (send c get-first-visible-item) (send c number-of-visible-items)))))) (define cdp (make-object horizontal-panel% p)) @@ -1555,9 +1555,9 @@ (lambda (e) (check-callback-event c c e commands #t)) old-list) - (printf "content: ~s~n" actual-content) + (printf "content: ~s\n" actual-content) (when multi? - (printf "selections: ~s~n" (send c get-selections)))))) + (printf "selections: ~s\n" (send c get-selections)))))) (send c stretchable-width #t) (instructions p "choice-list-steps.txt") (send f show #t)) @@ -1570,7 +1570,7 @@ (define s (make-object slider% "Slide Me" -1 11 p (lambda (sl e) (check-callback-event s sl e commands #f) - (printf "slid: ~a~n" (send s get-value))) + (printf "slid: ~a\n" (send s get-value))) 3)) (define c (make-object button% "Check" p (lambda (c e) @@ -1578,7 +1578,7 @@ (lambda (e) (check-callback-event s s e commands #t)) old-list) - (printf "All Ok~n")))) + (printf "All Ok\n")))) (define (simulate v) (let ([e (make-object control-event% 'slider)]) (send s set-value v) @@ -1634,13 +1634,13 @@ (define (handler get-this) (lambda (c e) (unless (eq? c (get-this)) - (printf "callback: bad item: ~a~n" c)) + (printf "callback: bad item: ~a\n" c)) (let ([t (send e get-event-type)]) (cond [(eq? t 'text-field) - (printf "Changed: ~a~n" (send c get-value))] + (printf "Changed: ~a\n" (send c get-value))] [(eq? t 'text-field-enter) - (printf "Return: ~a~n" (send c get-value))])))) + (printf "Return: ~a\n" (send c get-value))])))) (define f (make-frame frame% "Text Test")) (define p (make-object vertical-panel% f)) @@ -1701,7 +1701,7 @@ (send f set-status-text s)))] [on-scroll (lambda (e) - (when auto? (printf "Hey - on-scroll called for auto scrollbars~n")) + (when auto? (printf "Hey - on-scroll called for auto scrollbars\n")) (unless incremental? (on-paint)))] [init-auto-scrollbars (lambda x (set! auto? #t) @@ -1877,7 +1877,7 @@ (let ([c (car (send p get-children))]) (let-values ([(w h) (send c get-size)] [(cw ch) (send c get-client-size)]) - (printf "~a: (~a x ~a) client[~a x ~a] diff<~a x ~a> min{~a x ~a}~n" + (printf "~a: (~a x ~a) client[~a x ~a] diff<~a x ~a> min{~a x ~a}\n" c w h cw ch (- w cw) (- h ch) (send c min-width) (send c min-height))))) @@ -1962,7 +1962,7 @@ (make-object button% "Rename" p2 (lambda (b e) (send p set-item-label (quotient (send p get-number) 2) "Do&nut"))) (make-object button% "Labels" p2 (lambda (b e) - (printf "~s~n" + (printf "~s\n" (reverse (let loop ([i (send p get-number)]) (if (zero? i) @@ -2000,10 +2000,10 @@ (define (message-boxes parent) (define (check expected got) (unless (eq? expected got) - (fprintf (current-error-port) "bad result: - expected ~e, got ~e~n" + (fprintf (current-error-port) "bad result: - expected ~e, got ~e\n" expected got))) (define (big s) - (format "~a~n~a~n~a~n~a~n" s + (format "~a\n~a\n~a\n~a\n" s (make-string 500 #\x) (make-string 500 #\x) (make-string 500 #\x))) diff --git a/collects/tests/gracket/random.rktl b/collects/tests/gracket/random.rktl index 9460e44319..7eb8b636cb 100644 --- a/collects/tests/gracket/random.rktl +++ b/collects/tests/gracket/random.rktl @@ -711,14 +711,14 @@ (with-handlers (((lambda (x) (not (fatal-exn? x))) (lambda (x) (fprintf (thread-output-port) - ": error: ~a~n" + ": error: ~a\n" (exn-message x))))) (if (eq? dest 'values) (k v) (send dest add (k v))) (flush-display) - (fprintf (thread-output-port) ": success~n")))) - (fprintf (thread-output-port) "~a: failure: ~a~n" name v))) + (fprintf (thread-output-port) ": success\n")))) + (fprintf (thread-output-port) "~a: failure: ~a\n" name v))) (define (try-args arg-types dest name k) (apply-args (get-args arg-types) dest name k)) @@ -734,7 +734,7 @@ (flush-output (thread-output-port)) (with-handlers ([exn:fail:contract? (lambda (x) - (fprintf (thread-output-port) ": exn: ~a~n" + (fprintf (thread-output-port) ": exn: ~a\n" (exn-message x)) ;; Check that exn is from the right place: (let ([class (if (list? name) @@ -748,30 +748,30 @@ ; init is never inherited, so class name really should be present (unless (regexp-match (symbol->string class) (exn-message x)) (fprintf (thread-output-port) - " NO OCCURRENCE of class name ~a in the error message~n" + " NO OCCURRENCE of class name ~a in the error message\n" class))) (unless (regexp-match (symbol->string method) (exn-message x)) (fprintf (thread-output-port) - " NO OCCURRENCE of method ~a in the error message~n" + " NO OCCURRENCE of method ~a in the error message\n" method))))] [exn:fail:contract:arity? (lambda (x) (fprintf (thread-output-port) - ": UNEXPECTED ARITY MISMATCH: ~a~n" + ": UNEXPECTED ARITY MISMATCH: ~a\n" (exn-message x)))] [(lambda (x) (not (fatal-exn? x))) (lambda (x) (fprintf (thread-output-port) - ": WRONG EXN TYPE: ~a~n" + ": WRONG EXN TYPE: ~a\n" (exn-message x)))]) (k v) (flush-display) - (fprintf (thread-output-port) ": NO EXN RAISED~n"))) + (fprintf (thread-output-port) ": NO EXN RAISED\n"))) (define (try-bad-args arg-types dest name k) (let ([args (get-bad-args arg-types)]) (cond - [(not (list? args)) (fprintf (thread-output-port) "~a: failure in bad-testing: ~a~n" name args)] + [(not (list? args)) (fprintf (thread-output-port) "~a: failure in bad-testing: ~a\n" name args)] [else (let loop ([pres null][posts args]) (unless (null? posts) @@ -799,16 +799,16 @@ (loop (cdr l))))))) (define (create-all-random) - (fprintf (thread-output-port) "creating all randomly...~n") + (fprintf (thread-output-port) "creating all randomly...\n") (hash-table-for-each classinfo (lambda (k v) (create-some k try-args)))) (define (create-all-exhaust) - (fprintf (thread-output-port) "creating all exhaustively...~n") + (fprintf (thread-output-port) "creating all exhaustively...\n") (hash-table-for-each classinfo (lambda (k v) (create-some k try-all-args)))) (define (create-all-bad) - (fprintf (thread-output-port) "creating all with bad arguments...~n") + (fprintf (thread-output-port) "creating all with bad arguments...\n") (hash-table-for-each classinfo (lambda (k v) (create-some k try-bad-args)))) @@ -819,7 +819,7 @@ [name (cadr v)] [methods (cdddr v)]) (if (void? use) - (fprintf (thread-output-port) "~s: no examples~n" name) + (fprintf (thread-output-port) "~s: no examples\n" name) (let loop ([l methods]) (unless (null? l) (unless (symbol? (car l)) @@ -850,7 +850,7 @@ (loop (cdr l))))))) (define (call-random except) - (fprintf (thread-output-port) "calling all except ~a randomly...~n" except) + (fprintf (thread-output-port) "calling all except ~a randomly...\n" except) (hash-table-for-each classinfo (lambda (k v) (unless (member k except) (try-methods k try-args))))) @@ -859,7 +859,7 @@ (call-random null)) (define (call-all-bad) - (fprintf (thread-output-port) "calling all with bad arguments...~n") + (fprintf (thread-output-port) "calling all with bad arguments...\n") (hash-table-for-each classinfo (lambda (k v) (try-methods k try-bad-args)))) (define (call-all-non-editor) @@ -871,7 +871,7 @@ (create-all-random) (create-all-random)) -(printf " Creating Example Instances~n") +(printf " Creating Example Instances\n") (define f (make-object frame% "Example Frame 1")) (send frame%-example-list add f) @@ -1000,9 +1000,9 @@ (send clipboard<%>-example-list add the-clipboard) (send clipboard-client%-example-list add (make-object clipboard-client%)) -(printf " Done Creating Example Instances~n") +(printf " Done Creating Example Instances\n") -(printf " Checking all methods~n") +(printf " Checking all methods\n") (define in-top-level null) (hash-table-for-each classinfo (lambda (key v) @@ -1015,7 +1015,7 @@ (if (void? (with-handlers ([void void]) (namespace-variable-value name))) ;; Not there - (printf "No such procedure/value: ~a~n" name) + (printf "No such procedure/value: ~a\n" name) (let ([v (namespace-variable-value name)]) (when (procedure? v) @@ -1028,7 +1028,7 @@ (andmap integer? a) (andmap integer? b) (equal? (sort a <) (sort b <))))) - (printf "Arity mismatch for ~a, real: ~a documented: ~a~n" + (printf "Arity mismatch for ~a, real: ~a documented: ~a\n" name (procedure-arity v) (cadr method)))))) (set! in-top-level (cons name in-top-level))) @@ -1046,12 +1046,12 @@ (if (interface? key) "interface" "class") s))]) (unless (string=? sp ss) - (printf "bad printed form: ~a != ~a~n" sp ss)))) + (printf "bad printed form: ~a != ~a\n" sp ss)))) ; Check documented methods are right (let ([ex (send (car v) choose-example)]) (unless (is-a? ex key) - (printf "Bad example: ~a for ~a~n" ex key)) + (printf "Bad example: ~a for ~a\n" ex key)) (for-each (lambda (name method) (if (or (and (interface? key) @@ -1063,21 +1063,21 @@ '(when (is-a? ex key) (let ([m (make-generic ex name)]) (unless (equal? (arity m) (cadr method)) - (printf "Warning: arity mismatch for ~a in ~a, real: ~a documented: ~a~n" + (printf "Warning: arity mismatch for ~a in ~a, real: ~a documented: ~a\n" name key (arity m) (cadr method))))) ;; Not there - (printf "No such method: ~a in ~a~n" name key))) + (printf "No such method: ~a in ~a\n" name key))) names methods)) ; Check everything is documented (for-each (lambda (n) (unless (memq n names) - (printf "Undocumented method: ~a in ~a~n" n key))) + (printf "Undocumented method: ~a in ~a\n" n key))) (interface->method-names (if (interface? key) key (class->interface key))))))))) -(printf " Method-checking done~n") +(printf " Method-checking done\n") (let* ([get-all (lambda (n) (parameterize ([current-namespace n]) @@ -1092,7 +1092,7 @@ (for-each (lambda (i) (unless (memq i expect-n) - (printf "Undocumented global: ~a~n" i))) + (printf "Undocumented global: ~a\n" i))) actual-n)) (unless (and (>= (vector-length argv) 1) diff --git a/collects/tests/gracket/windowing.rktl b/collects/tests/gracket/windowing.rktl index 3c952a894f..d6e2120e18 100644 --- a/collects/tests/gracket/windowing.rktl +++ b/collects/tests/gracket/windowing.rktl @@ -39,7 +39,7 @@ (test (list s) 'yield-wrapped (yield (wrap-evt s (lambda (v) (list v)))))) (define (enable-tests f) - (printf "Enable ~a~n" f) + (printf "Enable ~a\n" f) (st #t f is-enabled?) (stv f enable #f) (st #f f is-enabled?) @@ -47,7 +47,7 @@ (st #t f is-enabled?)) (define (drop-file-tests f) - (printf "Drop File ~a~n" f) + (printf "Drop File ~a\n" f) (st #f f accept-drop-files) (stv f accept-drop-files #t) (st #t f accept-drop-files) @@ -55,7 +55,7 @@ (st #f f accept-drop-files)) (define (client->screen-tests f) - (printf "Client<->Screen ~a~n" f) + (printf "Client<->Screen ~a\n" f) (let-values ([(x y) (send f client->screen 0 0)]) (stvals '(0 0) f screen->client x y)) (let-values ([(x y) (send f screen->client 0 0)]) @@ -66,7 +66,7 @@ (stv f refresh)) (define (area-tests f sw? sh? no-stretch?) - (printf "Area ~a~n" f) + (printf "Area ~a\n" f) (let ([x (send f min-width)] [y (send f min-height)]) (st sw? f stretchable-width) @@ -76,7 +76,7 @@ (let-values ([(w h) (if no-stretch? (send f get-size) (values 0 0))]) - (printf "Size ~a x ~a~n" w h) + (printf "Size ~a x ~a\n" w h) (when no-stretch? (stv f min-width w) ; when we turn of stretchability, don't resize (stv f min-height h)) @@ -95,7 +95,7 @@ (define (containee-tests f sw? sh? m) (area-tests f sw? sh? #f) - (printf "Containee ~a~n" f) + (printf "Containee ~a\n" f) (st m f horiz-margin) (st m f vert-margin) (stv f horiz-margin 3) @@ -108,14 +108,14 @@ (stv f vert-margin m)) (define (container-tests f win?) - (printf "Container ~a~n" f) + (printf "Container ~a\n" f) (let-values ([(x y) (send f get-alignment)]) (stv f set-alignment 'right 'bottom) (stvals '(right bottom) f get-alignment) (stv f set-alignment x y))) (define (cursor-tests f) - (printf "Cursor ~a~n" f) + (printf "Cursor ~a\n" f) (let ([c (send f get-cursor)]) (stv f set-cursor c) (st c f get-cursor) @@ -131,7 +131,7 @@ (define (show-tests f) (unless (is-a? f dialog%) - (printf "Show ~a~n" f) + (printf "Show ~a\n" f) (let ([on? (send f is-shown?)]) (stv f show #f) (when on? @@ -193,7 +193,7 @@ (st #f f get-menu-bar))] [space-tests (lambda () - (printf "Spacing~n") + (printf "Spacing\n") (let ([b (send f border)]) (stv f border 25) (st 25 f border) @@ -209,14 +209,14 @@ (drop-file-tests f))] [client->screen-tests (lambda () - (printf "Client<->Screen~n") + (printf "Client<->Screen\n") (let-values ([(x y) (send f client->screen 0 0)]) (stvals '(0 0) f screen->client x y)) (let-values ([(x y) (send f screen->client 0 0)]) (stvals '(0 0) f client->screen x y)))] [container-tests (lambda () - (printf "Container~n") + (printf "Container\n") (area-tests f #t #t #t) (let-values ([(x y) (send f container-size null)]) (st x f min-width) @@ -238,15 +238,15 @@ (container-tests) (cursor-tests) - (printf "Init~n") + (printf "Init\n") (init-tests #f) (stv f show #t) (pause) - (printf "Show Init~n") + (printf "Show Init\n") (init-tests #t) (stv f show #f) (pause) - (printf "Hide Init~n") + (printf "Hide Init\n") (init-tests #f) (send f show #t) (pause) @@ -258,7 +258,7 @@ (stv f change-children values) - (printf "Iconize~n") + (printf "Iconize\n") (stv f iconize #t) (pause) (pause) @@ -272,7 +272,7 @@ (stv f maximize #f) (pause) - (printf "Move~n") + (printf "Move\n") (stv f move 34 37) (pause) (FAILS (st 34 f get-x)) @@ -280,7 +280,7 @@ (st 150 f get-width) (st 151 f get-height) - (printf "Resize~n") + (printf "Resize\n") (stv f resize 56 57) (pause) (FAILS (st 34 f get-x)) @@ -306,7 +306,7 @@ (cursor-tests) - (printf "Menu Bar~n") + (printf "Menu Bar\n") (let ([mb (make-object menu-bar% f)]) (st mb f get-menu-bar) (st f mb get-frame) @@ -320,11 +320,11 @@ (st null mb get-items) - (printf "Menu 1~n") + (printf "Menu 1\n") (let* ([m (make-object menu% "&File" mb)] [i m] [delete-enable-test (lambda (i parent empty) - (printf "Item~n") + (printf "Item\n") (st #f i is-deleted?) (st #t i is-enabled?) @@ -371,7 +371,7 @@ (st null m get-items) - (printf "Menu Items~n") + (printf "Menu Items\n") (let ([i1 (make-object menu-item% "&Plain" m (lambda (i e) (test-control-event e '(menu)) @@ -391,7 +391,7 @@ (lambda (i empty name) (delete-enable-test i m empty) - (printf "Shortcut~n") + (printf "Shortcut\n") (set! hit i) (stv i command (make-object control-event% 'menu)) (test name 'hit-command hit) @@ -437,7 +437,7 @@ 'done) - (printf "Menu 2~n") + (printf "Menu 2\n") (let* ([m2 (make-object menu% "&Edit" mb "Help Edit")] [i2 m2]) (st (list i i2) mb get-items) @@ -468,7 +468,7 @@ (define (test-controls parent frame) (define side-effect #f) - (printf "Buttons~n") + (printf "Buttons\n") (letrec ([b (make-object button% "&Button" parent @@ -484,7 +484,7 @@ (containee-window-tests b #f #f parent frame 2)) - (printf "Check Box~n") + (printf "Check Box\n") (letrec ([c (make-object check-box% "&Check Box" parent @@ -511,7 +511,7 @@ #t)]) (st #t c get-value)) - (printf "Radio Box~n") + (printf "Radio Box\n") (letrec ([r (make-object radio-box% "&Radio Box" (list "O&ne" "T&wo" "T&hree") @@ -586,7 +586,7 @@ '(vertical) 3)) - (printf "Gauge~n") + (printf "Gauge\n") (letrec ([g (make-object gauge% "&Gauge" 10 @@ -618,7 +618,7 @@ (containee-window-tests g #t #f parent frame 2)) - (printf "Slider~n") + (printf "Slider\n") (letrec ([s (make-object slider% "&Slider" -2 8 @@ -774,7 +774,7 @@ 'done-list)]) - (printf "Choice~n") + (printf "Choice\n") (letrec ([c (make-object choice% "&Choice" '("A" "B" "C & D") @@ -808,7 +808,7 @@ (let ([mk-list (lambda (style) - (printf "List Box: ~a~n" style) + (printf "List Box: ~a\n" style) (letrec ([l (make-object list-box% "&List Box" '("A" "B" "C & D") @@ -869,7 +869,7 @@ (let ([c (make-object canvas% parent '(hscroll vscroll))]) - (printf "Tab Focus~n") + (printf "Tab Focus\n") (st #f c accept-tab-focus) (stv c accept-tab-focus #t) (st #t c accept-tab-focus) @@ -880,7 +880,7 @@ ; (stv c set-scrollbars 100 101 5 6 2 3 10 20 #t) (let-values ([(w h) (send c get-virtual-size)] [(cw ch) (send c get-client-size)]) - (printf "Canvas size: Virtual: ~a x ~a Client: ~a x ~a~n" w h cw ch) + (printf "Canvas size: Virtual: ~a x ~a Client: ~a x ~a\n" w h cw ch) (let ([check-scroll (lambda (xpos ypos) (let-values ([(x y) (send c get-view-start)]) @@ -958,7 +958,7 @@ 102)]) (let loop ([n 100]) (unless (zero? n) - (send e insert (format "line ~a~n" n)) + (send e insert (format "line ~a\n" n)) (loop (sub1 n)))) (st #f c allow-scroll-to-last) diff --git a/collects/tests/mysterx/mystests.rktl b/collects/tests/mysterx/mystests.rktl index a309b2fd77..f7b840e818 100644 --- a/collects/tests/mysterx/mystests.rktl +++ b/collects/tests/mysterx/mystests.rktl @@ -29,7 +29,7 @@ (for-each (lambda (n) (unless (test-scode n) - (printf "Error in test-scode for value ~a~n" n) + (printf "Error in test-scode for value ~a\n" n) (set! errors? #t))) '(25 -22 -1 -233344433 177000000 859489222)) @@ -49,13 +49,13 @@ (set-date-dst?! date #f) (set-date-time-zone-offset! date 0) (unless (test-date date) - (printf "Error in test-date~n") + (printf "Error in test-date\n") (set! errors? #t))) (for-each (lambda (n) (unless (test-currency n) - (printf "Error in test-currency for value ~a~n" n) + (printf "Error in test-currency for value ~a\n" n) (set! errors? #t))) '(0 1 3.14 25.00 -22.34 11.7832 91000000000 25034343434.9933)) @@ -81,7 +81,7 @@ [expected (caddr t)]) (unless (equal? got expected) (set! errors? #t) - (printf "Error in com-tests. Expected: ~a~nGot : ~a~n" + (printf "Error in com-tests. Expected: ~a\nGot : ~a\n" expected got)))) com-tests) @@ -93,11 +93,11 @@ (set! errors? #t)) (if errors? - (printf "There were errors!~n") - (printf "No errors in conversions and COM tests~n")) + (printf "There were errors!\n") + (printf "No errors in conversions and COM tests\n")) (define (make-mousefun s) - (let ([t (string-append s ": button = ~a shift = ~a x = ~a y = ~a~n")]) + (let ([t (string-append s ": button = ~a shift = ~a x = ~a y = ~a\n")]) (lambda (button shift x y) (printf t button shift x y)))) @@ -110,17 +110,10 @@ (lambda (sf) (com-register-event-handler ctrl (car sf) (cadr sf))) `(("Click" - ,(lambda () (printf "Click~n"))) + ,(lambda () (printf "Click\n"))) ,(mouse-pair "MouseMove") ,(mouse-pair "MouseDown") ,(mouse-pair "MouseUp"))) - (printf "Try clicking and moving the mouse over the object~n") - (printf "You should see Click, MouseMove, MouseDown, and MouseUp events~n")) - - - - - - - + (printf "Try clicking and moving the mouse over the object\n") + (printf "You should see Click, MouseMove, MouseDown, and MouseUp events\n")) diff --git a/collects/tests/mzcom/test.rktl b/collects/tests/mzcom/test.rktl index 786656d3ce..3a9b277f2a 100644 --- a/collects/tests/mzcom/test.rktl +++ b/collects/tests/mzcom/test.rktl @@ -17,43 +17,43 @@ (print-struct #t) ; should show an About box -(printf "You should see the About box~n") +(printf "You should see the About box\n") (run "About") ; tests whether Eval returns sensible result (if (string=? (mzeval "(+ 20 22)") "42") - (printf "1st Eval test ok~n") + (printf "1st Eval test ok\n") (begin (add-error!) - (fprintf (current-error-port) "1st Eval test failed~n"))) + (fprintf (current-error-port) "1st Eval test failed\n"))) (mzeval "(define x 42)") ; tests whether preceding definition really holds (if (string=? "42" (mzeval "x")) - (printf "define test ok~n") + (printf "define test ok\n") (begin (add-error!) - (fprintf (current-error-port) "define test failed~n"))) + (fprintf (current-error-port) "define test failed\n"))) -(printf "Resetting environment~n") +(printf "Resetting environment\n") (run "Reset") ; removes binding for x ; tests for removal of binding (with-handlers - ([void (lambda (exn) (printf "2nd Eval test looks ok~nexn was: ~a~n" exn))]) + ([void (lambda (exn) (printf "2nd Eval test looks ok\nexn was: ~a\n" exn))]) (mzeval "x") ; binding for x missing (add-error!) - (fprintf (current-error-port) "2nd Eval test failed~n")) + (fprintf (current-error-port) "2nd Eval test failed\n")) ; tests if a Scheme error results in a COM error (with-handlers - ([void (lambda (exn) (printf "3rd Eval test looks ok~nexn was: ~a~n" exn))]) + ([void (lambda (exn) (printf "3rd Eval test looks ok\nexn was: ~a\n" exn))]) (mzeval "(+ 'foo 42)") ; should raise Scheme error (add-error!) - (fprintf (current-error-port) "3rd Eval test failed~n")) + (fprintf (current-error-port) "3rd Eval test failed\n")) (when (> num-errors 0) - (fprintf (current-error-port) "There were ~a errors.~n" num-errors)) + (fprintf (current-error-port) "There were ~a errors.\n" num-errors)) -(printf "End of MzCOM tests.~n") +(printf "End of MzCOM tests.\n") diff --git a/collects/tests/plai/gc/good-mutators/student-1.rkt b/collects/tests/plai/gc/good-mutators/student-1.rkt index 0a46555e39..e8d4f19c9b 100755 --- a/collects/tests/plai/gc/good-mutators/student-1.rkt +++ b/collects/tests/plai/gc/good-mutators/student-1.rkt @@ -28,23 +28,23 @@ (define (loop x) - (printf "Iteration: ~a~n" x) + (printf "Iteration: ~a\n" x) (if (zero? x) 0 (loop (- (+ (local-vars) (- x 1)) 8)))) ; Generate gradually increasing sizes of lists ; To trigger garbage collection at different points -(printf "~a~n" (gen-list 1)) -(printf "~a~n" (gen-list 2)) -(printf "~a~n" (gen-list 4)) -(printf "~a~n" (gen-list 8)) +(printf "~a\n" (gen-list 1)) +(printf "~a\n" (gen-list 2)) +(printf "~a\n" (gen-list 4)) +(printf "~a\n" (gen-list 8)) ; Run a loop that uses local vars a few times -(printf "Generating Primitives in loops~n") +(printf "Generating Primitives in loops\n") (loop 20) -(printf "Try Allocating large list again~n") -(printf "~a~n" (gen-list 8)) +(printf "Try Allocating large list again\n") +(printf "~a\n" (gen-list 8)) ; Create some circular references @@ -54,25 +54,25 @@ (set-rest! x y) x))) -(printf "Testing Circular References~n") -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) -(printf "~a~n" (gen-circular)) +(printf "Testing Circular References\n") +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) +(printf "~a\n" (gen-circular)) -(printf "Try allocating large list again~n") -(printf "~a~n" (gen-list 8)) -(printf "~a~n" (gen-list 8)) -(printf "~a~n" (gen-list 8)) -(printf "~a~n" (gen-list 8)) -(printf "~a~n" (gen-list 8)) +(printf "Try allocating large list again\n") +(printf "~a\n" (gen-list 8)) +(printf "~a\n" (gen-list 8)) +(printf "~a\n" (gen-list 8)) +(printf "~a\n" (gen-list 8)) +(printf "~a\n" (gen-list 8)) -(printf "Running sample tests~n") +(printf "Running sample tests\n") (define (fact x) (if (zero? x) 1 @@ -114,18 +114,18 @@ (define head (cons 4 (cons 3 (cons 2 tail)))) (set-rest! tail head) -(printf "res ~a~n" head) +(printf "res ~a\n" head) (set! head empty) (set! tail head) -(printf "res ~a~n" lst) -(printf "res ~a~n" (length '(hello goodbye))) -(printf "res ~a~n" (map sub1 lst)) +(printf "res ~a\n" lst) +(printf "res ~a\n" (length '(hello goodbye))) +(printf "res ~a\n" (map sub1 lst)) -(printf "(fact-help 15 1): ~a~n" (fact-help 15 1)) -(printf "(fact 9): ~a~n" (fact 9)) +(printf "(fact-help 15 1): ~a\n" (fact-help 15 1)) +(printf "(fact 9): ~a\n" (fact 9)) -(printf "(append lst lst): ~a~n" (append lst lst)) +(printf "(append lst lst): ~a\n" (append lst lst)) -(printf "(map-add 5 lst): ~a~n" (map-add 5 lst)) -(printf "(filter even? (map sub1 lst)): ~a~n" (filter even? (map sub1 lst))) -(printf "(length lst): ~a~n" (length lst)) \ No newline at end of file +(printf "(map-add 5 lst): ~a\n" (map-add 5 lst)) +(printf "(filter even? (map sub1 lst)): ~a\n" (filter even? (map sub1 lst))) +(printf "(length lst): ~a\n" (length lst)) diff --git a/collects/tests/racket/benchmarks/shootout/ackermann.rkt b/collects/tests/racket/benchmarks/shootout/ackermann.rkt index c12966a983..293e6e51c9 100644 --- a/collects/tests/racket/benchmarks/shootout/ackermann.rkt +++ b/collects/tests/racket/benchmarks/shootout/ackermann.rkt @@ -7,6 +7,6 @@ (else (ack (- m 1) (ack m (- n 1)))))) (command-line #:args (n) - (printf "Ack(3,~a): ~a~n" + (printf "Ack(3,~a): ~a\n" n (ack 3 (string->number n)))) diff --git a/collects/tests/racket/benchmarks/shootout/except.rkt b/collects/tests/racket/benchmarks/shootout/except.rkt index 2067b9ddb0..0b3e927ca7 100644 --- a/collects/tests/racket/benchmarks/shootout/except.rkt +++ b/collects/tests/racket/benchmarks/shootout/except.rkt @@ -32,6 +32,6 @@ (do ((i 0 (+ i 1))) ((= i n)) (some_fun i))) - (printf "Exceptions: HI=~a / LO=~a~n" HI LO)) + (printf "Exceptions: HI=~a / LO=~a\n" HI LO)) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/hash.rkt b/collects/tests/racket/benchmarks/shootout/hash.rkt index d76d8f4ecf..653e86e5ce 100644 --- a/collects/tests/racket/benchmarks/shootout/hash.rkt +++ b/collects/tests/racket/benchmarks/shootout/hash.rkt @@ -14,6 +14,6 @@ (when (hash-ref hash (number->string i) false) (set! accum (+ accum 1))) (loop (sub1 i)))) - (printf "~s~n" accum))) + (printf "~s\n" accum))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/hash2.rkt b/collects/tests/racket/benchmarks/shootout/hash2.rkt index 2765050e4c..ca5089ec1e 100644 --- a/collects/tests/racket/benchmarks/shootout/hash2.rkt +++ b/collects/tests/racket/benchmarks/shootout/hash2.rkt @@ -17,7 +17,7 @@ key (+ (hash-ref hash2 key zero) value)))) (loop (add1 i)))) - (printf "~s ~s ~s ~s~n" + (printf "~s ~s ~s ~s\n" (hash-ref hash1 "foo_1") (hash-ref hash1 "foo_9999") (hash-ref hash2 "foo_1") diff --git a/collects/tests/racket/benchmarks/shootout/heapsort.rkt b/collects/tests/racket/benchmarks/shootout/heapsort.rkt index bafd246481..e44eb500ae 100644 --- a/collects/tests/racket/benchmarks/shootout/heapsort.rkt +++ b/collects/tests/racket/benchmarks/shootout/heapsort.rkt @@ -61,7 +61,7 @@ ((= i last)) (vector-set! ary i (gen_random 1.0))) (heapsort n ary) - (printf "~a~n" + (printf "~a\n" (real->decimal-string (vector-ref ary n) 10)))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/lists.rkt b/collects/tests/racket/benchmarks/shootout/lists.rkt index f2a735fe85..7a7efdf5a2 100644 --- a/collects/tests/racket/benchmarks/shootout/lists.rkt +++ b/collects/tests/racket/benchmarks/shootout/lists.rkt @@ -40,6 +40,6 @@ (when (> counter 0) (set! result (test-lists)) (loop (- counter 1)))) - (printf "~s~n" result))) + (printf "~s\n" result))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/nestedloop.rkt b/collects/tests/racket/benchmarks/shootout/nestedloop.rkt index 5959cc2211..fc77f06bee 100644 --- a/collects/tests/racket/benchmarks/shootout/nestedloop.rkt +++ b/collects/tests/racket/benchmarks/shootout/nestedloop.rkt @@ -14,6 +14,6 @@ (let* ([n (string->number (vector-ref argv 0))] [x 0]) (nest 6 (set! x (+ x 1))) - (printf "~s~n" x))) + (printf "~s\n" x))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/random.rkt b/collects/tests/racket/benchmarks/shootout/random.rkt index 2062939ffe..5426452be0 100644 --- a/collects/tests/racket/benchmarks/shootout/random.rkt +++ b/collects/tests/racket/benchmarks/shootout/random.rkt @@ -35,5 +35,5 @@ (gen_random 100.0) (loop (- iter 1))) #t)) - (printf "~a~%" + (printf "~a\n" (real->decimal-string (gen_random 100.0) 9))) diff --git a/collects/tests/racket/benchmarks/shootout/recursive.rkt b/collects/tests/racket/benchmarks/shootout/recursive.rkt index ee4523eb76..f9b1fe7a3c 100644 --- a/collects/tests/racket/benchmarks/shootout/recursive.rkt +++ b/collects/tests/racket/benchmarks/shootout/recursive.rkt @@ -43,16 +43,16 @@ (define (main n) - (printf "Ack(3,~A): ~A~%" n (ack 3 n)) - (printf "Fib(~a): ~a~%" + (printf "Ack(3,~A): ~A\n" n (ack 3 n)) + (printf "Fib(~a): ~a\n" (real->decimal-string (+ 27.0 n) 1) (real->decimal-string (fibflt (+ 27.0 n)) 1)) (set! n (- n 1)) - (printf "Tak(~A,~A,~A): ~A~%" (* n 3) (* n 2) n (tak (* n 3) (* n 2) n)) + (printf "Tak(~A,~A,~A): ~A\n" (* n 3) (* n 2) n (tak (* n 3) (* n 2) n)) - (printf "Fib(3): ~A~%" (fib 3)) - (printf "Tak(3.0,2.0,1.0): ~a~%" (real->decimal-string (takflt 3.0 2.0 1.0) 1))) + (printf "Fib(3): ~A\n" (fib 3)) + (printf "Tak(3.0,2.0,1.0): ~a\n" (real->decimal-string (takflt 3.0 2.0 1.0) 1))) ;; ------------------------------- diff --git a/collects/tests/racket/benchmarks/shootout/regexmatch.rkt b/collects/tests/racket/benchmarks/shootout/regexmatch.rkt index 6ce69a8c20..6dd0c9b6a9 100644 --- a/collects/tests/racket/benchmarks/shootout/regexmatch.rkt +++ b/collects/tests/racket/benchmarks/shootout/regexmatch.rkt @@ -55,7 +55,7 @@ [num (bytes-append #"(" area #") " exch #"-" numb)] [count (add1 count)]) (when (zero? n) - (printf "~a: ~a~n" count num)) + (printf "~a: ~a\n" count num)) (loop (cdr phones) count))) (loop (cdr phones) count)))))))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/ackermann.rktl b/collects/tests/racket/benchmarks/shootout/typed/ackermann.rktl index e0d5035096..6b365849bb 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/ackermann.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/ackermann.rktl @@ -7,6 +7,6 @@ (else (ack (- m 1) (ack m (- n 1)))))) (command-line #:args (n) - (printf "Ack(3,~a): ~a~n" + (printf "Ack(3,~a): ~a\n" n (ack 3 (assert (string->number (assert n string?)) exact-integer?)))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/except.rktl b/collects/tests/racket/benchmarks/shootout/typed/except.rktl index 4d4b2aba6a..8f74bf4d06 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/except.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/except.rktl @@ -39,6 +39,6 @@ (do ((i 0 (+ i 1))) ((= i n)) (some_fun i))) - (printf "Exceptions: HI=~a / LO=~a~n" HI LO)) + (printf "Exceptions: HI=~a / LO=~a\n" HI LO)) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/typed/hash.rktl b/collects/tests/racket/benchmarks/shootout/typed/hash.rktl index 4b2323c674..0106a89f4b 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/hash.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/hash.rktl @@ -13,6 +13,6 @@ (when (hash-ref hash (number->string i) false) (set! accum (+ accum 1))) (loop (sub1 i)))) - (printf "~s~n" accum))) + (printf "~s\n" accum))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/typed/hash2.rktl b/collects/tests/racket/benchmarks/shootout/typed/hash2.rktl index e2f47ccf8f..ad38b96a46 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/hash2.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/hash2.rktl @@ -16,7 +16,7 @@ key (+ (hash-ref hash2 key zero) value)))) (loop (add1 i)))) - (printf "~s ~s ~s ~s~n" + (printf "~s ~s ~s ~s\n" (hash-ref hash1 "foo_1") (hash-ref hash1 "foo_9999") (hash-ref hash2 "foo_1") diff --git a/collects/tests/racket/benchmarks/shootout/typed/heapsort.rktl b/collects/tests/racket/benchmarks/shootout/typed/heapsort.rktl index 55bd815b00..955ed458e9 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/heapsort.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/heapsort.rktl @@ -66,7 +66,7 @@ ((= i last)) (vector-set! ary i (gen_random 1.0))) (heapsort n ary) - (printf "~a~n" + (printf "~a\n" (real->decimal-string (vector-ref ary n) 10)))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/typed/lists.rktl b/collects/tests/racket/benchmarks/shootout/typed/lists.rktl index b9e31d13b9..f7e9bcc009 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/lists.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/lists.rktl @@ -44,6 +44,6 @@ (when (> counter 0) (set! result (test-lists)) (loop (- counter 1)))) - (printf "~s~n" result))) + (printf "~s\n" result))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/typed/nestedloop.rktl b/collects/tests/racket/benchmarks/shootout/typed/nestedloop.rktl index d96589383a..ebfb1244b3 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/nestedloop.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/nestedloop.rktl @@ -13,6 +13,6 @@ (let*: ([n : Integer (assert (string->number (vector-ref argv 0)) exact-integer?)] [x : Integer 0]) (nest 6 (set! x (+ x 1))) - (printf "~s~n" x))) + (printf "~s\n" x))) (main (current-command-line-arguments)) diff --git a/collects/tests/racket/benchmarks/shootout/typed/random.rktl b/collects/tests/racket/benchmarks/shootout/typed/random.rktl index c6cdff8485..5c48f828ed 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/random.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/random.rktl @@ -35,5 +35,5 @@ (gen_random 100.0) (loop (- iter 1))) #t)) - (printf "~a~%" + (printf "~a\n" (real->decimal-string (gen_random 100.0) 9))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/recursive.rktl b/collects/tests/racket/benchmarks/shootout/typed/recursive.rktl index c6b0706392..66c4227207 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/recursive.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/recursive.rktl @@ -48,16 +48,16 @@ (: main (Integer -> Void)) (define (main n) - (printf "Ack(3,~A): ~A~%" n (ack 3 n)) - (printf "Fib(~a): ~a~%" + (printf "Ack(3,~A): ~A\n" n (ack 3 n)) + (printf "Fib(~a): ~a\n" (real->decimal-string (+ 27.0 n) 1) (real->decimal-string (fibflt (+ 27.0 n)) 1)) (set! n (- n 1)) - (printf "Tak(~A,~A,~A): ~A~%" (* n 3) (* n 2) n (tak (* n 3) (* n 2) n)) + (printf "Tak(~A,~A,~A): ~A\n" (* n 3) (* n 2) n (tak (* n 3) (* n 2) n)) - (printf "Fib(3): ~A~%" (fib 3)) - (printf "Tak(3.0,2.0,1.0): ~a~%" (real->decimal-string (takflt 3.0 2.0 1.0) 1))) + (printf "Fib(3): ~A\n" (fib 3)) + (printf "Tak(3.0,2.0,1.0): ~a\n" (real->decimal-string (takflt 3.0 2.0 1.0) 1))) ;; ------------------------------- diff --git a/collects/tests/racket/benchmarks/shootout/typed/regexmatch.rktl b/collects/tests/racket/benchmarks/shootout/typed/regexmatch.rktl index a7da1211c3..bb2c737aa1 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/regexmatch.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/regexmatch.rktl @@ -60,7 +60,7 @@ (assert numb))] [count (add1 count)]) (when (zero? n) - (printf "~a: ~a~n" count num)) + (printf "~a: ~a\n" count num)) (loop (cdr phones) count))) (loop (cdr phones) count)))))))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/wordfreq.rktl b/collects/tests/racket/benchmarks/shootout/typed/wordfreq.rktl index c827de4f10..f1f839c0f3 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/wordfreq.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/wordfreq.rktl @@ -28,7 +28,7 @@ t (lambda: ((word : String) (count : Natural)) (let ((count (number->string count))) - (format"~a~a ~a~%" + (format"~a~a ~a\n" (make-string (- 7 (string-length count)) #\space) count word)))) diff --git a/collects/tests/racket/benchmarks/shootout/wordfreq.rkt b/collects/tests/racket/benchmarks/shootout/wordfreq.rkt index 67a0a9ff86..1bbec43635 100644 --- a/collects/tests/racket/benchmarks/shootout/wordfreq.rkt +++ b/collects/tests/racket/benchmarks/shootout/wordfreq.rkt @@ -26,7 +26,7 @@ t (lambda (word count) (let ((count (number->string count))) - (format"~a~a ~a~%" + (format"~a~a ~a\n" (make-string (- 7 (string-length count)) #\space) count word)))) diff --git a/collects/tests/racket/ltest.rktl b/collects/tests/racket/ltest.rktl index 5765a97c42..e7626f069b 100644 --- a/collects/tests/racket/ltest.rktl +++ b/collects/tests/racket/ltest.rktl @@ -1,4 +1,4 @@ -(printf "nested loop~n") +(printf "nested loop\n") (time (let loop ([n 10000]) (unless (zero? n) @@ -7,13 +7,13 @@ (loop (sub1 n)) (loop2 (sub1 m))))))) -(printf "single loop~n") +(printf "single loop\n") (time (let loop ([n 100000]) (unless (zero? n) (loop (sub1 n))))) -(printf "Y loop~n") +(printf "Y loop\n") (time ((lambda (f n) (f f n)) (lambda (loop n) @@ -22,27 +22,27 @@ 100000)) -(printf "let closure recur~n") +(printf "let closure recur\n") (time (let ([f (lambda (x) (sub1 x))]) (let loop ([n 100000]) (unless (zero? n) (loop (f n)))))) -(printf "direct closure recur~n") +(printf "direct closure recur\n") (time (let loop ([n 100000]) (unless (zero? n) (loop ((lambda (x) (sub1 x)) n))))) -(printf "direct closure recur if~n") +(printf "direct closure recur if\n") (time (let loop ([n 100000]) (if (zero? n) (void) (loop ((lambda (x) (sub1 x)) n))))) -(printf "let closure top-level~n") +(printf "let closure top-level\n") (define loop (let ([f (lambda (x) (sub1 x))]) (lambda (n) @@ -50,7 +50,7 @@ (loop (f n)))))) (time (loop 100000)) -(printf "direct closure top-level~n") +(printf "direct closure top-level\n") (define loop (lambda (n) (unless (zero? n) diff --git a/collects/tests/racket/stream.rktl b/collects/tests/racket/stream.rktl index df6c622d21..02b9d0a907 100644 --- a/collects/tests/racket/stream.rktl +++ b/collects/tests/racket/stream.rktl @@ -1,5 +1,5 @@ -(printf "Stream Tests (current dir must be startup dir)~n") +(printf "Stream Tests (current dir must be startup dir)\n") (require scheme/system) @@ -51,7 +51,7 @@ (error "check-failed" (file-position p) c c2) (begin (fprintf (current-error-port) - "fail: ~a ~s=~s ~s=~s~n" + "fail: ~a ~s=~s ~s=~s\n" (file-position p) c (integer->char c) c2 (integer->char c2)) (loop (add1 badc))))) (unless (eof-object? c) @@ -107,8 +107,8 @@ (define r2 #f) (define w2 #f) (thread (copy-stream (cadddr p) (current-error-port))) - (fprintf (cadr p) "(define log void)~n") - (fprintf (cadr p) "~s~n" cs-prog) + (fprintf (cadr p) "(define log void)\n") + (fprintf (cadr p) "~s\n" cs-prog) (if tcp? (let ([t (thread (lambda () @@ -118,12 +118,12 @@ (set! w ww) (set! r2 rr2) (set! w2 ww2)))]) - (fprintf (cadr p) "(define-values (r w) (tcp-connect \"localhost\" ~a))~n" portno) - (fprintf (cadr p) "(define-values (r2 w2) (tcp-connect \"localhost\" ~a))~n" (add1 portno)) + (fprintf (cadr p) "(define-values (r w) (tcp-connect \"localhost\" ~a))\n" portno) + (fprintf (cadr p) "(define-values (r2 w2) (tcp-connect \"localhost\" ~a))\n" (add1 portno)) (flush-output (cadr p)) (thread-wait t) - (fprintf (cadr p) "(begin ((copy-stream r w2)) (exit))~n")) - (fprintf (cadr p) "(begin (flush-output) ((copy-stream (current-input-port) (current-output-port))) (exit))~n")) + (fprintf (cadr p) "(begin ((copy-stream r w2)) (exit))\n")) + (fprintf (cadr p) "(begin (flush-output) ((copy-stream (current-input-port) (current-output-port))) (exit))\n")) (flush-output (cadr p)) (unless tcp? @@ -149,51 +149,51 @@ (let ([ps-ms (current-process-milliseconds)] [gc-ms (current-gc-milliseconds)] [ms (current-milliseconds)]) - (printf "cpu: ~a real: ~a gc ~a~n" + (printf "cpu: ~a real: ~a gc ~a\n" (- ps-ms start-ps-ms) (- ms start-ms) (- gc-ms start-gc-ms)))) '(thread (lambda () (let loop () - (printf "alive~n") + (printf "alive\n") (sleep 1) (loop)))) -(start "Quick check:~n") +(start "Quick check:\n") (define p (open-input-file test-file)) (check-file/fast p) (close-input-port p) (end) -(start "Quicker check:~n") +(start "Quicker check:\n") (define p (open-input-file test-file)) (check-file/fastest p) (close-input-port p) (end) -(start "Plain pipe...~n") +(start "Plain pipe...\n") (define-values (r w) (make-pipe)) (feed-file w) (close-output-port w) (check-file r) (end) -(start "Plain pipe, faster...~n") +(start "Plain pipe, faster...\n") (define-values (r w) (make-pipe)) (feed-file/fast w) (close-output-port w) (check-file/fast r) (end) -(start "Plain pipe, fastest...~n") +(start "Plain pipe, fastest...\n") (define-values (r w) (make-pipe)) (feed-file/fast w) (close-output-port w) (check-file/fastest r) (end) -(start "Limited pipe...~n") +(start "Limited pipe...\n") (define-values (r w) (make-pipe 253)) (thread (lambda () (feed-file w) @@ -201,7 +201,7 @@ (check-file r) (end) -(start "Limited pipe, faster...~n") +(start "Limited pipe, faster...\n") (define-values (r w) (make-pipe 253)) (thread (lambda () (feed-file/fast w) @@ -209,7 +209,7 @@ (check-file/fast r) (end) -(start "Limited pipe, fastest...~n") +(start "Limited pipe, fastest...\n") (define-values (r w) (make-pipe 253)) (thread (lambda () (feed-file/fast w) @@ -217,8 +217,8 @@ (check-file/fastest r) (end) -(start "To file and back:~n") -(start " to...~n") +(start "To file and back:\n") +(start " to...\n") (define-values (r w) (make-pipe)) (define p (open-output-file tmp-file #:exists 'truncate)) (define t (thread (copy-stream r p))) @@ -228,7 +228,7 @@ (close-output-port p) (end) -(start " back...~n") +(start " back...\n") (define-values (r w) (make-pipe)) (define p (open-input-file tmp-file)) (define t (thread (copy-stream p w))) @@ -238,8 +238,8 @@ (check-file r) (end) -(start "To file and back, faster:~n") -(start " to...~n") +(start "To file and back, faster:\n") +(start " to...\n") (define-values (r w) (make-pipe)) (define p (open-output-file tmp-file #:exists 'truncate)) (define t (thread (copy-stream r p))) @@ -249,7 +249,7 @@ (close-output-port p) (end) -(start " back...~n") +(start " back...\n") (define-values (r w) (make-pipe)) (define p (open-input-file tmp-file)) (define t (thread (copy-stream p w))) @@ -259,7 +259,7 @@ (check-file/fast r) (end) -(start "File back, fastest:~n") +(start "File back, fastest:\n") (define-values (r w) (make-pipe)) (define p (open-input-file tmp-file)) (define t (thread (copy-stream p w))) @@ -269,7 +269,7 @@ (check-file/fastest r) (end) -(start "Echo...~n") +(start "Echo...\n") (define p (setup-mzscheme-echo #f)) (thread (lambda () (feed-file (cadr p)) @@ -277,7 +277,7 @@ (check-file (car p)) (end) -(start "Echo, faster...~n") +(start "Echo, faster...\n") (define p (setup-mzscheme-echo #f)) (thread (lambda () (feed-file/fast (cadr p)) @@ -285,7 +285,7 @@ (check-file/fast (car p)) (end) -(start "Echo, indirect...~n") +(start "Echo, indirect...\n") (define p (setup-mzscheme-echo #f)) (define-values (rp1 wp1) (make-pipe)) (define-values (rp2 wp2) (make-pipe)) @@ -300,7 +300,7 @@ (define l1 (tcp-listen portno 5 #t)) (define l2 (tcp-listen (add1 portno) 5 #t)) -(start "TCP Echo...~n") +(start "TCP Echo...\n") (define-values (r w r2 w2) (setup-mzscheme-echo #t)) (close-input-port r) (thread (lambda () @@ -310,7 +310,7 @@ (close-input-port r2) (end) -(start "TCP Echo, faster...~n") +(start "TCP Echo, faster...\n") (define-values (r w r2 w2) (setup-mzscheme-echo #t)) (close-input-port r) (thread (lambda () @@ -320,7 +320,7 @@ (close-input-port r2) (end) -(start "TCP Echo, indirect...~n") +(start "TCP Echo, indirect...\n") (define-values (rp1 wp1) (make-pipe)) (define-values (rp2 wp2) (make-pipe)) (define-values (r w r2 w2) (setup-mzscheme-echo #t)) diff --git a/collects/tests/racket/subprocess.rktl b/collects/tests/racket/subprocess.rktl index 5d0d0d040e..1d85c93f9a 100644 --- a/collects/tests/racket/subprocess.rktl +++ b/collects/tests/racket/subprocess.rktl @@ -23,7 +23,7 @@ ;; Simple `process' tests using "cat" (let ([p (process* cat)]) - (fprintf (cadr p) "Hello~n") + (fprintf (cadr p) "Hello\n") (close-output-port (cadr p)) (test "Hello" read-line (car p)) (test eof read-line (car p)) @@ -38,7 +38,7 @@ ;; Generate output to stderr as well as stdout (let ([p (process* cat "-" "nosuchfile")]) - (fprintf (cadr p) "Hello~n") + (fprintf (cadr p) "Hello\n") (close-output-port (cadr p)) (test "Hello" read-line (car p)) (test eof read-line (car p)) @@ -58,7 +58,7 @@ (let ([p (process*/ports f #f #f cat)]) (test #f car p) - (fprintf (cadr p) "Hello~n") + (fprintf (cadr p) "Hello\n") (close-output-port (cadr p)) (test eof read-line (cadddr p)) @@ -78,7 +78,7 @@ (test #f car p) (test #f cadddr p) - (fprintf (cadr p) "Hello~n") + (fprintf (cadr p) "Hello\n") (close-output-port (cadr p)) ((list-ref p 4) 'wait) @@ -132,7 +132,7 @@ (test #f car p) (test #f cadddr p) - (fprintf (cadr p) "First line~n") + (fprintf (cadr p) "First line\n") (close-output-port (cadr p)) ((list-ref p 4) 'wait) @@ -153,7 +153,7 @@ (test #f car p) (test #f cadddr p) - (fprintf (cadr p) "The line~n") + (fprintf (cadr p) "The line\n") (close-output-port (cadr p)) ((list-ref p 4) 'wait) @@ -175,7 +175,7 @@ ;; Supply file for stdin (let ([f (open-output-file tmpfile #:exists 'truncate/replace)]) - (fprintf f "Howdy~n") + (fprintf f "Howdy\n") (close-output-port f)) (let ([f (open-input-file tmpfile)]) (let ([p (process*/ports #f f #f cat)]) @@ -256,7 +256,7 @@ "(let loop () (unless (eof-object? (eval (read))) (loop)))"))) (define (test-line out in) - (fprintf w "~a~n" in) + (fprintf w "~a\n" in) (flush-output w) (when out (test out (lambda (ignored) (read-line r)) in))) diff --git a/collects/tests/racket/tcp.rktl b/collects/tests/racket/tcp.rktl index 3a917a63d7..2856e7ffb0 100644 --- a/collects/tests/racket/tcp.rktl +++ b/collects/tests/racket/tcp.rktl @@ -17,7 +17,7 @@ (define (tread connect) (let-values ([(r w close) (connect)]) - (printf "Hit return to start reading~n") + (printf "Hit return to start reading\n") (read-line) (let loop ([last -1]) (let ([v (read r)]) @@ -29,9 +29,9 @@ last) (begin (unless (= v (add1 last)) - (printf "skipped! ~a ~a~n" last v)) + (printf "skipped! ~a ~a\n" last v)) (when (zero? (modulo v print-mod)) - (printf "got ~a~n" v)) + (printf "got ~a\n" v)) (loop v))))))) (define (twrite connect) @@ -39,7 +39,7 @@ [(t) (thread (lambda () (let loop () (sleep 1) - (printf "tick~n") + (printf "tick\n") (loop))))]) (let ([done (lambda () (close-output-port w) @@ -49,11 +49,11 @@ (let loop ([n 0]) (if (= n max-send) (begin - (printf "stopped before ~a~n" n) + (printf "stopped before ~a\n" n) (done)) (begin - (fprintf w "~s~n" n) + (fprintf w "~s\n" n) (when (zero? (modulo n print-mod)) - (printf "sent ~a~n" n)) + (printf "sent ~a\n" n)) (loop (add1 n)))))))) diff --git a/collects/tests/racket/ttt/tic-bang.rktl b/collects/tests/racket/ttt/tic-bang.rktl index 9cd38f06de..1ed328078a 100644 --- a/collects/tests/racket/ttt/tic-bang.rktl +++ b/collects/tests/racket/ttt/tic-bang.rktl @@ -53,9 +53,9 @@ (define make-move (lambda (other-move p/o tag) (lambda (states) - (printf "~s: processing ~s states ~n" tag (length states)) + (printf "~s: processing ~s states \n" tag (length states)) (let ((t (print&remove-terminals states))) - (printf "terminal states removed: ~s~n" + (printf "terminal states removed: ~s\n" (- (length states) (length t))) (if (null? t) (void) diff --git a/collects/tests/racket/ttt/tic-func.rktl b/collects/tests/racket/ttt/tic-func.rktl index aaca9c6292..0b6da1c2c2 100644 --- a/collects/tests/racket/ttt/tic-func.rktl +++ b/collects/tests/racket/ttt/tic-func.rktl @@ -29,10 +29,10 @@ (define make-move (lambda (other-move p/o tag) (lambda (states) - (printf "~s: processing ~s states of length ~s ~n" + (printf "~s: processing ~s states of length ~s \n" tag (length states) (length (car states))) (let ((t (print&remove-terminals states))) - (printf "terminal states removed: ~s~n" + (printf "terminal states removed: ~s\n" (- (length states) (length t))) (if (null? t) (void) @@ -85,10 +85,10 @@ (define print-state2 (lambda (astate) (cond - ((null? astate) (printf "------------~n")) + ((null? astate) (printf "------------\n")) (else (print-state (cdr astate)) (let ((x (car astate))) - (printf " ~s @ (~s,~s) ~n" + (printf " ~s @ (~s,~s) \n" (entry-who x) (entry-x x) (entry-y x))))))) (define print-state diff --git a/collects/tests/racket/ztest.rktl b/collects/tests/racket/ztest.rktl index 39f22c9ab2..92e4a76c0a 100644 --- a/collects/tests/racket/ztest.rktl +++ b/collects/tests/racket/ztest.rktl @@ -1,20 +1,20 @@ -;; rudimentary test harness for complex math routines in -;; zmath.ss +;; rudimentary test harness for complex math routines in +;; zmath.ss (require mzlib/zmath) (define ztest (lambda (z) - (printf "z = ~a~n" z) - (printf " zabs(z) = ~a~n" (zabs z)) - (printf " zlog(z) = ~a~n" (zlog z)) - (printf " zexp(z) = ~a~n" (zexp z)) - (printf " zsqrt(z) = ~a~n" (zsqrt z)) - (printf " zsin(z) = ~a~n" (zsin z)) - (printf " zcos(z) = ~a~n" (zcos z)) - (printf " ztan(z) = ~a~n" (ztan z)) - (printf " zasin(z) = ~a~n" (zasin z)) - (printf " zacos(z) = ~a~n" (zacos z)) - (printf " zatan(z) = ~a~n" (zatan z)))) + (printf "z = ~a\n" z) + (printf " zabs(z) = ~a\n" (zabs z)) + (printf " zlog(z) = ~a\n" (zlog z)) + (printf " zexp(z) = ~a\n" (zexp z)) + (printf " zsqrt(z) = ~a\n" (zsqrt z)) + (printf " zsin(z) = ~a\n" (zsin z)) + (printf " zcos(z) = ~a\n" (zcos z)) + (printf " ztan(z) = ~a\n" (ztan z)) + (printf " zasin(z) = ~a\n" (zasin z)) + (printf " zacos(z) = ~a\n" (zacos z)) + (printf " zatan(z) = ~a\n" (zatan z)))) (ztest 0.5) diff --git a/collects/tests/srpersist/srptests.rktl b/collects/tests/srpersist/srptests.rktl index 090890a2dc..82bc0efdc3 100644 --- a/collects/tests/srpersist/srptests.rktl +++ b/collects/tests/srpersist/srptests.rktl @@ -102,87 +102,12 @@ (define bi (make-boxed-uint 42)) -(printf "~a~n" results-1) -(printf "~a~n" results-2) -(printf "~a~n" results-3) -(printf "~a~n" ind-result-1) -(printf "~a~n" ind-result-2) -(printf "~a~n" ind-result-3) -(printf "~a~n" ind-result-4) +(printf "~a\n" results-1) +(printf "~a\n" results-2) +(printf "~a\n" results-3) +(printf "~a\n" ind-result-1) +(printf "~a\n" ind-result-2) +(printf "~a\n" ind-result-3) +(printf "~a\n" ind-result-4) -(printf "~a~n" (read-boxed-uint bi)) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +(printf "~a\n" (read-boxed-uint bi)) diff --git a/collects/tests/utils/mz-testing.rkt b/collects/tests/utils/mz-testing.rkt index f94cdeebc9..4376b9e971 100644 --- a/collects/tests/utils/mz-testing.rkt +++ b/collects/tests/utils/mz-testing.rkt @@ -226,9 +226,9 @@ (let ([v (with-handlers ([void (lambda (exn) (if (check? exn) - (printf " ~a~n" (exn-message exn)) + (printf " ~a\n" (exn-message exn)) (let ([ok-type? (exn:application:arity? exn)]) - (printf " WRONG EXN ~a: ~s~n" + (printf " WRONG EXN ~a: ~s\n" (if ok-type? "FIELD" "TYPE") @@ -240,7 +240,7 @@ (cons f args))))) (done (void)))]) (apply f args))]) - (printf "~s~n BUT EXPECTED ERROR~n" v) + (printf "~s\n BUT EXPECTED ERROR\n" v) (record-error (list v 'Error (cons f args))))))]) (let loop ([n 0][l '()]) (unless (>= n min) @@ -265,11 +265,11 @@ (test l call-with-values thunk list)) (define (report-errs) - (printf "~nPerformed ~a expression tests (~a good expressions, ~a bad expressions)~n" + (printf "\nPerformed ~a expression tests (~a good expressions, ~a bad expressions)\n" (+ number-of-tests number-of-error-tests) number-of-tests number-of-error-tests) - (printf "and ~a exception field tests.~n~n" + (printf "and ~a exception field tests.\n\n" number-of-exn-tests) (if (null? errs) (display "Passed all tests.") diff --git a/collects/tests/web-server/lang-test.rkt b/collects/tests/web-server/lang-test.rkt index 1f825d9dde..fbdf53ae00 100644 --- a/collects/tests/web-server/lang-test.rkt +++ b/collects/tests/web-server/lang-test.rkt @@ -104,9 +104,9 @@ (module m03 (lib "lang.rkt" "web-server") (provide start) (define (start x) - (begin (printf "Before~n") + (begin (printf "Before\n") (values 1 x) - (printf "After~n") + (printf "After\n") x))))]) (check = 3 (test `(dispatch-start start 3))))) @@ -118,9 +118,9 @@ (provide start) (define (start x) (begin0 x - (printf "Before~n") + (printf "Before\n") (values 1 x) - (printf "After~n")))))]) + (printf "After\n")))))]) (check = 3 (test `(dispatch-start start 3))))) (test-case @@ -132,9 +132,9 @@ (define (start x) (let-values ([(_ ans) (begin0 (values 1 x) - (printf "Before~n") + (printf "Before\n") x - (printf "After~n"))]) + (printf "After\n"))]) ans))))]) (check = 3 (test `(dispatch-start start 3)))))) @@ -229,18 +229,18 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "Please send the ~a number.~n" which)]) + (let ([ignore (printf "Please send the ~a number.\n" which)]) (store-k k)))))) (define (start ignore) (let ([result (+ (gn "first") (gn "second"))]) - (let ([ignore (printf "The answer is: ~s~n" result)]) + (let ([ignore (printf "The answer is: ~s\n" result)]) result))))) (table-01-eval '(require 'm06)) (let* ([first-key (table-01-eval '(dispatch-start start 'foo))] [second-key (table-01-eval `(dispatch lookup-k '(,first-key 1)))] [third-key (table-01-eval `(dispatch lookup-k '(,first-key -7)))]) - #;(printf "~S~n" (list first-key second-key third-key)) + #;(printf "~S\n" (list first-key second-key third-key)) (check = 3 (table-01-eval `(dispatch lookup-k '(,second-key 2)))) (check = 4 (table-01-eval `(dispatch lookup-k '(,second-key 3)))) (check-true (zero? (table-01-eval `(dispatch lookup-k '(,second-key -1))))) @@ -258,12 +258,12 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "Please send the ~a number.~n" which)]) + (let ([ignore (printf "Please send the ~a number.\n" which)]) k))))) (define (start ignore) (let ([result (+ (gn "first") (gn "second"))]) - (let ([ignore (printf "The answer is: ~s~n" result)]) + (let ([ignore (printf "The answer is: ~s\n" result)]) result)))))]) (let* ([first-key (test-m06.1 '(dispatch-start start 'foo))] [second-key (test-m06.1 `(dispatch ,the-dispatch (list (deserialize (serialize ,first-key)) 1)))] @@ -285,12 +285,12 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "Please send the ~a number.~n" which)]) + (let ([ignore (printf "Please send the ~a number.\n" which)]) k))))) (define (start ignore) (let ([result (+ (gn #:page "first") (gn #:page "second"))]) - (let ([ignore (printf "The answer is: ~s~n" result)]) + (let ([ignore (printf "The answer is: ~s\n" result)]) result)))))]) (let* ([first-key (test-m06.2 '(dispatch-start start 'foo))] [second-key (test-m06.2 `(dispatch ,the-dispatch (list (deserialize (serialize ,first-key)) 1)))] @@ -382,7 +382,7 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "Please send the ~a number.~n" which)]) + (let ([ignore (printf "Please send the ~a number.\n" which)]) k))))) (define (start ignore) @@ -391,7 +391,7 @@ [g (let ([n (gn "second")]) (lambda (m) (+ n (f m))))]) (let ([result (g (gn "third"))]) - (let ([ignore (printf "The answer is: ~s~n" result)]) + (let ([ignore (printf "The answer is: ~s\n" result)]) result))))))]) (let* ([k0 (test-m08 '(serialize (dispatch-start start 'foo)))] [k1 (test-m08 `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) 1))))] @@ -416,7 +416,7 @@ (define (non-tail-apply f . args) (let ([result (apply f args)]) - (printf "result = ~s~n" result) + (printf "result = ~s\n" result) result))))]) (nta-eval '(module m09 (lib "lang.rkt" "web-server") (require 'nta) @@ -438,7 +438,7 @@ (provide start) (define (nta f arg) (let ([result (f arg)]) - (printf "result = ~s~n" result) + (printf "result = ~s\n" result) result)) (define (start ignore) (nta (lambda (x) (let/cc k (k x))) 7))))]) @@ -493,7 +493,7 @@ (map (lambda (n) (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "n = ~s~n" n)]) + (let ([ignore (printf "n = ~s\n" n)]) k)))) (list 1 2 3)))))]) (check-true (catch-unsafe-context-exn @@ -519,7 +519,7 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "n = ~s~n" n)]) + (let ([ignore (printf "n = ~s\n" n)]) k))))) 7))))) (ta-eval '(require 'm14)) diff --git a/collects/tests/web-server/lang/anormal-test.rkt b/collects/tests/web-server/lang/anormal-test.rkt index 1f3e75c144..293927a7b5 100644 --- a/collects/tests/web-server/lang/anormal-test.rkt +++ b/collects/tests/web-server/lang/anormal-test.rkt @@ -99,7 +99,7 @@ (define (alpha= expr1 expr2) (define r (alpha=/env empty-env empty-env expr1 expr2)) (unless r - (error 'alpha= "Not alpha=:\t~S~n\t~S~n" (syntax->datum expr1) (syntax->datum expr2))) + (error 'alpha= "Not alpha=:\t~S\n\t~S\n" (syntax->datum expr1) (syntax->datum expr2))) r) (define normalize-term (make-anormal-term (lambda _ (error 'anormal "No elim-letrec given.")))) diff --git a/collects/tests/web-server/util.rkt b/collects/tests/web-server/util.rkt index 593ca99ec9..96db6b8d32 100644 --- a/collects/tests/web-server/util.rkt +++ b/collects/tests/web-server/util.rkt @@ -88,7 +88,7 @@ [(list _ s) (string->xexpr (bytes->string/utf-8 s))] [_ - (error 'html "Given ~S~n" bs)])) + (error 'html "Given ~S\n" bs)])) ; This causes infinite loop. I will try putting it in a thread like on the real server #;(define (collect d req) @@ -108,14 +108,14 @@ ; This causes a dead lock, even though the log shows that the channel should sync (define (channel-put* c v) - (printf "+CHAN ~S PUT: ~S~n" c v) + (printf "+CHAN ~S PUT: ~S\n" c v) (channel-put c v) - (printf "-CHAN ~S PUT: ~S~n" c v)) + (printf "-CHAN ~S PUT: ~S\n" c v)) (define (channel-get* c) - (printf "+CHAN ~S GET~n" c) + (printf "+CHAN ~S GET\n" c) (let ([v (channel-get c)]) - (printf "-CHAN ~S GET: ~S~n" c v) + (printf "-CHAN ~S GET: ~S\n" c v) v)) #;(define (collect d req) diff --git a/collects/texpict/private/texpict-extra.rkt b/collects/texpict/private/texpict-extra.rkt index 5555d0e4df..30c427e952 100644 --- a/collects/texpict/private/texpict-extra.rkt +++ b/collects/texpict/private/texpict-extra.rkt @@ -426,22 +426,22 @@ (let ([tag (car s)]) (case tag [(local) - (format "{~a}~n" (output (cadr s)))] + (format "{~a}\n" (output (cadr s)))] [(begin) (apply string-append (map output (cdr s)))] [(picture) - (format "\\begin{picture}(~a,~a)~n~a\\end{picture}~n" + (format "\\begin{picture}(~a,~a)\n~a\\end{picture}\n" (cadr s) (caddr s) (apply string-append (map output (cdddr s))))] [(color) - (format "\\special{color push ~a}~n~a\\special{color pop}~n" + (format "\\special{color push ~a}\n~a\\special{color pop}\n" (cadr s) (output (cddr s)))] [(thickness) (format "\\~a~a" (cadr s) (output (caddr s)))] [(put) - (format "\\put(~a,~a){~a}~n" (cadr s) (caddr s) (output (cadddr s)))] + (format "\\put(~a,~a){~a}\n" (cadr s) (caddr s) (output (cadddr s)))] [(qbezier) - (apply format "\\qbezier~a(~a,~a)(~a,~a)(~a,~a)~n" + (apply format "\\qbezier~a(~a,~a)(~a,~a)(~a,~a)\n" (if (cadr s) (format "[~a]" (cadr s)) "") diff --git a/collects/typed-scheme/private/colon.rkt b/collects/typed-scheme/private/colon.rkt index fb84c1795c..58152646f6 100644 --- a/collects/typed-scheme/private/colon.rkt +++ b/collects/typed-scheme/private/colon.rkt @@ -12,11 +12,11 @@ (define-syntax-class arr (pattern x:id #:fail-unless (eq? (syntax-e #'x) '->) #f - #:fail-unless (printf "id: ~a ~a~n" + #:fail-unless (printf "id: ~a ~a\n" (identifier-binding #'All-kw) (identifier-transformer-binding #'All-kw)) #f - #:fail-unless (printf "kw: ~a ~a~n" + #:fail-unless (printf "kw: ~a ~a\n" (identifier-binding #'t:All) (identifier-transformer-binding #'t:All)) #f diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt index 6005433a85..d542a8e536 100644 --- a/collects/typed-scheme/private/parse-type.rkt +++ b/collects/typed-scheme/private/parse-type.rkt @@ -24,7 +24,7 @@ (define enable-mu-parsing (make-parameter #t)) (define ((parse/id p) loc datum) - #;(printf "parse-type/id id : ~a~n ty: ~a~n" (syntax-object->datum loc) (syntax-object->datum stx)) + #;(printf "parse-type/id id : ~a\n ty: ~a\n" (syntax-object->datum loc) (syntax-object->datum stx)) (let* ([stx* (datum->syntax loc datum loc loc)]) (p stx*))) @@ -65,7 +65,7 @@ (parse-type s)])) (define (parse-all-type stx parse-type) - ;(printf "parse-all-type: ~a ~n" (syntax->datum stx)) + ;(printf "parse-all-type: ~a \n" (syntax->datum stx)) (syntax-parse stx #:literals (t:All) [((~and kw t:All) (vars:id ... v:id dd:ddd) . t) (let* ([vars (map syntax-e (syntax->list #'(vars ...)))] @@ -282,13 +282,13 @@ [(lookup-type-alias #'id parse-type (lambda () #f)) => (lambda (t) - ;(printf "found a type alias ~a~n" #'id) + ;(printf "found a type alias ~a\n" #'id) (add-type-name-reference #'id) t)] ;; if it's a type name, we just use the name [(lookup-type-name #'id (lambda () #f)) (add-type-name-reference #'id) - ;(printf "found a type name ~a~n" #'id) + ;(printf "found a type name ~a\n" #'id) (make-Name #'id)] [(free-identifier=? #'id #'t:->) (tc-error/delayed "Incorrect use of -> type constructor") diff --git a/collects/typed-scheme/private/type-annotation.rkt b/collects/typed-scheme/private/type-annotation.rkt index 75c4db9a1b..e5ab42be14 100644 --- a/collects/typed-scheme/private/type-annotation.rkt +++ b/collects/typed-scheme/private/type-annotation.rkt @@ -27,10 +27,10 @@ (define (print-size stx) (syntax-case stx () [(a . b) (begin - (printf/log "Annotation Sexp Pair ~n") + (printf/log "Annotation Sexp Pair \n") (print-size #'a) (print-size #'b))] - [_ (printf/log "Annotation Sexp ~n" )])) + [_ (printf/log "Annotation Sexp \n" )])) ;; get the type annotation of this syntax ;; syntax -> Maybe[Type] @@ -46,7 +46,7 @@ (parse-type prop) (parse-type/id stx prop))) ;(unless let-binding (error 'ohno)) - ;(printf "in type-annotation:~a~n" (syntax->datum stx)) + ;(printf "in type-annotation:~a\n" (syntax->datum stx)) (cond [(syntax-property stx type-label-symbol) => pt] [(syntax-property stx type-ascrip-symbol) => pt] @@ -87,11 +87,11 @@ [else #f]))) (define (log/ann stx ty) - (printf/log "Required Annotated Variable: ~a ~a~n" (syntax-e stx) ty)) + (printf/log "Required Annotated Variable: ~a ~a\n" (syntax-e stx) ty)) (define (log/extra stx ty ty2) - (printf/log "Extra Annotated Variable: ~a ~a ~a~n" (syntax-e stx) ty ty2)) + (printf/log "Extra Annotated Variable: ~a ~a ~a\n" (syntax-e stx) ty ty2)) (define (log/noann stx ty) - (printf/log "Unannotated Variable: ~a ~a~n" (syntax-e stx) ty)) + (printf/log "Unannotated Variable: ~a ~a\n" (syntax-e stx) ty)) ;; get the type annotation of this identifier, otherwise error ;; if #:default is provided, return that instead of error @@ -146,7 +146,7 @@ (parameterize ([current-orig-stx stx]) (unless (subtype e-type ty) ;(printf "orig-stx: ~a" (syntax->datum stx*)) - (tc-error "Body had type:~n~a~nVariable had type:~n~a~n" e-type ty)))) + (tc-error "Body had type:\n~a\nVariable had type:\n~a\n" e-type ty)))) (define (dotted? stx) (cond [(syntax-property stx type-dotted-symbol) => syntax-e] diff --git a/collects/typed-scheme/private/type-env-lang.rkt b/collects/typed-scheme/private/type-env-lang.rkt index 3892a58338..dd0173946d 100644 --- a/collects/typed-scheme/private/type-env-lang.rkt +++ b/collects/typed-scheme/private/type-env-lang.rkt @@ -21,7 +21,7 @@ ;(define-syntax provider (lambda (stx) #'(begin (provide nm) ...))) ;(provide provider) (begin-for-syntax - ;(printf "running base-types~n") + ;(printf "running base-types\n") (initialize-type-name-env (list (list #'nm ty) ...))))))] [(mb . rest) diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.rkt b/collects/typed-scheme/typecheck/check-subforms-unit.rkt index 6196c0b9b8..ac0bf4e21c 100644 --- a/collects/typed-scheme/typecheck/check-subforms-unit.rkt +++ b/collects/typed-scheme/typecheck/check-subforms-unit.rkt @@ -25,7 +25,7 @@ (Values: (list (Result: rngs _ _) ...)) _ _ (list (Keyword: _ _ #t) ...)))) (apply Un rngs)] - [_ (int-err "Internal error in get-result-ty: not a function type: ~n~a" t)])) + [_ (int-err "Internal error in get-result-ty: not a function type: \n~a" t)])) (let loop ([form form]) (parameterize ([current-orig-stx form]) (syntax-parse form @@ -44,7 +44,7 @@ (Function: (list (arr: (list _) _ _ _ (list (Keyword: _ _ #f) ...)) ...)))) (set! handler-tys (cons (get-result-ty t) handler-tys))] [(tc-results: t) - (tc-error "Exception handler must be a single-argument function, got ~n~a" t)]))] + (tc-error "Exception handler must be a single-argument function, got \n~a" t)]))] [stx ;; this is the body of the with-handlers #:when (syntax-property form 'typechecker:exn-body) diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt index ef16316921..0263ccc8ed 100644 --- a/collects/typed-scheme/typecheck/tc-app.rkt +++ b/collects/typed-scheme/typecheck/tc-app.rkt @@ -173,7 +173,7 @@ (for ([n names] #:when (not (memq n tnames))) (tc-error/delayed - "unknown named argument ~a for class~nlegal named arguments are ~a" + "unknown named argument ~a for class\nlegal named arguments are ~a" n (stringify tnames))) (for-each (match-lambda [(list tname tfty opt?) @@ -623,25 +623,25 @@ ;; special case for `list' [(#%plain-app list . args) (begin - ;(printf "calling list: ~a ~a~n" (syntax->datum #'args) expected) + ;(printf "calling list: ~a ~a\n" (syntax->datum #'args) expected) (match expected [(tc-result1: (Mu: var (Union: (or (list (Pair: elem-ty (F: var)) (Value: '())) (list (Value: '()) (Pair: elem-ty (F: var))))))) - ;(printf "special case 1 ~a~n" elem-ty) + ;(printf "special case 1 ~a\n" elem-ty) (for ([i (in-list (syntax->list #'args))]) (tc-expr/check i (ret elem-ty))) expected] [(tc-result1: (app untuple (? (lambda (ts) (and ts (= (length (syntax->list #'args)) (length ts)))) ts))) - ;(printf "special case 2 ~a~n" ts) + ;(printf "special case 2 ~a\n" ts) (for ([ac (in-list (syntax->list #'args))] [exp (in-list ts)]) (tc-expr/check ac (ret exp))) expected] [_ - ;(printf "not special case~n") + ;(printf "not special case\n") (let ([tys (map tc-expr/t (syntax->list #'args))]) (ret (apply -lst* tys)))]))] ;; special case for `list*' @@ -699,7 +699,7 @@ dom) (Values: (list (Result: v (FilterSet: (Top:) (Top:)) (Empty:)))) #f #f (list (Keyword: _ _ #f) ...))))))) - ;(printf "f dom: ~a ~a~n" (syntax->datum #'f) dom) + ;(printf "f dom: ~a ~a\n" (syntax->datum #'f) dom) (let ([arg-tys (map (lambda (a t) (tc-expr/check a (ret t))) (syntax->list #'args) dom)]) diff --git a/collects/typed-scheme/typecheck/tc-apply.rkt b/collects/typed-scheme/typecheck/tc-apply.rkt index a28ef37165..99400ff338 100644 --- a/collects/typed-scheme/typecheck/tc-apply.rkt +++ b/collects/typed-scheme/typecheck/tc-apply.rkt @@ -53,7 +53,7 @@ [(null? doms*) (tc-error/expr #:return (ret (Un)) (string-append - "Bad arguments to function in apply:~n" + "Bad arguments to function in apply:\n" (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty #f)))] ;; this case of the function type has a rest argument [(and (car rests*) @@ -87,7 +87,7 @@ [(tc-result1: (Poly-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))) (tc-error/expr #:return (ret (Un)) (string-append - "Bad arguments to polymorphic function in apply:~n" + "Bad arguments to polymorphic function in apply:\n" (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty tail-bound)))])] ;; the actual work, when we have a * function and a list final argument [(and (car rests*) @@ -141,7 +141,7 @@ [(tc-result1: (PolyDots-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))) (tc-error/expr #:return (ret (Un)) (string-append - "Bad arguments to polymorphic function in apply:~n" + "Bad arguments to polymorphic function in apply:\n" (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty tail-bound)))])] ;; the actual work, when we have a * function and a list final argument [(and (car rests*) @@ -208,4 +208,4 @@ (tc-error/expr #:return (ret (Un)) "Function has no cases")] [(tc-result1: f-ty) (tc-error/expr #:return (ret (Un)) - "Type of argument to apply is not a function type: ~n~a" f-ty)])) + "Type of argument to apply is not a function type: \n~a" f-ty)])) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index 7a42fb87a4..bf632f86a6 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -116,12 +116,12 @@ [(and (Poly? ty) (not (= (length (syntax->list inst)) (Poly-n ty)))) (tc-error/expr #:return (Un) - "Wrong number of type arguments to polymorphic type ~a:~nexpected: ~a~ngot: ~a" + "Wrong number of type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a" ty (Poly-n ty) (length (syntax->list inst)))] [(and (PolyDots? ty) (not (>= (length (syntax->list inst)) (sub1 (PolyDots-n ty))))) ;; we can provide 0 arguments for the ... var (tc-error/expr #:return (Un) - "Wrong number of type arguments to polymorphic type ~a:~nexpected at least: ~a~ngot: ~a" + "Wrong number of type arguments to polymorphic type ~a:\nexpected at least: ~a\ngot: ~a" ty (sub1 (PolyDots-n ty)) (length (syntax->list inst)))] [(PolyDots? ty) ;; In this case, we need to check the last thing. If it's a dotted var, then we need to @@ -135,7 +135,7 @@ (let* ([last-id (syntax-e last-id-stx)] [last-ty (extend-tvars (list last-id) (parse-type last-ty-stx))]) (instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id)) - (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:~nexpected: ~a~ngot: ~a" + (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a" ty (sub1 (PolyDots-n ty)) (length all-but-last)))] [_ (instantiate-poly ty (map parse-type (syntax->list inst)))]))] @@ -210,7 +210,7 @@ ;; tc-expr/check : syntax tc-results -> tc-results (define (tc-expr/check/internal form expected) (parameterize ([current-orig-stx form]) - ;(printf "form: ~a~n" (syntax-object->datum form)) + ;(printf "form: ~a\n" (syntax-object->datum form)) ;; the argument must be syntax (unless (syntax? form) (int-err "bad form input to tc-expr: ~a" form)) @@ -243,7 +243,7 @@ (match-let* ([(tc-result1: id-t) (single-value #'id)] [(tc-result1: val-t) (single-value #'val)]) (unless (subtype val-t id-t) - (tc-error/expr "Mutation only allowed with compatible types:~n~a is not a subtype of ~a" val-t id-t)) + (tc-error/expr "Mutation only allowed with compatible types:\n~a is not a subtype of ~a" val-t id-t)) (ret -Void))] ;; top-level variable reference - occurs at top level [(#%top . id) (check-below (tc-id #'id) expected)] @@ -296,7 +296,7 @@ [(letrec-values ([(name ...) expr] ...) . body) (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body form expected)] ;; other - [_ (tc-error/expr #:return (ret expected) "cannot typecheck unknown form : ~a~n" (syntax->datum form))] + [_ (tc-error/expr #:return (ret expected) "cannot typecheck unknown form : ~a\n" (syntax->datum form))] )))) ;; type check form in the current type environment @@ -355,7 +355,7 @@ (match-let* ([(tc-result1: id-t) (tc-expr #'id)] [(tc-result1: val-t) (tc-expr #'val)]) (unless (subtype val-t id-t) - (tc-error/expr "Mutation only allowed with compatible types:~n~a is not a subtype of ~a" val-t id-t)) + (tc-error/expr "Mutation only allowed with compatible types:\n~a is not a subtype of ~a" val-t id-t)) (ret -Void))] ;; top-level variable reference - occurs at top level [(#%top . id) (tc-id #'id)] @@ -384,10 +384,10 @@ (begin (tc-exprs (syntax->list #'es)) (tc-expr #'e))] ;; other - [_ (tc-error/expr #:return (ret (Un)) "cannot typecheck unknown form : ~a~n" (syntax->datum form))])) + [_ (tc-error/expr #:return (ret (Un)) "cannot typecheck unknown form : ~a\n" (syntax->datum form))])) (parameterize ([current-orig-stx form]) - ;(printf "form: ~a~n" (syntax->datum form)) + ;(printf "form: ~a\n" (syntax->datum form)) ;; the argument must be syntax (unless (syntax? form) (int-err "bad form input to tc-expr: ~a" form)) diff --git a/collects/typed-scheme/typecheck/tc-if.rkt b/collects/typed-scheme/typecheck/tc-if.rkt index ce1bca7b13..0c61c8833d 100644 --- a/collects/typed-scheme/typecheck/tc-if.rkt +++ b/collects/typed-scheme/typecheck/tc-if.rkt @@ -50,12 +50,12 @@ [(tc-results: ts fs2 os2) (with-lexical-env env-thn (tc thn (unbox flag+)))] [(tc-results: us fs3 os3) (with-lexical-env env-els (tc els (unbox flag-)))]) ;(printf "old props: ~a\n" (env-props (lexical-env))) - ;(printf "fs+: ~a~n" fs+) - ;(printf "fs-: ~a~n" fs-) - ;(printf "thn-props: ~a~n" (env-props env-thn)) - ;(printf "els-props: ~a~n" (env-props env-els)) - ;(printf "new-thn-props: ~a~n" new-thn-props) - ;(printf "new-els-props: ~a~n" new-els-props) + ;(printf "fs+: ~a\n" fs+) + ;(printf "fs-: ~a\n" fs-) + ;(printf "thn-props: ~a\n" (env-props env-thn)) + ;(printf "els-props: ~a\n" (env-props env-els)) + ;(printf "new-thn-props: ~a\n" new-thn-props) + ;(printf "new-els-props: ~a\n" new-els-props) ;; record reachability (when (not (unbox flag+)) diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt index cbd401cce0..aa4a89677a 100644 --- a/collects/typed-scheme/typecheck/tc-let-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt @@ -42,8 +42,8 @@ [names (in-list namess)]) (match r [(tc-results: ts (FilterSet: fs+ fs-) os) - ;(printf "f+: ~a~n" fs+) - ;(printf "f-: ~a~n" fs-) + ;(printf "f+: ~a\n" fs+) + ;(printf "f-: ~a\n" fs-) (values ts (apply append (for/list ([n names] @@ -129,7 +129,7 @@ [(tc-results: ts) ts])) (loop (cdr names) (cdr exprs) (apply append (cdr names)) (cdr clauses)))] [else - ;(for-each (lambda (vs) (for-each (lambda (v) (printf/log "Letrec Var: ~a~n" (syntax-e v))) vs)) names) + ;(for-each (lambda (vs) (for-each (lambda (v) (printf/log "Letrec Var: ~a\n" (syntax-e v))) vs)) names) (do-check (lambda (stx e t) (tc-expr/check e t)) names (map (λ (l) (ret (map get-type l))) names) form exprs body clauses expected)])))) diff --git a/collects/typed-scheme/utils/syntax-traversal.rkt b/collects/typed-scheme/utils/syntax-traversal.rkt index e56836e9a7..a9e828477f 100644 --- a/collects/typed-scheme/utils/syntax-traversal.rkt +++ b/collects/typed-scheme/utils/syntax-traversal.rkt @@ -23,8 +23,8 @@ ;; if it can't find it. (define (enclosing-syntaxes-with-source enclosing lookfor src) (let loop ([r '()] [stx enclosing]) - ;(printf "stx is ~a~n" (syntax->datum stx)) - ;(printf "source is ~a~n" (syntax-source stx)) + ;(printf "stx is ~a\n" (syntax->datum stx)) + ;(printf "source is ~a\n" (syntax-source stx)) (let* ([r (if (and (syntax? stx) (eq? src (syntax-source stx))) (cons stx r) r)] @@ -47,10 +47,10 @@ ;; given in `expanded'. (define (look-for-in-orig orig expanded lookfor) (define src (syntax-source orig)) - ;(printf "orig : ~a~n" (unwind orig)) - ;(printf "expanded : ~a~n" expanded) - ;(printf "lookfor : ~a~n" (unwind lookfor)) - ;(printf "src : ~a~n" src) + ;(printf "orig : ~a\n" (unwind orig)) + ;(printf "expanded : ~a\n" expanded) + ;(printf "lookfor : ~a\n" (unwind lookfor)) + ;(printf "src : ~a\n" src) (let ([enclosing (enclosing-syntaxes-with-source expanded lookfor src)] [syntax-locs (make-hash)]) ;; find all syntax locations in original code @@ -62,13 +62,11 @@ ;; we just might get a lookfor that is already in the original (and (eq? src (syntax-source lookfor)) (hash-ref syntax-locs (syntax-loc lookfor) #f) - #;(printf "chose branch one: ~a~n" (hash-ref syntax-locs (syntax-loc lookfor) #f))) + #;(printf "chose branch one: ~a\n" (hash-ref syntax-locs (syntax-loc lookfor) #f))) ;; look for some enclosing expression (and enclosing (begin0 (ormap (lambda (enc) (hash-ref syntax-locs (syntax-loc enc) #f)) enclosing) - #;(printf "chose branch two ~a~n" enclosing)))))) - - + #;(printf "chose branch two ~a\n" enclosing)))))) diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt index cc9ca93b43..7ce94208f4 100644 --- a/collects/typed-scheme/utils/tc-utils.rkt +++ b/collects/typed-scheme/utils/tc-utils.rkt @@ -60,9 +60,9 @@ don't depend on any other portion of the system (define (locate-stx stx) (define omodule (orig-module-stx)) (define emodule (expanded-module-stx)) - ;(printf "orig: ~a~n" (syntax-object->datum omodule)) - ;(printf "exp: ~a~n" (syntax-object->datum emodule)) - ;(printf "stx (locate): ~a~n" (syntax-object->datum stx)) + ;(printf "orig: ~a\n" (syntax-object->datum omodule)) + ;(printf "exp: ~a\n" (syntax-object->datum emodule)) + ;(printf "stx (locate): ~a\n" (syntax-object->datum stx)) (if (and (not (print-syntax?)) omodule emodule stx) (or (look-for-in-orig omodule emodule stx) stx) stx)) diff --git a/collects/waterworld/waterworld.rkt b/collects/waterworld/waterworld.rkt index b8b04b27df..8664d4a8a2 100644 --- a/collects/waterworld/waterworld.rkt +++ b/collects/waterworld/waterworld.rkt @@ -192,7 +192,7 @@ (foldr (lambda (s a) (if a - (format "~a~n~a" + (format "~a\n~a" s a) s)) #f @@ -484,12 +484,12 @@ (car assns))))))))] [dump-assignment (lambda (assn) - (printf "*** dumping assignment ***~n") + (printf "*** dumping assignment ***\n") (let loop ([curr assn]) (unless (null? curr) (let ([loc (caar curr)] [val (cdar curr)]) - (printf "row: ~a col: ~a val: ~a~n" + (printf "row: ~a col: ~a val: ~a\n" (send loc get-row) (send loc get-column) val)) @@ -961,18 +961,18 @@ (hash-table-map frontier-table (lambda (k v) k)))] [dump-frontier (lambda () - (printf "Current frontier:~n") + (printf "Current frontier:\n") (hash-table-for-each frontier-table (lambda (loc _) - (printf "row: ~a col: ~a~n" + (printf "row: ~a col: ~a\n" (send loc get-row) (send loc get-column)))))] [dump-border (lambda () - (printf "Current border:~n") + (printf "Current border:\n") (for-each (lambda (loc) - (printf "row: ~a col: ~a~n" + (printf "row: ~a col: ~a\n" (send loc get-row) (send loc get-column))) (get-revealed-border)))] @@ -1044,16 +1044,16 @@ (delete-file filename)) (with-output-to-file filename (lambda () - (printf "(game~n") - (printf " (rows ~a)~n" rows) - (printf " (columns ~a)~n" columns) + (printf "(game\n") + (printf " (rows ~a)\n" rows) + (printf " (columns ~a)\n" columns) (printf " (locations") (board-for-each (lambda (loc) - (printf "~n (location (row ~a) (column ~a) (safe? ~a) (concealed? ~a))" + (printf "\n (location (row ~a) (column ~a) (safe? ~a) (concealed? ~a))" (send loc get-row) (send loc get-column) (send loc get-safe?) (send loc get-concealed?)))) - (printf "))~n"))))]) + (printf "))\n"))))]) (super-instantiate ()) (set-unsafe-count!) (reset-pirate-counts!))) @@ -1201,7 +1201,7 @@ (send board set-size! rs cs))] [dump-board ; for debugging (lambda () - (printf "** board dump **~n") + (printf "** board dump **\n") (send board board-for-each (lambda (loc) @@ -1209,9 +1209,9 @@ [col (send loc get-column)] [safe? (send loc get-safe?)] [concealed? (send loc get-concealed?)]) - (printf "row=~a col=~a safe?=~a concealed?=~a~n" + (printf "row=~a col=~a safe?=~a concealed?=~a\n" row col safe? concealed?)))) - (printf "** end of dump **~n"))] + (printf "** end of dump **\n"))] [expose-row-col (lambda (r c safe? assert) (send board expose-row-col r c safe? assert #f))] diff --git a/collects/web-server/configuration/responders.rkt b/collects/web-server/configuration/responders.rkt index c73ba8c104..945ecb579d 100644 --- a/collects/web-server/configuration/responders.rkt +++ b/collects/web-server/configuration/responders.rkt @@ -8,7 +8,7 @@ (define (format-stack-trace trace) `(pre ,@(for/list ([item (in-list trace)]) - (format "~a at:~n ~a~n" + (format "~a at:\n ~a\n" (if (car item) (car item) "") diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.rkt b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.rkt index 35166dd1da..9f06590841 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.rkt +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.rkt @@ -6,11 +6,11 @@ (define printf void) (define (gn) - (printf "gn ~a~n" (msg)) + (printf "gn ~a\n" (msg)) (let* ([req (send/suspend/url (lambda (k-url) - (printf "ssu ~S~n" (msg)) + (printf "ssu ~S\n" (msg)) `(html (head (title ,(format "Get ~a number" (msg)))) (body (form ([action ,(url->string k-url)] @@ -24,11 +24,11 @@ (binding:form-value (bindings-assq #"number" (request-bindings/raw req)))))]) - (printf "gn ~a ~a~n" (msg) num) + (printf "gn ~a ~a\n" (msg) num) num)) (define (start initial-request) - (printf "after s-s~n") + (printf "after s-s\n") `(html (head (title "Final Page")) (body (h1 "Final Page") diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.rkt b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.rkt index e0b4b2f154..1b551a872e 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.rkt +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.rkt @@ -6,11 +6,11 @@ (define printf void) (define (gn) - (printf "gn ~a~n" (msg)) + (printf "gn ~a\n" (msg)) (let* ([req (send/suspend/url (lambda (k-url) - (printf "ssu ~S~n" (msg)) + (printf "ssu ~S\n" (msg)) `(html (head (title ,(format "Get ~a number" (msg)))) (body (form ([action ,(url->string k-url)] @@ -24,11 +24,11 @@ (binding:form-value (bindings-assq #"number" (request-bindings/raw req)))))]) - (printf "gn ~a ~a~n" (msg) num) + (printf "gn ~a ~a\n" (msg) num) num)) (define (start initial-request) - (printf "after s-s~n") + (printf "after s-s\n") `(html (head (title "Final Page")) (body (h1 "Final Page") diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add.rkt b/collects/web-server/default-web-root/htdocs/lang-servlets/add.rkt index 7460aa3d5d..1cef119646 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add.rkt +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add.rkt @@ -7,11 +7,11 @@ ;; get-number-from-user: string -> number ;; ask the user for a number (define (get-number msg) - (printf "gn ~a~n" msg) + (printf "gn ~a\n" msg) (let* ([req (send/suspend/url (lambda (k-url) - (printf "ssu~n") + (printf "ssu\n") `(html (head (title ,(format "Get ~a number" msg))) (body (form ([action ,(url->string k-url)] @@ -25,11 +25,11 @@ (binding:form-value (bindings-assq #"number" (request-bindings/raw req)))))]) - (printf "gn ~a ~a~n" msg num) + (printf "gn ~a ~a\n" msg num) num)) (define (start initial-request) - (printf "after s-s~n") + (printf "after s-s\n") `(html (head (title "Final Page")) (body (h1 "Final Page") diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.rkt b/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.rkt index 3c18220d35..0cc9738c2c 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.rkt +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.rkt @@ -6,12 +6,12 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "Please send the ~a number.~n" which)]) + (let ([ignore (printf "Please send the ~a number.\n" which)]) k))))) (define (start initial) (let ([ans (+ (gn "first") (gn "second") (gn "third"))]) - (printf "The answer is: ~s~n" ans) + (printf "The answer is: ~s\n" ans) ans)) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.rkt b/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.rkt index 0445506300..734cb9f466 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.rkt +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.rkt @@ -6,7 +6,7 @@ (cadr (call-with-serializable-current-continuation (lambda (k) - (let ([ignore (printf "Please send the ~a number.~n" which)]) + (let ([ignore (printf "Please send the ~a number.\n" which)]) k))))) (define (start initial) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/soft.rkt b/collects/web-server/default-web-root/htdocs/lang-servlets/soft.rkt index 48070412ef..ae70d39694 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/soft.rkt +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/soft.rkt @@ -4,13 +4,13 @@ (define softie (soft-state - (printf "Doing a long computation...~n") + (printf "Doing a long computation...\n") (sleep 1) 5)) (define (start req) (soft-state-ref softie) - (printf "Done~n") + (printf "Done\n") (start (send/suspend (lambda (k-url) diff --git a/collects/web-server/dispatchers/dispatch-files.rkt b/collects/web-server/dispatchers/dispatch-files.rkt index 6c81358ee6..037f311647 100644 --- a/collects/web-server/dispatchers/dispatch-files.rkt +++ b/collects/web-server/dispatchers/dispatch-files.rkt @@ -77,7 +77,7 @@ [range-regexp #px#"^([0-9]*)-([0-9]*)$"] [range-error (lambda (header) (fprintf (current-error-port) - (format "Bad Range header: ~s. File a Racket bug report!~n" + (format "Bad Range header: ~s. File a Racket bug report!\n" (header-value header))) #f)]) (lambda (headers) diff --git a/collects/web-server/dispatchers/dispatch-filter.rkt b/collects/web-server/dispatchers/dispatch-filter.rkt index af1daa4424..09cee5109d 100644 --- a/collects/web-server/dispatchers/dispatch-filter.rkt +++ b/collects/web-server/dispatchers/dispatch-filter.rkt @@ -11,7 +11,7 @@ (define interface-version 'v1) (define ((make regex inner) conn req) (define path (url-path->string (url-path (request-uri req)))) - #;(printf "~S~n" `(filter ,regex ,(url->string (request-uri req)) ,path ,(regexp-match regex path))) + #;(printf "~S\n" `(filter ,regex ,(url->string (request-uri req)) ,path ,(regexp-match regex path))) (if (regexp-match regex path) (inner conn req) (next-dispatcher))) diff --git a/collects/web-server/dispatchers/dispatch-log.rkt b/collects/web-server/dispatchers/dispatch-log.rkt index 35f8ac37ce..0790c87719 100644 --- a/collects/web-server/dispatchers/dispatch-log.rkt +++ b/collects/web-server/dispatchers/dispatch-log.rkt @@ -46,7 +46,7 @@ (url->string (request-uri req)))) (define (apache-default-format req) (define request-time (srfi-date:current-date)) - (format "~a - - [~a] \"~a\" ~a ~a~n" + (format "~a - - [~a] \"~a\" ~a ~a\n" (request-client-ip req) (srfi-date:date->string request-time "~d/~b/~Y:~T ~z") (request-line-raw req) @@ -54,14 +54,14 @@ 512)) (define (paren-format req) - (format "~s~n" + (format "~s\n" (list 'from (request-client-ip req) 'to (request-host-ip req) 'for (url->string (request-uri req)) 'at (date->string (seconds->date (current-seconds)) #t)))) (define (extended-format req) - (format "~s~n" + (format "~s\n" `((client-ip ,(request-client-ip req)) (host-ip ,(request-host-ip req)) (referer ,(let ([R (headers-assq* #"Referer" (request-headers/raw req))]) diff --git a/collects/web-server/lang/abort-resume.rkt b/collects/web-server/lang/abort-resume.rkt index 284b9450c3..e33a37e866 100644 --- a/collects/web-server/lang/abort-resume.rkt +++ b/collects/web-server/lang/abort-resume.rkt @@ -69,13 +69,13 @@ ;; resume*: (listof (value -> value)) value -> value ;; resume a computation given a value and list of frame procedures (define (resume* frames val) - #;(printf "~S~n" `(resume ,frames ,val)) + #;(printf "~S\n" `(resume ,frames ,val)) (match frames [(list) - #;(printf "Returning value ~S~n" val) + #;(printf "Returning value ~S\n" val) (apply values val)] [(list-rest frame fs) - #;(printf "Frame ~S~n" frame) + #;(printf "Frame ~S\n" frame) (match frame [(vector #f #f #f) ; XXX Perhaps I should err? @@ -106,7 +106,7 @@ ;; rebuild-cms : frames (-> value) -> value (define (rebuild-cms frames thunk) - #;(printf "~S~n" `(rebuild-cms ,frames ,thunk)) + #;(printf "~S\n" `(rebuild-cms ,frames ,thunk)) (match frames [(list) (thunk)] diff --git a/collects/xml/private/xexpr.rkt b/collects/xml/private/xexpr.rkt index ef7a65815f..fb84d8108b 100644 --- a/collects/xml/private/xexpr.rkt +++ b/collects/xml/private/xexpr.rkt @@ -50,7 +50,7 @@ (raise-blame-error blame val - "Not an Xexpr. ~a~n~nContext:~n~a" + "Not an Xexpr. ~a\n\nContext:\n~a" (exn-message exn) (pretty-format val)))]) (validate-xexpr val) diff --git a/src/racket/gc/upgrade.rkt b/src/racket/gc/upgrade.rkt index 2b58f4c47b..1374d2a481 100644 --- a/src/racket/gc/upgrade.rkt +++ b/src/racket/gc/upgrade.rkt @@ -54,19 +54,19 @@ (hash-table-remove! old k)))) (hash-table-for-each old (lambda (k v) - (printf "Remove ~a~n" k))) + (printf "Remove ~a\n" k))) (hash-table-for-each new (lambda (k v) - (printf "Add ~a~n" k))) + (printf "Add ~a\n" k))) (hash-table-for-each mod (lambda (k v) - (printf "Changed ~a~n" k))) + (printf "Changed ~a\n" k))) (hash-table-for-each plt-mod (lambda (k v) - (printf "PLTSCHEME ~a~n" k))) + (printf "PLTSCHEME ~a\n" k))) (unless (null? (hash-table-map plt-mod cons)) (error "!! Cannot continue until PLTSCHEME diffs are managed !!")) (define (go cmd) - (printf "CMD: ~a~n" cmd) + (printf "CMD: ~a\n" cmd) (when really-git? (system cmd))) diff --git a/src/racket/gc2/setup.rkt b/src/racket/gc2/setup.rkt index f9e79270ee..f3b80ffd03 100644 --- a/src/racket/gc2/setup.rkt +++ b/src/racket/gc2/setup.rkt @@ -21,7 +21,7 @@ 'up 'up "collects")]) - (printf "Setting collection path: ~s~n" p) + (printf "Setting collection path: ~s\n" p) (current-library-collection-paths (list p)))) @@ -63,7 +63,7 @@ (make-directory next)) (loop next (cdr rel-path)))))))]) (unless (file-exists? target) - (printf "Copying ~a to ~a~n" path target) + (printf "Copying ~a to ~a\n" path target) (copy-file path target) (let ([code (get-module-code path "no-such-dir")]) (map (lambda (x) @@ -93,7 +93,7 @@ (current-library-collection-paths (list (build-path (current-directory) "xform-collects"))) -(printf "Compiling xform support...~n") +(printf "Compiling xform support...\n") (let ([mk-cm make-compilation-manager-load/use-compiled-handler] [old-namespace (current-namespace)]) diff --git a/src/racket/make-configure b/src/racket/make-configure index 08b57ead7b..528597df72 100755 --- a/src/racket/make-configure +++ b/src/racket/make-configure @@ -39,6 +39,5 @@ exit 0 (loop) ;; Copy (begin - (printf "~a~n" l) + (printf "~a\n" l) (loop)))))) - diff --git a/src/racket/sgc/checkreg b/src/racket/sgc/checkreg index 55a5f5b00a..328df37e3d 100755 --- a/src/racket/sgc/checkreg +++ b/src/racket/sgc/checkreg @@ -1,5 +1,5 @@ #!/bin/sh -string=? ; exec ${PLTHOME}/bin/racket -gqr $0 "$@" +string=? ; exec "${PLTHOME}/bin/racket" -gqr $0 "$@" ; Script to check that global and static variables are registered @@ -154,26 +154,26 @@ string=? ; exec ${PLTHOME}/bin/racket -gqr $0 "$@" (vector->list argv)) #| -(printf "Declared: ~n") +(printf "Declared: \n") (hash-table-for-each declared (lambda (k v) - (printf " ~a: ~a : ~a~n" + (printf " ~a: ~a : ~a\n" (decl-file v) k (decl-type v)))) -(printf "Registered: ~n") +(printf "Registered: \n") (hash-table-for-each registered (lambda (k v) - (printf " ~a~n" k))) + (printf " ~a\n" k))) |# -(printf "Declared but not registered: ~n") +(printf "Declared but not registered: \n") (hash-table-for-each declared (lambda (k v) (hash-table-get registered k (lambda () - (printf " ~a: ~a : ~a~n" + (printf " ~a: ~a : ~a\n" (decl-file v) k (decl-type v)))))) diff --git a/src/racket/sgc/sgcdiff b/src/racket/sgc/sgcdiff index 8ed9bb796a..cef82fcfd2 100755 --- a/src/racket/sgc/sgcdiff +++ b/src/racket/sgc/sgcdiff @@ -58,7 +58,7 @@ string=? ; exec $PLTHOME/bin/racket -agrq $0 "$@" [wx-stats (string-append spaces name (repeat 4 spaces number-or-hyphen) anything)]) - '(printf "mz-stats: ~s~nwx-stats: ~s~n" mz-stats wx-stats) + '(printf "mz-stats: ~s\nwx-stats: ~s\n" mz-stats wx-stats) (values (regexp mz-stats) (regexp wx-stats)))) diff --git a/src/racket/src/makeexn b/src/racket/src/makeexn index 8b45cef5c4..18522c6a1d 100755 --- a/src/racket/src/makeexn +++ b/src/racket/src/makeexn @@ -242,9 +242,9 @@ Not an exception in the above sense: (with-output-to-file filename #:exists 'replace (λ () - (printf ";; This file was generated by makeexn~n") - (printf ";;----------------------------------------------------------------------~n") - (printf ";; record for static info produced by structs defined in c~n") + (printf ";; This file was generated by makeexn\n") + (printf ";;----------------------------------------------------------------------\n") + (printf ";; record for static info produced by structs defined in c\n") (pretty-print (append preamble exceptions structs))))) (define (print-header) diff --git a/src/racket/src/mk-uchar.rkt b/src/racket/src/mk-uchar.rkt index d74dfdba58..601dd43960 100644 --- a/src/racket/src/mk-uchar.rkt +++ b/src/racket/src/mk-uchar.rkt @@ -318,7 +318,7 @@ (let ([m (regexp-match #rx"^([0-9A-F]+);([^;]*);([^;]*);([^;]*);[^;]*;([^;]*);[^;]*;([^;]*);[^;]*;[^;]*;[^;]*;[^;]*;([^;]*);([^;]*);([^;]*)" l)]) (unless m - (printf "no match: ~a~n" l)) + (printf "no match: ~a\n" l)) (let ([code (string->number (cadr m) 16)] [name (caddr m)] [cat (cadddr m)] @@ -510,10 +510,10 @@ (define world-count (expt 2 10)) -(printf "/* Generated by mk-uchar.rkt */~n~n") +(printf "/* Generated by mk-uchar.rkt */\n\n") -(printf "/* Character count: ~a */~n" ccount) -(printf "/* Total bytes for all tables: ~a */~n~n" +(printf "/* Character count: ~a */\n" ccount) +(printf "/* Total bytes for all tables: ~a */\n\n" (+ (* (add1 low) (* 2 (add1 (length (hash-table-map vectors cons))))) (* (add1 low) @@ -534,19 +534,19 @@ " via the scheme_uchar_find() macro in scheme.h. */\n\n")) (printf "/* Character properties: */\n") -(printf "unsigned short *scheme_uchar_table[~a];~n" hi-count) +(printf "unsigned short *scheme_uchar_table[~a];\n" hi-count) (printf "\n/* Character case mapping as index into scheme_uchar_ups, etc.: */\n") -(printf "unsigned char *scheme_uchar_cases_table[~a];~n" hi-count) +(printf "unsigned char *scheme_uchar_cases_table[~a];\n" hi-count) (printf "\n/* Character general categories: */\n") -(printf "unsigned char *scheme_uchar_cats_table[~a];~n" hi-count) +(printf "unsigned char *scheme_uchar_cats_table[~a];\n" hi-count) (printf "\n/* The udata... arrays are used by init_uchar_table to fill the above mappings.*/\n\n") (define print-row (lambda (vec name pos hex?) - (printf " /* ~a */~n" name) + (printf " /* ~a */\n" name) (let loop ([i 0]) (printf (if hex? " 0x~x~a" " ~a~a") (or (vector-ref vec i) "0") @@ -559,26 +559,26 @@ (loop (add1 i)))))) (define (print-table type suffix vectors pos hex?) - (printf "static unsigned ~a udata~a[] = {~n" type suffix) + (printf "static unsigned ~a udata~a[] = {\n" type suffix) (print-row (make-vector (add1 low) 0) 0 pos hex?) (map (lambda (p) (print-row (car p) (cdr p) pos hex?)) (sort (hash-table-map vectors cons) (lambda (a b) (< (cdr a) (cdr b))))) - (printf "};~n")) + (printf "};\n")) (print-table "short" "" vectors pos #t) (printf "\n") (print-table "char" "_cases" vectors2 pos2 #f) (print-table "char" "_cats" vectors3 pos3 #f) -(printf "~n/* Case mapping size: ~a */\n" (hash-table-count (car cases))) +(printf "\n/* Case mapping size: ~a */\n" (hash-table-count (car cases))) (printf "/* Find an index into the ups, downs, etc. table for a character\n") (printf " by using scheme_uchar_cases_table; then, the value at the index\n") (printf " is relative to the original character (except for combining class,\n") (printf " of course). */\n") (define (print-shift t end select type name) - (printf "~n~a scheme_uchar_~a[] = {~n" type name) + (printf "\n~a scheme_uchar_~a[] = {\n" type name) (for-each (lambda (p) (printf " ~a~a" (select (car p)) @@ -589,7 +589,7 @@ (newline))) (sort (hash-table-map t cons) (lambda (a b) (< (cdr a) (cdr b))))) - (printf " };~n")) + (printf " };\n")) (print-shift (car cases) (unbox (cdr cases)) car "int" "ups") (print-shift (car cases) (unbox (cdr cases)) cadr "int" "downs") @@ -612,11 +612,11 @@ (set! ranges (cons (list range-bottom range-top (range-v . > . -1)) ranges)) -(printf "~n#define NUM_UCHAR_RANGES ~a~n" (length ranges)) -(printf "~n#define URANGE_VARIES 0x40000000~n") -(printf "static int mapped_uchar_ranges[] = {~n") +(printf "\n#define NUM_UCHAR_RANGES ~a\n" (length ranges)) +(printf "\n#define URANGE_VARIES 0x40000000\n") +(printf "static int mapped_uchar_ranges[] = {\n") (for-each (lambda (r) - (printf " 0x~x, 0x~x~a~a~n" + (printf " 0x~x, 0x~x~a~a\n" (car r) (cadr r) (if (caddr r) "" " | URANGE_VARIES") @@ -624,16 +624,16 @@ "" ","))) (reverse ranges)) -(printf "};~n") +(printf "};\n") -(printf "~nstatic void init_uchar_table(void)~n{~n") -(printf " int i;~n~n") -(printf " for (i = 0; i < ~a; i++) { ~n" hi-count) -(printf " scheme_uchar_table[i] = udata;~n") -(printf " scheme_uchar_cases_table[i] = udata_cases;~n") -(printf " scheme_uchar_cats_table[i] = udata_cats;~n") -(printf " }~n") -(printf "~n") +(printf "\nstatic void init_uchar_table(void)\n{\n") +(printf " int i;\n\n") +(printf " for (i = 0; i < ~a; i++) { \n" hi-count) +(printf " scheme_uchar_table[i] = udata;\n") +(printf " scheme_uchar_cases_table[i] = udata_cases;\n") +(printf " scheme_uchar_cats_table[i] = udata_cats;\n") +(printf " }\n") +(printf "\n") (define (print-init top vectors suffix) (let loop ([i 0]) (unless (= i hi-count) @@ -646,15 +646,15 @@ [vec-pos (* (add1 low) (hash-table-get vectors vec))]) (if (> same-count 4) (begin - (printf " for (i = ~a; i < ~a; i++) {~n" + (printf " for (i = ~a; i < ~a; i++) {\n" i (+ i same-count)) - (printf " scheme_uchar~a_table[i] = udata~a + ~a;~n" + (printf " scheme_uchar~a_table[i] = udata~a + ~a;\n" suffix suffix vec-pos) - (printf " }~n") + (printf " }\n") (loop (+ same-count i))) (begin - (printf " scheme_uchar~a_table[~a] = udata~a + ~a;~n" + (printf " scheme_uchar~a_table[~a] = udata~a + ~a;\n" suffix i suffix @@ -664,13 +664,13 @@ (print-init top vectors "") (print-init top2 vectors2 "_cases") (print-init top3 vectors3 "_cats") -(printf "}~n") +(printf "}\n") ;; ---------------------------------------- (current-output-port (open-output-file "schustr.inc" #:exists 'truncate/replace)) -(printf "/* Generated by mk-uchar.rkt */~n~n") +(printf "/* Generated by mk-uchar.rkt */\n\n") (define specials null) (define special-count 0) @@ -721,7 +721,7 @@ v) (set! n (add1 n))) (reverse specials))) -(printf " };~n") +(printf " };\n") (printf "\n#define SPECIAL_CASE_FOLD_MAX ~a\n" (apply max diff --git a/src/racket/src/mkmark.rkt b/src/racket/src/mkmark.rkt index 17a238242a..38cca5f65a 100644 --- a/src/racket/src/mkmark.rkt +++ b/src/racket/src/mkmark.rkt @@ -38,7 +38,7 @@ [print-lines (lambda (l) (for-each (lambda (s) - (printf "~a~n" s)) + (printf "~a\n" s)) l))]) (let ([prefix (read-lines re:mark)] [mark (read-lines re:size-or-more)] @@ -48,13 +48,13 @@ (read-lines re:size)) null)] [size (read-lines re:close)]) - (printf "static int ~a_SIZE(void *p, struct NewGC *gc) {~n" name) + (printf "static int ~a_SIZE(void *p, struct NewGC *gc) {\n" name) (print-lines prefix) - (printf " return~n") + (printf " return\n") (print-lines size) - (printf "}~n~n") + (printf "}\n\n") - (printf "static int ~a_MARK(void *p, struct NewGC *gc) {~n" name) + (printf "static int ~a_MARK(void *p, struct NewGC *gc) {\n" name) (print-lines prefix) (print-lines (map (lambda (s) (regexp-replace* @@ -65,11 +65,11 @@ "MARK2(") "")) mark)) - (printf " return~n") + (printf " return\n") (print-lines size) - (printf "}~n~n") + (printf "}\n\n") - (printf "static int ~a_FIXUP(void *p, struct NewGC *gc) {~n" name) + (printf "static int ~a_FIXUP(void *p, struct NewGC *gc) {\n" name) (print-lines prefix) (print-lines (map (lambda (s) (regexp-replace* @@ -82,24 +82,24 @@ (append mark fixup))) - (printf " return~n") + (printf " return\n") (print-lines size) - (printf "}~n~n") + (printf "}\n\n") - (printf "#define ~a_IS_ATOMIC ~a~n" + (printf "#define ~a_IS_ATOMIC ~a\n" name (if (null? mark) "1" "0")) - (printf "#define ~a_IS_CONST_SIZE ~a~n~n" + (printf "#define ~a_IS_CONST_SIZE ~a\n\n" name (if (and (= 1 (length size)) (regexp-match re:const-size (car size))) "1" "0"))))) -(printf "/* >>>> Generated by mkmark.rkt from mzmarksrc.c <<<< */~n") +(printf "/* >>>> Generated by mkmark.rkt from mzmarksrc.c <<<< */\n") (let loop () (let ([l (read-line)]) @@ -108,7 +108,7 @@ [(regexp-match re:start l) => (lambda (m) (let ([who (upcase (cadr m))]) - (printf "#ifdef MARKS_FOR_~a_C~n" who) + (printf "#ifdef MARKS_FOR_~a_C\n" who) (let file-loop () (let ([l (read-line)]) @@ -117,13 +117,13 @@ (cond [(regexp-match re:end l) => (lambda (m) - (printf "#endif /* ~a */~n" (upcase (cadr m))) + (printf "#endif /* ~a */\n" (upcase (cadr m))) (loop))] [(regexp-match re:form l) => (lambda (m) (do-form (cadr m)) (file-loop))] - [else (printf "~a~n" l) + [else (printf "~a\n" l) (file-loop)]))))))] - [else (printf "~a~n" l) + [else (printf "~a\n" l) (loop)])))) diff --git a/src/racket/src/renumber.rkt b/src/racket/src/renumber.rkt index 26792f1fac..57f9659021 100644 --- a/src/racket/src/renumber.rkt +++ b/src/racket/src/renumber.rkt @@ -22,7 +22,7 @@ [(regexp-match #rx"^( +[a-z_A-Z][a-z_A-Z0-9]*,) *(?:/[*] [0-9]* [*]/)? *$" l) => (lambda (m) (let ([s (cadr m)]) - (printf "~a~a~n" + (printf "~a~a\n" s (format "~a/* ~a */" (make-string (max 0 (- 40 (string-length s))) #\space) @@ -30,7 +30,7 @@ (set! n (add1 n)))] [(regexp-match #rx"^ +[a-zA-Z_][a-z_A-Z0-9]*," l) (set! n (add1 n)) - (printf "~a~n" l)] + (printf "~a\n" l)] [else - (printf "~a~n" l)])) + (printf "~a\n" l)])) lines))) diff --git a/src/racket/src/sstoinc.rkt b/src/racket/src/sstoinc.rkt index d29cb79c92..0643fb9418 100644 --- a/src/racket/src/sstoinc.rkt +++ b/src/racket/src/sstoinc.rkt @@ -17,7 +17,7 @@ [p (open-output-bytes)]) (write c p) (let ([s (get-output-bytes p)]) - (fprintf outfile " {~n SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {") + (fprintf outfile " {\n SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {") (let loop ([chars (bytes->list s)][pos 0]) (unless (null? chars) (let ([char (car chars)]) @@ -28,6 +28,6 @@ (newline outfile) 0) (add1 pos))))) - (fprintf outfile "0};~n EVAL_ONE_SIZED_STR((char *)expr, ~a);~n" (bytes-length s)) - (fprintf outfile " }~n"))) + (fprintf outfile "0};\n EVAL_ONE_SIZED_STR((char *)expr, ~a);\n" (bytes-length s)) + (fprintf outfile " }\n"))) (loop)))))) diff --git a/src/worksp/gc2/make.rkt b/src/worksp/gc2/make.rkt index 216586cc34..838ca78243 100644 --- a/src/worksp/gc2/make.rkt +++ b/src/worksp/gc2/make.rkt @@ -6,7 +6,7 @@ mzlib/process) (define (system- s) - (fprintf (current-error-port) "~a~n" s) + (fprintf (current-error-port) "~a\n" s) (system s)) (define accounting-gc? #t) @@ -495,7 +495,7 @@ (unless (and (file-exists? dest) (string=? (with-input-from-file src (lambda () (read-string (file-size src)))) (with-input-from-file dest (lambda () (read-string (file-size dest)))))) - (printf "Updating ~a~n" dest) + (printf "Updating ~a\n" dest) (when (file-exists? dest) (delete-file dest)) (copy-file src dest)))