1:- module(units, [
    2   op(600, xfx, as),
    3   op(600, xfx, in),
    4   op(100, yf,  []),
    5   op(99, xfy, :),
    6   quantity_dimension/2,
    7   quantity_parent/2,
    8   quantity_formula/2,
    9   alias_quantity/2,
   10   kind/1,
   11   unit_symbol/2,
   12   unit_symbol_formula/3,
   13   unit_kind/2,
   14   prefix_unit_symbol/2,
   15   qeval/1
   16]).   17:- reexport([units/q]).   18
   19:- use_module(library(dcg/high_order)).   20:- use_module(library(clpBNR)).   21:- use_module(library(error)).   22
   23:- multifile quantity_dimension/2.   24:- multifile quantity_parent/2.   25:- multifile quantity_formula/2.   26:- multifile alias_quantity/2.   27:- multifile kind/1.   28:- multifile unit_symbol/2.   29:- multifile unit_symbol_formula/3.   30:- multifile unit_kind/2.   31:- multifile prefix_unit_symbol/2.   32
   33:- use_module(units/q).   34:- use_module(units/isq).   35:- use_module(units/si).   36:- use_module(units/international).   37
   38user:portray(Q) :-
   39   is_dict(Q, q),
   40   get_dict(v, Q, V),
   41   get_dict(q, Q, Quantity),
   42   get_dict(u, Q, U),
   43   !,
   44   format("~p * ~p[~p]", [V, Quantity, U]).
   45
   46is_quantity(Term) :-
   47   is_dict(Term, q),
   48   get_dict(q, Term, Q),
   49   (  var(Q)
   50   -> true
   51   ;  Q = kind_of(K)
   52   -> derived_root_kind(K)
   53   ;  mapexpr(alias_or_quantity, Q)
   54   ),
   55   get_dict(u, Term, U),
   56   (  var(U)
   57   -> true
   58   ;  mapexpr(normalize_unit, U, _)
   59   ),
   60   get_dict(v, Term, _).
   61error:has_type(q:Quantity, Term) :-
   62   (  ground(Quantity), alias_or_quantity(Quantity)
   63   -> true
   64   ;  domain_error(quantity, Quantity)
   65   ),
   66   is_quantity(Term),
   67   implicitly_convertible(Term.q, Quantity).
   68
   69parse(A*B) ==>
   70   parse(A), parse(B).
   71parse(A/B) ==>
   72   parse(A),
   73   { phrase(parse(B), L) },
   74   sequence(inverse, L).
   75parse((A*B)**N) ==>
   76   parse(A**N*B**N).
   77parse((A/B)**N) ==>
   78   parse(A**N/B**N).
   79parse((A**N1)**N2) ==>
   80   { N is N1 * N2 },
   81   parse(A**N).
   82parse(A**N) ==>
   83   [A-N].
   84parse(A) ==>
   85   [A-1].
   86
   87inverse(A-N) -->
   88   { N1 is -N },
   89   [A-N1].
   90
   91aggregate(L, L2) :-
   92   group_pairs_by_key(L, Groups),
   93   maplist([A-Ns, A-N]>>sum_list(Ns, N), Groups, L1),
   94   simplify(L1, L2).
   95
   96identity(_-0, _) => fail.
   97identity(1-_, _) => fail.
   98identity(A, R) => R = A.
   99simplify(L, L1) :-
  100   convlist(identity, L, L1).
  101
  102num_denom([], Denom, Expr) :-
  103   denom(Denom, 1, Expr).
  104num_denom([H | T], Denom, Expr) :-
  105   multiply([H | T], Num),
  106   denom(Denom, Num, Expr).
  107
  108denom([], Num, Num).
  109denom([H | T], Num, Num/Expr) :-
  110   multiply([H | T], Expr).
  111
  112multiply([H | T], Expr) :-
  113   foldl([B, A, A*B]>>true, T, H, Expr).
  114
  115normalize(In, Out) :-
  116   phrase(parse(In), L),
  117   normalize_factors(L, L1),
  118   generate_expression(L1, Out).
  119
  120is_num(_-N) => N > 0.
  121
  122power(A-1, Res) => Res = A.
  123power(A-N, Res) => Res = A**N.
  124
  125generate_expression(In, Out) :-
  126   partition(is_num, In, Num, Denom),
  127   maplist(power, Num, Num1),
  128   phrase(sequence(inverse, Denom), Denom1),
  129   maplist(power, Denom1, Denom2),
  130   num_denom(Num1, Denom2, Out).
  131
  132parse_normalize_factors(In, L3) :-
  133   phrase(parse(In), L),
  134   normalize_factors(L, L3).
  135normalize_factors(L, L2) :-
  136   msort(L, L1),
  137   aggregate(L1, L2).
  138
  139:- meta_predicate mapexpr(1, ?).  140
  141mapexpr(Goal, A) :-
  142   mapexpr1(Goal, [_]>>true, A).
  143
  144:- meta_predicate mapexpr1(1, 1, ?).  145
  146mapexpr1(Goal, F, A*B) =>
  147   mapexpr1(Goal, F, A),
  148   mapexpr1(Goal, F, B).
  149mapexpr1(Goal, F, A/B) =>
  150   mapexpr1(Goal, F, A),
  151   mapexpr1(Goal, F, B).
  152mapexpr1(Goal, F, A**_) =>
  153   mapexpr1(Goal, F, A).
  154mapexpr1(Goal, Failure, A) =>
  155   (  call(Goal, A)
  156   *-> true
  157   ;  call(Failure, A)
  158   ).
  159
  160:- meta_predicate mapexpr(2, ?, ?).  161
  162mapexpr(Goal, A, R) :-
  163   mapexpr(Goal, =, A, R).
  164
  165:- meta_predicate mapexpr(2, 2, ?, ?).  166
  167mapexpr(Goal, F, A*B, R) =>
  168   mapexpr(Goal, F, A, A1),
  169   mapexpr(Goal, F, B, B1),
  170   R = A1*B1.
  171mapexpr(Goal, F, A/B, R) =>
  172   mapexpr(Goal, F, A, A1),
  173   mapexpr(Goal, F, B, B1),
  174   R = A1/B1.
  175mapexpr(Goal, F, A**B, R) =>
  176   mapexpr(Goal, F, A, A1),
  177   R = A1**B.
  178mapexpr(Goal, Failure, A, A1) =>
  179   (  call(Goal, A, A1)
  180   *-> true
  181   ;  call(Failure, A, A1)
  182   ).
  183
  184common_expr(Type, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit) :-
  185   parse_normalize_factors(Unit1, F1),
  186   parse_normalize_factors(Unit2, F2),
  187   once(iterative_deepening(1,
  188      {F1, NewF1, Type, NewUnits, F2, NewF2}/[N]>>common_factors(
  189         F1, NewF1, Type, NewUnits, N, F2, NewF2))),
  190   msort(NewUnits, SortedNewUnits),
  191   maplist(generate_expression, [NewF1, NewF2, SortedNewUnits],
  192           [NewFactor1, NewFactor2, NewUnit]).
  193
  194iterative_deepening(Limit, Goal) :-
  195   N = n(no),
  196   (  call(Goal, Limit-N)
  197   -> true
  198   ;  (  N = n(depth_limit_exceeded)
  199      -> Limit1 is Limit + 1,
  200         iterative_deepening(Limit1, Goal)
  201      ;  fail
  202      )
  203   ).
  204
  205is_of(unit, U-_) :-
  206   ground(U),
  207   unit(U, _).
  208is_of(quantity, Q-_) :-
  209   ground(Q),
  210   alias_or_quantity(Q).
  211
  212common_factors(L1, R1, Type, L, N, L2, R2) :-
  213   partition(is_of(Type), L1, Unit1, Factor1),
  214   partition(is_of(Type), L2, Unit2, Factor2),
  215   ord_intersection(Unit1, Unit2, CommonUnits, Unit2Only),
  216   ord_subtract(Unit1, Unit2, Unit1Only),
  217   append(CommonUnits, R, L),
  218   append(Factor1, R11, R1),
  219   append(Factor2, R22, R2),
  220   expand_either_factors(Unit1Only, R11, Type, R, N, Unit2Only, R22).
  221expand_either_factors([], [], _, [], _-N, [], []) :-
  222   setarg(1, N, no).
  223expand_either_factors(L1, R1, Type, L, Limit-N, L2, R2) :-
  224   (  Limit > 0
  225   -> Limit1 is Limit - 1
  226   ;  nb_setarg(1, N, depth_limit_exceeded),
  227      fail
  228   ),
  229   (  phrase(select_factor(L1, R1, Type, L, Limit1-N), L2, R2)
  230   ;  phrase(select_factor(L2, R2, Type, L, Limit1-N), L1, R1)
  231   ).
  232select_factor(L1, R1, Type, L, N) -->
  233   select(A),
  234   expand_factors(Type, A),
  235   normalize_factors,
  236   common_factors(L1, R1, Type, L, N).
  237
  238expand_factors(Type, A), Factors -->
  239   { expand_factor(Type, A, Factors) }.
  240expand_factor(Type, Unit-N, Factors) :-
  241   (  Type == unit
  242   -> unit(Unit, _, Formula)
  243   ;  Type == quantity,
  244      (  alias_quantity(Unit, Formula)
  245      ;  quantity_parent(Unit, Formula)
  246      )
  247   ),
  248   parse_normalize_factors(Formula**N, Factors).
  249
  250:- table alias_quantity_dimension/2.  251
  252alias_quantity_dimension(Quantity, Symbol) :-
  253   quantity_dimension(Quantity, Symbol).
  254alias_quantity_dimension(Alias, Symbol) :-
  255   alias_quantity(Alias, Quantity),
  256   alias_quantity_dimension(Quantity, Symbol).
  257
  258:- table alias_quantity_parent/2.  259
  260alias_quantity_parent(Quantity, Parent) :-
  261   quantity_parent(Quantity, Parent).
  262alias_quantity_parent(Alias, Parent) :-
  263   alias_quantity(Alias, Quantity),
  264   alias_quantity_parent(Quantity, Parent).
  265
  266:- table alias_or_quantity/1.  267
  268alias_or_quantity(Quantity) :-
  269   alias_quantity_dimension(Quantity, _).
  270alias_or_quantity(Quantity) :-
  271   alias_quantity_parent(Quantity, _).
  272
  273:- table alias_quantity_formula/2.  274
  275alias_quantity_formula(Quantity, Formula) :-
  276   quantity_formula(Quantity, Formula).
  277alias_quantity_formula(Alias, Formula) :-
  278   alias_quantity(Alias, Quantity),
  279   alias_quantity_formula(Quantity, Formula).
  280
  281derived_quantity(_*_).
  282derived_quantity(_/_).
  283derived_quantity(_**_).
  284
  285:- table root/1.  286
  287root(BaseQuantity) :-
  288   quantity_dimension(BaseQuantity, _).
  289root(Quantity) :-
  290   quantity_parent(Quantity, DerivedQuantity),
  291   derived_quantity(DerivedQuantity).
  292
  293:- table quantity_dimensions_/2.  294
  295quantity_dimensions_(Quantity, Quantity) :-
  296   quantity_dimension(Quantity, _).
  297quantity_dimensions_(Alias, Dimension) :-
  298   alias_quantity(Alias, Quantity),
  299   quantity_dimensions_(Quantity, Dimension).
  300quantity_dimensions_(Quantity, Dimensions) :-
  301   quantity_parent(Quantity, Parent),
  302   quantity_dimensions_(Parent, Dimensions).
  303quantity_dimensions_(Quantity, Dimensions) :-
  304   derived_quantity(Quantity),
  305   mapexpr(quantity_dimensions_, Quantity, Dimensions).
  306quantity_dimensions(Quantity, Dimensions) :-
  307   quantity_dimensions_(Quantity, Dimension),
  308   parse_normalize_factors(Dimension, Dimensions).
  309
  310simplify_dimensions(Quantity, R) :-
  311   parse_normalize_factors(Quantity, Factors),
  312   maplist([F, Q]>>generate_expression([F], Q), Factors, Quantities),
  313   maplist(quantity_dimensions, Quantities, Dimensions),
  314   pairs_keys_values(Pairs, Factors, Dimensions),
  315   phrase(simplify_dimension_pairs, Pairs, SimplifiedPairs),
  316   pairs_keys(SimplifiedPairs, SimplifiedFactors),
  317   generate_expression(SimplifiedFactors, R).
  318simplify_dimension_pairs -->
  319   select(_-A),
  320   { maplist(is_inverse, A, B) },
  321   select(_-B),
  322   !,
  323   simplify_dimension_pairs.
  324simplify_dimension_pairs -->
  325   [].
  326
  327is_inverse(Q-N1, Q-N2) :-
  328   N2 is -N1.
  329
  330:- table root_kind/1.  331
  332root_kind(Kind) :-
  333   kind(Kind).
  334root_kind(Root) :-
  335   root(Root).
  336
  337:- table derived_root_kind/1.  338
  339derived_root_kind(Kind) :-
  340   mapexpr([X, X]>>root_kind(X), [X, _]>>domain_error(root_kind, X), Kind, Kind).
  341
  342:- table quantity_kind/2.  343
  344quantity_kind(kind_of(Kind), Kind).
  345quantity_kind(Kind, Kind) :-
  346   root_kind(Kind).
  347quantity_kind(Quantity, Kind) :-
  348   alias_or_quantity_parent(Quantity, Parent),
  349   quantity_kind(Parent, Kind).
  350
  351derived_quantity_kind(Quantity, Kind) :-
  352   mapexpr(quantity_kind, [_, 1]>>true, Quantity, Kind).
  353
  354alias_or_quantity_parent(Q, Q1) :-
  355   (  alias_quantity_parent(Q, Q1)
  356   ;  alias_quantity(Q, Q1)
  357   ).
  358
  359common_quantity(kind_of(Q1), kind_of(Q2), Q) =>
  360   simplify_dimensions(Q1, K1),
  361   simplify_dimensions(Q2, K2),
  362   common_quantity(K1, K2, Q3),
  363   (  K1 == Q3
  364   -> Q = kind_of(Q2)
  365   ;  K2 == Q3
  366   -> Q = kind_of(Q1)
  367   ;  Q = Q3
  368   ).
  369common_quantity(kind_of(Q1), Q2, Q) =>
  370   simplify_dimensions(Q1, K1),
  371   common_quantity(K1, Q2, Q3),
  372   (  K1 == Q3
  373   -> Q = Q2
  374   ;  Q = Q3
  375   ).
  376common_quantity(Q1, kind_of(Q2), Q) =>
  377   common_quantity(kind_of(Q2), Q1, Q).
  378common_quantity(Q1, Q2, Q) =>
  379   common_expr(quantity, Q1, 1, Q2, 1, Q).
  380
  381same_kind(Q1, Q2) :-
  382   derived_quantity_kind(Q1, K1),
  383   derived_quantity_kind(Q2, K2),
  384   common_quantity(K1, K2, K),
  385   (  (K1 == K ; K2 == K)
  386   -> true
  387   ).
  388
  389%  From is implicitly convertible to To if:
  390%  
  391%  * From is a direct descendent of To: i.e. common_quantity(From, To, To)
  392%  * 
  393%
  394%  Exceptions:
  395%
  396%  * if To is a kind_of, then common_quantity(From, To, From)
  397%
  398%
  399implicitly_convertible(From, To, Explicit) :-
  400   normalize(To, NormalizedTo),
  401   mapexpr(alias_quantity, NormalizedTo, AliasNormalizedTo),
  402   common_quantity(From, AliasNormalizedTo, CommonQuantity),
  403   (  AliasNormalizedTo = kind_of(_), CommonQuantity = From
  404   ;  CommonQuantity = AliasNormalizedTo
  405   ),
  406   (  Explicit == false, quantity_kind(From, FromKind), kind(FromKind)
  407   -> common_quantity(FromKind, AliasNormalizedTo, FromKind)
  408   ;  true
  409   ),
  410   !.
  411implicitly_convertible(From, ToKind, Explicit) :-
  412   root_kind(ToKind),
  413   alias_quantity_parent(ToKind, Formula),
  414   implicitly_convertible(From, Formula, Explicit),
  415   derived_quantity_kind(From, FromKind),
  416   normalize(FromKind, NormalizedFromKind),
  417   common_quantity(NormalizedFromKind, ToKind, CommonKind),
  418   (  (CommonKind == NormalizedFromKind ; CommonKind == ToKind)
  419   -> true
  420   ),
  421   !.
  422implicitly_convertible(From, To, _) :-
  423   alias_quantity_formula(To, Formula),
  424   implicitly_convertible(From, Formula).
  425
  426implicitly_convertible(From, To) :-
  427   implicitly_convertible(From, To, false).
  428
  429:- table explicitly_convertible/2.  430
  431explicitly_convertible(From, To) :-
  432   implicitly_convertible(From, To, true).
  433explicitly_convertible(From, To) :-
  434   implicitly_convertible(To, From, true).
  435
  436normalize_unit(Unit, R), unit(Unit, _) =>
  437   R = Unit.
  438normalize_unit(Symbol, R), unit(Unit, Symbol) =>
  439   R = Unit.
  440normalize_unit(Unit, R), unit(Module:Unit, _) =>
  441   R = Module:Unit.
  442normalize_unit(Module:Symbol, R), unit(Module:Unit, Symbol) =>
  443   R = Module:Unit.
  444normalize_unit(Module:PrefixUnit, R),
  445      PrefixUnit =.. [Prefix, Unit],
  446      prefix(Module:Prefix, _, _) =>
  447   normalize_unit(Unit, R1),
  448   R2 =.. [Prefix, R1],
  449   R = Module:R2.
  450normalize_unit(PrefixUnit, R),
  451      PrefixUnit =.. [Prefix, Unit],
  452      prefix(Module:Prefix, _, _) =>
  453   normalize_unit(Unit, R1),
  454   R2 =.. [Prefix, R1],
  455   R = Module:R2.
  456normalize_unit(_, _) => fail.
  457
  458:- table all_unit_symbol/2.  459
  460all_unit_symbol(Unit, Symbol) :-
  461   (  unit_symbol(Unit, Symbol)
  462   ;  unit_symbol_formula(Unit, Symbol, _)
  463   ).
  464
  465:- table unit/3.  466
  467unit(U, S, F) :-
  468   unit_symbol_formula(U, S, F).
  469unit(Module:PrefixUnit, Symbol, PrefixFormula*Unit) :-
  470   \+ compound(Symbol),
  471   \+ prefix_unit_symbol(Module:PrefixUnit, Symbol),
  472   prefix(Module:Prefix, PrefixSymbol, PrefixFormula),
  473   PrefixUnit =.. [Prefix, Unit],
  474   all_unit_symbol(Unit, UnitSymbol),
  475   atom_concat(PrefixSymbol, UnitSymbol, Symbol).
  476
  477:- table unit/2.  478
  479unit(U, S) :-
  480   (  unit_symbol(U, S)
  481   ;  unit(U, S, _)
  482   ).
  483
  484:- table all_unit_kind/2.  485
  486all_unit_kind(Unit, kind_of(Kind)) :-
  487   unit_kind(Unit, Kind),
  488   !.
  489all_unit_kind(Unit, R) :-
  490   unit(Unit, _, Formula),
  491   mapexpr(all_unit_kind, [_, 1]>>true, Formula, Kind),
  492   normalize(Kind, NKind),
  493   normalize_kind(NKind, R).
  494
  495common_unit(Unit1, NewFactor1, Unit2, NewFactor2, NewUnit) :-
  496   common_expr(unit, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit).
  497
  498comparable(AB, R) :-
  499   AB =.. [Op, A, B],
  500   eval_(A, A1),
  501   eval_(B, B1),
  502   (  same_kind(A1.q, B1.q), common_quantity(A1.q, B1.q, Q)
  503   -> (  common_unit(A1.v*A1.u, AV, B1.v*B1.u, BV, U)
  504      -> V =.. [Op, AV, BV],
  505         R = q{v: V, u: U, q: Q}
  506      ;  domain_error(A1.u, B1.u)
  507      )
  508   ;  domain_error(A1, B1)
  509   ).
  510
  511normalize_kind(kind_of(A)/kind_of(B), R) =>
  512   normalize(A/B, AB),
  513   R = kind_of(AB).
  514normalize_kind(kind_of(A)*kind_of(B), R) =>
  515   normalize(A*B, AB),
  516   R = kind_of(AB).
  517normalize_kind(kind_of(A)**N, R) =>
  518   normalize(A**N, AN),
  519   R = kind_of(AN).
  520normalize_kind(kind_of(A)/1, R) =>
  521   R = kind_of(A).
  522normalize_kind(1/kind_of(A), R) =>
  523   normalize(1/A, AN),
  524   R = kind_of(AN).
  525normalize_kind(kind_of(A)*1, R) =>
  526   R = kind_of(A).
  527normalize_kind(1*kind_of(A), R) =>
  528   R = kind_of(A).
  529normalize_kind(kind_of(A)/B, R) =>
  530   normalize(A/B, R).
  531normalize_kind(A/kind_of(B), R) =>
  532   normalize(A/B, R).
  533normalize_kind(kind_of(A)*B, R) =>
  534   normalize(A*B, R).
  535normalize_kind(A*kind_of(B), R) =>
  536   normalize(A*B, R).
  537normalize_kind(A, R) =>
  538   normalize(A, R).
  539
  540qeval((A, B)) =>
  541   qeval(A),
  542   qeval(B).
  543qeval(Expr) =>
  544   eval_(Expr, Q),
  545   call(Q.v).
  546eval_({ExprIn}, R) =>
  547   eval_(ExprIn, ExprOut),
  548   R = ExprOut.put(v, {ExprOut.v}).
  549eval_(Result is ExprIn, R) =>
  550   eval_(ExprIn, ExprOut),
  551   R = ExprOut.put(v, V is ExprOut.v),
  552   Result = ExprOut.put(v, V).
  553eval_(+A, R) =>
  554   eval_(A, A1),
  555   R = A1.put(v, +A1.v).
  556eval_(-A, R) =>
  557   eval_(A, A1),
  558   R = A1.put(v, -A1.v).
  559eval_(A+B, R) =>
  560   comparable(A+B, R).
  561eval_(A-B, R) =>
  562   comparable(A-B, R).
  563eval_(A=:=B, R) =>
  564   comparable(A=:=B, R).
  565eval_(A=\=B, R) =>
  566   comparable(A=\=B, R).
  567eval_(A<B, R) =>
  568   comparable(A<B, R).
  569eval_(A>B, R) =>
  570   comparable(A>B, R).
  571eval_(A=<B, R) =>
  572   comparable(A=<B, R).
  573eval_(A>=B, R) =>
  574   comparable(A>=B, R).
  575eval_(A*B, R) =>
  576   eval_(A, A1),
  577   eval_(B, B1),
  578   normalize_kind(A1.q*B1.q, Q),
  579   normalize(A1.u*B1.u, U),
  580   normalize(A1.v*B1.v, V),
  581   R = q{v: V, q: Q, u: U}.
  582eval_(A/B, R) =>
  583   eval_(A, A1),
  584   eval_(B, B1),
  585   normalize_kind(A1.q/B1.q, Q),
  586   normalize(A1.u/B1.u, U),
  587   normalize(A1.v/B1.v, V),
  588   R = q{v: V, q: Q, u: U}.
  589eval_(A**N, R) =>
  590   eval_(A, A1),
  591   normalize_kind(A1.q**N, Q),
  592   normalize(A1.u**N, U),
  593   normalize(A1.v**N, V),
  594   R = q{v: V, q: Q, u: U}.
  595eval_(A^N, R) =>
  596   eval_(A**N, R).
  597eval_(in(Expr, Unit), R) =>
  598   eval_(Expr, M),
  599   eval_(Unit, Q),
  600   (  implicitly_convertible(M.q, Q.q)
  601   -> common_unit(M.u, F1, Q.u, F2, _),
  602      normalize(M.v*F1/F2, V1),
  603      V is V1,
  604      R = q{v: V, q: M.q, u: Q.u}
  605   ;  domain_error(M.q, Q.q)
  606   ).
  607eval_(as(Expr, Quantity), R), alias_or_quantity(Quantity) =>
  608   eval_(Expr, M),
  609   (  implicitly_convertible(M.q, Quantity)
  610   -> R = M.put(q, Quantity)
  611   ;  domain_error(M.q, Quantity)
  612   ).
  613eval_(force_as(Expr, Quantity), R), alias_or_quantity(Quantity) =>
  614   eval_(Expr, M),
  615   (  explicitly_convertible(M.q, Quantity)
  616   -> R = M.put(q, Quantity)
  617   ;  domain_error(M.q, Quantity)
  618   ).
  619eval_(cast(Expr, Quantity), R), alias_or_quantity(Quantity) =>
  620   eval_(Expr, M),
  621   (  common_quantity(M.q, Quantity, _)
  622   -> R = M.put(q, Quantity)
  623   ;  domain_error(M.q, Quantity)
  624   ).
  625eval_(X, R), var(X) =>
  626   R = q{v: X, q: 1, u: 1}.
  627eval_(UnitOrSymbol, R), normalize_unit(UnitOrSymbol, Unit) =>
  628   all_unit_kind(Unit, Kind),
  629   R = q{v: 1, q: Kind, u: Unit}.
  630eval_(QuantityExpr[UnitExpr], R) =>
  631   eval_(QuantityExpr, R),
  632   eval_(UnitExpr, Unit),
  633   (  implicitly_convertible(Unit.q, R.q)
  634   -> true
  635   ;  domain_error(Unit.q, R.q)
  636   ),
  637   R.v = Unit.v,
  638   R.u = Unit.u.
  639eval_(N, R), number(N) =>
  640   R = q{v: N, q: 1, u: 1}.
  641eval_(Quantity, R), alias_or_quantity(Quantity) =>
  642   R = q{v: _, q: Quantity, u: _}.
  643eval_(kind_of(Kind), R), derived_root_kind(Kind) =>
  644   R = q{v: _, q: kind_of(Kind), u: _}.
  645eval_(pi, R) =>
  646   R = q{v: pi, q: 1, u: 1}.
  647eval_(random_float, R) =>
  648   R = q{v: random_float, q: 1, u: 1}.
  649eval_(Q, R), is_dict(Q, q) =>
  650   R = Q.
  651
  652:- begin_tests(units).  653
  654qeval_data(si:metre =:= si:metre).
  655qeval_data(si:kilo(metre) =:= si:kilo(metre)).
  656qeval_data(si:kilogram =:= si:kilo(gram)).
  657qeval_data(si:kg =:= si:kilo(gram)).
  658qeval_data(10*(si:kilo(metre)) =:= 5*2*(si:kilo(metre))).
  659qeval_data(10*(si:kilo(metre)) / 2 =:= 5*(si:kilo(metre))).
  660qeval_data(1 * (si:hour) =:= 3600 * (si:second)).
  661qeval_data(1 * (si:kilo(metre)) + 1 * (si:metre) =:= 1001 * (si:metre)).
  662qeval_data(1 * (si:kilo(metre)) / (1 * (si:second)) =:= 1000 * (si:metre) / (si:second)).
  663qeval_data(2 * (si:kilo(metre)) / (si:hour) * (2 * (si:hour)) =:= 4 * (si:kilo(metre))).
  664qeval_data(2 * (si:kilo(metre)) / (2 * (si:kilo(metre)) / (si:hour)) =:= 1 * (si:hour)).
  665qeval_data(2 * (si:metre) * (3 * (si:metre)) =:= 6 * (si:metre)**2).
  666qeval_data(10 * (si:kilo(metre)) / (5 * (si:kilo(metre))) =:= 2).
  667qeval_data(1000 / (1 * (si:second)) =:= 1 * (si:kilo(hertz))).
  668qeval_data(1001 / (1 * (si:second)) =\= 1 * (si:kilo(hertz))).
  669qeval_data(si:metre < si:kilo(metre)).
  670qeval_data(si:metre =< si:kilo(metre)).
  671qeval_data(si:metre > si:centi(metre)).
  672qeval_data(si:metre >= si:centi(metre)).
  673
  674test('qeval', [forall(qeval_data(Expr))]) :-
  675   qeval(Expr).
  676
  677fail_qeval_data(1001 / (1 * (si:second)) =:= 1 * (si:kilo(hertz))).
  678
  679test('fail_qeval', [forall(fail_qeval_data(Expr)), fail]) :-
  680   qeval(Expr).
  681
  682error_qeval_data(si:hertz =:= si:becquerel).
  683error_qeval_data(_ is si:hertz + si:becquerel).
  684
  685test('error_qeval', [forall(error_qeval_data(Expr)), error(domain_error(_, _))]) :-
  686   qeval(Expr).
  687
  688implicitly_convertible_data(isq:width, isq:length).
  689implicitly_convertible_data(isq:radius, isq:width).
  690implicitly_convertible_data(isq:radius, isq:length).
  691implicitly_convertible_data(isq:mass*isq:length**2/isq:time**2, isq:energy).
  692implicitly_convertible_data(isq:mass*isq:height**2/isq:time**2, isq:energy).
  693implicitly_convertible_data(isq:height**2*isq:mass/isq:time**2, isq:energy).
  694implicitly_convertible_data(isq:mass*isq:speed**2, isq:kinetic_energy).
  695implicitly_convertible_data(kind_of(isq:length), isq:height).
  696implicitly_convertible_data(isq:acceleration, isq:speed/isq:time).
  697implicitly_convertible_data(kind_of(isq:length/isq:time**2), isq:acceleration).
  698implicitly_convertible_data(kind_of(isq:length/isq:time**2), isq:velocity/isq:duration).
  699implicitly_convertible_data(kind_of(isq:time*isq:frequency), isq:rotation).
  700implicitly_convertible_data(kind_of(isq:time*isq:frequency), kind_of(isq:rotation)).
  701implicitly_convertible_data(kind_of(isq:time*isq:frequency), kind_of(isq:angular_measure)).
  702implicitly_convertible_data(kind_of(isq:rotation/isq:frequency), kind_of(isq:time)).
  703
  704test('implicitly_convertible', [forall(implicitly_convertible_data(Q1, Q2))]) :-
  705   implicitly_convertible(Q1, Q2).
  706
  707% not implicitly convertible that are explicitly convertible
  708explicitly_convertible_data(isq:length, isq:width).
  709explicitly_convertible_data(isq:width, isq:radius).
  710explicitly_convertible_data(isq:length, isq:radius).
  711explicitly_convertible_data(isq:energy, isq:mechanical_energy).
  712explicitly_convertible_data(isq:length, isq:height).
  713explicitly_convertible_data(isq:mass*isq:length**2/isq:time**2, isq:mechanical_energy).
  714explicitly_convertible_data(isq:angular_measure, 1).
  715explicitly_convertible_data(isq:speed/isq:time, isq:acceleration).
  716
  717not_implicitly_convertible_data(isq:time*isq:frequency, isq:rotation).
  718
  719test('not_implicitly_convertible(explicit_data)', [forall(explicitly_convertible_data(Q1, Q2)), fail]) :-
  720   implicitly_convertible(Q1, Q2).
  721test('not_implicitly_convertible', [forall(not_implicitly_convertible_data(Q1, Q2)), fail]) :-
  722   implicitly_convertible(Q1, Q2).
  723
  724common_quantity_data(isq:width, isq:height, isq:length).
  725common_quantity_data(isq:thickness, isq:radius, isq:width).
  726common_quantity_data(isq:distance, isq:path_length, isq:path_length).
  727common_quantity_data(1, 1, 1).
  728common_quantity_data(1, isq:rotation, 1).
  729common_quantity_data(kind_of(isq:length), kind_of(isq:length), kind_of(isq:length)).
  730common_quantity_data(isq:width, kind_of(isq:length), isq:width).
  731
  732test('common_quantity', [forall(common_quantity_data(Q1, Q2, Q))]) :-
  733   common_quantity(Q1, Q2, Q).
  734
  735test('explicitly_convertible', [forall(implicitly_convertible_data(Q1, Q2))]) :-
  736   explicitly_convertible(Q1, Q2).
  737
  738test('explicitly_convertible', [forall(explicitly_convertible_data(Q1, Q2))]) :-
  739   explicitly_convertible(Q1, Q2).
  740
  741not_explicitly_convertible_data(isq:height, isq:width).
  742not_explicitly_convertible_data(isq:time, isq:length).
  743not_explicitly_convertible_data(isq:frequency, isq:activity).
  744not_explicitly_convertible_data(kind_of(isq:frequency), kind_of(isq:activity)).
  745not_explicitly_convertible_data(isq:mass*isq:height**2/isq:time**2, isq:mechanical_energy).
  746
  747test('not_explicitly_convertible', [forall(not_explicitly_convertible_data(Q1, Q2)), fail]) :-
  748   explicitly_convertible(Q1, Q2).
  749
  750avg_speed(Distance, Time, Speed) :-
  751   qeval(Speed is Distance / Time as isq:speed).
  752
  753test('avg_speed') :-
  754   avg_speed(220 * isq:distance[si:kilo(metre)], 2 * si:hour, _Speed).
  755
  756test('in as') :-
  757   qeval(_Speed is (m/s in inch/h) as isq:speed).
  758
  759as_data(_ is isq:width[m] as isq:length).
  760as_data(_ is isq:width[m] / isq:time[s] as isq:speed).
  761
  762test('as', [forall(as_data(Expr))]) :-
  763   qeval(Expr).
  764
  765error_as_data(_ is isq:length[m] as isq:width).
  766
  767test('error_as', [forall(error_as_data(Expr)), error(domain_error(_, _))]) :-
  768   qeval(Expr).
  769
  770test('error_in', [error(domain_error(_, _))]) :-
  771   qeval(_ is si:hertz in si:becquerel).
  772
  773test('acceleration') :-
  774   qeval(Speed is 60 * isq:velocity[km/h]),
  775   qeval(Duration is 8 * s),
  776   qeval(A is (Speed / Duration) as isq:acceleration),
  777   qeval(B is A in m/s**2),
  778   must_be(q:isq:acceleration, B).
  779
  780test('clpBNR') :-
  781   qeval({A * inch =:= 1 * metre}),
  782   A == 5000r127,
  783   qeval({B =:= 5000 * gram / (2*gram)}),
  784   B == 2500,
  785   qeval({C is 1^2}),
  786   C == q{q:1, u:1, v:1}.
  787
  788test('quantity_kind') :-
  789   quantity_kind(isq:duration, isq:time).
  790
  791:- end_tests(units).