1:- module(quantity, [ quantity/0, quantity/3 ]).
    2:- use_module(library(dcg/basics)).
    3
    4% Parse quantity
    5quantity(Number, Options, String) :-
    6    string(String),
    7    string_codes(String, Codes),
    8    quantity(Number, Options, Codes).
    9
   10quantity(Number, Options, Atom) :-
   11    atom(Atom),
   12    atom_codes(Atom, Codes),
   13    quantity(Number, Options, Codes).
   14
   15quantity(Number, Options, [H | Codes]) :-
   16    quantity(Number, Options, [H | Codes], []).
   17
   18quantity(Number, Options, [H | Codes]) :-
   19    interval(Number, Options, [H | Codes], []).
   20
   21% Examples
   22quantity :-
   23    quantity("2.5").
   24
   25quantity :-
   26    quantity("+2.5").
   27
   28quantity :-
   29    quantity("-2.5").
   30
   31quantity :-
   32    quantity(".5").
   33
   34quantity :-
   35    quantity("-.5").
   36
   37quantity :-
   38    quantity("-5").
   39
   40quantity :-
   41    quantity("5").
   42
   43quantity :-
   44    quantity("-3.3 to -3.2").
   45
   46quantity(String) :-
   47    quantity(N, Options, String),
   48    writeln(string(String)-number(N)-options(Options)).
   49
   50% Main types
   51:- discontiguous quantity//2.
   52
   53quantity(Q, [type(natural)])
   54--> nat(Q).
   55
   56quantity(Q, [type(integer) | Options])
   57--> int(Q, Options).
   58
   59quantity(Q, [type(real) | Options])
   60--> real(Q, Options).
   61
   62interval(ci(Lo, Hi), Options)
   63--> quantity(Lo, LoOpt),
   64    to(ToOpt),
   65    quantity(Hi, HiOpt),
   66    { append([LoOpt, ToOpt, HiOpt], Options) }.
   67
   68% Components
   69sign(+1, [sign(none)])
   70--> "".
   71
   72sign(+1, [sign(plus)])
   73--> "+".
   74
   75sign(-1, [sign(hyphen)])
   76--> "-".
   77
   78sign(-1, [sign(dash)])
   79--> [226, 136, 146].
   80
   81sign(-1, [sign(minus)])
   82--> [8722].
   83
   84nat(N)
   85--> digits([H | Codes]),
   86    { number_codes(N, [H | Codes]) }.
   87
   88int(I, Options)
   89--> sign(S, Options),
   90    nat(N),
   91    { I is S * N }.
   92
   93sep(dot)
   94--> ".".
   95
   96sep(comma)
   97--> ",".
   98
   99frac(F, [frac(given), sep(S), digits(D)])
  100--> sep(S),
  101    digits([H | Codes]),
  102    { number_codes(N, [H | Codes]),
  103      length(Codes, L),
  104      D is L + 1,
  105      F = N / 10^D
  106    }.
  107
  108% 1.23
  109real(R, [int(given) | Options])
  110--> sign(S, Opt1),
  111    nat(N),
  112    frac(F, Opt2),
  113    { R is S * (N + F),
  114      append([Opt1, Opt2], Options)
  115    }.
  116
  117% .77
  118real(R, [int(none) | Options])
  119--> sign(S, Opt1),
  120    frac(F, Opt2),
  121    { R is S * F,
  122      append([Opt1, Opt2], Options)
  123    }.
  124
  125% 12
  126real(R, [int(given), frac(none) | Options])
  127--> sign(S, Options),
  128    nat(N),
  129    { R is S * N }.
  130
  131% Intervals (e.g., confidence intervals)
  132to([to(to)])
  133--> blank, blanks, "to", blank, blanks.
  134
  135to([to(dotdotdot)])
  136--> blank, blanks, "...", blank, blanks.
  137
  138to([to(dash)])
  139--> blank, blanks, [226, 136, 146], blank, blanks.
  140
  141to([to(hyphen)])
  142--> blank, blanks, "-", blank, blanks