add lambda/this

1 files changed, 0 insertions, 92 deletions

diff --git a/srfi-259.sld b/srfi-259.sld
deleted file mode 100644
index 649f42d..0000000
--- a/srfi-259.sld
+++ /dev/null
@@ -1,92 +0,0 @@
-#| Copyright (C) 2025 Peter McGoron
- |
- | Permission is hereby granted, free of charge, to any person obtaining a
- | copy of this software and associated documentation files (the
- | "Software"), to deal in the Software without restriction, including
- | without limitation the rights to use, copy, modify, merge, publish,
- | distribute, sublicense, and/or sell copies of the Software, and to
- | permit persons to whom the Software is furnished to do so, subject to
- | the following conditions:
- |
- | The above copyright notice and this permission notice (including the
- | next paragraph) shall be included in all copies or substantial portions
- | of the Software.
- |
- | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
- | OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
- | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
- | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
- | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
- |#
-
-(define-library (srfi 259)
-  (import (scheme base) (scheme write)
-          integer-map
-          (chicken base)
-          (chicken foreign)
-          (chicken condition)
-          (chicken fixnum))
-  (export define-procedure-tag)
-  (include "lowlevel.scm")
-  (begin
-    (define is-type? (condition-predicate 'type))
-    (define-syntax define-procedure-tag
-      (syntax-rules ()
-        ((define-procedure-tag constructor predicate? accessor)
-         ;; This uses `define-values` instead of a define for `id` because
-         ;; Chicken breaks hygiene for top-level `define` names.
-         (define-values (constructor predicate? accessor)
-           (let ((id (unique-id)))
-             (values
-              ;; constructor
-              (lambda (tag proc)
-                (handle-exceptions E (abort
-                                      (make-composite-condition
-                                       (make-property-condition
-                                        'exn
-                                        'location
-                                        (quote constructor)
-                                        'arguments
-                                        (list proc)
-                                        'message
-                                        "not a procedure")
-                                       E))
-                  (set-tagged-mapping proc id tag)))
-              ;; predicate?
-              (lambda (proc)
-                (cond
-                  ((not (procedure? proc)) #f)
-                  ((get-mapping proc)
-                   => (cut fxmapping-contains? <> id))
-                  (else #f)))
-              ;; accessor
-              (lambda (proc)
-                (define map
-                  (handle-exceptions E (abort
-                                        (make-composite-condition
-                                         (make-property-condition
-                                          'exn
-                                          'location
-                                          (quote accessor)
-                                          'arguments
-                                          (list proc)
-                                          'message
-                                          "not a procedure")
-                                         E))
-                    (get-mapping proc)))
-                (define (raise-error)
-                  (abort
-                   (make-composite-condition
-                    (make-property-condition 'exn
-                                             'location
-                                             (quote accessor)
-                                             'arguments
-                                             (list proc)
-                                             'message
-                                             "tag was not found")
-                    (make-property-condition 'assertion))))
-                (if map
-                    (fxmapping-ref map id raise-error)
-                    (raise-error)))))))))))
\ No newline at end of file