diff --git a/lib/srfi/229.sld b/lib/srfi/229.sld
new file mode 100644
index 00000000..3018da15
--- /dev/null
+++ b/lib/srfi/229.sld
@@ -0,0 +1,29 @@
+
+(define-library (srfi 229)
+  (import (scheme base) (scheme case-lambda) (chibi ast))
+  (export case-lambda/tag lambda/tag procedure/tag? procedure-tag)
+  (begin
+    (define procedure-tag-object (list 'procedure-tag))
+    (define (procedure->tagged f tag)
+      (make-procedure (procedure-flags f)
+                      (procedure-arity f)
+                      (procedure-code f)
+                      (vector-append (or (procedure-vars f) '#())
+                                     (vector tag procedure-tag-object))))
+    (define-syntax lambda/tag
+      (syntax-rules ()
+        ((lambda/tag tag-expr formals . body)
+         (procedure->tagged (lambda formals . body) tag-expr))))
+    (define-syntax case-lambda/tag
+      (syntax-rules ()
+        ((case-lambda/tag tag-expr . clauses)
+         (procedure->tagged (case-lambda . clauses) tag-expr))))
+    (define (procedure/tag? f)
+      (and (procedure? f)
+           (let ((vars (procedure-vars f)))
+             (and (vector? vars)
+                  (eq? procedure-tag-object
+                       (vector-ref vars (- (vector-length vars) 1)))))))
+    (define (procedure-tag f)
+      (let ((vars (procedure-vars f)))
+        (vector-ref vars (- (vector-length vars) 2))))))
diff --git a/lib/srfi/229/test.sld b/lib/srfi/229/test.sld
new file mode 100644
index 00000000..754f3f9b
--- /dev/null
+++ b/lib/srfi/229/test.sld
@@ -0,0 +1,22 @@
+
+(define-library (srfi 229 test)
+  (import (scheme base) (srfi 229) (chibi test))
+  (export run-tests)
+  (begin
+    (define (run-tests . o)
+      (test-begin "(srfi 229)")
+      (let ()
+        (define f
+          (lambda/tag 42
+                      (x)
+                      (* x x)))
+        (define f*
+          (lambda/tag 43
+                      (x)
+                      (* x x)))
+        (test-assert (procedure/tag? f))
+        (test 9 (f 3))
+        (test 42 (procedure-tag f))
+        (test-not (eqv? f f*))
+        (test 43 (procedure-tag f*)))
+      (test-end))))