diff options
| -rw-r--r-- | srfi-229.sld | 38 | ||||
| -rw-r--r-- | srfi-259.egg | 8 | ||||
| -rw-r--r-- | srfi-259.release-info | 1 | ||||
| -rw-r--r-- | tests/run.scm | 77 |
4 files changed, 121 insertions, 3 deletions
diff --git a/srfi-229.sld b/srfi-229.sld new file mode 100644 index 0000000..54bbc91 --- /dev/null +++ b/srfi-229.sld @@ -0,0 +1,38 @@ +#| 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 229) + (import (scheme base) (srfi 259) (scheme case-lambda)) + (export lambda/tag case-lambda/tag procedure/tag? procedure-tag) + (begin + (define-procedure-tag %procedure-tag %procedure/tag? procedure-tag) + (define (procedure/tag? proc) + (and (procedure? proc) (%procedure/tag? proc))) + (define-syntax case-lambda/tag + (syntax-rules () + ((_ expression clauses ...) + (%procedure-tag expression (case-lambda clauses ...))))) + (define-syntax lambda/tag + (syntax-rules () + ((_ expression formals body ...) + (%procedure-tag expression (lambda formals body ...))))))) diff --git a/srfi-259.egg b/srfi-259.egg index 87a4b77..5581e4d 100644 --- a/srfi-259.egg +++ b/srfi-259.egg @@ -1,6 +1,6 @@ ((author "Peter McGoron") - (version "1.0.0") - (synopsis "Tagged procedures with type safety") + (version "1.1.0") + (synopsis "Tagged procedures with type safety (with SRFI-229 compatability)") (category data) (license "MIT") (dependencies r7rs integer-map) @@ -12,4 +12,8 @@ (extension srfi.259.extensions (source "extensions.sld") (source-dependencies "lowlevel.scm" "internal.scm") + (csc-options "-R" "r7rs" "-X" "r7rs" "-O3")) + (extension srfi-229 + (source "srfi-229.sld") + (component-dependencies srfi-259) (csc-options "-R" "r7rs" "-X" "r7rs" "-O3")))) diff --git a/srfi-259.release-info b/srfi-259.release-info index 49bbc8f..0e3f006 100644 --- a/srfi-259.release-info +++ b/srfi-259.release-info @@ -1,6 +1,7 @@ (repo git "https://software.mcgoron.com/peter/srfi-259-egg.git") (uri targz "https://files.mcgoron.com/chicken/srfi-259-egg/{egg-release}-{chicken-release}.tar.gz") +(release "1.1.0") (release "1.0.0") (release "0.10.0") (release "0.9.2") diff --git a/tests/run.scm b/tests/run.scm index ce927ff..f965ba3 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -22,7 +22,7 @@ | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |# -(import r7rs test (chicken condition) (chicken gc) (srfi 259 extensions)) +(import r7rs test (chicken condition) (chicken gc) (srfi 259 extensions) (srfi 229)) (test-begin "SRFI 259") @@ -133,4 +133,79 @@ (test "does not affect the one with no tag" 10 (try-this 10)) (test-end "SRFI 259 extensions") + +;; Copyright (C) Marc Nieper-Wißkirchen (2021). All Rights Reserved. + +;; 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 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. + + +(test-begin "SRFI-229") + +(define f + (lambda/tag 42 + (x) + (* x x))) + +(test #t (procedure/tag? f)) +(test 9 (f 3)) +(test 42 (procedure-tag f)) + +(define f* + (lambda/tag 43 + (x) + (* x x))) + +(test #f (eqv? f f*)) + +(define g + (let ((y 10)) + (lambda/tag y () + (set! y (+ y 1)) + y))) + +(test 10 (procedure-tag g)) +(test 10 (let ((y 9)) (procedure-tag g))) +(test 11 (g)) +(test 10 (procedure-tag g)) + +(define h + (let ((box (vector #f))) + (case-lambda/tag box + (() (vector-ref box 0)) + ((val) (vector-set! box 0 val))))) + +(h 1) +(test 1 (vector-ref (procedure-tag h) 0)) +(test 1 (h)) + +(test-begin "SRFI-229 and 259 do not conflict") +(let ((proc (tag-foo 'foo (lambda/tag 'bar (x) x)))) + (test-assert (tag-foo? proc)) + (test-assert (procedure/tag? proc)) + (test 'foo (get-tag-foo proc)) + (test 'bar (procedure-tag proc))) +(test-end) + + +(test-end) + + (test-exit) |