From: Stephen Adams Date: Sun, 1 Dec 1996 17:23:03 +0000 (+0000) Subject: Changed some calls to ERROR to calls to ERROR:WRONG-TYPE-ARGUMENT etc. X-Git-Tag: 20090517-FFI~5316 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c002fbe3d65fed0dfeef14398282746343998b7c;p=mit-scheme.git Changed some calls to ERROR to calls to ERROR:WRONG-TYPE-ARGUMENT etc. --- diff --git a/v7/src/runtime/msort.scm b/v7/src/runtime/msort.scm index 5b2bfd0e8..1f0ed5fe7 100644 --- a/v7/src/runtime/msort.scm +++ b/v7/src/runtime/msort.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/msort.scm,v 14.2 1996/11/26 17:32:06 adams Exp $ +$Id: msort.scm,v 14.3 1996/12/01 17:23:03 adams Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988-1996 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -64,7 +64,7 @@ MIT in each case. |# ((vector? obj) (sort! (vector-copy obj) pred)) (else - (error "sort: argument should be a list or vector" obj)))) + (error:wrong-type-argument obj "list or vector" 'SORT)))) ;; This merge sort is stable for partial orders (for predicates like ;; <=, rather than like <). @@ -97,7 +97,7 @@ MIT in each case. |# (loop (1+ p) p1 (1+ p2))))))))) (if (not (vector? v)) - (error "sort!: argument not a vector" v)) + (error:wrong-type-argument v "vector" 'SORT!)) (sort-internal! v (vector-copy v) diff --git a/v7/src/runtime/partab.scm b/v7/src/runtime/partab.scm index 49434fe78..a73dda085 100644 --- a/v7/src/runtime/partab.scm +++ b/v7/src/runtime/partab.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/partab.scm,v 14.3 1988/07/13 18:41:33 cph Rel $ +$Id: partab.scm,v 14.4 1996/12/01 17:21:22 adams Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988-1996 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -44,9 +44,9 @@ MIT in each case. |# (parse-object-special false read-only true) (collect-list-special false read-only true)) -(define (guarantee-parser-table table) +(define-integrable (guarantee-parser-table table procedure) (if (not (parser-table? table)) - (error "Not a valid parser table" table)) + (error:wrong-type-argument table "parser table" procedure)) table) (define (make-parser-table parse-object @@ -68,11 +68,11 @@ MIT in each case. |# *current-parser-table*) (define (set-current-parser-table! table) - (guarantee-parser-table table) + (guarantee-parser-table table 'SET-CURRENT-PARSER-TABLE!) (set! *current-parser-table* table)) (define (with-current-parser-table table thunk) - (guarantee-parser-table table) + (guarantee-parser-table table 'WITH-CURRENT-PARSER-TABLE) (fluid-let ((*current-parser-table* table)) (thunk))) diff --git a/v7/src/runtime/qsort.scm b/v7/src/runtime/qsort.scm index 290884ac2..054cde99c 100644 --- a/v7/src/runtime/qsort.scm +++ b/v7/src/runtime/qsort.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/qsort.scm,v 14.1 1988/06/13 11:50:22 cph Rel $ +$Id: qsort.scm,v 14.2 1996/12/01 17:20:23 adams Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988-1996 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -83,6 +83,6 @@ MIT in each case. |# (vector-set! vector j ith-element))) (if (not (vector? vector)) - (error "SORT! works on vectors only" vector)) + (error:wrong-type-argument vector "vector" 'SORT!)) (outer-loop 0 (-1+ (vector-length vector))) vector) \ No newline at end of file diff --git a/v7/src/runtime/uproc.scm b/v7/src/runtime/uproc.scm index a255a0fb8..2e41a80f3 100644 --- a/v7/src/runtime/uproc.scm +++ b/v7/src/runtime/uproc.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: uproc.scm,v 1.9 1996/04/24 04:23:19 cph Exp $ +$Id: uproc.scm,v 1.10 1996/12/01 17:19:29 adams Exp $ Copyright (c) 1990-96 Massachusetts Institute of Technology @@ -76,7 +76,7 @@ MIT in each case. |# (cond ((%primitive-procedure? procedure*) (if-primitive procedure*)) ((%compound-procedure? procedure*) (if-compound procedure*)) ((%compiled-procedure? procedure*) (if-compiled procedure*)) - (else (error "not a procedure" procedure))))) + (else (error:wrong-type-argument procedure "procedure" #F))))) (define (skip-entities object) (if (%entity? object) @@ -125,7 +125,8 @@ MIT in each case. |# (loop (apply-hook-procedure p) e) (loop (entity-procedure p) (1+ e)))) (else - (error "not a procedure" procedure))))) + (error:wrong-type-argument procedure "procedure" + 'PROCEDURE-ARITY))))) (define (procedure-arity-valid? procedure n-arguments) (let ((arity (procedure-arity procedure))) @@ -171,7 +172,7 @@ MIT in each case. |# (define (%primitive-procedure-arg procedure) (let ((procedure* (skip-entities procedure))) (if (not (%primitive-procedure? procedure*)) - (error "not a primitive procedure" procedure)) + (error:wrong-type-datum procedure "primitive procedure")) procedure*)) (define-integrable (%compound-procedure? object) @@ -215,7 +216,8 @@ MIT in each case. |# (loop (apply-hook-procedure p)) (1+ (loop (entity-procedure p))))) (else - (error "not a compiled procedure" procedure))))) + (error:wrong-type-argument procedure "compiled procedure" + 'COMPILED-PROCEDURE-FRAME-SIZE))))) (define (%compiled-closure? object) (and (%compiled-procedure? object) @@ -233,7 +235,8 @@ MIT in each case. |# (%compiled-closure->entry (let ((closure* (skip-entities closure))) (if (not (%compiled-closure? closure*)) - (error "not a compiled closure" closure)) + (error:wrong-type-argument closure "compiled closure" + 'COMPILED-CLOSURE->ENTRY)) closure*))) ;; In the following two procedures, offset can be #f to support diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm index 91822fdd2..3e3625f21 100644 --- a/v8/src/runtime/global.scm +++ b/v8/src/runtime/global.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: global.scm,v 14.51 1995/08/08 15:32:15 adams Exp $ +$Id: global.scm,v 14.52 1996/12/01 17:22:31 adams Exp $ -Copyright (c) 1988-95 Massachusetts Institute of Technology +Copyright (c) 1988-1996 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -152,7 +152,7 @@ MIT in each case. |# (define (pa procedure) (cond ((not (procedure? procedure)) - (error "Must be a procedure" procedure)) + (error:wrong-type-argument procedure "procedure" 'PA)) ((procedure-lambda procedure) => (lambda (scode) (pp (unsyntax-lambda-list scode)))) diff --git a/v8/src/runtime/uenvir.scm b/v8/src/runtime/uenvir.scm index c40b7b8b2..6df961a1e 100644 --- a/v8/src/runtime/uenvir.scm +++ b/v8/src/runtime/uenvir.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: uenvir.scm,v 14.39 1995/08/23 14:21:58 adams Exp $ +$Id: uenvir.scm,v 14.40 1996/12/01 17:21:54 adams Exp $ -Copyright (c) 1988-1995 Massachusetts Institute of Technology +Copyright (c) 1988-1996 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -420,7 +420,8 @@ MIT in each case. |# (define (compiled-procedure/environment entry) (if (not (compiled-procedure? entry)) - (error "Not a compiled procedure" entry 'COMPILED-PROCEDURE/ENVIRONMENT)) + (error:wrong-type-argument entry "compiled procedure" + 'COMPILED-PROCEDURE/ENVIRONMENT)) (let ((procedure (compiled-entry/dbg-object entry))) (if (not procedure) (error "Unable to obtain closing environment" entry))