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

Lots of "~e" to "~.s" changes.

Browse Source 
original commit: 606b7f60dc597a6870efc11364e1dd3e1a8b4a1b
This commit is contained in:
Eli Barzilay 2010-08-25 16:10:55 -04:00
parent dd7c71f05d
commit 7eb9bb8efb
2 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/macro-debugger/model/reductions-config.rkt
View File

@ -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))

52
collects/macro-debugger/model/reductions-engine.rkt
View File

@ -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)!"