Changeset 16102 in project


Ignore:
Timestamp:
09/27/09 05:24:32 (10 years ago)
Author:
Kon Lovett
Message:

Added current value api for invalid procedure call hook & unbound variable hook.

Location:
chicken/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/lolevel.import.scm

    r13150 r16102  
    3232   block-ref
    3333   block-set!
     34   clear-unbound-variable-value!
    3435   extend-procedure
    3536   extended-procedure?
     
    3940   global-ref
    4041   global-set!
     42   invalid-procedure-call-handler
    4143   locative->object
    4244   locative-ref
     
    9395   set-invalid-procedure-call-handler!
    9496   set-procedure-data!
     97   set-unbound-variable-value!
    9598   tag-pointer
    9699   tagged-pointer?
    97100   unbound-variable-value
     101   unbound-variable-given-value
     102   unbound-variable-signals-error?
    98103   vector-like?))
  • chicken/trunk/lolevel.scm

    r15543 r16102  
    3131  (usual-integrations)
    3232  (disable-warning var redef)
    33   (hide ipc-hook-0 xproc-tag
     33  (hide ipc-hook-0 *set-invalid-procedure-call-handler! xproc-tag
    3434   ##sys#check-block
    3535   ##sys#check-become-alist
     
    5959    (bound-to-procedure
    6060     ##sys#check-pointer ##sys#check-closure ##sys#check-integer ##sys#check-special
    61      ##sys#error ##sys#signal-hook
     61     ##sys#error ##sys#signal-hook ##sys#error-hook
    6262     ##sys#error-not-a-proper-list
    6363     make-hash-table hash-table-ref/default hash-table-set!
     
    650650;;; Hooks:
    651651
    652 (define ipc-hook-0 #f)                  ; we need this because `##sys#invalid-procedure-call-hook' may not have free variables.
     652; we need this because `##sys#invalid-procedure-call-hook' cannot
     653; have free variables.
     654(define ipc-hook-0 #f)
     655
     656(define (invalid-procedure-call-handler) ipc-hook-0)
    653657
    654658(define (set-invalid-procedure-call-handler! proc)
    655659  (##sys#check-closure proc 'set-invalid-procedure-call-handler!)
    656660  (set! ipc-hook-0 proc)
    657   (set! ##sys#invalid-procedure-call-hook
    658     (lambda args
    659       (ipc-hook-0 ##sys#last-invalid-procedure args) ) ) )
    660 
     661  (set! ##sys#invalid-procedure-call-hook
     662        (lambda args (ipc-hook-0 ##sys#last-invalid-procedure args))) )
     663
     664(define (unbound-variable-signals-error?) (not ##sys#unbound-variable-value-hook))
     665
     666; result only trusted when (unbound-variable-signals-error?) is #f
     667(define (unbound-variable-given-value)
     668  (and ##sys#unbound-variable-value-hook
     669       (vector-ref ##sys#unbound-variable-value-hook 0)) )
     670
     671(define (set-unbound-variable-value! val) (set! ##sys#unbound-variable-value-hook (vector val)))
     672
     673(define (clear-unbound-variable-value!) (set! ##sys#unbound-variable-value-hook #f))
     674
     675; this should be the current value procedure
    661676(define (unbound-variable-value . val)
    662677  (set! ##sys#unbound-variable-value-hook
Note: See TracChangeset for help on using the changeset viewer.