cond-values: add with example

1 files changed, 66 insertions, 0 deletions

diff --git a/units.sml b/units.sml
new file mode 100644
index 0000000..0a821c1
--- /dev/null
+++ b/units.sml
@@ -0,0 +1,66 @@
+datatype si_prefix
+= QUETTA | RONNA | YOTTA | ZETTA | EXA | PETA | TERA | GIGA | MEGA
+| KILO | HECTO | DEKA | DECI | CENTI | MILLI | MICRO | NANO
+| PICO | FEMTO | ATTO | ZEPTO | YOCTO | RONTO | QUECTO;
+
+datatype si_function
+= DIVISION | MULT;
+
+datatype si_unit
+= UNIT of string
+| PREFIX of si_prefix * si_unit
+| ALGEBRA of si_function * si_unit list
+;
+
+fun factor_of_prefix QUETTA = 1e30
+  | factor_of_prefix RONNA = 1e27
+  | factor_of_prefix YOTTA = 1e24
+  | factor_of_prefix ZETTA = 1e21
+  | factor_of_prefix EXA = 1e18
+  | factor_of_prefix PETA = 1e15
+  | factor_of_prefix TERA = 1e12
+  | factor_of_prefix GIGA = 1e9
+  | factor_of_prefix MEGA = 1e6
+  | factor_of_prefix KILO = 1e3
+  | factor_of_prefix HECTO = 1e2
+  | factor_of_prefix DEKA = 1e1
+  | factor_of_prefix DECI = 1e~1
+  | factor_of_prefix CENTI = 1e~2
+  | factor_of_prefix MILLI = 1e~3
+  | factor_of_prefix MICRO = 1e~6
+  | factor_of_prefix NANO = 1e~9
+  | factor_of_prefix PICO = 1e~12
+  | factor_of_prefix FEMTO = 1e~15
+  | factor_of_prefix ATTO = 1e~18
+  | factor_of_prefix ZEPTO = 1e~21
+  | factor_of_prefix YOCTO = 1e~24
+  | factor_of_prefix RONTO = 1e~27
+  | factor_of_prefix QUECTO = 1e~30
+  ;
+
+fun apply_function DIVISION (head::[]) = head
+  | apply_function DIVISION [] = raise Match
+  | apply_function DIVISION (x::y::rest)
+    = apply_function DIVISION (x/y::rest)
+  | apply_function MULT [] = 1.0
+  | apply_function MULT (head::[]) = head
+  | apply_function MULT (x::y::rest)
+    = apply_function MULT (x*y::rest)
+  ;
+
+fun car (x,y) = x;
+fun cdr (x,y) = y;
+
+fun remove_prefixes (UNIT x) = (1e0, UNIT x)
+  | remove_prefixes (PREFIX (prefix, the_unit))
+    = let val (factor, sub_unit) = remove_prefixes the_unit
+      in (factor * (factor_of_prefix prefix), sub_unit)
+      end
+  | remove_prefixes (ALGEBRA (function, units))
+   = let val returned = map remove_prefixes units;
+         val factors = map car returned;
+         val units = map cdr returned;
+     in
+        (apply_function function factors, (ALGEBRA (function, units)))
+     end
+  ;