diff options
author | Thomas White <taw@physics.org> | 2020-08-12 21:55:19 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2020-08-12 21:55:19 +0200 |
commit | 080ea374cd7477d794380fc5ef60943e545e09e1 (patch) | |
tree | 4b5b7fc5e5edf4a64fb64121c320278b4fd82e60 | |
parent | b3b9d504079ac56aa9ee2c021fef9964641cfffd (diff) |
Obviate wrap-merge, use LTP for non-intensity parameters
-rw-r--r-- | guile/starlet/base.scm | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index 326a91f..8bba4d9 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -291,7 +291,7 @@ (set-in-state! combined-state fix attr - (wrap-merge merge-rule current-value value)) + (merge-rule attr current-value value)) (set-in-state! combined-state fix attr @@ -305,12 +305,6 @@ val)) -(define (wrap-merge merge-rule a b) - (lambda (time) - (merge-rule (value->number a time) - (value->number b time)))) - - ;; If "state" is a procedure, call it to get the real state ;; Otherwise, pass through (define (expand-state state) @@ -319,11 +313,21 @@ state)) -(define (merge-rule-ltp a b) - b) +(define (merge-rule-ltp attr a b) + (lambda (time) + (value->number b time))) + +(define (merge-rule-htp attr a b) + (if (eq? 'intensity (get-attr-name attr)) + + ;; HTP only for intensity attributes + (lambda (time) + (max (value->number a time) + (value->number b time))) -(define (merge-rule-htp a b) - (max a b)) + ;; LTP for all non-intensity attributes + (lambda (time) + (value->number b time)))) (define (merge-states-htp list-of-states) (merge-states merge-rule-htp |