~ chicken-core (chicken-5) e6ebb0280fb9e47b62a960eba7fffcb6cd470765
commit e6ebb0280fb9e47b62a960eba7fffcb6cd470765
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Sep 9 21:49:19 2014 +1200
Commit: Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Wed Sep 10 09:48:00 2014 +0200
Remove the unused typename procedure from scrutinizer.scm
Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 77b14f58..fc88438a 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -30,7 +30,7 @@
procedure-type? named? procedure-result-types procedure-argument-types
noreturn-type? rest-type procedure-name d-depth
noreturn-procedure-type? trail trail-restore walked-result
- typename multiples procedure-arguments procedure-results
+ multiples procedure-arguments procedure-results
smash-component-types! generate-type-checks! over-all-instantiations
compatible-types? type<=? match-types resolve match-argument-types))
@@ -895,79 +895,6 @@
(cute set-car! (cddr t) <>))))))))
-;;; Converting type into string
-
-(define (typename t)
- (define (argument-string args)
- (let* ((len (length (delete '#!optional args eq?)))
- (m (multiples len)))
- ;;XXX not quite right for rest/optional arguments
- (cond ((memq '#!rest args)
- (sprintf "~a or more arguments" len))
- ((zero? len) "zero arguments")
- (else
- (sprintf
- "~a argument~a of type~a ~a"
- len m m
- (string-intersperse (map typename args) ", "))))))
- (define (result-string results)
- (if (eq? '* results)
- "an unknown number of values"
- (let* ((len (length results))
- (m (multiples len)))
- (if (zero? len)
- "zero values"
- (sprintf
- "~a value~a of type~a ~a"
- len m m
- (string-intersperse (map typename results) ", "))))))
- (case t
- ((*) "anything")
- ((char) "character")
- (else
- (cond ((symbol? t) (symbol->string t))
- ((pair? t)
- (case (car t)
- ((procedure)
- (if (or (string? (cadr t)) (symbol? (cadr t)))
- (->string (cadr t))
- (sprintf "a procedure with ~a returning ~a"
- (argument-string (cadr t))
- (result-string (cddr t)))))
- ((or)
- (string-intersperse
- (map typename (cdr t))
- " OR "))
- ((struct)
- (sprintf "a structure of type ~a" (cadr t)))
- ((forall)
- (sprintf "~a (for all ~a)"
- (typename (third t))
- (string-intersperse
- (map (lambda (tv)
- (if (symbol? tv)
- (symbol->string tv)
- (sprintf "~a being ~a" (first tv) (typename (second tv)))))
- (second t))
- " ")))
- ((not)
- (sprintf "NOT ~a" (typename (second t))))
- ((pair)
- (sprintf "a pair wth car ~a and cdr ~a"
- (typename (second t))
- (typename (third t))))
- ((vector-of)
- (sprintf "a vector with element type ~a" (typename (second t))))
- ((list-of)
- (sprintf "a list with element type ~a" (typename (second t))))
- ((vector list)
- (sprintf "a ~a with the element types ~a"
- (car t)
- (map typename (cdr t))))
- (else (bomb "typename: invalid type" t))))
- (else (bomb "typename: invalid type" t))))))
-
-
;;; Type-matching
;
; - "exact" means: first argument must match second one exactly
Trap