|
|
@ -25,13 +25,6 @@ |
|
|
|
(define (is-not value) (lambda (x) (not (equal? x value)))) |
|
|
|
(define (is-not value) (lambda (x) (not (equal? x value)))) |
|
|
|
(define (is-not-empty value) (not (null? value))) |
|
|
|
(define (is-not-empty value) (not (null? value))) |
|
|
|
|
|
|
|
|
|
|
|
;=============== prepend ====================== |
|
|
|
|
|
|
|
(define (prepend first-value) (lambda (rest) (cons first-value rest))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(assert-eq "prepend test failed" |
|
|
|
|
|
|
|
'(1 2 3 4) |
|
|
|
|
|
|
|
((prepend 1) '(2 3 4))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;=============== combinators ====================== |
|
|
|
;=============== combinators ====================== |
|
|
|
(define (Y f) (f (lambda (x) ((Y f) x)))) |
|
|
|
(define (Y f) (f (lambda (x) ((Y f) x)))) |
|
|
|
(define (Y2 f) (f (lambda (x y) ((Y2 f) x y)))) |
|
|
|
(define (Y2 f) (f (lambda (x y) ((Y2 f) x y)))) |
|
|
@ -72,6 +65,20 @@ |
|
|
|
(lambda (current accumulator) (cons (+ 1 (car accumulator)) (cons current accumulator)))) |
|
|
|
(lambda (current accumulator) (cons (+ 1 (car accumulator)) (cons current accumulator)))) |
|
|
|
'(101 102 103 104))) |
|
|
|
'(101 102 103 104))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;=============== prepend ====================== |
|
|
|
|
|
|
|
(define (prepend first-value) (lambda (rest) (cons first-value rest))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(assert-eq "prepend test failed" |
|
|
|
|
|
|
|
'(1 2 3 4) |
|
|
|
|
|
|
|
((prepend 1) '(2 3 4))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;=============== append ====================== |
|
|
|
|
|
|
|
(define (append first-value) (reduce-right (list first-value) cons)) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(assert-eq "append test failed" |
|
|
|
|
|
|
|
'(1 2 3 4) |
|
|
|
|
|
|
|
((append 4) '(1 2 3))) |
|
|
|
|
|
|
|
|
|
|
|
;=============== reverse ====================== |
|
|
|
;=============== reverse ====================== |
|
|
|
(define reverse (reduce-left '() cons)) |
|
|
|
(define reverse (reduce-left '() cons)) |
|
|
|
|
|
|
|
|
|
|
@ -433,25 +440,22 @@ |
|
|
|
(get-range-start state-value) |
|
|
|
(get-range-start state-value) |
|
|
|
(get-range-end state-value))) |
|
|
|
(get-range-end state-value))) |
|
|
|
|
|
|
|
|
|
|
|
(define (seed-maps-processor seed-maps) |
|
|
|
(define seed-maps-processor |
|
|
|
(compose (list |
|
|
|
(compose (list |
|
|
|
;; for state |
|
|
|
;; for list of maps (within a single map set); returns state-transforming lambda |
|
|
|
#!(tee-with-comment "state after applying mapset")!# |
|
|
|
compose |
|
|
|
((compose (list |
|
|
|
#!(prepend (tee-with-comment "state after applying mapset"))!# |
|
|
|
;; for list of maps (within a single map set); returns state-transforming lambda |
|
|
|
(append swap-state) |
|
|
|
compose |
|
|
|
(map (lambda (seed-map) |
|
|
|
(map (lambda (seed-map) |
|
|
|
;; for seed map within the list: returns state-transforming lambda |
|
|
|
;; for seed map within the list: returns state-transforming lambda |
|
|
|
(compose (list |
|
|
|
(compose (list |
|
|
|
flat |
|
|
|
flat |
|
|
|
(map (lambda (state-entry) |
|
|
|
(map (lambda (state-entry) |
|
|
|
;; for seed map _and_ single range from state, returns list of new ranges |
|
|
|
;; for seed map _and_ single range from state, returns list of new ranges |
|
|
|
(if |
|
|
|
(if |
|
|
|
(is-state-value-current state-entry) |
|
|
|
(is-state-value-current state-entry) |
|
|
|
(list state-entry) |
|
|
|
(list state-entry) |
|
|
|
(apply-map-to-previous-state-value seed-map (get-state-value state-entry)))))))))))) |
|
|
|
(apply-map-to-previous-state-value seed-map (get-state-value state-entry))))))))))) |
|
|
|
|
|
|
|
seed-maps) |
|
|
|
|
|
|
|
swap-state))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define parse-seed-maps |
|
|
|
(define parse-seed-maps |
|
|
|
(compose (list |
|
|
|
(compose (list |
|
|
|