adding some handy syntax modules

lib/srfi/11.module

@@ -0,0 +1,28 @@
+
+(define-module (srfi 11)
+  (export let-values let*-values)
+  (import (scheme))
+  (body
+   (define-syntax let*-values
+     (syntax-rules ()
+       ((let*-values () . body)
+        (begin . body))
+       ((let*-values (((a) expr) . rest) . body)
+        (let ((a expr)) (let*-values rest . body)))
+       ((let*-values ((params expr) . rest) . body)
+        (call-with-values (lambda () expr)
+          (lambda params (let*-values rest . body))))))
+   (define-syntax let-values
+     (syntax-rules ()
+       ((let-values ("step") (binds ...) bind expr maps () () . body)
+        (let*-values (binds ... (bind expr)) (let maps . body)))
+       ((let-values ("step") (binds ...) bind old-expr maps () ((params expr) . rest) . body)
+        (let-values ("step") (binds ... (bind old-expr)) () expr maps params rest . body))
+       ((let-values ("step") binds (bind ...) expr (maps ...) (x . y) rest . body)
+        (let-values ("step") binds (bind ... tmp) expr (maps ... (x tmp)) y rest . body))
+       ((let-values ("step") binds (bind ...) expr (maps ...) x rest . body)
+        (let-values ("step") binds (bind ... . tmp) expr (maps ... (x tmp)) () rest . body))
+       ((let-values ((params expr) . rest) . body)
+        (let-values ("step") () () expr () params rest . body))
+       ))))
+

lib/srfi/16.module

@@ -0,0 +1,24 @@
+
+(define-module (srfi 16)
+  (export case-lambda)
+  (import (scheme))
+  (body
+   (define-syntax %case
+     (syntax-rules ()
+       ((%case args len n p ((params ...) . body) . rest)
+        (if (= len (length '(params ...)))
+            (apply (lambda (params ...) . body) args)
+            (%case args len 0 () . rest)))
+       ((%case args len n (p ...) ((x . y) . body) . rest)
+        (%case args len (+ n 1) (p ... x) (y . body) . rest))
+       ((%case args len n (p ...) (y . body) . rest)
+        (if (>= len n)
+            (apply (lambda (p ... y) . body) args)
+            (%case args len 0 () . rest)))
+       ((%case args len n p)
+        (error "case-lambda: no cases matched"))))
+   (define-syntax case-lambda
+     (syntax-rules ()
+       ((case-lambda . clauses)
+        (lambda args (let ((len (length args))) (%case args len 0 () . clauses))))))))
+

lib/srfi/2.module

@@ -0,0 +1,16 @@
+
+(define-module (srfi 2)
+  (export and-let*)
+  (import (scheme))
+  (body
+   (define-syntax and-let*
+     (syntax-rules ()
+       ((and-let* () . body)
+        (begin . body))
+       ((and-let* ((var expr) . rest) . body)
+        (let ((var expr))
+          (and var (and-let* rest . body))))
+       ((and-let* ((expr) . rest) . body)
+        (let ((tmp expr))
+          (and tmp (and-let* rest . body))))))))
+

lib/srfi/26.module

@@ -0,0 +1,24 @@
+
+(define-module (srfi 26)
+  (export cut cute)
+  (import (scheme))
+  (body
+   (define-syntax %cut
+     (syntax-rules (<> <...>)
+       ((%cut e? params args)
+        (lambda params args))
+       ((%cut e? (params ...) (args ...) <> . rest)
+        (%cut e? (params ... tmp) (args ... tmp) . rest))
+       ((%cut e? (params ...) (args ...) <...>)
+        (%cut e? (params ... . tmp) (apply args ... tmp)))
+       ((%cut e? (params ...) (args ...) <...> . rest)
+        (error "cut: non-terminal <...>"))
+       ((%cut #t (params ...) (args ...) x . rest)
+        (let ((tmp x)) (%cut #t (params ...) (args ... tmp) . rest)))
+       ((%cut #f (params ...) (args ...) x . rest)
+        (%cut #t (params ...) (args ... x) . rest))))
+   (define-syntax cut
+     (syntax-rules () ((cut args ...) (%cut #f () () args ...))))
+   (define-syntax cute
+     (syntax-rules () ((cute args ...) (%cut #t () () args ...))))))
+

lib/srfi/6.module

@@ -0,0 +1,5 @@
+
+(define-module (srfi 6)
+  (export open-input-string open-output-string get-output-string)
+  (import (scheme)))
+

lib/srfi/8.module

@@ -0,0 +1,10 @@
+
+(define-module (srfi 8)
+  (export receive)
+  (import (scheme))
+  (body
+   (define-syntax receive
+     (syntax-rules ()
+       ((receive params expr . body)
+        (call-with-values (lambda () expr) (lambda params . body)))))))
+