[srfi-26
atsmyles@earthlink.net**20090624203117] hunk ./compile-r6rs-libs 25
-     (path-expand* "libs/srfi/" "srfi-0.scm" "srfi-2.scm" "srfi-21.scm" "srfi-18.scm" "srfi-23.scm" "srfi-27.scm" "srfi-39.scm" "srfi-4.scm" "srfi-6.scm" "srfi-66.scm" "srfi-69.scm" "srfi-8.scm" "srfi-88.scm" "srfi-89.scm" "srfi-99.scm" "srfi-9.scm"))
+     (path-expand* "libs/srfi/" "srfi-0.scm" "srfi-2.scm" "srfi-21.scm" "srfi-18.scm" "srfi-23.scm" "srfi-26.scm" "srfi-27.scm" "srfi-39.scm" "srfi-4.scm" "srfi-6.scm" "srfi-66.scm" "srfi-69.scm" "srfi-8.scm" "srfi-88.scm" "srfi-89.scm" "srfi-99.scm" "srfi-9.scm"))
addfile ./libs/srfi/srfi-26.scm
hunk ./libs/srfi/srfi-26.scm 1
+;; REFERENCE IMPLEMENTATION FOR SRFI-26 "CUT"
+;; ==========================================
+;; adapted from the posting by Al Petrofsky <al@petrofsky.org>
+;; placed in the public domain
+
+(library (srfi :26 cut)
+(export cut cute)
+(import (rnrs base))
+
+(define-syntax srfi-26-internal-cut
+  (syntax-rules (<> <...>)
+
+    ;; construct fixed- or variable-arity procedure:
+    ;;   (begin proc) throws an error if proc is not an <expression>
+    ((srfi-26-internal-cut (slot-name ...) (proc arg ...))
+     (lambda (slot-name ...) ((begin proc) arg ...)))
+    ((srfi-26-internal-cut (slot-name ...) (proc arg ...) <...>)
+     (lambda (slot-name ... . rest-slot) (apply proc arg ... rest-slot)))
+
+    ;; process one slot-or-expr
+    ((srfi-26-internal-cut (slot-name ...)   (position ...)      <>  . se)
+     (srfi-26-internal-cut (slot-name ... x) (position ... x)        . se))
+    ((srfi-26-internal-cut (slot-name ...)   (position ...)      nse . se)
+     (srfi-26-internal-cut (slot-name ...)   (position ... nse)      . se))))
+
+; (srfi-26-internal-cute slot-names nse-bindings combination . se)
+;   transformer used internally
+;     slot-names     : the internal names of the slots
+;     nse-bindings   : let-style bindings for the non-slot expressions.
+;     combination    : procedure being specialized, followed by its arguments
+;     se             : slots-or-exprs, the qualifiers of the macro
+
+(define-syntax srfi-26-internal-cute
+  (syntax-rules (<> <...>)
+
+    ;; If there are no slot-or-exprs to process, then:
+    ;; construct a fixed-arity procedure,
+    ((srfi-26-internal-cute
+      (slot-name ...) nse-bindings (proc arg ...))
+     (let nse-bindings (lambda (slot-name ...) (proc arg ...))))
+    ;; or a variable-arity procedure
+    ((srfi-26-internal-cute
+      (slot-name ...) nse-bindings (proc arg ...) <...>)
+     (let nse-bindings (lambda (slot-name ... . x) (apply proc arg ... x))))
+
+    ;; otherwise, process one slot:
+    ((srfi-26-internal-cute
+      (slot-name ...)         nse-bindings  (position ...)   <>  . se)
+     (srfi-26-internal-cute
+      (slot-name ... x)       nse-bindings  (position ... x)     . se))
+    ;; or one non-slot expression
+    ((srfi-26-internal-cute
+      slot-names              nse-bindings  (position ...)   nse . se)
+     (srfi-26-internal-cute
+      slot-names ((x nse) . nse-bindings) (position ... x)       . se))))
+
+; exported syntax
+
+(define-syntax cut
+  (syntax-rules ()
+    ((cut . slots-or-exprs)
+     (srfi-26-internal-cut () () . slots-or-exprs))))
+
+(define-syntax cute
+  (syntax-rules ()
+    ((cute . slots-or-exprs)
+     (srfi-26-internal-cute () () () . slots-or-exprs))))
+)
+
+(library (srfi :26) (export cut cute) (import (srfi :26 cut)))