Changeset 37752 in project


Ignore:
Timestamp:
07/04/19 13:10:17 (2 weeks ago)
Author:
juergen
Message:

curried and uncurried versions, syntax of for changed

Location:
release/5/list-comprehensions
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/list-comprehensions/tags/1.1/list-comprehensions.egg

    r37163 r37752  
    55 (test-dependencies simple-tests)
    66 (author "[[/users/juergen-lorenz|Juergen Lorenz]]")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension list-comprehensions))
    99)
  • release/5/list-comprehensions/tags/1.1/list-comprehensions.scm

    r37163 r37752  
    7171         (error 'range "wrong sign of" step))))))
    7272
    73 (define (repeat times)
    74   (lambda (x)
    75     (let loop ((k 0) (result '()))
    76       (if (= k times)
    77         result
    78         (loop (+ k 1) (cons x result))))))
    79 
    80 (define (iterate-while fn ok?)
    81   (lambda (start)
    82     (let loop ((var start) (result '()))
    83       (if (ok? var)
    84         (loop (fn var) (cons var result))
    85         (reverse result)))))
    86 
    87 (define (iterate-until fn ok?)
    88   (lambda (start)
    89     (let loop ((var start) (result '()))
    90       (if (ok? var)
    91         (reverse result)
    92         (loop (fn var) (cons var result))))))
    93 
    94 (define (iterate-times fn times)
    95   (lambda (start)
    96     (let loop ((var start) (k 0) (result '()))
    97       (if (= k times)
    98         (reverse result)
    99         (loop (fn var) (+ k 1) (cons var result))))))
    100 
    101 ;;; (for ((var lst fltr ...) ....) item)
    102 ;;; ------------------------------------
     73(define repeat
     74  (case-lambda
     75    ((times)
     76     (lambda (x)
     77       (repeat times x)))
     78    ((times x)
     79     (let loop ((k 0) (result '()))
     80       (if (= k times)
     81         result
     82         (loop (+ k 1) (cons x result)))))
     83    ))
     84
     85(define iterate-while
     86  (case-lambda
     87    ((fn ok?)
     88     (lambda (start)
     89       (iterate-while fn ok? start)))
     90    ((fn ok? start)
     91     (let loop ((var start) (result '()))
     92       (if (ok? var)
     93         (loop (fn var) (cons var result))
     94         (reverse result))))
     95    ))
     96
     97(define iterate-until
     98  (case-lambda
     99    ((fn ok?)
     100     (lambda (start)
     101       (iterate-until fn ok? start)))
     102    ((fn ok? start)
     103     (let loop ((var start) (result '()))
     104       (if (ok? var)
     105         (reverse result)
     106         (loop (fn var) (cons var result)))))
     107    ))
     108
     109(define iterate-times
     110  (case-lambda
     111    ((fn times)
     112     (lambda (start)
     113       (iterate-times fn times start)))
     114    ((fn times start)
     115     (let loop ((var start) (k 0) (result '()))
     116       (if (= k times)
     117         (reverse result)
     118         (loop (fn var) (+ k 1) (cons var result)))))
     119    ))
     120
     121;;; (for item (var lst fltr ...) ....)
     122;;; ----------------------------------
    103123(define-syntax for
    104124  (syntax-rules ()
    105    ((_ ((var lst fltr ...)) item)
     125   ((_ item (var lst fltr ...))
    106126     (let recur ((seq lst))
    107127       (if (null? seq)
     
    111131             (cons item (recur (cdr seq)))
    112132             (recur (cdr seq)))))))
    113     ((_ ((var lst fltr ...) (var1 lst1 fltr1 ...) ...) item)
     133    ((_ item (var lst fltr ...) (var1 lst1 fltr1 ...) ...)
    114134     (let recur ((seq lst))
    115135       (if (null? seq)
     
    117137         (let ((var (car seq)))
    118138           (if (and fltr ...)
    119              (append (for ((var1 lst1 fltr1 ...) ...) item)
     139             (append (for item (var1 lst1 fltr1 ...) ...)
    120140                     (recur (cdr seq)))
    121141             (recur (cdr seq)))))))
     
    143163      procedure:
    144164      (repeat times)
    145       "returns a unary procedure which repeats its only argument"
     165      (repeat times x)
     166      "returns a list with times items x")
     167    (iterate-times
     168      procedure:
     169      (iterate-times fn times)
     170      (iterate-times fn times start)
     171      "returns a list by applying fn successively to start"
    146172      "a number of times")
    147     (iterate-times
    148       procedure:
    149       (iterate-times fn times)
    150       "returns a unary procedure which iterates the function fn"
    151       "on its only argument a number of times")
    152173    (iterate-while
    153174      procedure:
    154175      (iterate-while fn ok?)
    155       "returns a unary procedure which iterates the function fn"
    156       "on its only argument while the predicate ok? returns true")
     176      (iterate-while fn ok? start)
     177      "returns a list by applying fn successively to start"
     178      "as long as ok? succeeds")
    157179    (iterate-until
    158180      procedure:
    159181      (iterate-until fn ok?)
    160       "returns a unary procedure which iterates the function fn"
    161       "on its only argument until the predicate ok? returns true")
     182      (iterate-until fn ok? start)
     183      "returns a list by applying fn successively to start"
     184      "until ok? succeeds")
    162185    (for
    163186      macro:
    164       (for ((var lst fltr ...) ....) item)
     187      (for item (var lst fltr ...) ....)
    165188      "creates a new list by binding var to each element"
    166189      "of the list lst in sequence, and if it passes the checks,"
  • release/5/list-comprehensions/tags/1.1/tests/run.scm

    r37163 r37752  
    88  (equal? (range 5 1) '(5 4 3 2))
    99  (equal? (range 1 5 2) '(1 3))
    10   (equal? ((repeat 5) 'x) '(x x x x x))
    11   (equal? ((iterate-times add1 5) 1) '(1 2 3 4 5))
    12   (equal? ((iterate-until sub1 zero?) 5) '(5 4 3 2 1))
    13   (equal? ((iterate-while sub1 positive?) 5) '(5 4 3 2 1))
    14   (equal? (for ((word '(the quick brown fox))) word)
     10  (equal? (repeat 5 'x) '(x x x x x))
     11  (equal? (iterate-times add1 5 1) '(1 2 3 4 5))
     12  (equal? (iterate-until sub1 zero? 5) '(5 4 3 2 1))
     13  (equal? (iterate-while sub1 positive? 5) '(5 4 3 2 1))
     14  (equal? (for word (word '(the quick brown fox)))
    1515          '(the quick brown fox))
    16   (equal? (for ((x '(0 1 2 3))) (add1 x)) ; map
     16  (equal? (for (add1 x) (x '(0 1 2 3))) ; map
    1717          '(1 2 3 4))
    18   (equal? (for ((x '(0 1 2 3 4 5) (odd? x))) x) ; filter
     18  (equal? (for x (x '(0 1 2 3 4 5) (odd? x))) ; filter
    1919          '(1 3 5))
    20   (equal? (for ((n '(0 1 2 3 4 5) (positive? n) (even? n)))
    21             (* 10 n))
     20  (equal? (for (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    2221          '(20 40))
    23   (equal? (for ((c '(A B C D E F G))
    24                 (k '(1 2 3 4 5 6 7 8)))
    25             (list c k))
     22  (equal? (for (list c k)
     23               (c '(A B C D E F G))
     24               (k '(1 2 3 4 5 6 7 8)))
    2625          '((A 1) (A 2) (A 3) (A 4) (A 5) (A 6) (A 7) (A 8)
    2726            (B 1) (B 2) (B 3) (B 4) (B 5) (B 6) (B 7) (B 8)
     
    3130            (F 1) (F 2) (F 3) (F 4) (F 5) (F 6) (F 7) (F 8)
    3231            (G 1) (G 2) (G 3) (G 4) (G 5) (G 6) (G 7) (G 8)))
    33   (equal? (for ((c '(A B C D E F G)
    34                    (memv c '(A G)))
    35                 (k '(1 2 3 4 5 6 7 8)
    36                    (memv k '(1 8))))
    37             (list c k))
     32  (equal? (for (list c k)
     33               (c '(A B C D E F G)
     34                  (memv c '(A G)))
     35               (k '(1 2 3 4 5 6 7 8)
     36                  (memv k '(1 8))))
    3837          '((A 1) (A 8) (G 1) (G 8)))
    39   (equal? (for ((c '(A B C D E F G))
    40                 (k '(1 2 3 4 5 6 7 8)
    41                    (memv c '(A G))
    42                    (memv k '(1 8))))
    43             (list c k))
     38  (equal? (for (list c k)
     39               (c '(A B C D E F G))
     40               (k '(1 2 3 4 5 6 7 8)
     41                  (memv c '(A G))
     42                  (memv k '(1 8))))
    4443          '((A 1) (A 8) (G 1) (G 8)))
    45   (equal? (for ((x '(A B))
    46                 (y '(1 2))
    47                 (z '(#f #t)))
    48             (list x y z))
     44  (equal? (for (list x y z)
     45               (x '(A B))
     46               (y '(1 2))
     47               (z '(#f #t)))
    4948          '((A 1 #f) (A 1 #t) (A 2 #f) (A 2 #t)
    5049            (B 1 #f) (B 1 #t) (B 2 #f) (B 2 #t)))
  • release/5/list-comprehensions/trunk/list-comprehensions.egg

    r37163 r37752  
    55 (test-dependencies simple-tests)
    66 (author "[[/users/juergen-lorenz|Juergen Lorenz]]")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension list-comprehensions))
    99)
  • release/5/list-comprehensions/trunk/list-comprehensions.scm

    r37163 r37752  
    7171         (error 'range "wrong sign of" step))))))
    7272
    73 (define (repeat times)
    74   (lambda (x)
    75     (let loop ((k 0) (result '()))
    76       (if (= k times)
    77         result
    78         (loop (+ k 1) (cons x result))))))
    79 
    80 (define (iterate-while fn ok?)
    81   (lambda (start)
    82     (let loop ((var start) (result '()))
    83       (if (ok? var)
    84         (loop (fn var) (cons var result))
    85         (reverse result)))))
    86 
    87 (define (iterate-until fn ok?)
    88   (lambda (start)
    89     (let loop ((var start) (result '()))
    90       (if (ok? var)
    91         (reverse result)
    92         (loop (fn var) (cons var result))))))
    93 
    94 (define (iterate-times fn times)
    95   (lambda (start)
    96     (let loop ((var start) (k 0) (result '()))
    97       (if (= k times)
    98         (reverse result)
    99         (loop (fn var) (+ k 1) (cons var result))))))
    100 
    101 ;;; (for ((var lst fltr ...) ....) item)
    102 ;;; ------------------------------------
     73(define repeat
     74  (case-lambda
     75    ((times)
     76     (lambda (x)
     77       (repeat times x)))
     78    ((times x)
     79     (let loop ((k 0) (result '()))
     80       (if (= k times)
     81         result
     82         (loop (+ k 1) (cons x result)))))
     83    ))
     84
     85(define iterate-while
     86  (case-lambda
     87    ((fn ok?)
     88     (lambda (start)
     89       (iterate-while fn ok? start)))
     90    ((fn ok? start)
     91     (let loop ((var start) (result '()))
     92       (if (ok? var)
     93         (loop (fn var) (cons var result))
     94         (reverse result))))
     95    ))
     96
     97(define iterate-until
     98  (case-lambda
     99    ((fn ok?)
     100     (lambda (start)
     101       (iterate-until fn ok? start)))
     102    ((fn ok? start)
     103     (let loop ((var start) (result '()))
     104       (if (ok? var)
     105         (reverse result)
     106         (loop (fn var) (cons var result)))))
     107    ))
     108
     109(define iterate-times
     110  (case-lambda
     111    ((fn times)
     112     (lambda (start)
     113       (iterate-times fn times start)))
     114    ((fn times start)
     115     (let loop ((var start) (k 0) (result '()))
     116       (if (= k times)
     117         (reverse result)
     118         (loop (fn var) (+ k 1) (cons var result)))))
     119    ))
     120
     121;;; (for item (var lst fltr ...) ....)
     122;;; ----------------------------------
    103123(define-syntax for
    104124  (syntax-rules ()
    105    ((_ ((var lst fltr ...)) item)
     125   ((_ item (var lst fltr ...))
    106126     (let recur ((seq lst))
    107127       (if (null? seq)
     
    111131             (cons item (recur (cdr seq)))
    112132             (recur (cdr seq)))))))
    113     ((_ ((var lst fltr ...) (var1 lst1 fltr1 ...) ...) item)
     133    ((_ item (var lst fltr ...) (var1 lst1 fltr1 ...) ...)
    114134     (let recur ((seq lst))
    115135       (if (null? seq)
     
    117137         (let ((var (car seq)))
    118138           (if (and fltr ...)
    119              (append (for ((var1 lst1 fltr1 ...) ...) item)
     139             (append (for item (var1 lst1 fltr1 ...) ...)
    120140                     (recur (cdr seq)))
    121141             (recur (cdr seq)))))))
     
    143163      procedure:
    144164      (repeat times)
    145       "returns a unary procedure which repeats its only argument"
     165      (repeat times x)
     166      "returns a list with times items x")
     167    (iterate-times
     168      procedure:
     169      (iterate-times fn times)
     170      (iterate-times fn times start)
     171      "returns a list by applying fn successively to start"
    146172      "a number of times")
    147     (iterate-times
    148       procedure:
    149       (iterate-times fn times)
    150       "returns a unary procedure which iterates the function fn"
    151       "on its only argument a number of times")
    152173    (iterate-while
    153174      procedure:
    154175      (iterate-while fn ok?)
    155       "returns a unary procedure which iterates the function fn"
    156       "on its only argument while the predicate ok? returns true")
     176      (iterate-while fn ok? start)
     177      "returns a list by applying fn successively to start"
     178      "as long as ok? succeeds")
    157179    (iterate-until
    158180      procedure:
    159181      (iterate-until fn ok?)
    160       "returns a unary procedure which iterates the function fn"
    161       "on its only argument until the predicate ok? returns true")
     182      (iterate-until fn ok? start)
     183      "returns a list by applying fn successively to start"
     184      "until ok? succeeds")
    162185    (for
    163186      macro:
    164       (for ((var lst fltr ...) ....) item)
     187      (for item (var lst fltr ...) ....)
    165188      "creates a new list by binding var to each element"
    166189      "of the list lst in sequence, and if it passes the checks,"
  • release/5/list-comprehensions/trunk/tests/run.scm

    r37163 r37752  
    88  (equal? (range 5 1) '(5 4 3 2))
    99  (equal? (range 1 5 2) '(1 3))
    10   (equal? ((repeat 5) 'x) '(x x x x x))
    11   (equal? ((iterate-times add1 5) 1) '(1 2 3 4 5))
    12   (equal? ((iterate-until sub1 zero?) 5) '(5 4 3 2 1))
    13   (equal? ((iterate-while sub1 positive?) 5) '(5 4 3 2 1))
    14   (equal? (for ((word '(the quick brown fox))) word)
     10  (equal? (repeat 5 'x) '(x x x x x))
     11  (equal? (iterate-times add1 5 1) '(1 2 3 4 5))
     12  (equal? (iterate-until sub1 zero? 5) '(5 4 3 2 1))
     13  (equal? (iterate-while sub1 positive? 5) '(5 4 3 2 1))
     14  (equal? (for word (word '(the quick brown fox)))
    1515          '(the quick brown fox))
    16   (equal? (for ((x '(0 1 2 3))) (add1 x)) ; map
     16  (equal? (for (add1 x) (x '(0 1 2 3))) ; map
    1717          '(1 2 3 4))
    18   (equal? (for ((x '(0 1 2 3 4 5) (odd? x))) x) ; filter
     18  (equal? (for x (x '(0 1 2 3 4 5) (odd? x))) ; filter
    1919          '(1 3 5))
    20   (equal? (for ((n '(0 1 2 3 4 5) (positive? n) (even? n)))
    21             (* 10 n))
     20  (equal? (for (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    2221          '(20 40))
    23   (equal? (for ((c '(A B C D E F G))
    24                 (k '(1 2 3 4 5 6 7 8)))
    25             (list c k))
     22  (equal? (for (list c k)
     23               (c '(A B C D E F G))
     24               (k '(1 2 3 4 5 6 7 8)))
    2625          '((A 1) (A 2) (A 3) (A 4) (A 5) (A 6) (A 7) (A 8)
    2726            (B 1) (B 2) (B 3) (B 4) (B 5) (B 6) (B 7) (B 8)
     
    3130            (F 1) (F 2) (F 3) (F 4) (F 5) (F 6) (F 7) (F 8)
    3231            (G 1) (G 2) (G 3) (G 4) (G 5) (G 6) (G 7) (G 8)))
    33   (equal? (for ((c '(A B C D E F G)
    34                    (memv c '(A G)))
    35                 (k '(1 2 3 4 5 6 7 8)
    36                    (memv k '(1 8))))
    37             (list c k))
     32  (equal? (for (list c k)
     33               (c '(A B C D E F G)
     34                  (memv c '(A G)))
     35               (k '(1 2 3 4 5 6 7 8)
     36                  (memv k '(1 8))))
    3837          '((A 1) (A 8) (G 1) (G 8)))
    39   (equal? (for ((c '(A B C D E F G))
    40                 (k '(1 2 3 4 5 6 7 8)
    41                    (memv c '(A G))
    42                    (memv k '(1 8))))
    43             (list c k))
     38  (equal? (for (list c k)
     39               (c '(A B C D E F G))
     40               (k '(1 2 3 4 5 6 7 8)
     41                  (memv c '(A G))
     42                  (memv k '(1 8))))
    4443          '((A 1) (A 8) (G 1) (G 8)))
    45   (equal? (for ((x '(A B))
    46                 (y '(1 2))
    47                 (z '(#f #t)))
    48             (list x y z))
     44  (equal? (for (list x y z)
     45               (x '(A B))
     46               (y '(1 2))
     47               (z '(#f #t)))
    4948          '((A 1 #f) (A 1 #t) (A 2 #f) (A 2 #t)
    5049            (B 1 #f) (B 1 #t) (B 2 #f) (B 2 #t)))
Note: See TracChangeset for help on using the changeset viewer.