]> gitweb.factorcode.org Git - factor.git/commitdiff
contrib/units update
authorerg <erg@trifocus.net>
Thu, 3 Aug 2006 03:19:54 +0000 (03:19 +0000)
committererg <erg@trifocus.net>
Thu, 3 Aug 2006 03:19:54 +0000 (03:19 +0000)
contrib/units/dimensioned.factor
contrib/units/load.factor
contrib/units/test/units.factor [new file with mode: 0644]

index 98d38112624231f71124006e2af6584c2e599849..10438eba8bc23686b9be999ae82fda8d7afe6dd0 100644 (file)
@@ -5,12 +5,12 @@ IN: units
 : seq-intersect ( seq1 seq2 -- seq1/\seq2 )
     [ swap member? ] subset-with ;
 
-TUPLE: dimensioned val top bot ;
+TUPLE: dimensioned value top bot ;
 C: dimensioned 
     [ set-dimensioned-bot ] keep
     [ set-dimensioned-top ] keep
     over number? [ "dimensioned must be a number" throw ] unless
-    [ set-dimensioned-val ] keep ;
+    [ set-dimensioned-value ] keep ;
 
 : remove-one ( obj seq -- seq )
     [ index ] keep over -1 = [
@@ -39,8 +39,8 @@ C: dimensioned
 : 2reduce-units ( d d -- )
     >r dup reduce-units r> dup reduce-units ;
 
-: 2val ( d d -- )
-    [ dimensioned-val ] 2apply ;
+: 2value ( d d -- )
+    [ dimensioned-value ] 2apply ;
 
 : =units?
     >r dimensions 2array r> dimensions 2array = ;
@@ -51,41 +51,41 @@ C: dimensioned
         "d+: dimensions must be the same" throw
     ] unless
     dup dimensions
-    >r >r 2val + r> r> <dimensioned> ;
+    >r >r 2value + r> r> <dimensioned> ;
 
 : d- ( d d -- )
     2dup =units? [
         "d-: dimensions must be the same" throw
     ] unless
     dup dimensions
-    >r >r 2val - r> r> <dimensioned> ;
+    >r >r 2value - r> r> <dimensioned> ;
 
 : add-dimensions ( d d -- d )
     >r dimensions r> dimensions >r swap >r append r> r> append 0 -rot <dimensioned> ;
 
 : (d*)
-    >r add-dimensions r> over set-dimensioned-val dup reduce-units ;
+    >r add-dimensions r> over set-dimensioned-value dup reduce-units ;
 
 : d* ( d d -- )
-    2dup 2val * (d*) ;
+    2dup 2value * (d*) ;
 
 : swap-dimensions ( d -- d )
     dup dimensions rot [ set-dimensioned-top ] keep [ set-dimensioned-bot ] keep ;
 
 : d/ ( d d -- )
-    swap-dimensions 2dup 2val / (d*) ;
+    swap-dimensions 2dup 2value / (d*) ;
 
 : d-inv ( d -- d )
-    swap-dimensions dup dimensioned-val 1 swap / over set-dimensioned-val ;
+    swap-dimensions dup dimensioned-value 1 swap / over set-dimensioned-value ;
 
 : d-product ( v -- d ) 1 { } { } <dimensioned> [ d* ] reduce ;
 
 ! does not compile
 ! Example: 4 m { km } { } convert
-: convert ( d top bot -- val )
+: convert ( d top bot -- value )
     >r [ [ 1 swap execute , ] each ] { } make d-product r>
     [ [ 1 swap execute d-inv , ] each ] { } make d-product
     d*
     2dup =units? [ "cannot make that conversion" throw ] unless
-    2val / ;
+    [ 2value / ] keep [ set-dimensioned-value ] keep ;
 
index ffd3d2ef1144730cd8921f9dd6d31078040f4272..48efec857d95dafe1a4966ea313c5d82de008828 100644 (file)
@@ -1,2 +1,7 @@
 PROVIDE: units
-{ "dimensioned.factor" "si-units.factor" "constants.factor" } ;
+{
+    "dimensioned.factor" "si-units.factor" "constants.factor"
+} {
+    "test/units.factor"
+} ;
+
diff --git a/contrib/units/test/units.factor b/contrib/units/test/units.factor
new file mode 100644 (file)
index 0000000..70d9618
--- /dev/null
@@ -0,0 +1,7 @@
+USING: arrays errors kernel math sequences si-units test units ;
+
+[ T{ dimensioned f 3 { m } { } } ] [ 3 m ] unit-test
+[ T{ dimensioned f 3 { m } { s } } ] [ 3 m/s ] unit-test
+[ T{ dimensioned f 4000 { m } { } } ] [ 4 km ] unit-test
+[ t ] [ 4 km { m } { } convert 4000 m = ] unit-test
+