scsh-0.6/scheme/rts/xprim.scm

35 lines
1.2 KiB
Scheme
Raw Normal View History

1999-09-14 08:45:02 -04:00
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Hairier exceptions & interrupts.
; Enable generic arithmetic, informative error messages, etc.
; Deal with optional arguments, etc. to primitives.
; This is not necessarily the cleanest way to do this, and certainly not
; the most efficient, but for the time being it's the most expedient.
; We don't want to depend on tables. But if we did, we might do this:
;(define (closure-hash closure)
; (let ((cv (vector-ref (closure-template closure) 0))) ;template-ref
; (do ((h 0 (+ h (code-vector-ref cv i)))
; (i (- (code-vector-length cv) 1) (- i 1)))
; ((< i 0) h))))
;(define wna-handlers (make-table closure-hash))
;(define-exception-handler (enum op check-nargs=)
; (lambda (opcode reason proc args)
; (let ((probe (assq proc *wna-handlers*)))
; (if probe
; ((cdr probe) args)
; (signal-exception opcode reason proc args)))))
(define *wna-handlers* '())
(define (define-wna-handler proc handler)
(set! *wna-handlers* (cons (cons proc handler) *wna-handlers*)))
(define op/check-nargs= (enum op protocol)) ; temporary hack
(define (wna-lose proc args)
(signal-exception op/check-nargs= #f proc args)) ; lost our reason