factor: trim using lists

[factor.git] / extra / bank / bank.factor

diff --git a/extra/bank/bank.factor b/extra/bank/bank.factor
index 0ea4bae2b317c8ea6dca3ffc609f170e8a6c20cd..fc214e05e31f3ecd8ddb46f68162f1295dba9e92 100644 (file)
--- a/extra/bank/bank.factor
+++ b/extra/bank/bank.factor
@@ -1,10 +1,12 @@
-USING: accessors calendar kernel math money sequences ;
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors calendar kernel math math.order sequences ;
 IN: bank
 
 TUPLE: account name interest-rate interest-payment-day opening-date transactions unpaid-interest interest-last-paid ;
 
 : <account> ( name interest-rate interest-payment-day opening-date -- account )
-    V{ } clone 0 pick account construct-boa ;
+    V{ } clone 0 pick account boa ;
 
 TUPLE: transaction date amount description ;
 C: <transaction> transaction
@@ -13,12 +15,12 @@ C: <transaction> transaction
     over transactions>> push ;
 
 : total ( transactions -- balance )
-    0 [ amount>> + ] reduce ;
+    [ amount>> ] map-sum ;
 
 : balance>> ( account -- balance ) transactions>> total ;
 
 : open-account ( name interest-rate interest-payment-day opening-date opening-balance -- account )
-    >r [ <account> ] keep r> "Account Opened" <transaction> >>transaction ;
+    [ [ <account> ] keep ] dip "Account Opened" <transaction> >>transaction ;
 
 : daily-rate ( yearly-rate day -- daily-rate )
     days-in-year / ;
@@ -26,10 +28,8 @@ C: <transaction> transaction
 : daily-rate>> ( account date -- rate )
     [ interest-rate>> ] dip daily-rate ;
 
-: before? ( date date -- ? ) <=> 0 < ;
-
 : transactions-on-date ( account date -- transactions )
-    [ before? ] curry subset ;
+    [ before? ] curry filter ;
 
 : balance-on-date ( account date -- balance )
     transactions-on-date total ;
@@ -54,16 +54,16 @@ C: <transaction> transaction
 : process-day ( account date -- )
     2dup accumulate-interest ?pay-interest ;
 
-: each-day ( quot start end -- )
+: each-day ( ... quot: ( ... day -- ... ) start end -- ... )
     2dup before? [
-        >r dup >r over >r swap call r> r> 1 days time+ r> each-day
+        [ dup [ over [ swap call ] dip ] dip 1 days time+ ] dip each-day
     ] [
         3drop
-    ] if ;
+    ] if ; inline recursive
 
 : process-to-date ( account date -- account )
     over interest-last-paid>> 1 days time+
-    [ dupd process-day ] spin each-day ;
+    [ [ dupd process-day ] ] 2dip swap each-day ;
 
 : inserting-transactions ( account transactions -- account )
     [ [ date>> process-to-date ] keep >>transaction ] each ;