comparison interps/brachylog/brachylog/Brachylog-master/src/utils.pl @ 11868:70dedbc831e9 draft

<ais523> ` mv ibin/brachylog interps/brachylog
author HackEso <hackeso@esolangs.org>
date Tue, 16 Jul 2019 21:39:11 +0000
parents ibin/brachylog/Brachylog-master/src/utils.pl@318de151d0ec
children
comparison
equal deleted inserted replaced
11867:b0414b6b332f 11868:70dedbc831e9
1 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2 ____ ____
3 \ \ / /
4 \ \ ____ / /
5 \ \/ \/ /
6 \ /\ / BRACHYLOG
7 \ / \ / A terse declarative logic programming language
8 / \ / \
9 / \/ \ Written by Julien Cumin - 2017
10 / /\____/\ \ https://github.com/JCumin/Brachylog
11 / / ___ \ \
12 /___/ /__/ \___\
13
14 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
15
16
17 :- module(utils, [integer_value/2,
18 brachylog_prolog_variable/2,
19 length_/2,
20 prepend_string/2,
21 prepend_integer/2,
22 is_brachylog_list/1,
23 single_atom_code/2,
24 ceiled_square_root/2,
25 scompare/4,
26 if_/3,
27 (=)/3,
28 (#>)/3,
29 (===)/6
30 ]).
31
32 :- use_module(library(clpfd)).
33
34
35 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
36 INTEGER_VALUE
37 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
38 integer_value('integer':Sign:I, E) :-
39 integer_value('integer':Sign:I, 0, E, E).
40
41 integer_value('integer':Sign:[], N0, N, _) :-
42 ( Sign = 'positive',
43 N #= N0
44 ; Sign = 'negative',
45 N #= - N0
46 ).
47 integer_value('integer':Sign:[H], N0, N, M) :-
48 H in 0..9,
49 N1 #= H + N0 * 10,
50 abs(M) #>= abs(N1),
51 integer_value('integer':Sign:[], N1, N, M).
52 integer_value('integer':Sign:[H,I|T], N0, N, M) :-
53 H in 0..9,
54 N1 #= H + N0 * 10,
55 abs(M) #>= abs(N1),
56 integer_value('integer':Sign:[I|T], N1, N, M).
57
58
59 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
60 BRACHYLOG_PROLOG_VARIABLE
61 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
62 brachylog_prolog_variable('integer':I, I) :- !.
63 brachylog_prolog_variable('float':F, F) :- !.
64 brachylog_prolog_variable('string':S, String) :- !,
65 escape_string_list(S, T),
66 atomic_list_concat(T, U),
67 atomic_list_concat(['"',U,'"'], A),
68 term_to_atom(String, A).
69 brachylog_prolog_variable(List, PrologList) :-
70 is_list(List),
71 maplist(brachylog_prolog_variable, List, PrologList).
72
73 escape_string_list([], []).
74 escape_string_list(['"'|T], ['\\','"'|T2]) :-
75 escape_string_list(T, T2).
76 escape_string_list(['\\'|T], ['\\','\\'|T2]) :-
77 escape_string_list(T, T2).
78 escape_string_list([H|T], [H|T2]) :-
79 H \= '"',
80 H \= '\\',
81 escape_string_list(T, T2).
82
83
84 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
85 LENGTH_
86 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
87 length_(Length, List) :-
88 length(List, Length).
89
90
91 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
92 PREPEND_STRING
93 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
94 prepend_string(S, 'string':S).
95
96
97 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
98 PREPEND_INTEGER
99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
100 prepend_integer(I, 'integer':I).
101
102
103 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
104 IS_BRACHYLOG_LIST
105 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
106 is_brachylog_list([]).
107 is_brachylog_list([_|_]).
108
109
110 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
111 SINGLE_ATOM_CODE
112 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
113 single_atom_code(A, C) :-
114 catch(atom_codes(A, [C]), _, false).
115
116
117 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
118 CEILED_SQUARE_ROOT
119 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
120 ceiled_square_root(0, 0).
121 ceiled_square_root(N0, Root) :-
122 N1 #= N0 - 1,
123 Max in 0..N1,
124 R0^2 #= Max,
125 Root #= Root0 + 1,
126 fd_sup(R0, Root0).
127
128
129 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
130 SCOMPARE
131 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
132 scompare(@>, TypeX:X, TypeY:Y, TypeZ:Z) :-
133 ( X @> Y ->
134 TypeZ:Z = TypeX:X
135 ; TypeZ:Z = TypeY:Y
136 ).
137 scompare(@<, TypeX:X, TypeY:Y, TypeZ:Z) :-
138 ( X @< Y ->
139 TypeZ:Z = TypeX:X
140 ; TypeZ:Z = TypeY:Y
141 ).
142
143
144 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
145 IF_/3
146 Credits to Ulrich Neumerkel
147 See: http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/sicstus/reif.pl
148 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
149 if_(If_1, Then_0, Else_0) :-
150 call(If_1, T),
151 ( T == true -> Then_0
152 ; T == false -> Else_0
153 ; nonvar(T) -> throw(error(type_error(boolean,T),
154 type_error(call(If_1,T),2,boolean,T)))
155 ; throw(error(instantiation_error,instantiation_error(call(If_1,T),2)))
156 ).
157
158
159 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
160 (=)/3
161 Credits to Ulrich Neumerkel
162 See: http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/sicstus/reif.pl
163 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
164 =(X, Y, T) :-
165 ( X == Y -> T = true
166 ; X \= Y -> T = false
167 ; T = true, X = Y
168 ; T = false,
169 dif(X, Y)
170 ).
171
172
173 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
174 (#>)/3
175 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
176 #>(X, Y, T) :-
177 zcompare(C, X, Y),
178 greater_true(C, T).
179
180 greater_true(>, true).
181 greater_true(<, false).
182 greater_true(=, false).
183
184
185 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
186 (===)/6
187 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
188 ===(X1, Y1, X2, Y2, T1, T) :-
189 ( X1 == Y1 -> T1 = true, T = true
190 ; X1 \= Y1 -> T1 = true, T = false
191 ; X2 == Y2 -> T1 = false, T = true
192 ; X2 \= Y2 -> T1 = false, T = false
193 ; T1 = true, T = true, X1 = Y1
194 ; T1 = true, T = false, dif(X1, Y1)
195 ).