Changeset 34400 in project


Ignore:
Timestamp:
08/27/17 03:59:50 (3 months ago)
Author:
kon
Message:

re-flow

Location:
release/4/combinators/trunk
Files:
9 edited
1 moved

Legend:

Unmodified
Added
Removed
  • release/4/combinators/trunk/arguments-helpers.inc.scm

    r34399 r34400  
    1 ;;;; arguments-helpers.inc
     1;;;; arguments-helpers.inc.scm
    22;;;; Kon Lovett, Jul '10
    33
     
    77  ; assume the length of fns is << so recursion depth is also <<
    88  (let recur ((fns fns))
    9     (if (null? fns) xs
     9    (if (null? fns)
     10      xs
    1011      (apply (car fns) (recur (cdr fns))) ) ) )
    1112
  • release/4/combinators/trunk/bi-combinators.scm

    r19028 r34400  
    44(module bi-combinators
    55
    6   (;export
    7     bi bi2 bi3 bi-each bi-all)
     6(;export
     7  bi bi2 bi3 bi-each bi-all)
    88
    9   (import
    10     scheme
    11     chicken)
     9(import
     10  scheme
     11  chicken)
    1212
    1313#|
  • release/4/combinators/trunk/combinators.meta

    r26672 r34400  
    99 (depends (setup-helper "1.5.2"))
    1010 (test-depends test)
    11  (files "logical-combinators.scm" "section-combinators.scm" "combinators.meta" "combinators.release-info" "uni-combinators.scm" "generic-section-combinators.scm" "combinators.setup" "arguments-helpers.inc" "stack-combinators.scm" "tri-combinators.scm" "bi-combinators.scm" "sort-combinators.scm" "tests/run.scm") )
     11 (files
     12   "arguments-helpers.inc.scm"
     13   "logical-combinators.scm"
     14   "section-combinators.scm"
     15   "sort-combinators.scm"
     16   "generic-section-combinators.scm"
     17   "stack-combinators.scm"
     18   "uni-combinators.scm" "bi-combinators.scm" "tri-combinators.scm"
     19   "combinators.meta" "combinators.setup" "combinators.release-info"
     20   "tests/run.scm") )
  • release/4/combinators/trunk/generic-section-combinators.scm

    r19028 r34400  
    22;;;; Kon Lovett, Jul '10
    33
    4 !IN PROGRESS!
     4;; Issues
     5;;
     6;; !IN PROGRESS!
    57
    68(module generic-section-combinators
    79
    8   (;export
    9     left-hook-each right-hook-each
    10     left-hook-each+ right-hook-each+
    11     left-hook-argument-chain right-hook-argument-chain
    12     left-hook-argument-chain+ right-hook-argument-chain+
    13     fork-each fork-all
    14     fork-each+ fork-all+)
    15 
    16   (import
    17     (except scheme map)
    18     chicken
    19     (only data-structures identity)
    20     (only srfi-1 circular-list map))
    21 
    22   (require-library data-structures srfi-1)
    23 
    24   (declare
    25     (type
    26       (left-hook-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    27       (right-hook-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    28       (left-hook-each+ (procedure (#!rest) (procedure (#!rest) *)))
    29       (right-hook-each+ (procedure (#!rest) (procedure (#!rest) *)))
    30       (left-hook-argument-chain (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    31       (right-hook-argument-chain (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    32       (left-hook-argument-chain+ (procedure (#!rest) (procedure (#!rest) *)))
    33       (right-hook-argument-chain+ (procedure (#!rest) (procedure (#!rest) *)))
    34       (fork-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    35       (fork-all (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    36       (fork-each+ (procedure (#!rest) (procedure (#!rest) *)))
    37       (fork-all+ (procedure (#!rest) (procedure (#!rest) *))) ))
    38 
    39   (include "arguments-helpers.inc")
     10(;export
     11  left-hook-each right-hook-each
     12  left-hook-each+ right-hook-each+
     13  left-hook-argument-chain right-hook-argument-chain
     14  left-hook-argument-chain+ right-hook-argument-chain+
     15  fork-each fork-all
     16  fork-each+ fork-all+)
     17
     18(import
     19  (except scheme map)
     20  chicken
     21  (only data-structures identity)
     22  (only srfi-1 circular-list map))
     23
     24(require-library data-structures srfi-1)
     25
     26(declare
     27  (type
     28    (left-hook-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     29    (right-hook-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     30    (left-hook-each+ (procedure (#!rest) (procedure (#!rest) *)))
     31    (right-hook-each+ (procedure (#!rest) (procedure (#!rest) *)))
     32    (left-hook-argument-chain (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     33    (right-hook-argument-chain (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     34    (left-hook-argument-chain+ (procedure (#!rest) (procedure (#!rest) *)))
     35    (right-hook-argument-chain+ (procedure (#!rest) (procedure (#!rest) *)))
     36    (fork-each (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     37    (fork-all (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     38    (fork-each+ (procedure (#!rest) (procedure (#!rest) *)))
     39    (fork-all+ (procedure (#!rest) (procedure (#!rest) *))) ))
     40
     41(include "arguments-helpers.inc")
    4042
    4143;;; Hook
     
    4749  (lambda xs ((X-funcs (cons list fns)) xs)) )
    4850
     51#|
    4952?????
    5053(left-hook-X c fn0 ... fnn) = (arguments-chain c (arguments-X fn0 ... fnn list))
    5154(right-hook-X c fn0 ... fnn) = (arguments-chain c (arguments-X list fn0 ... fnn))
     55|#
    5256
    5357;; left-hook-each
     
    5862
    5963(define (left-hook-each c . fns)
    60   (if (null? fns) (lambda xs (apply c xs))
     64  (if (null? fns)
     65    (lambda xs (apply c xs))
    6166    (let ((fn (each-func fns)))
    6267      (lambda xs (apply c (append (list (fn xs)) xs))) ) ) )
     
    6974
    7075(define (right-hook-each c . fns)
    71   (if (null? fns) (lambda xs (apply c xs))
     76  (if (null? fns)
     77    (lambda xs (apply c xs))
    7278    (let ((fn (each-func fns)))
    7379      (lambda xs (apply c (append xs (list (fn xs))))) ) ) )
     
    8086
    8187(define (left-hook-each+ . fns)
    82   (if (null? fns) (lambda (c) (left-hook-each+ c))
    83     (let ((c (car fns)) (fns (cdr fns)))
    84       (if (null? fns) (lambda fns (apply left-hook-each+ c fns))
     88  (if (null? fns)
     89    (lambda (c) (left-hook-each+ c))
     90    (let ((c (car fns)) (fns (cdr fns)))
     91      (if (null? fns)
     92        (lambda fns (apply left-hook-each+ c fns))
    8593        (apply left-hook-each c fns) ) ) ) )
    8694
     
    92100
    93101(define (right-hook-each+ . fns)
    94  (if (null? fns) (lambda (c) (right-hook-each+ c))
    95     (let ((c (car fns)) (fns (cdr fns)))
    96       (if (null? fns) (lambda fns (apply right-hook-each+ c fns))
     102 (if (null? fns) (lambda (c)
     103    (right-hook-each+ c))
     104    (let ((c (car fns)) (fns (cdr fns)))
     105      (if (null? fns)
     106        (lambda fns (apply right-hook-each+ c fns))
    97107        (apply right-hook-each c fns) ) ) ) )
    98108
     
    106116  (let ((c (car fns))
    107117        (fns (cdr fns)) )
    108     (if (null? fns) (lambda xs (apply c xs))
     118    (if (null? fns)
     119      (lambda xs (apply c xs))
    109120      (lambda xs (apply c (chain-recur fns xs) xs)) ) ) )
    110121
     
    118129  (let ((c (car fns))
    119130        (fns (cdr fns)) )
    120     (if (null? fns) (lambda xs (apply c xs))
     131    (if (null? fns)
     132      (lambda xs (apply c xs))
    121133      (lambda xs (apply c (append xs (list (chain-recur fns xs))))) ) ) )
    122134
     
    128140
    129141(define (left-hook-argument-chain+ . fns)
    130   (if (null? fns) (lambda (c) (left-hook-argument-chain+ c))
    131     (let ((c (car fns)) (fns (cdr fns)))
    132       (if (null? fns) (lambda fns (apply left-hook-argument-chain+ c fns))
     142  (if (null? fns)
     143    (lambda (c) (left-hook-argument-chain+ c))
     144    (let ((c (car fns)) (fns (cdr fns)))
     145      (if (null? fns)
     146        (lambda fns (apply left-hook-argument-chain+ c fns))
    133147        (apply left-hook-argument-chain c fns) ) ) ) )
    134148
     
    140154
    141155(define (right-hook-argument-chain+ . fns)
    142  (if (null? fns) (lambda (c) (right-hook-argument-chain+ c))
    143     (let ((c (car fns)) (fns (cdr fns)))
    144       (if (null? fns) (lambda fns (apply right-hook-argument-chain+ c fns))
     156 (if (null? fns)
     157    (lambda (c) (right-hook-argument-chain+ c))
     158    (let ((c (car fns)) (fns (cdr fns)))
     159      (if (null? fns)
     160        (lambda fns (apply right-hook-argument-chain+ c fns))
    145161        (apply right-hook-argument-chain c fns) ) ) ) )
    146162
     
    170186
    171187(define (fork-each+ . fns)
    172   (if (null? fns) (lambda (c) (fork-each+ c))
    173     (let ((c (car fns)) (fns (cdr fns)))
    174       (if (null? fns) (lambda fns (apply fork-each+ c fns))
     188  (if (null? fns)
     189    (lambda (c) (fork-each+ c))
     190    (let ((c (car fns)) (fns (cdr fns)))
     191      (if (null? fns)
     192        (lambda fns (apply fork-each+ c fns))
    175193        (apply fork-each c fns) ) ) ) )
    176194
     
    182200
    183201(define (fork-all+ . fns)
    184   (if (null? fns) (lambda (c) (fork-all+ c))
    185     (let ((c (car fns)) (fns (cdr fns)))
    186       (if (null? fns) (lambda fns (apply fork-all+ c fns))
     202  (if (null? fns)
     203    (lambda (c) (fork-all+ c))
     204    (let ((c (car fns)) (fns (cdr fns)))
     205      (if (null? fns)
     206        (lambda fns (apply fork-all+ c fns))
    187207        (apply fork-all c fns) ) ) ) )
    188208
  • release/4/combinators/trunk/logical-combinators.scm

    r18918 r34400  
    44(module logical-combinators
    55
    6   (;export
    7     andf
    8     orf)
     6(;export
     7  andf
     8  orf)
    99
    10   (import scheme chicken data-structures srfi-1)
     10(import scheme chicken data-structures srfi-1)
    1111
    12   (declare
    13     (type
    14       (andf (procedure (#!rest) *))
    15       (orf (procedure (#!rest) *)) ) )
     12(declare
     13  (type
     14    (andf (procedure (#!rest) *))
     15    (orf (procedure (#!rest) *)) ) )
    1616
    1717;; Eager 'or' & 'and'
     
    1919(define (andf . args)
    2020  (let loop ((args args) (prev #t))
    21     (if (null? args) prev
    22         (let ((cur (car args)))
    23           (and cur
    24               (loop (cdr args) cur) ) ) ) ) )
     21    (if (null? args)
     22      prev
     23      (let ((cur (car args)))
     24        (and cur (loop (cdr args) cur) ) ) ) ) )
    2525
    2626(define (orf . args)
    2727  (let loop ((args args))
    28     (and (not (null? args))
    29          (or (car args)
    30             (loop (cdr args)) ) ) ) )
     28    (and
     29      (not (null? args))
     30      (or (car args) (loop (cdr args)) ) ) ) )
    3131
    3232) ;module logical-combinators
  • release/4/combinators/trunk/section-combinators.scm

    r19028 r34400  
    44(module section-combinators
    55
    6   (;export
    7     left-section right-section
    8     crop-left crop-right
    9     reversed
    10     arguments-chain arguments-each arguments-all)
     6(;export
     7  left-section right-section
     8  crop-left crop-right
     9  reversed
     10  arguments-chain arguments-each arguments-all)
    1111
    12   (import
    13     scheme
    14     chicken
    15     (only srfi-1 drop drop-right circular-list)
    16     (only data-structures identity))
     12(import
     13  scheme
     14  chicken
     15  (only (srfi 1) drop drop-right circular-list)
     16  (only data-structures identity))
     17(require-library data-structures (srfi 1))
    1718
    18   (require-library srfi-1)
    19 
    20   (declare
    21     (type
    22       (left-section (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    23       (right-section (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
    24       (reversed (procedure ((procedure (#!rest) *)) (procedure (#!rest) *)))
    25       (crop-left (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *)))
    26       (crop-right (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *)))
    27       (arguments-chain (procedure (#!rest) (procedure (#!rest) *)))
    28       (arguments-each (procedure (#!rest) (procedure (#!rest) list)))
    29       (arguments-all (procedure (#!rest) (procedure (#!rest) list))) ) )
     19(declare
     20  (type
     21    (left-section (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     22    (right-section (procedure ((procedure (#!rest) *) #!rest) (procedure (#!rest) *)))
     23    (reversed (procedure ((procedure (#!rest) *)) (procedure (#!rest) *)))
     24    (crop-left (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *)))
     25    (crop-right (procedure ((procedure (#!rest) *) fixnum) (procedure (#!rest) *)))
     26    (arguments-chain (procedure (#!rest) (procedure (#!rest) *)))
     27    (arguments-each (procedure (#!rest) (procedure (#!rest) list)))
     28    (arguments-all (procedure (#!rest) (procedure (#!rest) list))) ) )
    3029
    3130;;; Section
     
    5655;;; Argument
    5756
    58   (include "arguments-helpers.inc")
     57(include "arguments-helpers.inc")
    5958
    6059;; arguments-chain
  • release/4/combinators/trunk/sort-combinators.scm

    r19028 r34400  
    66;; - group/key is not a combinator
    77
    8 (module sort-combinators (;export
     8(module sort-combinators
     9
     10(;export
    911  group-by group/key
    1012  make-equal/key make-less-than/key)
    1113
    12   (import
    13     scheme
    14     chicken
    15     (only srfi-1 span)
    16     (only bi-combinators bi-each))
     14(import
     15  scheme
     16  chicken
     17  (only (srfi 1) span)
     18  (only bi-combinators bi-each))
     19(require-library (srfi 1) bi-combinators)
    1720
    18   (require-library srfi-1 bi-combinators)
    19 
    20   (declare
    21     (type
    22       (group-by (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (list) list)))
    23       (group/key (procedure ((procedure (*) *) list #!optional (procedure (* *) boolean)) list))
    24       (make-less-than/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean)))
    25       (make-equal/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean))) ) )
     21(declare
     22  (type
     23    (group-by (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (list) list)))
     24    (group/key (procedure ((procedure (*) *) list #!optional (procedure (* *) boolean)) list))
     25    (make-less-than/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean)))
     26    (make-equal/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean))) ) )
    2627
    2728;;
    2829
    29 ;kinda violates the argument list orientation of comibinators
     30;kinda violates the argument list orientation of combinators
    3031(define (group-by proc #!optional (equals equal?))
    3132  (lambda (ls)
    3233    (let loop ((ls ls) (acc '()))
    33       (if (null? ls) acc #;(reverse! acc)
    34           (let ((key (proc (car ls))))
    35             (receive (grouped rest) (span (lambda (item) (equals key (proc item))) ls)
    36               (loop rest (cons grouped acc)) ) ) ) ) ) )
     34      (if (null? ls)
     35        acc #;(reverse! acc)
     36        (let ((key (proc (car ls))))
     37          (receive (grouped rest) (span (lambda (item) (equals key (proc item))) ls)
     38            (loop rest (cons grouped acc)) ) ) ) ) ) )
    3739
    3840;; Group a list of elements by some key attribute.
  • release/4/combinators/trunk/stack-combinators.scm

    r18918 r34400  
    77(module stack-combinators
    88
    9   (;export
    10     uni uni2 uni3 uni@
    11     bi bi2 bi3 bi@
    12     tri tri2 tri3 tri@
    13     dip
    14     dup dupd
    15     swap
    16     drop drop/2)
    17  
    18   (import scheme chicken)
     9(;export
     10  uni uni2 uni3 uni@
     11  bi bi2 bi3 bi@
     12  tri tri2 tri3 tri@
     13  dip
     14  dup dupd
     15  swap
     16  drop drop/2)
     17
     18(import scheme chicken)
    1919
    2020;;
  • release/4/combinators/trunk/tri-combinators.scm

    r19028 r34400  
    44(module tri-combinators
    55
    6   (;export
    7     tri tri2 tri3 tri-each tri-all)
     6(;export
     7  tri tri2 tri3 tri-each tri-all)
    88
    9   (import
    10     scheme
    11     chicken)
     9(import
     10  scheme
     11  chicken)
    1212
    1313;;; Hook
  • release/4/combinators/trunk/uni-combinators.scm

    r19028 r34400  
    44(module uni-combinators
    55
    6   (;export
    7     uni uni2 uni3 uni-each uni-all)
     6(;export
     7  uni uni2 uni3 uni-each uni-all)
    88
    9   (import
    10     scheme
    11     chicken)
     9(import
     10  scheme
     11  chicken)
    1212
    1313#|
Note: See TracChangeset for help on using the changeset viewer.