Changeset 15995 in project


Ignore:
Timestamp:
09/20/09 20:46:06 (10 years ago)
Author:
Kon Lovett
Message:

Added alist support

Location:
release/4/check-errors/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/check-errors/trunk/check-errors.setup

    r14288 r15995  
    77(copy-to-home "inline-type-checks.scm")
    88
    9 (setup-shared-extension-module 'type-errors (extension-version "1.0.0"))
     9(setup-shared-extension-module 'type-errors (extension-version "1.0.0")
     10  #:compile-options '(-optimize-level 3
     11                      -fixnum-arithmetic))
    1012
    11 (setup-shared-extension-module 'type-checks (extension-version "1.0.0"))
     13(setup-shared-extension-module 'type-checks (extension-version "1.0.0")
     14  #:compile-options '(-optimize-level 3
     15                      -no-procedure-checks -no-bound-checks -no-argc-checks))
    1216
    13 (setup-shared-extension-module 'conditions (extension-version "1.0.0"))
     17(setup-shared-extension-module 'conditions (extension-version "1.0.0")
     18  #:compile-options '(-optimize-level 3
     19                      -fixnum-arithmetic))
    1420
    1521(install-extension 'check-errors '() `((version ,(extension-version "1.0.0"))))
  • release/4/check-errors/trunk/conditions.scm

    r15716 r15995  
    11;;;; conditions.scm
    22;;;; Kon Lovett, Apr '09
    3 
    4 (declare
    5   (usual-integrations)
    6   (fixnum)
    7   (inline)
    8   (local)
    9   (no-procedure-checks)
    10   (no-bound-checks) )
    113
    124;;;
     
    2113  (make-condition-property-accessor condition-property-accessor*))
    2214
    23 (import scheme chicken (only srfi-1 alist-cons) #;srfi-12 type-checks)
    24 (require-library srfi-1 #;srfi-12 type-checks)
     15  (import scheme chicken (only srfi-1 alist-cons) #;srfi-12 type-checks)
     16
     17  (require-library srfi-1 #;srfi-12 type-checks)
    2518
    2619;;
  • release/4/check-errors/trunk/type-checks.scm

    r15914 r15995  
    11;;;; type-checks.scm
    22;;;; Kon Lovett, Apr '09
    3 
    4 (declare
    5   (usual-integrations)
    6   (generic)
    7   (inline)
    8   (local)
    9   (no-procedure-checks)
    10   (no-bound-checks)
    11   (bound-to-procedure
    12     ##sys#structure?) )
    133
    144;;;
     
    3828  check-char
    3929  check-boolean
     30  check-alist
    4031  ;;
    4132  define-check-type define-check+error-type
     
    4435  check-argument-count)
    4536
    46 (import chicken scheme type-errors)
    47 (require-library type-errors)
     37  (import chicken scheme (only srfi-1 every) type-errors)
     38
     39  (require-library srfi-1 type-errors)
     40
     41  (declare
     42    (bound-to-procedure ##sys#structure?) )
    4843
    4944;;
     
    145140(define-check-type vector)
    146141
     142(define (alist? obj) (or (null? obj) (and (pair? obj) (every pair? obj))))
     143(define-check-type alist)
     144
     145(define (check-minimum-argument-count loc actargc minargc)
     146  (unless (<= minargc actargc)
     147    (error-minimum-argument-count loc actargc minargc)) )
     148
     149(define (check-argument-count loc actargc maxargc)
     150  (unless (<= actargc maxargc)
     151    (error-argument-count loc actargc maxargc)) )
     152
    147153;;
    148154
     
    160166           (,$define-check-type ,typ ,@(if pred `(,pred) '())) ) ) ) ) )
    161167
    162 ;;
    163 
    164 (define (check-minimum-argument-count loc actargc minargc)
    165   (unless (<= minargc actargc)
    166     (error-minimum-argument-count loc actargc minargc)) )
    167 
    168 (define (check-argument-count loc actargc maxargc)
    169   (unless (<= actargc maxargc)
    170     (error-argument-count loc actargc maxargc)) )
    171 
    172168) ;module type-checks
  • release/4/check-errors/trunk/type-errors.scm

    r15914 r15995  
    3434  error-char
    3535  error-boolean
     36  error-alist
    3637  ;;
    3738  (define-error-type error-argument-type)
     
    4041  error-argument-count)
    4142
    42 (import scheme chicken foreign (only data-structures ->string conc))
     43  (import scheme chicken foreign (only data-structures ->string conc))
    4344
    44 (declare
    45   (fixnum)
    46   (inline)
    47   (local)
    48   (no-procedure-checks)
    49   (no-bound-checks)
    50   (constant
    51     vowel?)
    52   (bound-to-procedure
    53     ##sys#signal-hook
    54     ##sys#error-hook) )
     45  (require-library data-structures)
     46
     47  (declare
     48    (constant vowel?)
     49    (bound-to-procedure ##sys#signal-hook ##sys#error-hook) )
    5550
    5651;;;
     
    135130(define (error-structure loc obj tag #!optional argnam)
    136131        (error-argument-type loc obj (conc "structure" #\space tag) argnam) )
    137 
    138 ;;
     132 
     133(define-error-type alist "association-list")
    139134
    140135(define (error-minimum-argument-count loc argcnt cnt)
Note: See TracChangeset for help on using the changeset viewer.