67 lines
2.0 KiB
Standard ML
67 lines
2.0 KiB
Standard ML
|
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
|
||
|
|
;
|