Permalink
Browse files

SRFI-11 and very basic test for it

  • Loading branch information...
1 parent eeb5ddd commit fb89b79486f5cb92d6bf6b2b181001ecef6a4946 @alvatar alvatar committed Jun 10, 2010
Showing with 64 additions and 0 deletions.
  1. +41 −0 srfi/11.scm
  2. +23 −0 srfi/test/11.scm
View
@@ -0,0 +1,41 @@
+;; Copyright (C) Lars T Hansen (1999). All Rights Reserved.
+;; This code is in the public domain.
+
+;;
+;; Adapted to Blackhole for Gambit by Álvaro Castro-Castilla
+;; (no changes needed from reference implementation)
+
+(define-syntax let-values
+ (syntax-rules ()
+ ((let-values (?binding ...) ?body0 ?body1 ...)
+ (let-values "bind" (?binding ...) () (begin ?body0 ?body1 ...)))
+
+ ((let-values "bind" () ?tmps ?body)
+ (let ?tmps ?body))
+
+ ((let-values "bind" ((?b0 ?e0) ?binding ...) ?tmps ?body)
+ (let-values "mktmp" ?b0 ?e0 () (?binding ...) ?tmps ?body))
+
+ ((let-values "mktmp" () ?e0 ?args ?bindings ?tmps ?body)
+ (call-with-values
+ (lambda () ?e0)
+ (lambda ?args
+ (let-values "bind" ?bindings ?tmps ?body))))
+
+ ((let-values "mktmp" (?a . ?b) ?e0 (?arg ...) ?bindings (?tmp ...) ?body)
+ (let-values "mktmp" ?b ?e0 (?arg ... x) ?bindings (?tmp ... (?a x)) ?body))
+
+ ((let-values "mktmp" ?a ?e0 (?arg ...) ?bindings (?tmp ...) ?body)
+ (call-with-values
+ (lambda () ?e0)
+ (lambda (?arg ... . x)
+ (let-values "bind" ?bindings (?tmp ... (?a x)) ?body))))))
+
+(define-syntax let*-values
+ (syntax-rules ()
+ ((let*-values () ?body0 ?body1 ...)
+ (begin ?body0 ?body1 ...))
+
+ ((let*-values (?binding0 ?binding1 ...) ?body0 ?body1 ...)
+ (let-values (?binding0)
+ (let*-values (?binding1 ...) ?body0 ?body1 ...)))))
View
@@ -0,0 +1,23 @@
+(import ../64)
+(import ../11)
+
+(test-begin "srfi-11" 3)
+
+(test-equal
+ (let-values (((a b) (values 1 2))
+ ((c d) (values 3 4)))
+ (list a b c d))
+ (list 1 2 3 4))
+
+(test-error
+ (let-values (((a b) (values 1 2))
+ ((c d e) (values a b 3)))
+ (list a b c d e)))
+
+(test-equal
+ (let*-values (((a b) (values 1 2))
+ ((c d e) (values a b 3)))
+ (list a b c d e))
+ (list 1 2 1 2 3))
+
+(test-end "srfi-11")

0 comments on commit fb89b79

Please sign in to comment.