12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758 |
- (import
- (ice-9 exceptions)
- (srfi srfi-9 gnu))
- (define-immutable-record-type <position>
- (construct-position row col)
- position?
- (row position-row set-position-row)
- (col position-col set-position-col))
- ;; Here we define a new, a custom, exception type, by giving the
- ;; constructor of an exception type a name, which conforms to the
- ;; style of other exception constructor names.
- (define make-inappropriate-value-exception
- ;; record-constructor is a procedure, which will return the
- ;; constructor for any record.
- (record-constructor
- ;; Create an exception type, which is a record. This record has a
- ;; constructor, which we can name using define for example.
- (make-exception-type
- ;; name of the new exception type
- '&inappropriate-value
- ;; parent exception type
- &programming-error
- ;; list of values the constructor of the exception takes and their
- ;; names in the record
- '(val))))
- (define make-position
- (λ (row col)
- (cond
- [(not
- (and (integer? row)
- (or (zero? row) (positive? row))))
- (raise-exception
- (make-exception
- (make-inappropriate-value-exception row)
- (make-exception-with-message "row must be a zero or a positive integer")
- (make-exception-with-irritants (list row))
- (make-exception-with-origin 'make-position)))]
- [(not
- (and (integer? col)
- (or (zero? col) (positive? col))))
- (raise-exception
- (make-exception
- (make-inappropriate-value-exception col)
- (make-exception-with-message "col must be a zero or a positive integer")
- (make-exception-with-irritants (list col))
- (make-exception-with-origin 'make-position)))]
- [else
- (make-position row col)])))
- (make-position -1 0)
|