Lots of "~e" to "~.s" changes.
This commit is contained in:
Eli Barzilay
parent
e179449d0e
commit
606b7f60dc
|
|
@ -298,7 +298,7 @@
|
|||
(raise-syntax-error 'c-declare "declaration is not a string" stx decl))
|
||||
(let ([stx-out (syntax
|
||||
(error 'c-declare
|
||||
"declaration not compiled by mzc: ~e"
|
||||
"declaration not compiled by mzc: ~.s"
|
||||
str))])
|
||||
(syntax-property stx-out 'mzc-cffi 'c-declare)))]))
|
||||
|
||||
|
|
|
|||
|
|
@ -1583,7 +1583,7 @@
|
|||
(syntax-position stx))])
|
||||
(fprintf (current-output-port) " "))
|
||||
(fprintf (current-output-port)
|
||||
"~a: ~e~n"
|
||||
"~a: ~.s~n"
|
||||
msg
|
||||
(syntax->datum (send exp sexpr)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -530,7 +530,7 @@
|
|||
(match v
|
||||
[`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)]
|
||||
[`(,datum . ,wraps) (values #f datum wraps)]
|
||||
[else (error 'decode-wraps "bad datum+wrap: ~e" v)])])
|
||||
[else (error 'decode-wraps "bad datum+wrap: ~.s" v)])])
|
||||
(let* ([wraps (decode-wraps cp encoded-wraps)]
|
||||
[marks (decode-marks cp cert-marks)]
|
||||
[add-wrap (lambda (v) (make-wrapped v wraps marks))])
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@
|
|||
(for-each
|
||||
(λ (i<%>)
|
||||
(unless (is-a? language i<%>)
|
||||
(error 'drracket:language:add-language "expected language ~e to implement ~e, forgot to use drracket:language:get-default-mixin ?" language i<%>)))
|
||||
(error 'drracket:language:add-language "expected language ~e to implement ~e, forgot to use `drracket:language:get-default-mixin'?" language i<%>)))
|
||||
(drracket:language:get-language-extensions))
|
||||
|
||||
(ensure-no-duplicate-numbers language languages)
|
||||
|
|
|
|||
|
|
@ -420,7 +420,7 @@
|
|||
[_
|
||||
(begin
|
||||
#;
|
||||
(printf "unknown stx: ~e datum: ~e source: ~e\n"
|
||||
(printf "unknown stx: ~.s datum: ~e source: ~e\n"
|
||||
sexp
|
||||
(and (syntax? sexp)
|
||||
(syntax->datum sexp))
|
||||
|
|
|
|||
|
|
@ -356,10 +356,9 @@
|
|||
[line (syntax-line stx)]
|
||||
[col (syntax-column stx)]
|
||||
[pos (syntax-position stx)])
|
||||
(fprintf p "~a~a: ~e~n"
|
||||
(fprintf p "~a~a: ~.s\n"
|
||||
(or file "[unknown source]")
|
||||
(cond
|
||||
[line (format ":~a:~a" line col)]
|
||||
(cond [line (format ":~a:~a" line col)]
|
||||
[pos (format "::~a" pos)]
|
||||
[else ""])
|
||||
(syntax->datum stx))
|
||||
|
|
|
|||
|
|
@ -201,7 +201,7 @@
|
|||
|
||||
[_else
|
||||
(error 'errortrace
|
||||
"unrecognized (non-top-level) expression form: ~e"
|
||||
"unrecognized (non-top-level) expression form: ~.s"
|
||||
(syntax->datum sexpr))])))
|
||||
|
||||
(define (profile-annotate-lambda name expr clause bodys-stx phase)
|
||||
|
|
@ -564,7 +564,7 @@
|
|||
annotate phase)))])]
|
||||
|
||||
[_else
|
||||
(error 'errortrace "unrecognized expression form~a: ~e"
|
||||
(error 'errortrace "unrecognized expression form~a: ~.s"
|
||||
(if top? " at top-level" "")
|
||||
(syntax->datum expr))])
|
||||
expr
|
||||
|
|
|
|||
|
|
@ -502,7 +502,7 @@
|
|||
(lambda (k)
|
||||
(cond [(assq k ks) => cdr]
|
||||
[(assq k _fun-keywords) => cadr]
|
||||
[else (error '_fun "internal error: unknown keyword: ~e" k)]))
|
||||
[else (error '_fun "internal error: unknown keyword: ~.s" k)]))
|
||||
(lambda (k-stx v [sub k-stx])
|
||||
(let ([k (if (syntax? k-stx) (syntax-e k-stx) k-stx)])
|
||||
(cond [(assq k ks)
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@ the state transitions / contracts are:
|
|||
(let ([default (hash-ref defaults p)])
|
||||
(unless ((default-checker default) value)
|
||||
(error 'preferences:set
|
||||
"tried to set preference ~e to ~e but it does not meet test from preferences:set-default"
|
||||
"tried to set preference ~e to ~e but it does not meet test from `preferences:set-default'"
|
||||
p value))
|
||||
(check-callbacks p value)
|
||||
(hash-set! preferences p value))]
|
||||
|
|
|
|||
|
|
@ -918,15 +918,15 @@ 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: ~e~n" (reverse x))
|
||||
(printf "tokens: ~.s~n" (reverse x))
|
||||
(set! x null)
|
||||
(send (lexer-state-invalid-tokens ls) for-each f)
|
||||
(printf "invalid-tokens: ~e~n" (reverse x))
|
||||
(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: ~e~n" (car (send (lexer-state-parens ls) test)))))
|
||||
(printf "parens: ~.s~n" (car (send (lexer-state-parens ls) test)))))
|
||||
lexer-states))
|
||||
|
||||
;; ------------------------- Callbacks to Override ----------------------
|
||||
|
|
|
|||
|
|
@ -267,7 +267,7 @@
|
|||
(send panel get-children)))])
|
||||
(or found
|
||||
(error object-tag
|
||||
"no object of class ~a named ~e in active frame"
|
||||
"no object of class ~a named ~.s in active frame"
|
||||
obj-class
|
||||
b-desc)))]
|
||||
[(is-a? b-desc obj-class) b-desc]
|
||||
|
|
@ -289,11 +289,11 @@
|
|||
[ctrl (find-ctrl)])
|
||||
(cond
|
||||
[(not (send ctrl is-shown?))
|
||||
(error error-tag "control ~e is not shown (label ~e)" ctrl (send ctrl get-label))]
|
||||
(error error-tag "control ~.s is not shown (label ~e)" ctrl (send ctrl get-label))]
|
||||
[(not (send ctrl is-enabled?))
|
||||
(error error-tag "control ~e is not enabled (label ~e)" ctrl (send ctrl get-label))]
|
||||
(error error-tag "control ~.s is not enabled (label ~e)" ctrl (send ctrl get-label))]
|
||||
[(not (in-active-frame? ctrl))
|
||||
(error error-tag "control ~e is not in active frame (label ~e)" ctrl (send ctrl get-label))]
|
||||
(error error-tag "control ~.s is not in active frame (label ~e)" ctrl (send ctrl get-label))]
|
||||
[else
|
||||
(update-control ctrl)
|
||||
(send ctrl command event)
|
||||
|
|
|
|||
|
|
@ -269,7 +269,7 @@ corresponds to the unplayed move! that's confusing.
|
|||
(update-players-dice (past-color past) (past-roll past))
|
||||
(send board-pasteboard set-board (past-board past))
|
||||
(send board-pasteboard set-highlighted-squares '() '()))]
|
||||
[else (error 'update-gui "unknown viewing index ~e\n" viewing-index)])
|
||||
[else (error 'update-gui "unknown viewing index ~e" viewing-index)])
|
||||
(reset-accept/move-buttons)
|
||||
(reset-forw-back-buttons))
|
||||
|
||||
|
|
|
|||
|
|
@ -19,5 +19,4 @@
|
|||
(if path
|
||||
(let ([u (path->url path)])
|
||||
(send-url (url->string u)))
|
||||
(error 'show-scribbling "cannot find docs for: ~e ~e" mod-path tag))))))
|
||||
|
||||
(error 'show-scribbling "cannot find docs for: ~.s ~.s" mod-path tag))))))
|
||||
|
|
|
|||
|
|
@ -273,10 +273,8 @@
|
|||
(lambda ()
|
||||
(let* ([msg (if (exn? exn)
|
||||
(let ([s (exn-message exn)])
|
||||
(if (string? s)
|
||||
s
|
||||
(format "~e" s)))
|
||||
(format "~e" exn))]
|
||||
(if (string? s) s (format "~.s" s)))
|
||||
(format "~.s" exn))]
|
||||
[retry? (regexp-match #rx"bad username or password for" msg)])
|
||||
(custodian-shutdown-all comm-cust)
|
||||
(set! committing? #f)
|
||||
|
|
@ -541,8 +539,8 @@
|
|||
(message-box
|
||||
"Server Error"
|
||||
(if (exn? exn)
|
||||
(let ([s (exn-message exn)]) (if (string? s) s (format "~e" s)))
|
||||
(format "~e" exn))
|
||||
(let ([s (exn-message exn)]) (if (string? s) s (format "~.s" s)))
|
||||
(format "~.s" exn))
|
||||
this)
|
||||
(set! comm-cust (make-custodian))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -674,7 +674,7 @@
|
|||
(error* "missing binding: ~.s" (->disp 'id)))]
|
||||
[exn:fail:syntax?
|
||||
(lambda (_)
|
||||
(error* "bound to a syntax, expecting a value: ~e"
|
||||
(error* "bound to a syntax, expecting a value: ~.s"
|
||||
(->disp 'id)))])
|
||||
(parameterize ([current-namespace (get-namespace (submission-eval))])
|
||||
(namespace-variable-value `id)))
|
||||
|
|
@ -698,7 +698,7 @@
|
|||
(syntax-rules ()
|
||||
[(_ expr)
|
||||
(unless (procedure? ((submission-eval) `expr))
|
||||
(error* "~e is expected to be bound to a procedure" (->disp 'expr)))]
|
||||
(error* "~.s is expected to be bound to a procedure" (->disp 'expr)))]
|
||||
[(_ expr arity)
|
||||
(let ([ar arity]
|
||||
[val ((submission-eval) `expr)])
|
||||
|
|
|
|||
|
|
@ -650,7 +650,7 @@
|
|||
(lambda (exn)
|
||||
(let ([msg (if (exn? exn)
|
||||
(exn-message exn)
|
||||
(format "~e" exn))])
|
||||
(format "~.s" exn))])
|
||||
(kill-watcher)
|
||||
(log-line "ERROR: ~a" msg)
|
||||
(write+flush w msg)
|
||||
|
|
|
|||
|
|
@ -173,7 +173,8 @@ Keywords for configuring @scheme[check:]:
|
|||
report an error that occurred during evaluation of the submitted
|
||||
code (not during additional tests). It can be a plain string which
|
||||
will be used as the error message, or a string with single a
|
||||
@scheme["~a"] (or @scheme["~e"], @scheme["~s"], @scheme["~v"]) that
|
||||
@scheme["~a"] (or @scheme["~s"], @scheme["~v"], @scheme["~e"],
|
||||
or @scheme["~.a"] etc) that
|
||||
will be used as a format string with the actual error message. The
|
||||
default is @scheme["Error in your code --\n~a"]. Useful examples of
|
||||
these messages:
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
(with-handlers ([void (lambda (exn)
|
||||
(error (if (exn? exn)
|
||||
(exn-message exn)
|
||||
(format "exception: ~e" exn))))])
|
||||
(format "exception: ~.s" exn))))])
|
||||
(thunk)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
@ -119,7 +119,7 @@
|
|||
(with-handlers ([void
|
||||
(lambda (x)
|
||||
(error
|
||||
(format "instructor-supplied test ~a failed with an error: ~e"
|
||||
(format "instructor-supplied test ~a failed with an error: ~.s"
|
||||
(format-history test)
|
||||
(exn-message x))))])
|
||||
(let ([val (e `(,f ,@(map value-converter args)))])
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
(if tag
|
||||
(go-to-tag xref tag)
|
||||
(error 'help
|
||||
"no documentation found for: ~e provided by: ~a"
|
||||
"no documentation found for: ~.s provided by: ~a"
|
||||
(syntax-e id)
|
||||
(module-path-index-resolve (caddr b)))))
|
||||
(search-for-exports xref (syntax-e id) any-b))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)!"
|
||||
|
|
|
|||
|
|
@ -192,9 +192,9 @@
|
|||
(reverse r)
|
||||
(let* ([bin (car bins)] [src (get-tag bin)])
|
||||
(cond
|
||||
[(not src) (error 'binaries "no type assigned to `~e'" bin)]
|
||||
[(not src) (error 'binaries "no type assigned to `~.s'" bin)]
|
||||
[(not (= 1 (length src)))
|
||||
(error 'binaries "bad type assignment for `~e': ~e" bin src)]
|
||||
(error 'binaries "bad type assignment for `~.s': ~.s" bin src)]
|
||||
[else (loop (cdr bins)
|
||||
(if (memq (car src) r) r (cons (car src) r)))])))))
|
||||
(dprintf "Scanning full tgzs")
|
||||
|
|
@ -374,7 +374,7 @@
|
|||
(let ([rx (expand-spec spec)])
|
||||
(if (and (pair? rx) (null? (cdr rx)) (string? (car rx)))
|
||||
(car rx)
|
||||
(error 'filter-bintree "bad value for ~e: ~e" spec rx))))
|
||||
(error 'filter-bintree "bad value for ~.s: ~e" spec rx))))
|
||||
(define keep-pattern (get-pattern 'binary-keep))
|
||||
(define throw-pattern (get-pattern 'binary-throw))
|
||||
(define keep-rx (regexpify-spec (string-append "*" keep-pattern "*")))
|
||||
|
|
|
|||
|
|
@ -423,7 +423,7 @@
|
|||
;; first.
|
||||
=> (lambda (p)
|
||||
(make-cached (apply p (map primitive-spec->filter (cdr spec)))))]
|
||||
[else (error 'primitive-spec->filter "bad spec: ~e" spec)])))
|
||||
[else (error 'primitive-spec->filter "bad spec: ~.s" spec)])))
|
||||
|
||||
;; Toplevel entry point for converting a spec into a tree predicate function.
|
||||
(define (spec->filter spec)
|
||||
|
|
@ -431,7 +431,7 @@
|
|||
(if (= 1 (length specs))
|
||||
(primitive-spec->filter (car specs))
|
||||
(error 'spec->filter
|
||||
"spec `~e' did not expand to a single expression: ~e"
|
||||
"spec `~.s' did not expand to a single expression: ~.s"
|
||||
spec specs))))
|
||||
|
||||
;;; ===========================================================================
|
||||
|
|
|
|||
|
|
@ -120,7 +120,7 @@ path/s is either such a string or a list of them.
|
|||
;; script?
|
||||
(fprintf (current-error-port) "warning: ~a\n" (apply format fmt args)))
|
||||
|
||||
(define (find-prop who pname [error-message "unknown property: ~e"])
|
||||
(define (find-prop who pname [error-message "unknown property: ~.s"])
|
||||
(if (prop? pname)
|
||||
pname ; might happen when `set-prop!' calls `get-prop'
|
||||
(or (for/or ([p (in-list known-props)])
|
||||
|
|
@ -272,7 +272,7 @@ path/s is either such a string or a list of them.
|
|||
[(string? x)
|
||||
;; new path, find the node or create if none
|
||||
(loop (tree-find x #t) #f)]
|
||||
[(find-prop #f x "bad datum `~e'")
|
||||
[(find-prop #f x "bad datum `~.s'")
|
||||
;; new prop
|
||||
(loop (or tree (malformed "initial property has no path")) x)]
|
||||
[else (malformed (format x))])))
|
||||
|
|
@ -498,7 +498,8 @@ path/s is either such a string or a list of them.
|
|||
(error "can't use more than a single `~s'"))
|
||||
xs)))))
|
||||
(lambda (cmd)
|
||||
(define (bad) (error 'drdr:command-line "bad command-line value: ~e" cmd))
|
||||
(define (bad)
|
||||
(error 'drdr:command-line "bad command-line value: ~.s" cmd))
|
||||
(cond [(not cmd) ""]
|
||||
[(not (list? cmd)) (bad)]
|
||||
[else (string-join (map (lambda (x)
|
||||
|
|
|
|||
|
|
@ -151,7 +151,7 @@
|
|||
;; spec -> spec-list, the input is always a cond spec
|
||||
(define (expand-cond-spec spec)
|
||||
(define (eval-cond c)
|
||||
(define (bad-cond) (error 'expand-cond-spec "got a bad condition: ~e" c))
|
||||
(define (bad-cond) (error 'expand-cond-spec "got a bad condition: ~.s" c))
|
||||
(cond [(eq? c 'else) #t]
|
||||
[(pair? c)
|
||||
(case (car c)
|
||||
|
|
@ -180,12 +180,12 @@
|
|||
[(eq? 'tag (car spec))
|
||||
(if (pair? (cdr spec))
|
||||
(tag (cadr spec) (expand-specs (cddr spec)))
|
||||
(error 'expand-spec "bad `tag' form: ~e" spec))]
|
||||
(error 'expand-spec "bad `tag' form: ~.s" spec))]
|
||||
[(eq? 'lambda (car spec))
|
||||
(if (pair? (cdr spec))
|
||||
(list (eval `(lambda ,(cadr spec)
|
||||
(splice (list ,@(cddr spec))))))
|
||||
(error 'expand-spec "bad `lambda' form: ~e" spec))]
|
||||
(error 'expand-spec "bad `lambda' form: ~.s" spec))]
|
||||
[(procedure? (car spec))
|
||||
(let ([newspec (apply (car spec) (expand-specs (cdr spec)))])
|
||||
(cond [(spliced? newspec) (expand-specs (cdr newspec))]
|
||||
|
|
@ -212,7 +212,7 @@
|
|||
(let ([r (expand-spec spec)])
|
||||
(if (= 1 (length r))
|
||||
(car r)
|
||||
(error 'expand-spec-1 "expected a single result for ~s, but got ~e"
|
||||
(error 'expand-spec-1 "expected a single result for ~.s, but got ~e"
|
||||
spec r))))
|
||||
|
||||
;; Expand tags
|
||||
|
|
@ -234,5 +234,5 @@
|
|||
(let ([r (expand-specs conds)])
|
||||
(if (= 1 (length r))
|
||||
(car r)
|
||||
(error 'expand-conds "expected a single result for ~s, but got ~e"
|
||||
(error 'expand-conds "expected a single result for ~.s, but got ~e"
|
||||
conds r))))))
|
||||
|
|
|
|||
|
|
@ -331,7 +331,7 @@
|
|||
#`((if (and in-seen? in-keys?)
|
||||
#,(if allow-duplicate-keys?
|
||||
#`seen-keys
|
||||
#`(error* 'name "duplicate keyword: ~e"
|
||||
#`(error* 'name "duplicate keyword: ~.s"
|
||||
(car body*)))
|
||||
(cons (car body*) seen-keys)))
|
||||
'()))])
|
||||
|
|
@ -343,12 +343,12 @@
|
|||
nl
|
||||
#`(if in-keys?
|
||||
#,nl
|
||||
(error* 'name "unknown keyword: ~e"
|
||||
(error* 'name "unknown keyword: ~.s"
|
||||
(car body*)))))]
|
||||
[(not allow-other-keys?)
|
||||
#`(if (memq (car body*) 'keywords)
|
||||
#,nl
|
||||
(error* 'name "unknown keyword: ~e"
|
||||
(error* 'name "unknown keyword: ~.s"
|
||||
(car body*)))]
|
||||
[else nl]))]
|
||||
[expr
|
||||
|
|
@ -381,7 +381,7 @@
|
|||
#'next-loop
|
||||
#'(if (pair? (cdr body*))
|
||||
next-loop
|
||||
(error* 'name "keyword list not balanced: ~e" rest*)))
|
||||
(error* 'name "keyword list not balanced: ~.s" rest*)))
|
||||
#,(if allow-body?
|
||||
(if (and body (not (identifier? body)))
|
||||
(with-syntax ([name (string->symbol
|
||||
|
|
@ -395,7 +395,7 @@
|
|||
#'expr)
|
||||
#'(if (null? body*)
|
||||
expr
|
||||
(error* 'name "expecting a ~s keyword got: ~e"
|
||||
(error* 'name "expecting a ~s keyword got: ~.s"
|
||||
'keywords (car body*))))))))))
|
||||
;; ------------------------------------------------------------------------
|
||||
;; generates the loop that turns flags to #t's
|
||||
|
|
@ -456,7 +456,7 @@
|
|||
(syntax/loc stx
|
||||
(lambda vars
|
||||
(if (and (pair? body) (keyword? (car body)))
|
||||
(error* 'name "unknown keyword: ~e" (car body))
|
||||
(error* 'name "unknown keyword: ~.s" (car body))
|
||||
expr)))))]
|
||||
;; no keys => make a case-lambda for optionals
|
||||
[(and (null? keys) (not (or body allow-other-keys?)))
|
||||
|
|
|
|||
|
|
@ -85,7 +85,7 @@
|
|||
(null? (cdr strs)))
|
||||
(list "mzlib")
|
||||
(append (cddr p) (drop-right strs 1)))))]
|
||||
[else (error 'runtime-path "unknown form: ~e" p)])))
|
||||
[else (error 'runtime-path "unknown form: ~.s" p)])))
|
||||
paths)))
|
||||
|
||||
(define-for-syntax (register-ext-files tag-stx paths)
|
||||
|
|
|
|||
|
|
@ -843,7 +843,7 @@
|
|||
(names (apply append nameses))
|
||||
(dup (check-duplicate-identifier names)))
|
||||
(when dup
|
||||
(raise-stx-err (format "duplicate binding for ~e" (syntax-e dup))))
|
||||
(raise-stx-err (format "duplicate binding for ~.s" (syntax-e dup))))
|
||||
(quasisyntax/loc stx
|
||||
(provide #,@names))))))
|
||||
|
||||
|
|
@ -1652,7 +1652,7 @@
|
|||
(tmp-bindings (map (λ (s) (map tmarker (map car (car s)))) out-sigs))
|
||||
(def-table (make-bound-identifier-mapping)))
|
||||
(when dup
|
||||
(raise-stx-err (format "duplicate binding for ~e" (syntax-e dup))))
|
||||
(raise-stx-err (format "duplicate binding for ~.s" (syntax-e dup))))
|
||||
(for-each
|
||||
(λ (sig new-xs)
|
||||
(for-each
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@
|
|||
tail
|
||||
(string-append tail ".ss")))])
|
||||
(make-request fullspec final-path '())))]
|
||||
[_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~e" (cdr spec)) stx)]))
|
||||
[_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~.s" (cdr spec)) stx)]))
|
||||
|
||||
;; short-pkg-string->spec : string (string -> string -> 'a) -> (list pkg-spec string)
|
||||
;; extracts the named package from the given short-style string, returning
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@
|
|||
(λ (opt/i opt/info stx)
|
||||
expr ...)))
|
||||
(void))
|
||||
(error 'define/opter "expected opter name to be an identifier, got ~e" (syntax-e #'for)))]))
|
||||
(error 'define/opter "expected opter name to be an identifier, got ~.s" (syntax-e #'for)))]))
|
||||
|
||||
;;
|
||||
;; opt/recursive-call
|
||||
|
|
|
|||
|
|
@ -245,7 +245,7 @@
|
|||
#:property prop:procedure (lambda (this)
|
||||
(let ([name (running-name this)])
|
||||
(if name
|
||||
(error 'force "reentrant promise ~e" name)
|
||||
(error 'force "reentrant promise ~.s" name)
|
||||
(error 'force "reentrant promise")))))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -441,7 +441,7 @@
|
|||
(let ([l (syntax->list c)]
|
||||
[h? highlight?])
|
||||
(unless (and l (= 2 (length l)))
|
||||
(error "bad code:redex: ~e" (syntax->datum c)))
|
||||
(error "bad code:redex: ~.s" (syntax->datum c)))
|
||||
(advance c init-line!)
|
||||
(set! src-col (syntax-column (cadr l)))
|
||||
(hash-set! next-col-map src-col dest-col)
|
||||
|
|
|
|||
|
|
@ -159,14 +159,14 @@
|
|||
"unknown value for syntax property 'stepper-define-type: ~e"
|
||||
define-type)])]
|
||||
[else (error 'unwind-define
|
||||
"expr with stepper-define-type is not a lambda: ~e"
|
||||
"expr with stepper-define-type is not a lambda: ~.s"
|
||||
(syntax->datum unwound-body))])
|
||||
#`(define #,printed-name #,unwound-body)))
|
||||
;; this is there just to see the unsupported stuff go by...
|
||||
#`(define-values (name . others) #,(unwind #'body settings))
|
||||
)]
|
||||
[else (error 'unwind-define
|
||||
"expression is not a define-values: ~e"
|
||||
"expression is not a define-values: ~.s"
|
||||
(syntax->datum stx))]))
|
||||
|
||||
(define (unwind-mz-let stx settings)
|
||||
|
|
@ -216,7 +216,7 @@
|
|||
#`((define-values vars exp) ...)))])
|
||||
#`(local defns #,(unwind #'body settings)))]
|
||||
[else (error 'unwind-local
|
||||
"expected a letrec-values, given: ~e"
|
||||
"expected a letrec-values, given: ~.s"
|
||||
(syntax->datum stx))]))
|
||||
|
||||
;(define (unwind-quasiquote-the-cons-application stx settings)
|
||||
|
|
@ -257,10 +257,10 @@
|
|||
[(begin . rest) null]
|
||||
[else-stx
|
||||
(error 'unwind-cond
|
||||
"expected an if, got: ~e"
|
||||
"expected an if, got: ~.s"
|
||||
(syntax->datum (syntax else-stx)))])
|
||||
(error 'unwind-cond
|
||||
"expected a cond clause expansion, got: ~e"
|
||||
"expected a cond clause expansion, got: ~.s"
|
||||
(syntax->datum stx))))])
|
||||
(syntax (cond . clauses)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -180,7 +180,7 @@
|
|||
([non-lexical]
|
||||
varref)
|
||||
(else
|
||||
(error 'varref-skip-step? "unexpected value for stepper-binding-type: ~e for variable: ~e\n"
|
||||
(error 'varref-skip-step? "unexpected value for stepper-binding-type: ~e for variable: ~.s\n"
|
||||
(stepper-syntax-property varref 'stepper-binding-type)
|
||||
varref))))))))
|
||||
|
||||
|
|
@ -931,7 +931,7 @@
|
|||
(apply append (map syntax->list (syntax->list #`(vars ...))))]
|
||||
[(let-values ([vars . rest] ...) . bodies)
|
||||
(apply append (map syntax->list (syntax->list #`(vars ...))))]
|
||||
[else (error 'reconstruct "expected a let-values as source for a double-break, got: ~e"
|
||||
[else (error 'reconstruct "expected a let-values as source for a double-break, got: ~.s"
|
||||
(syntax->datum source-expr))])]
|
||||
[innermost-after (mark-as-highlight (recon-source-expr (mark-source (car mark-list)) mark-list null newly-lifted-bindings render-settings))])
|
||||
(list (recon innermost-before (cdr mark-list) #f)
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
(rewrite-xml-box stx rewrite-other))
|
||||
|
||||
(define (rewrite-xml-error)
|
||||
(error 'rewrite-xml-box "unexpected syntax in expansion of xml box: ~e" stx))
|
||||
(error 'rewrite-xml-box "unexpected syntax in expansion of xml box: ~.s" stx))
|
||||
|
||||
(case (stepper-syntax-property stx 'stepper-hint)
|
||||
[(from-scheme-box from-splice-box) (rewrite-other stx)]
|
||||
|
|
@ -56,9 +56,6 @@
|
|||
'from-xml-box)]
|
||||
|
||||
[else
|
||||
(error 'rewrite-xml-box "unexpected stepper-hint \"~v\" on syntax from xml box: ~e"
|
||||
(error 'rewrite-xml-box "unexpected stepper-hint ~e on syntax from xml box: ~.s"
|
||||
(stepper-syntax-property stx 'stepper-hint)
|
||||
stx)])))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1651,10 +1651,10 @@
|
|||
(arity-at-least-value arity))]
|
||||
[required (or at-least arity)])
|
||||
(unless (integer? required)
|
||||
(error 'echo "handler function for `~e' has bad arity" keyword))
|
||||
(error 'echo "handler function for `~.s' has bad arity" keyword))
|
||||
(lambda (args)
|
||||
(if (< (length args) required)
|
||||
(error 'echo "user-keyword `~e' didn't get enough arguments" keyword)
|
||||
(error 'echo "user-keyword `~.s' didn't get enough arguments" keyword)
|
||||
(let*-values ([(proc-args rest-args)
|
||||
(if at-least
|
||||
(values args '())
|
||||
|
|
@ -1724,7 +1724,7 @@
|
|||
(when (and (pair? l-args) (eq? echo: (car l-args)))
|
||||
(set! l-args (cdr l-args)) (pop-key-tags)))
|
||||
(when (null? args)
|
||||
(error 'echo "found a `~e' with no matching `~e'" :\{ :\}))
|
||||
(error 'echo "found a `~.s' with no matching `~.s'" :\{ :\}))
|
||||
(let ([arg (getarg)])
|
||||
(define (next) (loop (cons arg l-args)))
|
||||
(cond
|
||||
|
|
@ -1777,18 +1777,18 @@
|
|||
[(:push) (push-state!)]
|
||||
[(:pop) (pop-state!)]
|
||||
[(:\{) (process-list)]
|
||||
[(:\} :^) (error 'echo "unexpected list keyword `~e'" arg)]
|
||||
[(:\} :^) (error 'echo "unexpected list keyword `~.s'" arg)]
|
||||
[(:k-) (set! keys? #f)]
|
||||
[(:k+) (set! keys? #t)]
|
||||
[(:set-user :unset-user)
|
||||
(let loop ([keyword echo:])
|
||||
(if (null? args)
|
||||
(error 'echo "expecting a keyword+handler after `~e'" arg)
|
||||
(error 'echo "expecting a keyword+handler after `~.s'" arg)
|
||||
(let ([x (getarg)])
|
||||
(cond
|
||||
[(eq? keyword echo:) (loop x)]
|
||||
[(not (keyword? keyword))
|
||||
(error 'echo "got a `~e' with a non-keyword `~e'"
|
||||
(error 'echo "got a `~.s' with a non-keyword `~.s'"
|
||||
arg keyword)]
|
||||
[(eq? arg :unset-user)
|
||||
(hash-table-put! echo-user-table keyword #f)]
|
||||
|
|
@ -1806,7 +1806,7 @@
|
|||
(cond [(procedure? user) (user args)]
|
||||
[(keyword? user) (list* echo: user args)]
|
||||
[else (cons user args)]))
|
||||
(error 'echo "unknown keyword: `~e'" arg)))])]
|
||||
(error 'echo "unknown keyword: `~.s'" arg)))])]
|
||||
[first? (printer arg out) (set! first? #f)]
|
||||
[spaces? (display " " out) (printer arg out)
|
||||
(unless (eq? spaces? #t) (set! spaces? #f))]
|
||||
|
|
|
|||
|
|
@ -438,7 +438,8 @@
|
|||
;; (%class-getters-n-setters class))
|
||||
(%class-getters-n-setters class))
|
||||
(raise* make-exn:fail:contract
|
||||
"slot-ref: no slot `~e' in ~e" slot-name class)))))
|
||||
"slot-ref: no slot `~.s' in ~.s"
|
||||
slot-name class)))))
|
||||
|
||||
;;; These are for optimizations - works only for single inheritance!
|
||||
(define (%slot-getter class slot-name)
|
||||
|
|
@ -560,7 +561,7 @@
|
|||
(cond [(integer? a) (sub1 a)]
|
||||
[(arity-at-least? a)
|
||||
(make-arity-at-least (sub1 (arity-at-least-value a)))]
|
||||
[else (error 'method-arity "the procedure in ~e has bad arity ~e"
|
||||
[else (error 'method-arity "the procedure in ~.s has bad arity ~e"
|
||||
m a)])))
|
||||
|
||||
;;; These versions will be optimized later.
|
||||
|
|
@ -784,7 +785,7 @@
|
|||
(make-setter-locked! (lookup-slot-info <method> slot values) #t
|
||||
(lambda ()
|
||||
(raise* make-exn:fail:contract
|
||||
"slot-set!: slot `~e' in <method> is locked" slot))))
|
||||
"slot-set!: slot `~.s' in <method> is locked" slot))))
|
||||
|
||||
;;>>...
|
||||
;;> *** Convenience functions
|
||||
|
|
@ -1591,14 +1592,14 @@
|
|||
(%instance-set! o f n)
|
||||
(raise* make-exn:fail:contract
|
||||
"slot-set!: wrong type for slot ~
|
||||
~e in ~e (~e not in ~e)"
|
||||
`~.s' in ~e (~e not in ~e)"
|
||||
(car slot) class n type)))
|
||||
(lambda (o n) (%instance-set! o f n))))])
|
||||
(when lock
|
||||
(make-setter-locked! g+s lock
|
||||
(lambda ()
|
||||
(raise* make-exn:fail:contract
|
||||
"slot-set!: slot `~e' in ~e is locked"
|
||||
"slot-set!: slot `~.s' in ~.s is locked"
|
||||
(car slot) (%class-name class)))))
|
||||
g+s)]
|
||||
[(:class)
|
||||
|
|
@ -1629,14 +1630,14 @@
|
|||
(raise*
|
||||
make-exn:fail:contract
|
||||
"slot-set!: wrong type for shared slot ~
|
||||
~e in ~e (~e not in ~e)"
|
||||
`~.s' in ~e (~e not in ~e)"
|
||||
(car slot) class n type)
|
||||
(set! cell n))))])
|
||||
(when lock
|
||||
(make-setter-locked! (car slot) g+s lock
|
||||
(lambda ()
|
||||
(raise* make-exn:fail:contract
|
||||
"slot-set!: slot `~e' in ~e is locked"
|
||||
"slot-set!: slot `~.s' in ~.s is locked"
|
||||
(car slot) (%class-name class)))))
|
||||
g+s)
|
||||
;; the slot was inherited as :class - fetch its getters/setters
|
||||
|
|
@ -1646,7 +1647,7 @@
|
|||
[else (loop (cdr cpl))])))]
|
||||
[else
|
||||
(error 'class
|
||||
"allocation for ~e must be :class or :instance, got ~e"
|
||||
"allocation for `~.s' must be :class or :instance, got ~e"
|
||||
(car slot) allocation)]))))))
|
||||
|
||||
;;; Use the previous function when populating this generic.
|
||||
|
|
@ -1783,7 +1784,7 @@
|
|||
;;; class-names (in case of unnamed-methods in clos.ss).
|
||||
(define (compute-method-name specs generic-name)
|
||||
(define (spec-string spec)
|
||||
(cond [(%singleton? spec) (format "{~e}" (singleton-value spec))]
|
||||
(cond [(%singleton? spec) (format "{~.s}" (singleton-value spec))]
|
||||
[(%class? spec) (symbol->string
|
||||
(%class-name (%struct->class spec)))]
|
||||
[else "???"]))
|
||||
|
|
@ -1809,7 +1810,7 @@
|
|||
;; note: equal? works on arity-at-least structs
|
||||
[(not (equal? generic-arity method-arity))
|
||||
(error 'add-method
|
||||
"wrong arity for `~e', expects ~a; given a method with ~a"
|
||||
"wrong arity for `~.s', expects ~a; given a method with ~a"
|
||||
(%generic-name generic)
|
||||
(if (integer? generic-arity)
|
||||
generic-arity
|
||||
|
|
|
|||
|
|
@ -499,7 +499,7 @@
|
|||
|
||||
[_else
|
||||
(error 'syntax->zodiac
|
||||
"unrecognized expression form: ~e"
|
||||
"unrecognized expression form: ~.s"
|
||||
(syntax->datum stx))]))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -871,7 +871,7 @@ END-OF-TESTS
|
|||
[(column=) syntax-column]
|
||||
[(position=) syntax-position]
|
||||
[(span=) syntax-span]
|
||||
[else (error 'syntax-test "unknown test form: ~e" (car y))])
|
||||
[else (error 'syntax-test "unknown test form: ~.s" (car y))])
|
||||
x)
|
||||
(cadr y))
|
||||
(check-stx x (cddr y))]
|
||||
|
|
|
|||
|
|
@ -259,7 +259,7 @@
|
|||
(if (equal? actual expected)
|
||||
#t
|
||||
(begin (warn error-box 'not-equal?
|
||||
"~e:\nactual: ~e =/= \nexpected: ~e\n here's the diff: ~e" name actual expected (sexp-diff actual expected))
|
||||
"~.s:\nactual: ~e =/= \nexpected: ~e\n here's the diff: ~e" name actual expected (sexp-diff actual expected))
|
||||
#f)))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@
|
|||
(let ([maybe-test (assq name list-of-tests)])
|
||||
(if maybe-test
|
||||
(run-one-test/helper maybe-test)
|
||||
(error 'run-test "test not found: ~e" name))))
|
||||
(error 'run-test "test not found: ~.s" name))))
|
||||
|
||||
(define (run-tests names)
|
||||
(ormap/no-shortcut run-test names))
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ don't depend on any other portion of the system
|
|||
(and (syntax-transforming?) (syntax-original? (syntax-local-introduce e)))
|
||||
#;(and (orig-module-stx) (eq? (debugf syntax-source-module e) (debugf syntax-source-module (orig-module-stx))))
|
||||
#;(syntax-source-module stx))
|
||||
(log-message l 'warning (format "Typed Scheme has detected unreachable code: ~e" (syntax->datum (locate-stx e)))
|
||||
(log-message l 'warning (format "Typed Scheme has detected unreachable code: ~.s" (syntax->datum (locate-stx e)))
|
||||
e))))
|
||||
|
||||
(define (locate-stx stx)
|
||||
|
|
|
|||
|
|
@ -173,7 +173,7 @@
|
|||
...
|
||||
[(_ new-name method-name)
|
||||
(raise-syntax-error 'define/generic
|
||||
(format "~e not a method of ~e"
|
||||
(format "~.s not a method of ~.s"
|
||||
(syntax->datum #'method-name)
|
||||
'generics)
|
||||
stx
|
||||
|
|
|
|||
|
|
@ -9,15 +9,15 @@
|
|||
(define make-CLOSURE-box
|
||||
(syntax-local-lift-expression
|
||||
(quasisyntax/loc stx
|
||||
(box (lambda (env) (error 'make-CLOSURE "Closure<~e> not initialized" '#,label))))))
|
||||
(box (lambda (env) (error 'make-CLOSURE "Closure<~.s> not initialized" '#,label))))))
|
||||
(define CLOSURE-set-env!-box
|
||||
(syntax-local-lift-expression
|
||||
(quasisyntax/loc stx
|
||||
(box (lambda (clsr new-env) (error 'CLOSURE-set-env! "Closure<~e> not initialized" '#,label))))))
|
||||
(box (lambda (clsr new-env) (error 'CLOSURE-set-env! "Closure<~.s> not initialized" '#,label))))))
|
||||
(define CLOSURE-env-box
|
||||
(syntax-local-lift-expression
|
||||
(quasisyntax/loc stx
|
||||
(box (lambda (clsr) (error 'CLOSURE-env "Closure<~e> not initialized" '#,label))))))
|
||||
(box (lambda (clsr) (error 'CLOSURE-env "Closure<~.s> not initialized" '#,label))))))
|
||||
; Define the deserializer (req closure struct values under lambdas)
|
||||
(define CLOSURE:deserialize-info-id
|
||||
(syntax-local-lift-expression
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@
|
|||
(hash-ref
|
||||
(frame-env (current-frame)) i
|
||||
(lambda ()
|
||||
(error 'web-cell "Undefined web-cell: ~e" i))))
|
||||
(error 'web-cell "Undefined web-cell: ~.s" i))))
|
||||
|
||||
(define (web-cell-shadow wc nv)
|
||||
(update-frame!
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
(hash-ref
|
||||
(frame-env (current-frame)) i
|
||||
(lambda ()
|
||||
(error 'web-cell "Undefined web-cell: ~e" i))))
|
||||
(error 'web-cell "Undefined web-cell: ~.s" i))))
|
||||
|
||||
(define (web-cell-shadow wc nv)
|
||||
(update-frame!
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user