commit 7eb9bb8efb1c7071ec41db17145009b4b68e7d44
parent dd7c71f05d32aba4cd00bd717b9baa21961e70f1
Author: Eli Barzilay <eli@barzilay.org>
Date: Wed, 25 Aug 2010 16:10:55 -0400
Lots of "~e" to "~.s" changes.
original commit: 606b7f60dc597a6870efc11364e1dd3e1a8b4a1b
Diffstat:
2 files changed, 28 insertions(+), 28 deletions(-)
diff --git a/collects/macro-debugger/model/reductions-config.rkt b/collects/macro-debugger/model/reductions-config.rkt
@@ -286,11 +286,11 @@
;; Only bad effect should be missed subterms (usually at phase1).
(STRICT-CHECKS
(fprintf (current-error-port)
- "from:\n~e\n\nto:\n~e\n\n"
+ "from:\n~.s\n\nto:\n~.s\n\n"
(stx->datum from)
(stx->datum to))
(fprintf (current-error-port)
- "original from:\n~e\n\noriginal to:\n~e\n\n"
+ "original from:\n~.s\n\noriginal to:\n~.s\n\n"
(stx->datum from0)
(stx->datum to0))
(error 'add-to-renames-table))
diff --git a/collects/macro-debugger/model/reductions-engine.rkt b/collects/macro-debugger/model/reductions-engine.rkt
@@ -289,9 +289,9 @@
[(R** f v p s ws [#:print-state msg] . more)
#'(begin (printf "** ~s\n" msg)
- (printf "f = ~e\n" (stx->datum f))
- (printf "v = ~e\n" (stx->datum v))
- (printf "s = ~e\n" (stx->datum s))
+ (printf "f = ~.s\n" (stx->datum f))
+ (printf "v = ~.s\n" (stx->datum v))
+ (printf "s = ~.s\n" (stx->datum s))
(R** f v p s ws . more))]
;; ** Multi-pass reductions **
@@ -365,10 +365,10 @@
[fills fills-e])
(DEBUG
(printf "Run (multi, vis=~s)\n" (visibility))
- (printf " f: ~e\n" (stx->datum f))
- (printf " v: ~e\n" (stx->datum v))
- (printf " p: ~e\n" 'p)
- (printf " hole: ~e\n" '(hole :::))
+ (printf " f: ~.s\n" (stx->datum f))
+ (printf " v: ~.s\n" (stx->datum v))
+ (printf " p: ~.s\n" 'p)
+ (printf " hole: ~.s\n" '(hole :::))
(print-viable-subterms v))
(if (visibility)
(let ([vctx (CC (hole :::) v p)]
@@ -381,10 +381,10 @@
[fctx (CC hole f p)])
(DEBUG
(printf "Run (single, vis=~s)\n" (visibility))
- (printf " f: ~e\n" (stx->datum f))
- (printf " v: ~e\n" (stx->datum v))
- (printf " p: ~e\n" 'p)
- (printf " hole: ~e\n" 'hole)
+ (printf " f: ~.s\n" (stx->datum f))
+ (printf " v: ~.s\n" (stx->datum v))
+ (printf " p: ~.s\n" 'p)
+ (printf " hole: ~.s\n" 'hole)
(print-viable-subterms v))
(if (visibility)
(let ([vctx (CC hole v p)]
@@ -396,8 +396,8 @@
(define (run-one reducer init-e fctx vsub vctx fill s ws k)
(DEBUG
(printf "run-one\n")
- (printf " fctx: ~e\n" (stx->datum (fctx #'HOLE)))
- (printf " vctx: ~e\n" (stx->datum (vctx #'HOLE))))
+ (printf " fctx: ~.s\n" (stx->datum (fctx #'HOLE)))
+ (printf " vctx: ~.s\n" (stx->datum (vctx #'HOLE))))
(RSbind (with-context vctx
((reducer fill) init-e vsub s ws))
(lambda (f2 v2 s2 ws2) (k (fctx f2) (vctx v2) s2 ws2))))
@@ -406,12 +406,12 @@
(define (run-multiple/visible reducer init-e1s fctx vsubs vctx fills s ws k)
(DEBUG
(printf "run-multiple/visible\n")
- (printf " fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE))))
- (printf " vctx: ~e\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE))))
+ (printf " fctx: ~.s\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE))))
+ (printf " vctx: ~.s\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE))))
(unless (= (length fills) (length init-e1s))
- (printf " fills(~s): ~e\n" (length fills) fills)
- (printf " init-e1s: ~s\n" (stx->datum init-e1s))
- (printf " vsubs: ~s\n" (stx->datum vsubs))))
+ (printf " fills(~s): ~.s\n" (length fills) fills)
+ (printf " init-e1s: ~.s\n" (stx->datum init-e1s))
+ (printf " vsubs: ~.s\n" (stx->datum vsubs))))
(let loop ([fills fills] [prefix null] [vprefix null] [suffix init-e1s] [vsuffix vsubs] [s s] [ws ws])
(cond
[(pair? fills)
@@ -432,10 +432,10 @@
(define (run-multiple/nonvisible reducer init-e1s fctx v fills s ws k)
(DEBUG
(printf "run-multiple/nonvisible\n")
- (printf " fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))))
+ (printf " fctx: ~.s\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))))
(let loop ([fills fills] [prefix null] [suffix init-e1s] [v v] [s s] [ws ws])
(DEBUG
- (printf " v: ~e\n" (stx->datum (datum->syntax #f v))))
+ (printf " v: ~.s\n" (stx->datum (datum->syntax #f v))))
(cond
[(pair? fills)
(RSbind ((reducer (car fills)) (car suffix) v s ws)
@@ -468,7 +468,7 @@
(cond [(and (not new-visible?) (or (visibility) reset-subterms?))
(begin
(DEBUG
- (printf "hide => seek: ~e\n" (stx->datum stx)))
+ (printf "hide => seek: ~.s\n" (stx->datum stx)))
(current-pass-hides? #t)
(let* ([subterms (gather-proper-subterms stx)]
[marking (marking-table)]
@@ -496,11 +496,11 @@
(k vstx)
(let ([paths (table-get (subterms-table) stx)])
(cond [(null? paths)
- (DEBUG (printf "seek-point: failed on ~e\n" (stx->datum stx)))
+ (DEBUG (printf "seek-point: failed on ~.s\n" (stx->datum stx)))
(k vstx)]
[(null? (cdr paths))
(let ([path (car paths)])
- (DEBUG (printf "seek => hide: ~e\n" (stx->datum stx)))
+ (DEBUG (printf "seek => hide: ~.s\n" (stx->datum stx)))
(let ([ctx (lambda (x) (path-replace vstx path x))])
(RScase (parameterize ((visibility #t)
(subterms-table #f)
@@ -538,16 +538,16 @@
[same-form? (equal? actual-datum expected-datum)])
(if same-form?
(fprintf (current-error-port)
- "same form but wrong wrappings:\n~e\nwrongness:\n~e\n"
+ "same form but wrong wrappings:\n~.s\nwrongness:\n~.s\n"
actual-datum
(wrongness actual expected))
(fprintf (current-error-port)
- "got:\n~s\n\nexpected:\n~e\n"
+ "got:\n~.s\n\nexpected:\n~.s\n"
actual-datum
expected-datum))
(for ([d derivs])
(fprintf (current-error-port)
- "\n~e\n" d))
+ "\n~.s\n" d))
(error function
(if same-form?
"wrong starting point (wraps)!"
