www

commit cde9f24a4d3baa047dc92665961ccc47001f0767
parent 6ee1fad47877e11c0d385930ed7987ef17b3c07e
Author: AlexKnauth <alexander@knauth.org>
Date:   Mon, 30 Mar 2015 17:05:28 -0400

convert kw-map.rkt to sweet-exp

Diffstat:
M
kw-utils/kw-map.rkt
 | 
75
++++++++++++++++++++++++++++++++++++++-------------------------------------

1 file changed, 38 insertions(+), 37 deletions(-)
diff --git a/kw-utils/kw-map.rkt b/kw-utils/kw-map.rkt
@@ -1,41 +1,42 @@
-#lang racket/base
+#lang sweet-exp racket/base
 
-(provide map)
+provide map
 
-(require (only-in racket/base [map rkt:map])
-         racket/list
-         "keyword-lambda.rkt"
-         )
-(module+ test
-  (require rackunit racket/math))
+require (only-in racket/base [map rkt:map])
+        racket/list
+        my-cond/iffy
+        "keyword-lambda.rkt"
+module+ test
+  require rackunit
+          racket/math
 
-(define map
-  (keyword-lambda (kws kw-args f . args)
-    (cond
-      [(and (empty? args) (empty? kw-args))
-       (error 'map "expected at least one list argument")]
-      [(empty? kw-args)
-       (apply rkt:map f args)]
-      [(empty? args)
-       (for/list ([kw-args (in-list (apply rkt:map list kw-args))])
-         (keyword-apply f kws kw-args '()))]
-      [else
-       (define argss (apply rkt:map list args))
-       (define kw-argss (apply rkt:map list kw-args))
-       (unless (= (length argss) (length kw-argss))
-         (error 'map "all lists must have same size, given ~v and ~v with different lengths"
-                (first args) (first kw-args)))
-       (for/list ([args (in-list argss)]
-                  [kw-args (in-list kw-argss)])
-         (keyword-apply f kws kw-args args))])))
+define map
+  keyword-lambda (kws kw-args f . args)
+    my-cond
+      if {empty?(args) and empty?(kw-args)}
+        error('map "expected at least one list argument")
+      else-if empty?(kw-args)
+        apply(rkt:map f args)
+      else-if empty?(args)
+        for/list ([kw-args in-list(apply(rkt:map list kw-args))])
+          keyword-apply(f kws kw-args '())
+      else
+        define argss apply(rkt:map list args)
+        define kw-argss apply(rkt:map list kw-args)
+        unless {length(argss) = length(kw-argss)}
+          error('map "all lists must have same size, given ~v and ~v with different lengths"
+                first(args) first(kw-args))
+        for/list ([args in-list(argss)]
+                  [kw-args in-list(kw-argss)])
+          keyword-apply(f kws kw-args args)
+
+module+ test
+  define (KE #:m m #:v v)
+    {1/2 * m * sqr(v)}
+  check-equal? (map KE #:m '(2 2 2 2) #:v '(0 1 2 3))
+               '(0 1 4 9)
+  check-equal? (map KE #:m '(0 1 2 3) #:v '(0 1 2 3))
+               '(0 1/2 4 27/2)
+  check-equal? (map KE #:m '(1 2 1/2 2/9) #:v '(0 1 2 3))
+               '(0 1 1 1)
 
-(module+ test
-  (define (KE #:m m #:v v)
-    (* 1/2 m (sqr v)))
-  (check-equal? (map KE #:m '(2 2 2 2) #:v '(0 1 2 3))
-                '(0 1 4 9))
-  (check-equal? (map KE #:m '(0 1 2 3) #:v '(0 1 2 3))
-                '(0 1/2 4 27/2))
-  (check-equal? (map KE #:m '(1 2 1/2 2/9) #:v '(0 1 2 3))
-                '(0 1 1 1))
-  )