--- scrutinizer.scm | 75 +------------------------------------------------------ 1 file changed, 1 insertion(+), 74 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm index c437933..2221aac 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 -- 1.7.10.4 _______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers