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

Change a bunch of "~%" and "~n" in format strings to "\n".

Browse Source 
original commit: 7dc4d2e5a63ab416d90e44d7bf75cb5593329909
This commit is contained in:
Eli Barzilay 2010-08-25 17:16:32 -04:00
parent d4b3623003
commit 8ab581cf2e
11 changed files with 47 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-scheme/private/colon.rkt
View File

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

8
collects/typed-scheme/private/parse-type.rkt
View File

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

14
collects/typed-scheme/private/type-annotation.rkt
View File

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

2
collects/typed-scheme/private/type-env-lang.rkt
View File

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

4
collects/typed-scheme/typecheck/check-subforms-unit.rkt
View File

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

12
collects/typed-scheme/typecheck/tc-app.rkt
View File

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

8
collects/typed-scheme/typecheck/tc-apply.rkt
View File

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

18
collects/typed-scheme/typecheck/tc-expr-unit.rkt
View File

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

12
collects/typed-scheme/typecheck/tc-if.rkt
View File

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

6
collects/typed-scheme/typecheck/tc-let-unit.rkt
View File

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

6
collects/typed-scheme/utils/tc-utils.rkt
View File

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