1:- module(thousands, [n/2,n/3,n/4]). 2:- use_module(library(function_expansion)). 3
10n(_,_).
15n(_,_,_).
20n(_,_,_,_).
21
22user:function_expansion(n(Thousands,Ones), X, true) :-
23 calc_n(0, 0, Thousands, Ones, X).
24
25user:function_expansion(n(Millions,Thousands,Ones), X, true) :-
26 calc_n(0, Millions, Thousands, Ones, X).
27
28user:function_expansion(n(Billions,Millions,Thousands,Ones), X, true) :-
29 calc_n(Billions, Millions, Thousands, Ones, X).
30
31calc_n(Billions, Millions, Thousands, Ones, X) :-
32 integer(Billions),
33 integer(Millions),
34 integer(Thousands),
35 integer(Ones),
36 X is 1000000000*Billions + 1000000*Millions + 1000*Thousands + Ones.
37
38:- begin_tests(thousands). 39test(billions) :-
40 1123456789 =:= n(1,123,456,789).
41test(millions) :-
42 123456789 =:= n(123,456,789).
43test(thousands) :-
44 123456 =:= n(123,456).
45
46test(nested) :-
47 a(9876,b(1234),c(d(6542))) = a(n(9,876),b(n(1,234)),c(d(n(6,542)))).
48
49test(variable) :-
50 X = n(9,876,543),
51 9876543 =:= X.
52
53test(hundreds_not_expanded) :-
54 n(123) =.. [n, 123].
55test(variables_not_expanded) :-
56 n(A,123) =.. [n, A, 123].
57:- end_tests(thousands).