#| -*-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
((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))))
\f
;; This merge sort is stable for partial orders (for predicates like
;; <=, rather than like <).
(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)
#| -*-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
(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
*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)))
#| -*-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
(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
#| -*-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
(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)
(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)))
(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)
(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)
(%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
#| -*-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
\f
(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))))
#| -*-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
(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))
projects / mit-scheme.git / commitdiff