1:- module(pac_word,[let_w/2, let_wd/2, let_wl/2, let_wld/2, 2 adjacent_interval/3, am_finals/2, 3 expand_recognize_act/7, 4 expand_w/5, expand_w/7, expand_wl/5, expand_wl/7, 5 regex_am/2, regex_coalgebra/2, regex_compare/3, 6 word/3, x_char_boole_form/2, 7 let_w/2, let_wd/2, let_wl/2, let_wld/2 8 ]). 9 10:- use_module(pac('parse-regex')). 11:- use_module(pac('interval-boole')). 12:- use_module(pac('anti-subst')). 13:- use_module(pac(reduce)). 14:- use_module(pac('expand-pac')). 15:- use_module(pac(op)).
21% 22% ?- coalgebra:show_am("a"). 23% ?- coalgebra:show_am(".*"). 24% ?- coalgebra:show_am(@($)). 25% ?- coalgebra:show_am(a). 26% ?- coalgebra:show_am(a^(3-5)). 27% ?- coalgebra:show_am(a^(>=(5))). 28% ?- regex_coalgebra(a^(>=(1)), X). 29% ?- regex_am(a^(>=(1)), X). 30 31word_am(char(X),A1) :-!, word_am(char_boole_form(X),A2), 32 word_am(i_boole(A2),A3), 33 am_char(A3,A1). 34word_am('I'(X),A1) :-!, am_char_simple(X,A1). 35word_am([],A1) :-!,am_unit(A1). 36word_am(coa(A,B),coa(A,B)):-!. 37word_am(X+Y,A1) :-!, word_am(X,A2), 38 word_am(Y,A3), 39 am_concat(A2,A3,A1). 40word_am((X|Y),A1) :-!, word_am(X,A2), 41 word_am(Y,A3), 42 am_cup(A2,A3,A1). 43word_am((X\Y),A1) :-!, word_am(X,A2), 44 word_am(Y,A3), 45 am_minus(A2,A3,A1). 46word_am(X&Y,A1) :-!, word_am(X,A2), 47 word_am(Y,A3), 48 am_cap(A2,A3,A1). 49word_am(+X,A1) :-!, word_am(X,A), 50 word_am(A+ *(A),A1). 51word_am(*(X),A1) :-!, word_am(X,A2), am_star(A2,A1). 52word_am(\+ X, A1) :-!, word_am(*('.')\X, A1). 53word_am(\ X, A1) :-!, word_am(*('.')\X, A1). 54word_am(?(X), A1) :-!, word_am(([]|X),A1). 55word_am(E^ >=(N),A1):-!, word_am(E, E0), 56 word_am(E0^N,A2), 57 word_am(*E0,A3), 58 word_am(A2+A3,A1). 59word_am(E^(I-J),A1) :-K is J-I, !, 60 word_am(E,E0), 61 word_am(E0^I,A2), 62 word_am(E0^ =<(K),A3), 63 word_am(A2+A3,A1). 64word_am(E^ =<(N),A1):-!, word_am(E,A2), 65 am_power_lower(N,A2,A1). 66word_am(E^N,A1) :-!, word_am(E,A2), am_power(N,A2,A1). 67word_am(rev(E),A1) :-!, word_am(E,A2), 68 am_reverse(A2,A1). 69word_am(special(X,Is),A1):-!, am_special(X,Is,A1). 70 71 /**************************** 72 * Special characters * 73 ****************************/ 74 75% 76regex_macro($, special($)). 77regex_macro(comment, "/\\*.*\\*/" | "%.*$"). 78regex_macro(paragraph, ".*$$$*"). 79 80final_special_pred(at_end_of_tape). 81 82% 83special_char_class($, '\n'). 84 85% ?- x_char_boole_form($, X), iboole:i_boole(X, I). 86x_char_boole_form(X, I):- special_char_class(X, X0), 87 once(char_boole_form(X0, I)). 88 89% So far, only "at_end_of_tape" is an example of special tokens. 90% ?- am_special($, [1,2,3], E). 91 92am_special($, Interval_list, coa(E, 1)):- 93 sort(Interval_list, Interval_list0), 94 E0 = [1- [ special(at_end_of_tape), 95 Interval_list0 - 2 ], 96 2 - [[]]], 97 split_goto(E0, E). 98 99% 100compile_special_char($, Ints, N, I, J, M, 101 [R|P], P) :- 102 ( N ==0, 103 Head0 =.. [I, [V |X], Y] , 104 CallJ =.. [J, X, Y] 105 ; N ==2, 106 Head0 =.. [I, A, B, [V |X], Y], 107 CallJ =.. [J, A, B, X, Y] 108 ), 109 ( Ints = (U-U) -> (U = V, V_test_code=true) 110 ; once(generate_code_test(Ints, V, V_test_code))), 111 slim_goal((V_test_code, CallJ), Body0), 112 prefix_convention(M, Head0:-Body0, R). 113% 114compile_special_pred(at_end_of_tape, [I, _, N, M], Head:-true):- 115 ( N ==0, Head0 =..[I, [],[]] 116 ; N ==2, Head0 =..[I, A, A, [],[]] 117 ), 118 prefix_convention(M, Head0, Head). 119 120 121% ?- phrase(w(char(alnum) + *(char(alpha))), `a1bc`, S). 122% ?- phrase(w(ab+cd), `abcde`, S). 123% ?- phrase(w("abcd"), `abcde`, S). 124% ?- phrase(w(i(2)+i(3)), [2,3], S). 125% ?- regex_coalgebra("23", S). 126% ?- regex_coalgebra(i(2)+i(3), S). 127 128% ?- phrase(w(i(2)+i(3)), [2,3], S). 129% ?- phrase(w(i(2)^(=<(3))), [2,2], S). 130% ?- phrase(w(i(2)^(>=(3))), [2,2,2,2], S). 131 132% ?- let_w(X, ".*"), phrase(X, `abc`, R). 133% ?- let_wd(X, ".*"), call(X, A, [], `abc`, R). 134% ?- let_wl(X, ".*"), phrase(X, `abc`, R). 135% ?- let_wld(X, ".*"), call(X, A, [], `abc`, R). 136 137let_w(F, X) :- once(let_expand_regex(w, 0, X, user, F)). 138let_wd(F, X):- once(let_expand_regex(w, 2, X, user, F)). 139let_wl(F, X):- once(let_expand_regex(wl, 0, X, user, F)). 140let_wld(F, X):- once(let_expand_regex(wl, 2, X, user, F)). 141 142% 143let_expand_regex(W, N, Regex, M_prefix, Pred):- 144 regex_coalgebra_code(Regex, coa(C, I, _)), 145 ( W == wl -> null_last_coa(C, C0); C0=C), 146 expand_coa(N, C0, I, M_prefix, Pred, P, []), 147 maplist(assert, P). 148 149% ?- let_sed(X, w("a") >> =([])). 150% ?- regex_word("a", _4774, _4776). 151% ?- let_sed(X, w("a") >> =([])), call(X, `abac`, S), basic:smash(S, S0). 152% ?- let_sed(X, w("a") >> =([])), call(X, `abac`, S), basic:smash(S). 153% ?- let_sed(X, w("a") >> =([])), call(X, `abac`, S), basic:smash(S). 154% ?- let_sed(X, w("a") >> =([])), call(X, `abac`, S), basic:smash(S). 155% ?- let_sed(X, (w("a", A), w("b", B)) >> append(B, A)), call(X, `abab`, S), basic:smash(S). 156% ?- let_sed(X, s/"a"/"x"), call(X, `abac`, S), basic:smash(S). 157% ?- let_sed(X, b/"a"/"x"), call(X, `abac`, S), basic:smash(S). 158% ?- let_sed(X, a/"a"/"x"), call(X, `abac`, S), basic:smash(S). 159% ?- let_sed(X, d/"a"), call(X, `abac`, S), basic:smash(S). 160% ?- let_sed(X, w/"a"/"xxx"/"yyy"), call(X, `abac`, S), basic:smash(S). 161% ?- let_sed(F, wl("a+", A) >> pred(A, ([B]:- length(A, L), length(B,L), maplist(=(0'b), B)))), call(F, `aaa`, R), basic:smash(R). 162% ?- let_sed(F, (w(".*", A), wl("b+")) >> pred(A, [A])), call(F, `aaabbccc`, R), basic:smash(R). 163% ?- basic:herbrand(_, `(w(".*", A), wl("b+")) >> pred(A, [A])`, H), let_sed(F, H), call(F, `aaabbccc`, R), basic:smash(R). 164 165userlet_sed(X, Y) :- prolog_load_context(module, M), 166 once(let_sed(X, M, Y)). 167 168% 169let_sed(X, M, S) :- pac:expand_sed(S, [F, W, A]), 170 once(expand_recognize_act(F, W, A, M, X, P, [])), 171 maplist(assert, P). 172 173% ?- regex_coalgebra("[^\\./]*", X). 174% ?- regex_coalgebra(( "\"([^\"\\\\]|(\\\\.))*\"" | "'([^'\\\\]|(\\\\.))*'" | "[^ \t\"']+"), X). 175% ?- regex_coalgebra(*(a|b)+ [a]+(*([]))+ (*(*([]|[]))), N). 176% ?- regex_coalgebra(*(a|b)+ "a"+(*([]))+ (*(*([]|[]))), N). 177% ?- regex_coalgebra(*(.), X). 178% ?- regex_coalgebra(".*", X). 179% ?- regex_coalgebra(ab+cd, X). 180% ?- regex_coalgebra(ab+cd, X, [code]). 181 182% ?- regex_coalgebra_code("a*", X). 183% ?- regex_coalgebra_code(ab+cd, X). 184% ?- regex_coalgebra_char(".*", X). 185% ?- regex_coalgebra_char("a*", X). 186% ?- regex_coalgebra_char("[adlz]", X). 187% ?- regex_coalgebra_char(ab+cd, X). 188% ?- regex_coalgebra_char(a, X). 189% ?- regex_coalgebra_char(i([-1, -1]), X). 190% ?- regex_coalgebra_char("a", X). 191 192regex_coalgebra(X, coa(E0, I, Fs), Options):- once(regex_am(X, coa(E, I))), 193 am_finals(coa(E, _), Fs), 194 ( memberchk(char, Options) 195 -> map_coa_char_int(E, E0) 196 ; E0 = E 197 ). 198 199% 200regex_coalgebra(X, C):- regex_coalgebra(X, C, [code]). 201% 202regex_coalgebra_code(X, C):- regex_coalgebra(X, C, [code]). 203% 204regex_coalgebra_char(X, C):- regex_coalgebra(X, C, [char]). 205 206 /*************************************** 207 * State Transition by Automaton * 208 ***************************************/ 209 210% ?- regex_coalgebra_char("a*", X). 211% ?- regex_coalgebra_char("a", X). 212% ?- map_coa_char_int([1-[[97-97]-2], 2-[[]]], _508). 213% ?- regex_coalgebra_char("a*", X), state_move([a], 1, S, X). 214% ?- (regex_coalgebra_char("a*", X), state_move([a,a,a], 1, S, X)). 215% ?- (regex_coalgebra("a*", X, [char]), state_move([a,a], 1, S, X)). 216% ?- regex_coalgebra("\001\*", X, [code]). 217% ?- regex_coalgebra(i([-1, -1]), X). 218 219state_move([], S, S, _). 220state_move([X|R], S, S0, Coa):- 221 once(state_move_one(X, S, S1, Coa)), 222 state_move(R, S1, S0, Coa). 223% 224state_move_one(X, S, S1, coa(E,_,_)):- memberchk(S-Dots, E), 225 member(Intervals-S1, Dots), 226 member(A-B, Intervals), 227 greater_or_eq(X, A), 228 smaller_or_eq(X, B). 229% 230greater_or_eq(_, inf). 231greater_or_eq(X, I):- X @>= I. 232% 233smaller_or_eq(_, sup). 234smaller_or_eq(X, I):- X @=< I. 235 236 /*************************** 237 * map character classes * 238 ***************************/ 239% ?- phrase(w(char(alnum) + *(char(alpha))), `a1bc`, S). 240% ?- phrase(w(ab+cd), `abcde`, S). 241% ?- phrase(w("abcd"), `abcde`, S). 242 243% ?- map_coa_char_int(R, [1-[[a-a]-2], 2-[[]]]). 244% ?- map_coa_char_int(R, [1-[[a-a]-2], 2-[[]]]), map_coa_char_int(R, S). 245 246map_coa_char_int(X, Y):- 247 maplist(coa_char_int_aux, X, Y). 248% 249coa_char_int_aux(I-R, I-R0):- maplist(map_goto_char_int, R, R0). 250 251% 252map_goto_char_int([], []). 253map_goto_char_int(Is-S, Js-S):- maplist(goto_char_int_aux, Is, Js). 254% 255goto_char_int_aux(A-B, A0-B0):- char_int(A, A0), char_int(B, B0). 256 257% 258char_int(inf, inf). 259char_int(sup, sup). 260char_int(X, Y):- 261 ( ( is_of_type(negative_integer, X) 262 ; is_of_type(negative_integer, Y) 263 ) 264 -> X = Y 265 ; char_code(Y, X) 266 ). 267 268 /********************* 269 * goto states * 270 *********************/ 271 272% ?- am_char_dict([2-[[inf-sup]-3]], C, [], P). 273%@ C = [2-[_G2137-3]], 274%@ P = [[inf-sup]-_G2137]. 275 276am_char_dict([], [], P, P). 277am_char_dict([[]|Z], [[]|Z0], P, Q):- am_char_dict(Z, Z0, P, Q). 278am_char_dict([X-Y|Z], [X-Y0|Z0], P, Q):- 279 once(goto_dict(Y, Y0, P, R)), 280 am_char_dict(Z, Z0, R, Q). 281 282% 283goto_dict([], [], P, P). 284goto_dict([[]|X],[[]|Y], P, Q):- goto_dict(X, Y, P, Q). 285goto_dict([I-S|X],[V-S|Y], P, Q):- add_char_dict(I, P, P0, V), 286 goto_dict(X, Y, P0, Q). 287 288% 289add_char_dict(I, P, P, V):- memberchk(I-V, P). 290add_char_dict(I, P, [I-V|P], V). 291 292% 293expand_char_class(U, V):- maplist(expand_char_class_aux, U, V). 294 295% 296expand_char_class_aux(X-Y, X-Y0):- 297 maplist(expand_char_class_aux_aux, Y, Y0). 298% 299expand_char_class_aux_aux([], []):- !. 300expand_char_class_aux_aux(V-S, Gotos) :- 301 maplist(expand_char_class_aux_aux_aux(S), V, Gotos). 302% 303expand_char_class_aux_aux_aux(S, A, A-S). 304 305% ?- split_goto([1-[[], [1,2,3]-s, [2,3]-t], 1-[[1,2,3]-s, [2,3]-t]], X). 306split_goto(X, Y):- maplist(split_goto_aux, X, Y). 307 308% 309split_goto_aux(I-S, I-S0):- distribute_state(S, S0, []). 310 311% 312distribute_state(X, Y):- distribute_state(X, Y, []). 313 314% 315distribute_state([X-S|Y], Z, U):- distribute_state(X, S, Z, V), 316 distribute_state(Y, V, U). 317distribute_state([A|X], [A|Y], Z):- distribute_state(X, Y, Z). 318distribute_state([], X, X). 319 320% 321distribute_state([A|R], S, [A-S|P], Q):- distribute_state(R, S, P, Q). 322distribute_state([], _, Z, Z). 323 324 /***************************** 325 * automaton synthesis * 326 *****************************/ 327 328% 329merge([X,X|Y], U):- merge([X|Y], U). 330merge([X|R], [X|U]):- merge(R, U). 331merge([], []). 332 333% ?- regex_am((.), R). 334% ?- regex_am(($), R). 335% ?- regex_am("abc", R). 336 337regex_am(X, Y):- regex_word(X, X0, Basic_interval_dict), 338 word_am(X0, Y0), 339 am_connected_region(Y0, Y0_reachable), 340 am_remove_empty_states(Y0_reachable, Y0_slim), 341 once(am_remove_useless_states(Y0_slim, Y0_useful)), 342 once(am_char_back(Y0_useful, Basic_interval_dict, Y1)), 343 am_normal(Y1, Y). 344 345% 346word_normal_am --> word_am, 347 am_connected_region, 348 am_remove_empty_states, 349 am_remove_useless_states, 350 am_normal. 351% 352regex_word(X, Y):- regex_word(X, Y, _).
Simplest usage:
?- pac_word:regex_word(("."), Y, Z).
Y = 'I'([1]),
Z = [inf-sup-1] .
?- regex_word(char(alpha), Y, Z).
Y = 'I'([1, 2]),
Z = [65-90-1, 97-122-2] .
?- regex_word(special($), Y, Z).
Y = special($, [x($, 1)]),
Z = [x($, 10-10)-x(1)] .
370x_snd(x(_, I), I):-!. 371x_snd(I, I). 372 373% ?- regex_word((special($) + a), Y, Z). 374regex_word(X, Y, Basic_interval_dict):- 375 once(parse_interval(X, Y, P, [])), 376 sort(P, SortedP), 377 once(merge(SortedP, PX)), 378 zip_hyphen(A, Target_interval_list, PX), 379 maplist(x_snd, A, A0), 380 zip_hyphen(A0, Refinement, Pzip), 381 refine_char_dict(Pzip), 382 basic_interval_index(Refinement, 383 Partition_in_index, 384 Basic_interval_dict0), 385 zip_hyphen(A, Partition_in_index, Char_dict), 386 mark_basic_interval_dict(Basic_interval_dict0, 387 Char_dict, 388 Basic_interval_dict), 389 mark_interval_block_list(Char_dict, 390 Partition_in_index, 391 Target_interval_list). 392 393% [2014/09/02] 394refine_char_dict(Tzip):- zip_hyphen(Left, Right, Tzip), 395 iboole:m_partition(Left, Right).
sample use:
?- mark_basic_interval_dict([(a-b)-1, (c-d)-2, (e-f)-3], [x($, _)-[1],
x(#, _)-[2], [_]-[3,4]], Y).
Y = [x($, a-b)-x(1), x(#, c-d)-x(2), e-f-3] .
406mark_basic_interval_dict(X, P, Y):- 407 maplist(mark_basic_interval_dict_aux(P), X, Y). 408 409% 410mark_basic_interval_dict_aux(P, A-N, x(S, A)- x(N)):- 411 member(x(S,_)-L, P), 412 memberchk(N, L). 413mark_basic_interval_dict_aux(_, U, U). 414 415% 416mark_interval_block_list(Assoc, IB, IBX):- 417 maplist(mark_interval_block(Assoc), IB, IBX). 418 419% 420mark_interval_block(Assoc, L, LX):- 421 maplist(mark_interval(Assoc), L, LX). 422 423% 424mark_interval(Assoc, I, x(S,I)):- member(x(S, _)-W, Assoc), 425 memberchk(I, W). 426mark_interval(_, I, I). 427 428% 429am_char_back(coa(X, I), M, coa(Y, I)):- maplist(am_char_back_aux(M), X, Y). 430 431% 432am_char_back_aux(M, I-A, I-B):- maplist(am_char_back_aux_aux(M), A, B). 433 434% 435am_char_back_aux_aux(M, x(_X, K)-J, A-J) :- memberchk(A-x(K), M). 436am_char_back_aux_aux(M, C-J, D-J) :- memberchk(D-C, M). 437am_char_back_aux_aux(_, U, U). 438 439% 440basic_interval_index(Ks, Js, Basic_interval_dict):- 441 maplist(zip_hyphen, Ks, Js, U), 442 flatten(U, V), 443 sort(V, Basic_interval_dict0), 444 once(merge(Basic_interval_dict0, Basic_interval_dict)), 445 length(Basic_interval_dict, N), 446 ( N==0 447 -> true 448 ; numlist(1, N, NZip), 449 zip_hyphen(_, NZip, Basic_interval_dict) 450 ). 451 452 453 /************************ 454 * parse interval * 455 ************************/
Simple usage:
?- parse_interval("[a-z]", R, X, []).
R = 'I'(_G5557),
X = [[97-122]-_G5557] .
468% ?- phrase(w(i([-1, -1])), [-1], X). 469% ?- expand_phrase(w(i([-1, -1])), [], G, L, []). 470 471% ?- regex_coalgebra("abc*", X, [code]). 472% ?- (regex_coalgebra("(\000\|\001\)*", X, [code]), state_move([0,1,0,0], 1, S, X)). 473% ?- regex_coalgebra(i(-1), X, [code]). 474% ?- regex_coalgebra(i([-1, -2]), X, [code]). 475% ?- (regex_coalgebra(*(i([-5 - -1])), X, [code]), state_move([-1, -2, -3], 1, S, X)). 476% ?- (regex_coalgebra(i(-1) + *(i(0)) + i(-2), X, [code]), state_move([-1, -2], 1, S, X)). 477% ?- (regex_coalgebra(i(-1) + *(i(0)) + i(-2), X, [code]), state_move([-1, 0,0, 0, 0, -2], 1, S, X)). 478% ?- show_phrase(w("a*$")). 479% ?- coalgebra:show_am("abc*"). 480%@ true. 481 482 483parse_interval(X, Y) --> i_parse(X, Y). 484 485% 486i_parse((.), 'I'(U)) --> [[inf-sup]-U]. 487i_parse(char(X), 'I'(U)) --> [I-U], 488 { once(char_boole_form(X, X0)), i_boole(X0, I) }. 489i_parse(i(X), 'I'(U)) --> [I - U], 490 { once(i_normal_class_form(X, Y)), i_boole(Y, I) }. 491i_parse('C'(X), U) --> i_parse_codes(X, U). 492i_parse([], []) --> []. 493i_parse(special(X), special(X, U)) --> [x(X, I)-U], 494 { x_char_boole_form(X, X0), i_boole(X0, I) }. 495i_parse(out(X), U) --> i_parse(char(out(X)), U). 496i_parse(dot(X), U) --> i_parse(char(X), U). 497i_parse(X+Y, U+V) --> i_parse(X, U), i_parse(Y, V). 498i_parse(X|Y, U|V) --> i_parse(X, U), i_parse(Y, V). 499i_parse(X\Y, U\V) --> i_parse(X, U), i_parse(Y, V). 500i_parse(X&Y, U&V) --> i_parse(X, U), i_parse(Y, V). 501i_parse(+(X), +(U)) --> i_parse(X, U). 502i_parse(*(X), *(U)) --> i_parse(X, U). 503i_parse(\+(X), U) --> i_parse( *(.) \ X, U). 504i_parse(\(X), U) --> i_parse( *(.) \ X, U). 505i_parse(rev(X), rev(U)) --> i_parse(X, U). 506i_parse(?(X), ?(U)) --> i_parse(X, U). 507i_parse(E^N, E0^N) --> i_parse(E, E0). 508i_parse(regexlist(L), regexlist(L0)) --> i_parse_list(L, L0). 509i_parse(@(X), U) --> {regex_macro(X, Y)}, i_parse(Y, U). 510i_parse("", []) --> []. 511i_parse(X, U) --> {string(X)}, 512 {parse_regex(X, Y)}, 513 i_parse(Y, U). 514i_parse(X, U) --> {atom(X)}, {atom_codes(X, Y)}, i_parse_codes(Y, U). 515i_parse(X, U) --> {number(X)}, {number_codes(X, Y)}, i_parse_codes(Y, U). 516i_parse(X, _) --> {throw(i_parse:'unknown hybrid regex found'(X))}. 517 518% 519i_parse_list([E|Es], [F|Fs]) --> i_parse(E, F), 520 i_parse_list(Es, Fs). 521i_parse_list([], []) --> []. 522 523% 524i_parse_codes([X], 'I'(U)) --> [[X-X] - U]. 525i_parse_codes([X, Y|Z], 'I'(U) + R) --> [[X-X]- U], 526 i_parse_codes([Y|Z], R). 527i_parse_codes([], []) --> []. 528 529% Note. 530% ?- eval(:(=) @ (:(=) @ (:(=) @ 1)), V). 531 532% ?- am_linear([a,b], X). 533% ?- am_linear([], X). 534 535am_linear(Cs, coa(E, 1)):- once(am_linear(Cs, 1, E, [])). 536 537am_linear([], N, [N-[[]]|L], L). 538am_linear([A|R], N, [N-[A-N0]|L], L0):- N0 is N+1, 539 am_linear(R, N0, L, L0).
A simple usage:
?- char_boole_form(a|b, X).
X = ([97-97];[] | [98-98];[]).
550char_boole_form((.), [inf-sup]). 551char_boole_form([], []). 552char_boole_form(X-Y, [A0-A1]):- 553 (atom(X), atom_length(X, 1); integer(X)), 554 (atom(Y), atom_length(Y, 1); integer(Y)), 555 ( atom(X) -> char_code(X, X0); X0=X ), 556 ( atom(Y) -> char_code(Y, Y0); Y0=Y ), 557 msort([X0,Y0], [A0,A1]). 558char_boole_form(X, Y):- atom(X), reserved_char_class(Assoc), 559 memberchk(X-C, Assoc), 560 maplist(char_boole_form_aux, C, C0), 561 char_boole_form(C0, Y). 562char_boole_form(X, Y):- atom(X), atom_codes(X, Y0), 563 char_boole_form(Y0, Y). 564char_boole_form(X, [X-X]):- integer(X). 565char_boole_form([X|Y], X0;Y0):- char_boole_form(X, X0), 566 char_boole_form(Y, Y0). 567char_boole_form(dot(X), Y):- char_boole_form(X, Y). 568char_boole_form(out(X), out(Y)):- char_boole_form(X, Y). 569char_boole_form(^(X), Y):- char_boole_form(out(X), Y). 570char_boole_form(X^N, Y^N):- char_boole_form(X, Y). 571char_boole_form(\+(X), Y):- char_boole_form(out(X), Y). 572char_boole_form(\(X), Y):- char_boole_form(out(X), Y). 573char_boole_form(X|Y, X0|Y0):- char_boole_form(X, X0), 574 char_boole_form(Y, Y0). 575char_boole_form(X;Y, Z):- char_boole_form(X|Y, Z). 576char_boole_form(\(X,Y), \(X0,Y0)):- char_boole_form(X, X0), 577 char_boole_form(Y, Y0). 578char_boole_form(X&Y, X0&Y0):- char_boole_form(X, X0), 579 char_boole_form(Y, Y0). 580 581% 582char_boole_form_aux(A-B, A0-B0):- char_code(A, A0), char_code(B, B0). 583char_boole_form_aux(A, A0):- char_code(A, A0). 584 585 586% ?- i_normal_class_form([-1, -2], X). 587%@ X = ([-1- -1];[-2- -2];[]) . 588 589i_normal_class_form([], []). 590i_normal_class_form(X, [X-X]):- integer(X). 591i_normal_class_form([X-Y|Z], ([X-Y]; U)):- i_normal_class_form(Z, U). 592i_normal_class_form([X|Z], ([X-X]; U)):- i_normal_class_form(Z, U). 593 594%%% Tiny helpers 595zip_hyphen([], [], []). 596zip_hyphen([A|B], [C|D], [A-C|R]):- zip_hyphen(B, D, R). 597 598% 599zip_comma([], [], []). 600zip_comma([A|B], [C|D], [(A,C)|R]):- zip_comma(B, D, R). 601 602% 603byte_in_bits(N, Bits):- poly:bits(N, [], Bits0), 604 length(Bits, 8), 605 append(P, Bits0, Bits), 606 maplist(=(0), P). 607 608 609 /****************************************** 610 * automaton sysnthesis basic steps * 611 ******************************************/
618am_determine(coa(E, I), D):- am_determine(E, I, E0, I0), 619 am_fresh(coa(E0, I0), D0), 620 am_clean(D0, D). 621 622am_determine(E, I, D, [I]):- once(am_determine([[I]], [], E, D, [])). 623 624am_determine([], _, _, P, P). 625am_determine([S|R], H, E, P, Q):- memberchk(S, H), 626 am_determine(R, H, E, P, Q). 627am_determine([S|R], H, E, [S-C|P], Q):- 628 expand_power_state(S, E, C, R0, R), 629 am_determine(R0, [S|H], E, P, Q).
635am_slim(coa(E, I), coa(D, I)):- once(am_slim([I], [], E, D, [])). 636 637am_slim([], _, _, P, P). 638am_slim([S|R], H, E, P, Q):- memberchk(S, H), 639 am_slim(R, H, E, P, Q). 640am_slim([I|A], H, E, [I-U|P], Q):- once(select(I-U, E, E0)), 641 once(am_slim(U, A, [I|H], E0, P, Q)). 642 643% 644am_slim([], A, H, E, P, Q):- am_slim(A, H, E, P, Q). 645am_slim([_-G|R], A, H, E, P, Q):- am_slim(R, [G|A], H, E, P, Q). 646am_slim([_|R], A, H, E, P, Q):- am_slim(R, A, H, E, P, Q). 647 648% ?- expand_power_state([x,y], [x-[a-2, b-3], y-[a-2, b-4, c-5]], R, A, []). 649%@ R = [a-[2], b-[3, 4], c-[5]], 650%@ A = [[2], [3, 4], [5]] . 651% ?- expand_power_state([x,y], [x-[[], a-2, b-3], y-[a-2, b-4, c-5]], R, A, []). 652%@ R = [[], a-[2], b-[3, 4], c-[5]], 653%@ A = [[2], [3, 4], [5]] . 654% ?- trace, expand_power_state([x,y], [x-[special(s), a-2, b-3], y-[a-2, b-4, c-5]], R, A, []). 655 656expand_power_state(S, E, Coa, P, Q):- 657 foldl(expand_power_state_aux(E), S, [], Pairs0), 658 sort(Pairs0, Pairs), 659 once(merge_pairs(Pairs, Coa, [], P, Q)). 660% 661expand_power_state_aux(E, K, L, M):- memberchk(K-B, E), 662 foldl(cons, B, L, M). 663 664cons(X, Y, [X|Y]). 665 666% ?-is_deterministic(coa([1-[a-1, b-1]], _)). 667% ?-is_deterministic(coa([1-[a-1, a-1]], _)). 668is_deterministic(coa(E, _)):- is_deterministic(E). 669 670is_deterministic([_-A|R]):- \+ consecutive_same_key(A), 671 is_deterministic(R). 672is_deterministic([]). 673 674% 675consecutive_same_key([A-_, A-_|_]). 676consecutive_same_key([_, A|B]):- consecutive_same_key([A|B]). 677 678 679 /************************************* 680 * automata state minimization * 681 *************************************/
687% ?- regex_coalgebra(".*****", X). 688%@ X = coa([1-[[], dot([inf-sup])-1]], 1, [1]) . 689% ?- am_minimum([2-[[], (inf-sup)-3], 3-[[], (inf-sup)-3]], 2, R). 690%@ R = coa([1-[[], inf-sup-1]], 1) . 691 692% ?- am_minimum(coa([1-[a-2, b-1], 2-[a-1, b-2], 3-[a-3, b-1]], 1), D). 693%@ D = coa([1-[a-1, b-1]], 1) . 694 695am_minimum(coa(E,I), C):- once(am_minimum(E, I, C)). 696 697am_minimum(E, I, coa(E3, J)):- minimum_am_qmap(E, Qmap), 698 ( Qmap == [] 699 -> E3 = E, 700 J = I 701 ; member(X-I0, Qmap), 702 memberchk(I, X), 703 quotient_coa(E, Qmap, E1), 704 am_clean(coa(E1, I0), coa(E2, J)), 705 sort(E2, E3) 706 ). 707 708make_singleton(I, [I]). 709% 710minimum_am_qmap(Coa, Qmap):- 711 once(am_conflict_pairs(Coa, Conflicts)), 712 sort(Conflicts, CSorted), 713 once(pairs_to_assoc(CSorted, Inicon, [])), 714 all_states(Coa, All), 715 assoc_product(All, All, Prod, []), 716 once(assoc_subtract(Prod, Inicon, Rel)), 717 maplist(make_singleton, All, Singletons), 718 once(coa_union_find(Rel, Singletons, Clusters)), 719 ( Clusters == [] 720 -> Qmap = [] 721 ; length(Clusters, N), 722 numlist(1, N, S), 723 zip_hyphen(Clusters, S, Qmap) 724 ). 725 726% 727% quotient_coa(Eqs, Qmap, Eqs0) :- 728% maplist(pred(Qmap, [S-L, S0-L0]:- 729% ( member(Cluster-S0, Qmap), 730% memberchk(S, Cluster), 731% maplist(pred(Qmap, 732% ([A-G, A-G0]:- 733% (member(GCluster-G0, Qmap), 734% memberchk(G, GCluster))) 735% & [X, X] ), 736% L, L1 ), 737% predsort(compare_right, L1, L0) 738% )), Eqs, Eqs0). 739 740% 741quotient_coa(Eqs, Qmap, Eqs0) :- maplist(quotient_coa_aux(Qmap), Eqs, Eqs0). 742 743% 744quotient_coa_aux(Qmap, S-L, S0-L0) :- 745 member(Cluster-S0, Qmap), 746 memberchk(S, Cluster), 747 maplist(quotient_coa_aux_aux(Qmap), L, L1), 748 predsort(compare_right, L1, L0). 749 750% 751quotient_coa_aux_aux(Qmap, A-G, A-G0) :- 752 member(GCluster-G0, Qmap), 753 memberchk(G, GCluster). 754quotient_coa_aux_aux(_, X, X). 755 756% 757am_normal(coa([], _), C):- am_empty(C). 758am_normal(coa(A,I), coa(B, I)):- sort(A, C), am_normal(C, B, []). 759 760% 761am_normal([], P, P). 762am_normal([I-A|R], [I-B|P], Q):- 763 am_normal(I, R, R0, As, []), 764 append([A|As], H), 765 sort(H, G), 766 am_normal_body(G, B), 767 am_normal(R0, P, Q). 768 769am_normal_body([], []). 770am_normal_body([[]|G], [[]|B]) :- am_normal_body(G, B). 771am_normal_body([special(X)|G], [special(X)|B]) :- am_normal_body(G, B). 772am_normal_body(G, B) :- keysort_right(G, G0), 773 join_char(G0, B0), 774 maplist(am_normal_body_aux, B0, B). 775 776% 777am_normal_body_aux(I-X, J-X):- x_normal(I, J). 778 779% 780am_normal(I, [I-A|R], R0, [A|P], Q):- am_normal(I, R, R0, P, Q). 781am_normal(_, R, R, P, P). 782 783% 784compare_right(C, X-Z, Y-Z):- compare(C, X, Y). 785compare_right(C, _-X, _-Y):- compare(C, X, Y). 786compare_right(=, X, X). 787compare_right(<, _, _-_). 788compare_right(>, _-_, _). 789compare_right(>, _, _). 790 791% ?- x_compare(C, x(2), 1-2). 792x_compare(C, x(X), x(Y)):- compare(C, X, Y). 793x_compare(<, x(_), _-_). 794x_compare(>, _-_, x(_)). 795x_compare(C, A, B):- iboole:i_compare(C, A, B). 796 797% 798x_normal(X, Y):- x_separate(X, X0, R), 799 iboole:i_normal(R, R0), 800 append(X0, R0, Y). 801 802x_separate([], [], []). 803x_separate([A-B|R], U, [A-B|V]):- x_separate(R, U, V). 804x_separate([X|R], [X|U], V):- x_separate(R, U, V). 805 806 807% ?- merge_pairs([a-2, a-3, a-2, b-1, b-3, c-2], R, [], S, []). 808%@ R = [a-[2, 3], b-[1, 3], c-[2]], 809%@ S = [[2, 3], [1, 3], [2]]. 810 811merge_pairs([I-X|Cs], [I-Pow|D0], D, [Pow|A0], A):- 812 power_state(I, Cs, Cs0, Pow0, []), 813 sort([X|Pow0], Pow), 814 merge_pairs(Cs0, D0, D, A0, A). 815merge_pairs([X|Cs], [X|D0], D, A0, A):- 816 merge_pairs(Cs, D0, D, A0, A). 817merge_pairs([], D, D, A, A). 818 819% 820power_state(I, [I-G|R], R0, [G|P], Q):- 821 power_state(I, R, R0, P, Q). 822power_state(_, A, A, B, B). 823 824% ?- join_char_interval([], []). 825% ?- join_char_interval([(3-4)-t], R). 826%@ R = [[3-4]-t] . 827% ?- coa:join_char_interval([(inf-4)-t, (5-sup)-t], R). 828%@ R = [[inf-4, 5-sup]-t]. 829% ?- join_char_interval([(10-sup)-t, (20-20)-s, (inf-4)-t], R). 830%@ R = [[20-20]-s, [10-sup, inf-4]-t]. 831 832keysort_right(X,Y):- predsort(keysort_right_aux, X, Y). 833% 834keysort_right_aux(=, [], []). 835keysort_right_aux(<, [], _). 836keysort_right_aux(>, _, []). 837keysort_right_aux(C, _-U, _-V):- U @> V, C=(>); C=(<). 838 839% 840join_char_interval(A, B):- keysort_right(A, A0), join_char(A0, B). 841 842% 843join_char([], []). 844join_char([[]|R], [[]|S]):- join_char(R, S). 845join_char([X-A|R], [[X|Xs]-A|S]):- 846 once(join_char(A, R, Xs, R0)), 847 join_char(R0, S). 848 849% 850join_char(_, [], [], []). 851join_char(A, [X-A|R], [X|Xs], S):- 852 join_char(A, R, Xs, S). 853join_char(_, R, [], R). 854 855% ?- merge_target([a-1], R, []). 856%@ R = [a-[1]]. 857% ?- merge_target([a-1, a-2], R, []). 858%@ R = [a-[1, 2]] . 859% ?- merge_target([a-1, a-2, b-3], R, []). 860%@ R = [a-[1, 2], b-[3]] . 861% ?- merge_target([[], a-1, a-2, b-3], R, []). 862%@ R = [[], a-[1, 2], b-[3]] . 863% ?- merge_target([[], a-1, b-3, a-2], R). 864%@ R = [[], a-[1, 2], b-[3]] . 865 866merge_target(X, Y):- sort(X, X0), once(merge_target(X0, Y, [])). 867 868merge_target([], P, P). 869merge_target([[]|R], [[]|P], Q):- merge_target(R, P, Q). 870merge_target([I-X|R], [I-Xs|P], Q):- 871 merge_target(I, R, R0, [X], Xs), 872 merge_target(R0, P, Q). 873 874% 875merge_target(I, [I-X|R], R0, P, Q):- contract_insert(X, P, P0), 876 merge_target(I, R, R0, P0, Q). 877merge_target(_, R, R, P, P). 878 879 880 /******************** 881 * union-find * 882 ********************/ 883% ?- coa_union_find([a-b,x-y, x-x, y-z, b-c], [], R). 884% ?- coa_union_find([a-b,x-y, x-x, y-z, b-c], [], R). 885 886coa_union_find([], X, X). 887coa_union_find([X-Ys|R],C,D):-coa_union_find(Ys, X, C,C1), 888 coa_union_find(R,C1,D). 889 890coa_union_find([], _, P, P). 891coa_union_find([Y|Ys], X, P, Q):- once(coa_union_find_one(X, Y, P, P0)), 892 coa_union_find(Ys, X, P0, Q). 893 894coa_union_find_one(X,Y,Z,U):-find_cluster(X,Z,C,Z0), 895 (memberchk(Y, C) -> U=[C|Z0] 896 ; find_cluster(Y, Z0, C0, Z1), 897 append(C,C0, C1), 898 U=[C1|Z1] 899 ). 900 901 902% ?- find_cluster(a, [[a,b],[c,d]], C, X). 903find_cluster(X,[],[X],[]). 904find_cluster(X,[Y|Z],Y,Z):- memberchk(X,Y). 905find_cluster(X,[Y|Z],U,[Y|V]):- find_cluster(X,Z,U,V). 906 907 908 /*************************** 909 * Reverse Automaton * 910 ***************************/ 911 912% Reversing coalgebra 913% ?- am_flip([a-[b-c], d-[b-c], e-[b-c], x-[y-z]], R). 914%@ R = [c-[b-[a, d, e]], z-[y-[x]]] . 915% ?- am_flip([a-[b-c], d-[b-c], e-[m-c], x-[y-z]], R). 916%@ R = [c-[b-[a, d], m-[e]], z-[y-[x]]] . 917% ?- am_flip([a-[[], b-c, d-e, e-c], x-[y-z]], R). 918%@ R = [c-[b-[a], e-[a]], e-[d-[a]], z-[y-[x]]] . 919% ?- am_flip([a-[d-e, e-c], x-[y-z]], R). 920%@ R = [c-[e-[a]], e-[d-[a]], z-[y-[x]]] . 921% ?- am_flip([1-[a-1]], R). 922% ?- am_flip([], X). 923 924am_flip --> am_flip_triples, triples_to_coa. 925 926% 927am_flip_triples(X, Y):- maplist(am_flip_triples_aux, X, X0), append(X0, Y). 928 929% 930am_flip_triples_aux(I-As, B):- 931 fold_right(am_flip_triples_aux_aux(I), As, B, []). 932 933% 934am_flip_triples_aux_aux(I, C-J, [J-(C-I)|W], W). 935am_flip_triples_aux_aux(_, _, W, W). 936% 937fold_right(_, [], P, P). 938fold_right(F, [A|As], P, Q):- call(F, A, Q0, Q), fold_right(F, As, P, Q0). 939 940 941% ?- am_reverse(coa([1-[[]]], 1), R). 942%@ R = coa([1-[[]]], 1) . 943% ?- am_reverse(coa([1-[a-2], 2-[b-3], 3-[[]]], 1), R). 944%@ R = coa([1-[[]], 2-[a-1], 3-[b-2]], 3) . 945 946am_reverse(coa(E, I), Coa) :- am_flip(E, E0), 947 once((select(I-W, E0, E1); W=[], E1=E0)), 948 once(am_finals(coa(E, _), Is)), 949 multi_entry_to_single(Is, [I-[[]|W]|E1], Coa0), 950 am_fresh(Coa0, Coa1), 951 am_clean(Coa1, Coa2), 952 am_minimum(Coa2, Coa). 953 954% 955multi_entry_to_single(Is, E, coa(D, Js)) :- 956 am_clean(coa(E, _), coa(F, _)), 957 sort(Is, Js), 958 once(power_state_closure([Js], F, [], D)). 959 960% ?- power_state_closure([[1]], [1-[a-[1]]], [], X). 961% ?- power_state_closure([[1]], [1-[a-[2]], 2-[a-[1,2], b-[1]]], [], X). 962 963power_state_closure([], _, P, P). 964power_state_closure([S|R], E, P, Q):- memberchk(S-_, P), 965 power_state_closure(R, E, P, Q). 966power_state_closure([S|R], E, P, Q):- 967 power_state_closure_step(S, R, R0, E, P, P0), 968 power_state_closure(R0, E, P0, Q). 969 970% 971power_state_closure_step(S, R, R0, E, P, [S-A|P]):- 972 merge_goto(S, E, [], A), 973 foldl(power_state_closure_step_aux, A, R, R0). 974 975% 976power_state_closure_step_aux(_-G, U, V):- memberchk(G, U), V=U; V=[G|U]. 977power_state_closure_step_aux([], U, U). 978 979% ?- merge_goto([1,2], [1-[a-[2,3]], 2-[a-[1,2], b-[3]]], [], X). 980%@ X = [a-[1, 2, 3], b-[3]]. 981merge_goto([], _, A, A). 982merge_goto([X|Xs], E, A, B):- memberchk(X-R, E), 983 once(gdict_ord_merge(R, A, A0)), 984 merge_goto(Xs, E, A0, B). 985 986% ?- gdict_ord_merge([[], a-[1,2], c-[3]], [a-[2,3], b-[2]], R). 987gdict_ord_merge([], X, X). 988gdict_ord_merge(X, [], X). 989gdict_ord_merge([I-A|X], [I-B|Y], [I-C|Z]):- ord_union(A, B, C), 990 gdict_ord_merge(X, Y, Z). 991gdict_ord_merge([U|X], [U|Y], [U|Z]):- gdict_ord_merge(X, Y, Z). 992gdict_ord_merge([U|X], [V|Y], [U|Z]):- U@<V, 993 gdict_ord_merge(X, [V|Y], Z). 994gdict_ord_merge([U|X], [V|Y], [V|Z]):- gdict_ord_merge([U|X], Y, Z). 995 996%?- triples_to_coa([1-(a-4), 3-(c-3), 2-(b-1), 1-(a-2)], R). 997%@ R = [1-[a-[2, 4]], 2-[b-[1]], 3-[c-[3]]]. 998triples_to_coa(X, Y):-sort(X, X0), 999 pairs_to_assoc(X0, Assoc, []), 1000 maplist(triples_to_coa_aux, Assoc, Y). 1001% 1002triples_to_coa_aux(I-U, I-V):- pairs_to_assoc(U, V, []). 1003 1004% 1005am_to_reversed_dag(E, D):- once(am_to_reversed_dag(E, [], Ps)), 1006 sort(Ps, Ps0), 1007 once(pairs_to_assoc(Ps0, D, [])). 1008 1009% 1010am_to_reversed_dag([I-A|R], X, Y):- once(am_to_reversed_dag(A, I, X, X0)), 1011 am_to_reversed_dag(R, X0, Y). 1012am_to_reversed_dag([], X, X). 1013 1014% 1015am_to_reversed_dag([_-G|R], I, X, Y):- am_to_reversed_dag(R, I, [G-I|X], Y). 1016am_to_reversed_dag([_|R], I, X, Y):- am_to_reversed_dag(R, I, X, Y). 1017am_to_reversed_dag([], _, X, X). 1018 1019% ?- am_conflict_pairs([a-[[],1-a], b-[1-b], c-[[],1-a]], S). 1020% ?- coa:am_conflict_pairs([a-[1-a], b-[1-b]], S). 1021% ?- coa:am_conflict_pairs([a-[[]], b-[[]]], S). 1022am_conflict_pairs(Coa, S):- 1023 am_arity_dict(Coa, Dict), 1024 once(arity_conflict_pairs(Dict, IniCon, [])), 1025 sort(IniCon, IniCon0), 1026 am_flip(Coa, RCoa), 1027 once(propagate_conflict(IniCon0, RCoa, [], S)). 1028 1029% by agenda programming 1030propagate_conflict([], _, P, P). 1031propagate_conflict([U|R], Coa, P, Q):- memberchk(U, P), 1032 propagate_conflict(R, Coa, P, Q). 1033propagate_conflict([I-J|R], Coa, P, Q):- memberchk(I-A, Coa), 1034 memberchk(J-B, Coa), 1035 fiber_product(A, B, F), 1036 append(F, R, R0), 1037 propagate_conflict(R0, Coa, [I-J|P], Q). 1038propagate_conflict([U|R], Coa, P, Q):- 1039 propagate_conflict(R, Coa, [U|P], Q). 1040 1041% ?- fiber_product([a-[7,8,9], b-[1,2,3]], [a-[6,7,8], b-[1,2,3]], P). 1042%@ P = [1-2, 1-3, 2-3, 6-7, 6-8, 6-9, 7-8, 7-9, 8-9] . 1043 1044fiber_product(A, B, P):- once(fiber_product(A, B, [], P0)), 1045 sort(P0, P). 1046 1047fiber_product([], _, P, P). 1048fiber_product([X|Y], N, P, Q):- 1049 fiber_product_one(X, N, P, R), 1050 fiber_product(Y, N, R, Q). 1051% 1052fiber_product_one([], _, P, P). 1053fiber_product_one(_, [], P, P). 1054fiber_product_one(X, [Y|Z], P, Q):- 1055 fiber_product_one_one(X, Y, P, R), 1056 fiber_product_one(X, Z, R, Q). 1057% 1058fiber_product_one_one(_, [], P, P). 1059fiber_product_one_one(A-G, A-H, P, Q):- 1060 s_product(G, H, P, Q). 1061fiber_product_one_one(_, _, P, P). 1062 1063% ?- module(pac_word). 1064% ?- pairs_to_assoc([1-[], 1-2, 1-3, 2-3, 2-4], X, []). 1065%@ X = [1-[2, 3, []], 2-[3, 4]]. 1066pairs_to_assoc([], X, X). 1067pairs_to_assoc([I-A|R], [I-As|V], V0):- 1068 once(pairs_to_assoc(I, R, R0, [A], As)), 1069 pairs_to_assoc(R0, V, V0). 1070 1071% 1072pairs_to_assoc(I, [I-A|R], R0, S, T):- 1073 once(contract_insert(A, S, S0)), 1074 pairs_to_assoc(I, R, R0, S0, T). 1075pairs_to_assoc(_, R, R, S, S). 1076 1077% ?- contract_insert(3, [2, 5, 7], R). 1078%@ R = [2, 3, 5, 7]. 1079 1080contract_insert(X, [], [X]). 1081contract_insert(X, [X|S], [X|S]). 1082contract_insert(X, [Y|S], [X, Y|S]):- X@<Y. 1083contract_insert(X, [Y|S], [Y|R]):- contract_insert(X, S, R). 1084 1085 1086% ?- all_states([1-[[],a-b], 2-[c-d]], R), 1087all_states(X, S):- maplist(all_states_aux, X, S0), sort(S0, S). 1088% 1089all_states_aux(A-_, A). 1090 1091% 1092arity(X, Y):- maplist(arity_aux, X, Y0), sort(Y0, Y). 1093% 1094arity_aux([], []). 1095arity_aux(A-_, A). 1096 1097% 1098am_arity_dict(Coa, Dict):- maplist(am_arity_dict_aux, Coa, Dict). 1099% 1100am_arity_dict_aux(I-X, I-M):- arity(X, M). 1101 1102% ?- arity_conflict_pairs([1-a, 2-b, 3-a, 4-b], A, []). 1103arity_conflict_pairs([I-A|As], P, Q):- arity_conflict_pairs(I, A, As, P, P0), 1104 arity_conflict_pairs(As, P0, Q). 1105arity_conflict_pairs([], A, A). 1106 1107% 1108arity_conflict_pairs(_, _, [], P, P). 1109arity_conflict_pairs(I, A, [J-B|Bs], [I-J|P], Q):- A\==B, 1110 arity_conflict_pairs(I, A, Bs, P, Q). 1111arity_conflict_pairs(I, A, [_|Bs], P, Q):- 1112 arity_conflict_pairs(I, A, Bs, P, Q). 1113 1114% ?-s_product([1,2,3],[1,2,3], P). 1115%@ P = [1-2, 1-3, 2-3] . 1116 1117s_product(X, Y, P):- s_product(X, Y, [], Q), sort(Q, P). 1118% 1119s_product([], _, P, P). 1120s_product([X|Xs], Y, P, Q):- 1121 s_product(X, Xs, Y, P, R), 1122 s_product(Xs, Y, R, Q). 1123% 1124s_product(X, Xs, Y, P, Q):- 1125 foldl(s_product_aux(X), Y, P, R), 1126 s_product(Xs, Y, R, Q). 1127 1128% 1129s_product_aux(X, A, L, L):- A==X, !. 1130s_product_aux(X, A, L, [W|L]):- s_pair(X, A, W). 1131 1132% ?- assoc_product([1,2,3], [1,2,3], R, []). 1133%@ R = [1-[2, 3], 2-[3]] . 1134 1135assoc_product([], _, P, P). 1136assoc_product(_, [], P, P). 1137assoc_product([X|Xs], [Y|Ys], [X-[Y|Ys]|P], Q):- Y@>X, 1138 assoc_product(Xs, [Y|Ys], P, Q). 1139assoc_product(Xs, [_|Ys], P, Q):-assoc_product(Xs, Ys, P, Q). 1140 1141% subtraction on assoc lists. 1142% ?- assoc_subtract([1-[2,3,4], 2-[3,4], 3-[4,5,6]], [1-[3], 2-[4], 5-[6,7,8]], R). 1143%@ R = [1-[2, 4], 2-[3], 3-[4, 5, 6]] . 1144 1145assoc_subtract([], _, []). 1146assoc_subtract(A, [], A). 1147assoc_subtract([I-A|Ps], [I-B|Qs], R):- once(ord_subtract(A, B, C)), 1148 ( C == [] 1149 -> R = Rs 1150 ; R = [I-C|Rs] 1151 ), 1152 once(assoc_subtract(Ps, Qs, Rs)). 1153assoc_subtract([I-A|Ps], [J-B|Qs], [I-A|Rs]):- I@<J, 1154 once(assoc_subtract(Ps,[J-B|Qs], Rs)). 1155assoc_subtract([I-A|Ps], [_|Qs], [I-A|Rs]):- 1156 once(assoc_subtract(Ps, Qs, Rs)). 1157 1158% ?-assoc_complement([1,2,3], [1-[2], 2-[3]], R). 1159%@ R = [1-[3]] . 1160 1161assoc_complement(A, C, D):- assoc_product(A, A, AConf, []), 1162 once(assoc_subtract(AConf, C, D)). 1163 1164% 1165s_pair(A, B, A-B):- A @< B. 1166s_pair(A, B, B-A). 1167 1168% 1169am_char([], coa([1-[[]]], 1)). 1170am_char(Is, coa([1-[[]|G], 2-[[]]], 1)):- maplist(am_char_aux, Is, G). 1171 1172am_char_aux(I, I-2). 1173 1174am_char_simple([], coa([1-[[]]], 1)). 1175am_char_simple(Is, coa([1 - G, 2-[[]]], 1)):- 1176 maplist(am_char_simple_aux, Is, G). 1177% 1178am_char_simple_aux(I, I-2). 1179 1180 1181 /*************************************** 1182 * automaton sysnthesis basics 2 * 1183 ***************************************/
1189% digraph traversal by Agenda Programming. 1190% 1191am_cap(coa(E0, I0), coa(E1, I1), Coa):- 1192 once(am_cap([I0*I1], [], E0, E1, [], E2)), 1193 am_fresh(coa(E2, I0*I1), Coa0), 1194 once(am_minimum(Coa0, Coa)). 1195 1196% 1197am_cap([], _, _, _, P, P). 1198am_cap([U|R], H, A, B, P0, P):- memberchk(U, H), 1199 am_cap(R, H, A, B, P0, P). 1200am_cap([I*J|R], H, A, B, P0, P):- memberchk(I-GI, A), 1201 memberchk(J-GJ, B), 1202 once(product_cap(GI, GJ, R0, R, Q, [])), 1203 am_cap(R0, [I*J|H], A, B, [I*J-Q|P0], P). 1204 1205% 1206product_cap([], _, R, R, Q, Q). 1207product_cap(_, [], R, R, Q, Q). 1208product_cap([[]|G], [[]|H], R0, R, [[]|Q0], Q):- 1209 product_cap(G, H, R0, R, Q0, Q). 1210product_cap([[]|G], H, R0, R, Q0, Q):- 1211 product_cap(G, H, R0, R, Q0, Q). 1212product_cap(G, [[]|H], R0, R, Q0, Q):- 1213 product_cap(G, H, R0, R, Q0, Q). 1214product_cap([U-I|G], [U-J|H], [I*J|R0], R, [U-I*J|Q0], Q):- 1215 product_cap(G, H, R0, R, Q0, Q). 1216product_cap([U-_|G], [V-I|H], R0, R, Q0, Q):- U@<V, 1217 product_cap(G, [V-I|H], R0, R, Q0, Q). 1218product_cap([U-I|G], [_|H], R0, R, Q0, Q):- 1219 product_cap([U-I|G], H, R0, R, Q0, Q).
1225am_minus(coa(E0,I0), coa(E1, I1), Coa):- 1226 once(am_minus([I0*I1], [], E0, E1, [], E2)), 1227 append(E0, E2, E3), 1228 am_determine(coa(E3, I0*I1), NCoa), 1229 once(am_minimum(NCoa, Coa)). 1230 1231% 1232am_minus([], _, _, _, P, P). 1233am_minus([U|R], H, A, B, P0, P):- memberchk(U, H), 1234 am_minus(R, H, A, B, P0, P). 1235am_minus([I*J|R], H, A, B, P0, P):- memberchk(I-GI, A), 1236 memberchk(J-GJ, B), 1237 once(product_minus(GI, GJ, R0, R, Q, [])), 1238 once(am_minus(R0, [I*J|H], A, B, [I*J-Q|P0], P)). 1239 1240% 1241product_minus([], _, R, R, Q, Q). 1242product_minus([W|G], [], R0, R, [W|P], Q):- 1243 product_minus(G, [], R0, R, P, Q). 1244product_minus([[]|G], [[]|H], R0, R, Q0, Q):- 1245 product_minus(G, H, R0, R, Q0, Q). 1246product_minus([[]|G], H, R0, R, [[]|Q0], Q):- 1247 product_minus(G, H, R0, R, Q0, Q). 1248product_minus(G, [[]|H], R0, R, Q0, Q):- 1249 product_minus(G, H, R0, R, Q0, Q). 1250product_minus([U-I|G], [U-J|H], [I*J|R0], R, [U-I*J|Q0], Q):- 1251 product_minus(G, H, R0, R, Q0, Q). 1252product_minus([U-I|G], [V-J|H], R0, R, [U-I|Q0], Q):- U@<V, % bug fix [2014/08/23] 1253 product_minus(G, [V-J|H], R0, R, Q0, Q). 1254product_minus([U-I|G], [_|H], R0, R, Q0, Q):- 1255 product_minus([U-I|G], H, R0, R, Q0, Q).
1262am_cup(coa(A,I), Coa0, Coa):-
1263 length(A, N),
1264 am_shift(N, Coa0, coa(C, K)),
1265 append(A, C, D),
1266 once(am_determine([[I,K]], [], D, E, [])),
1267 once(am_fresh(coa(E, [I,K]), Coa1)),
1268 once(am_minimum(Coa1, Coa)).1275% ?- am_concat(coa([1-[[], a-2], 2-[[]]],1), coa([1-[a-2], 2-[[]]],1), R). 1276% ?- am_concat(coa([1-[[], a-1]],1), coa([1-[[], b-1]],1), R). 1277 1278am_concat(coa(E0, I0), Coa1, Coa):-once(( 1279 length(E0, N), 1280 am_shift(N, Coa1, coa(E3, I3)), 1281 memberchk(I3-G, E3), 1282 maplist(am_replace_null(G), E0, E1), 1283 append(E1, E3, E4), 1284 am_slim(coa(E4,I0), E5), 1285 am_determine(E5, E), 1286 am_minimum(E, Coa))).
1292am_power(N, X, Y):- poly:bits(N, [], Bs), 1293 am_unit(U), 1294 once(am_power(Bs, X, U, Y)). 1295 1296% 1297am_power([], _, X, X). 1298am_power([0|Bs], A, X, Y):- 1299 am_concat(X, X, X2), 1300 am_power(Bs, A, X2, Y). 1301am_power([_|Bs], A, X, Y):- 1302 am_concat(X, X, X2), 1303 am_concat(A, X2, AX2), 1304 am_power(Bs, A, AX2, Y). 1305 1306% 1307am_power_lower(N, E, U):- am_unit(I), 1308 am_cup(I, E, E0), 1309 am_power(N, E0, U). 1310 1311am_power_upper(N, Coa, Coa0):- 1312 am_power(N, Coa, Coa1), 1313 am_star(Coa, Coa2), 1314 am_concat(Coa1, Coa2, Coa0). 1315 1316am_power_between(I, J, Coa, Coa0):- 1317 am_power(I, Coa, Coa1), 1318 K is J - I, 1319 am_power_lower(K, Coa, Coa2), 1320 am_concat(Coa1, Coa2, Coa0). 1321% 1322am_unit(coa([1-[[]]], 1)). 1323% 1324am_empty(coa([], 0)). 1325 1326 /************************** 1327 * special automata * 1328 **************************/ 1329 1330% ?- coa:am_shift(3, coa([1-[a-2, b-3]],1), R). 1331%@ R = coa([4-[a-5, b-6]], 4). 1332 1333am_shift(N, coa(E,I), coa(E0, I0)):- 1334 I0 is I+N, 1335 maplist(state_id_shift(N), E, E0). 1336 1337% 1338state_id_shift(N, I-A, J-B):- J is I + N, 1339 maplist(goto_id_shift(N), A, B). 1340 1341% 1342goto_id_shift(N, A-I, A-J):- J is I+N. 1343goto_id_shift(_, X, X). 1344 1345% ?- am_replace_null([a-2], 2-[[]], X). 1346am_replace_null(A, I-[[]|B], I-C):- ord_union(A, B, C). 1347am_replace_null(_, P, P).
1354% ?- am_minimum(coa([1-[a-2, a-3, b-3], 2-[b-3], 3-[a-1]], 1), R). 1355% ?- am_plus(coa([1-[a-2], 2-[[]]], 1), R). 1356% ?- am_star(coa([1-[a-2], 2-[[]]], 1), R). 1357% ?- am_star(coa([1-[a-2, b-3], 3-[[]], 2-[[]]], 1), R). 1358% ?- am_star(coa([1-[a-2, a-3, b-3], 3-[[]], 2-[[]]], 1), R). 1359% ?- am_star(coa([1-[a-2], 2-[[]]], 1), R). 1360%@ R = coa([1-[[], a-1]], 1) . 1361% ?- am_star(coa([1-[a-2, b-2], 2-[[]]], 1), R). 1362%@ R = coa([1-[[], a-1, b-1]], 1) . 1363% ?- am_plus(coa([1-[a-2, b-2], 2-[[]]], 1), R). 1364%@ R = coa([1-[a-2, b-2], 2-[[], a-2, b-2]], 1) . 1365% ?- am_copy(coa([1-[a-2], 2-[[]]], 1), D). 1366 1367 1368am_kleene(coa(E, I), Coa):- 1369 once(select(I-R, E, E0)), 1370 once(drop_null(R, NR)), 1371 maplist(am_replace_null([[]|NR]), E0, E1), 1372 once(am_determine(coa([I-R|E1], I), Coa)). 1373 1374% 1375am_star(C, D):- am_kleene(C, coa(E0, I)), 1376 once(select(I-R0, E0, E)), 1377 ( R0=[[]|_] 1378 -> R = R0 1379 ; R = [[]|R0] 1380 ), 1381 once(am_minimum(coa([I-R|E], I), D)). 1382 1383% 1384am_plus(X, Y):- once((am_kleene(X, Z), am_minimum(Z, Y))). 1385 1386% 1387am_fresh(coa([], _), C):- am_empty(C). 1388am_fresh(coa(E, I), coa(E0, I0)):- 1389 length(E, L), 1390 numlist(1, L, Ns), 1391 zip_hyphen(M, _, E), 1392 zip_hyphen(M, Ns, S), 1393 subst_coa(E, S, E0), 1394 memberchk(I-I0, S). 1395 1396% 1397am_fresh(Coa0, coa(E0, _), Coa):- length(E0, N), am_shift(N, Coa0, Coa). 1398 1399% 1400am_size(coa(E, _), N):- length(E, N). 1401 1402am_initial_state(coa(_, I), I). 1403 1404am_equations(coa(E, _), E). 1405 1406% ?- am_finals(coa([1-[[]], 2-[a-3], 3-[[]]], 1), R). 1407%@ R = [1, 3] . 1408% am_finals(coa(E, _), A):- 1409% foldl(pred( ([I-H, [I|U], U] :- once(is_final_state(H))) 1410% & [_, U, U]), 1411% E, A, []). 1412 1413am_finals(coa(E, _), A):- foldl(am_finals_aux, E, A, []). 1414 1415% 1416am_finals_aux(I-H, [I|U], U) :- once(is_final_state(H)). 1417am_finals_aux(_, U, U). 1418 1419% 1420is_final_state(H):- memberchk([], H). 1421is_final_state(H):- member(special(Spe), H), 1422 final_special_pred(Spe). 1423 1424% ?- am_states(coa([1-[[]], 2-[a-3], 3-[[]]], 1), R). 1425%@ R = [1, 2, 3]. 1426am_states(coa(E, _), A):- maplist(am_states_aux, E, A). 1427% 1428am_states_aux(I-_, I). 1429% 1430am_copy(C, D):- C = coa(E0, _), 1431 length(E0, N), 1432 am_shift(N, C, D). 1433% 1434am_clean(coa(E, I), coa(D, I)):- maplist(am_clean_aux, E, E0), 1435 sort(E0, D). 1436 1437am_clean_aux(J-A, J-B):-sort(A, B). 1438 1439% 1440drop_null([[]|A], A). 1441drop_null(A, A). 1442 1443% 1444add_one(X, Y, Z):- ( memberchk(X, Y) -> Z=Y ; Z = [X|Y]). 1445 1446% ?-subst_coa([1-[b-2]], [1-9, 2-10], X). 1447%@ X = [9-[b-10]]. 1448% ?-subst_coa([1-[[], b-2]], [1-9, 2-10], X). 1449%@ X = [9-[[], b-10]]. 1450% ?- am_remove_useless_states(coa([1-[[], a-1, a-2], 2-[b-3], 3-[c-3]], 1), R). 1451%@ R = coa([1-[[], a-1]], 1) . 1452 1453am_remove_useless_states(coa(E, I), coa(E0, I)):- 1454 am_live_dead(coa(E,I), _, Dead), 1455 am_remove_states(E, Dead, E0). 1456 1457am_live_dead(Coa, Live, Dead):- am_finals(Coa, Fs), 1458 am_equations(Coa, E), 1459 am_to_reversed_dag(E, Assoc), 1460 once(dg_path_find(Fs, Assoc, [], Live, Dead)). 1461 1462% ?- dg_path_find([], [1-[2], 2-[1]], [], X, Y). 1463%@ X = [], 1464%@ Y = [1, 2]. 1465% ?- dg_path_find([1], [1-[2], 2-[1], 3-[1,2]], [], X, Y). 1466%@ X = [2, 1], 1467%@ Y = [3]. 1468 1469dg_path_find([], E, Live, Live, Dead):- maplist(dg_path_find_aux, E, Dead). 1470dg_path_find([X|R], E, Z, Live, Dead):- memberchk(X, Z), 1471 dg_path_find(R, E, Z, Live, Dead). 1472dg_path_find([X|R], E, Z, Live, Dead):- select(X-G, E, E0), 1473 union(G, R, R0), 1474 dg_path_find(R0, E0, [X|Z], Live, Dead). 1475dg_path_find([X|R], E, Z, Live, Dead):- dg_path_find(R, E, [X|Z], Live, Dead). 1476 1477dg_path_find_aux(I-_, I). 1478 1479% ?- am_connected_region(coa([1-[[]]], 1), C). 1480% ?- am_connected_region(coa([1-[[], a-2], 2-[[]], 3-[a-3]], 1), C). 1481 1482am_connected_region(coa(E, I), coa(E0, I)):- 1483 once(am_path_find([I], [], E, E0, [])). 1484 1485% 1486am_path_find([],_H, _E, R, R). 1487am_path_find(_, _H, [], R, R). 1488am_path_find([X|R], H, STS, E0, E1):- memberchk(X, H), 1489 am_path_find(R, [X|H], STS, E0, E1). 1490am_path_find([X|R], H, STS, [X-G|E0], E1) :- select(X-G, STS, STS0), 1491 once(am_path_find_next(G, R0, R)), 1492 am_path_find(R0, [X|H], STS0, E0, E1). 1493am_path_find([X|R], H, STS, [X|E0], E1) :- am_path_find(R, [X|H], STS, E0, E1). 1494 1495% 1496am_path_find_next([_-G|R], [G|X], Y):- am_path_find_next(R, X, Y). 1497am_path_find_next([_|R], X, Y):- am_path_find_next(R, X, Y). 1498am_path_find_next([], X, X). 1499 1500% naive method. 1501 1502% ?- am_remove_empty_states(coa([], 1), C). 1503%@ C = coa([], 1). 1504% ?- am_remove_empty_states(coa([1-[[],a-2], 2-[]], 1), C). 1505%@ C = coa([1-[[]]], 1) . 1506% ?- am_remove_empty_states(coa([1-[[],a-2, a-3], 3-[b-2], 2-[]], 1), C). 1507%@ C = coa([1-[[]]], 1) . 1508 1509am_remove_empty_states(coa(E, I), coa(E0,I)):- am_elim_empty_states(E, E0). 1510 1511% 1512am_elim_empty_states(E, E0):- am_elim_empty_states(E, S, [], E1, []), 1513 ( S == [] 1514 -> E0 = E1 1515 ; once(am_elim_link(S, E1, E2)), 1516 once(am_elim_empty_states(E2, E0)) 1517 ). 1518 1519% 1520am_elim_empty_states([], X, X, Y, Y). 1521am_elim_empty_states([I-[]|R], [I|X], X0, Y, Y0):- 1522 am_elim_empty_states(R, X, X0, Y, Y0). 1523am_elim_empty_states([U|R], X, X0, [U|Y], Y0):- 1524 am_elim_empty_states(R, X, X0, Y, Y0). 1525 1526% 1527am_elim_link([], E, E). 1528am_elim_link(Is, E, E0):- once(am_elim_link(Is, E, E0, [])). 1529 1530% 1531am_elim_link(_, [], E, E). 1532am_elim_link(Is, [I-A|R], [I-B|E], F):- once(elim_link_step(Is, A, B, [])), 1533 am_elim_link(Is, R, E, F). 1534 1535% 1536elim_link_step(_, [], X, X). 1537elim_link_step(Is, [[]|R], [[]|X], Y):- elim_link_step(Is, R, X, Y). 1538elim_link_step(Is, [_-S|R], X, Y):- memberchk(S, Is), 1539 elim_link_step(Is, R, X, Y). 1540elim_link_step(Is, [I-S|R], [I-S|X], Y):- elim_link_step(Is, R, X, Y). 1541 1542% ?- am_remove_states([1-[a-2,b-2]], [1,2], R). 1543% ?- am_remove_states([1-[[],a-2,b-2], 2-[b-1]], [1], R). 1544am_remove_states([], _, []). 1545am_remove_states([I-_|R], Ds, E):- memberchk(I, Ds), 1546 am_remove_states(R, Ds, E). 1547am_remove_states([I-A|R], Ds, [I-B|E]):- once(am_remove_goto(A, Ds, B)), 1548 am_remove_states(R, Ds, E). 1549 1550% 1551am_remove_goto([], _, []). 1552am_remove_goto([[]|R], Ds, [[]|S]):- am_remove_goto(R, Ds, S). 1553am_remove_goto([_-G|R], Ds, S):- memberchk(G, Ds), 1554 am_remove_goto(R, Ds, S). 1555am_remove_goto([U|R], Ds, [U|S]):- am_remove_goto(R, Ds, S). 1556 1557% 1558subst_coa([], _, []). 1559subst_coa([I-G|R], S, [I0-G0|R0]):- memberchk(I-I0, S), 1560 subst_am_goto(G, S, G0), 1561 subst_coa(R, S, R0). 1562 1563% 1564subst_am_goto([A-I|R], S, [A-J|R0]):- memberchk(I-J, S), 1565 subst_am_goto(R, S, R0). 1566subst_am_goto([X|R], S, [X| R0]):- subst_am_goto(R, S, R0). 1567subst_am_goto([], _, []). 1568 1569 /**************************** 1570 * characters classes * 1571 ****************************/ 1572 1573:- meta_predicate cook_char_dict(, , , ). 1574% ?- cook_char_dict(0, 127, atom, Dict), maplist(([X]:- writeq(X), nl), Dict). 1575cook_char_dict(N0, N, Filter, Dict):- code_types(N0, N, Us), 1576 collect(Filter, Us, Ts), 1577 maplist(cook_char_dict_aux(N0, N), Ts, Dict). 1578 1579% 1580cook_char_dict_aux(N0, N, T, T-CT):- collect_chars(N0, N, T, CT). 1581 1582% 1583code_types(N0, N, S):- setof(T, C^ ( between(N0, N, C), code_type(C, T)), S). 1584 1585% ?- collect_chars(0, 10000, alpha, X). 1586collect_chars(N0, N, CC, X):- 1587 setof(C, (code_type(C, CC), between(N0, N, C)), S0), 1588 zip_hyphen(S0, S0, S), 1589 iboole:i_merge(S, Z0), 1590 maplist(collect_chars_aux, Z0, X). 1591 1592collect_chars_aux(V0-W0, V-W):- char_code(V, V0), char_code(W, W0). 1593 1594% 1595reserved_char_class([ 1596 alnum - ['0'-'9','A'-'Z',a-z], 1597 alpha - ['A'-'Z',a-z], 1598 ascii - ['\000\'-'\177\'], 1599 cntrl - ['\000\'-'\037\','\177\'-'\177\'], 1600 csym - ['0'-'9','A'-'Z','_'-'_',a-z], 1601 csymf - ['A'-'Z','_'-'_',a-z], 1602 digit - ['0'-'9'], 1603 end_of_line - ['\n'-'\r'], 1604 graph - [(!)-(~)], 1605 lower - [a-z], 1606 newline - ['\n'-'\n'], 1607 period - [(!)-(!), ('.')-('.'), (?)-(?)], 1608 prolog_atom_start - [a-z], 1609 prolog_identifier_continue - ['0'-'9','A'-'Z','_'-'_',a-z], 1610 prolog_symbol - [(#)- ($), (&)- (&), (*)- (+), 1611 (-)-(/), (:)-(:), (<)-(@), 1612 (\)-(\), (^)-(^), (~)-(~)], 1613 prolog_var_start - ['A'-'Z','_'-'_'], 1614 punct - [(!)-(/), (:)-(@),'['-('`'),'{'-(~)], 1615 quote - ['"'-'"','\''-'\'', ('`')-('`')], 1616 space - ['\t'-'\r',' '-' '], 1617 upper - ['A'-'Z'], 1618 white - ['\t'-'\t',' '-' '], 1619 utf8 - ['\200\' - sup ], % ' 1620 hiragana - ['ã'-'ã'], 1621 katakana - ['ã¡'-'ãº'], 1622 kanji - ['ä¸'-'é¾ '] 1623]). 1624 1625utf8_byte_char_class([ 1626 utf8 - ['\200\' - '\377\'], 1627 utf8c - ['\200\' - '\277\'], 1628 utf8b - ['\300\' - '\377\'] 1629 ]). 1630 1631% ?- C is 0xc0, char_code(X, C). 1632 1633% 1634look_ahead(C, [C|X], [C|X]). 1635 1636 1637 /************************************** 1638 * compiling coalgebra into clause * 1639 **************************************/
True if G is unified with a compiled version of C with (K+2)-ary state predicates in P (minus Q).
1655% ?- expand_coa(0, [1-[[], [10-10]-1]], 1, user, G, P, []). 1656expand_coa(K, C, I, M, M_G, P, Q):- 1657 all_states(C, Nts), 1658 maplist(expand_coa_aux, Nts, Assoc), 1659 memberchk(I-GI, Assoc), 1660 void_states(C, Vs), 1661 remove_void_state(C, I, C0), 1662 compile_coa(C0, Vs, K, M, P, Q, Assoc), 1663 prefix_convention(M, GI, M_G). 1664 1665expand_coa_aux(J, J-N):- new_nt_name(N). 1666 1667% 1668remove_void_state([], _, []). 1669remove_void_state([J-[[]]|C], Init, R):- J\==Init, !, 1670 remove_void_state(C, Init, R). 1671remove_void_state([X|C], Init, [X|R]):- 1672 remove_void_state(C, Init, R). 1673 1674% ?- new_nt_name(X). 1675new_nt_name(N):- var(N), nt_name_prefix(Prefix), 1676 gensym(Prefix, N). 1677new_nt_name(_). 1678 1679% 1680nt_name_prefix(N):- nb_current(nt_name_prefix, N), 1681 N \== [], 1682 !. 1683nt_name_prefix('nt#'). 1684 1685% 1686insert_semicolon([X], X). 1687insert_semicolon([X, Y|Z], X;U):- insert_semicolon([Y|Z], U). 1688 1689% 1690compose_relation([X, Y], [X, X0], [X0, Y]). 1691compose_relation([A, B, X, Y], [A, A0, X, X0], [A0, B, X0, Y]). 1692 1693prefix_convention([], P, P). 1694prefix_convention(M, P, M:P). 1695 1696% 1697void_states([], []). 1698void_states([I-[[]]|R], [I|R0]):- void_states(R, R0). 1699void_states([_|R], R0):- void_states(R, R0).
True if G is unified with a compiled version of C with (K+2)-ary state predicates in P (minus Q). State id numbers are replaced by A.
?- compile_coa([1-[[], [10-20, 22-30]-1]], [], 2, user, P, [], [1- a]).
1709compile_coa([],_, _, _, P, P, _). 1710compile_coa([I-A|R], Vs, N, M, P, Q, Assoc):- 1711 memberchk(I-I0, Assoc), 1712 once(compile_coa_state(I0, Vs, A, N, M, P, P0, Assoc)), 1713 compile_coa(R, Vs, N, M, P0, Q, Assoc). 1714% 1715compile_coa_state(I, Vs,[X|A], N, M, P, Q, Assoc):- 1716 once(compile_coa_state_one(I, Vs, X, N, M, P, P0, Assoc)), 1717 compile_coa_state(I, Vs, A, N, M, P0, Q, Assoc). 1718compile_coa_state(_, _, [], _, _, P, P, _). 1719 1720% 1721compile_coa_state_one(I, _, [], N, M, [R|P], P, _):- 1722 compile_coa_epsilon_rule(N, I, R0), 1723 once(prefix_convention(M, R0, R)). 1724compile_coa_state_one(I, _, special(X), N, M, [Pred|P], P, _):- 1725 once(compile_special_pred(X, [I, _, N, M], Pred)). 1726compile_coa_state_one(I, Vs, A-J, N, M, P, Q, Assoc):- is_list(A), 1727 ( memberchk(J, Vs) 1728 -> J0 = void_state 1729 ; memberchk(J-J0, Assoc) 1730 ), 1731 compile_coa_rule(A, I, J0, N, M, P, Q). 1732 1733% 1734compile_coa_epsilon_rule(0, I, Head:- true):- 1735 Head=..[I,X,X]. 1736compile_coa_epsilon_rule(2, I, Head:- true):- 1737 Head=..[I, A, A, X, X]. 1738 1739% ?- compile_coa_rule([10-20, 22-30], a, a, 2, user, P, []). 1740compile_coa_rule([], _, _, _, _,P, P). 1741compile_coa_rule([x(X, U)|A], I, J, N, M, P, Q):- 1742 once(compile_special_char(X, U, N, I, J, M, P, P0)), 1743 compile_coa_rule(A, I, J, N, M, P0, Q). 1744compile_coa_rule(A, I, J, N, M, P, Q) :- 1745 once(consecutive_intervals(A, Rest, B)), 1746 compile_coa_intervals(B, I, J, N, M, P, P0), 1747 compile_coa_rule(Rest, I, J, N, M, P0, Q). 1748 1749% ?- compile_coa_intervals([1-3], a, b, 0, user, P, []). 1750% ?- compile_coa_interval(1, 3, a, b, 0, user, P, []). 1751compile_coa_intervals([], _, _, _, _, P, P). 1752compile_coa_intervals([L-U|A], I, J, N, M, P, Q):- 1753 once(compile_coa_interval(L, U, I, J, N, M, P, P0)), 1754 compile_coa_intervals(A, I, J, N, M, P0, Q). 1755 1756% 1757narrow_interval(L, U):- integer(L), 1758 integer(U), 1759 L + 5 > U. 1760 1761compile_coa_interval(L, U, I, J, N, M, P, Q):- narrow_interval(L, U), !, 1762 compile_interval_smart(L, U, I, J, N, M, P, Q). 1763compile_coa_interval(L, U, I, J, N, M, [R|T], T):- 1764 once(generate_code_test([L-U], V, Cond)), 1765 ( N==0, Head =..[I, [V|Z], Z0] 1766 ; N==2, Head =..[I, [V|W], W0, [V|Z], Z0] 1767 ), 1768 ( J==void_state, Call = true 1769 ; N==0, Call=..[J, Z, Z0] 1770 ; N==2, Call=..[J, W, W0, Z, Z0] 1771 ), 1772 ( J==void_state, Z0=Z, W0=W 1773 ; true 1774 ), 1775 slim_goal((Cond, Call), Body), 1776 prefix_convention(M, Head:- Body, R). 1777 1778% ?- compile_interval_smart(1, a, b, 2, user, P, []). 1779% ?- compile_interval_smart(1, a, void_state, 2, user, P, []). 1780% ?- compile_interval_smart(1, a, b, 0, user, P, []). 1781% ?- compile_interval_smart(1, a, void_state, 2, user, P, []). 1782 1783compile_interval_smart(D, I, J, N, M, [Cls|P], P):- 1784 ( N==0, Head =..[I, [D|Z], Z0] 1785 ; N==2, Head =..[I, [D|W], W0, [D|Z], Z0] 1786 ), 1787 ( J==void_state, Call = true 1788 ; N==0, Call=..[J, Z, Z0] 1789 ; N==2, Call=..[J, W, W0, Z, Z0] 1790 ), 1791 ( J==void_state, Z0=Z, W0=W 1792 ; true 1793 ), 1794 prefix_convention(M, Head:- Call, Cls). 1795 1796% ?- compile_interval_smart(1, 2, a, void_state, 2, user, P, []). 1797% ?- compile_interval_smart(1, 2, a, b, 2, user, P, []). 1798 1799compile_interval_smart(L, U, I, J, N, M, P, Q):- L=<U, !, 1800 compile_interval_smart(L, I, J, N, M, P, P0), 1801 L0 is L + 1, 1802 compile_interval_smart(L0, U, I, J, N, M, P0, Q). 1803compile_interval_smart(_, _, _, _, _, _, P, P). 1804 1805% ?- consecutive_intervals([a-b, b-c, c], X, Y). 1806consecutive_intervals([], [], []). 1807consecutive_intervals([A-B|R], U, [A-B|V]):- consecutive_intervals(R, U, V). 1808consecutive_intervals([X|R], [X|R], []). 1809 1810% 1811goto_argument_form(0, V, [[V|R], S], [R, S]). 1812goto_argument_form(2, V, [[V|A], B, [V|R], S], [A, B, R, S]). 1813 1814% ?- generate_code_test([1-1], V, C). 1815% ?- generate_code_test([1-1, 4-4], V, C). 1816% ?- generate_code_test([(1-4)\2], V, C). 1817generate_code_test(A-B, V, C):- generate_code_test([A-B], V, C). 1818generate_code_test(Is, V, C):- adjacent_interval(Is, Js, []), 1819 maplist(generate_code_test_aux(V), Js, Ks), 1820 insert_semicolon(Ks, C). 1821 1822% 1823generate_code_test_aux(V, X, Y):- once(generate_code_between(X, V, Y)). 1824 1825 1826% ?- adjacent_interval([1-2, 4-5, 7-9, 11-13], P, []). 1827% ?- adjacent_interval([1-2, 4-5, 7-9, 11-13, 15-17], P, []). 1828 1829adjacent_interval([], X, [X|P], P). 1830adjacent_interval([A-B|R], C-D, [(C-B)\X|P], Q):- C\==D, 1831 succ_transitive(D, X, A), 1832 adjacent_interval(R, P, Q). 1833adjacent_interval(X, U, [U|P], Q):- 1834 adjacent_interval(X, P, Q). 1835 1836% 1837adjacent_interval([U|R], P, Q):- adjacent_interval(R, U, P, Q). 1838adjacent_interval([], P, P). 1839 1840% 1841succ_transitive(A, X, B):- plus(A, 2, B), plus(A, 1, X). 1842 1843% 1844generate_code_between(inf-sup, _, true). 1845generate_code_between(inf-A, V, V @=< A). 1846generate_code_between(A-sup, V, A @=< V). 1847generate_code_between(A-A, V, V == A). 1848generate_code_between(A-B, V, (A @=< V, V @=<B)). 1849generate_code_between((A-B)\W, V, BCode0):- 1850 once(generate_code_between(A-B, V, BCode)), 1851 ( BCode == true, BCode0 = (V\== W) 1852 ; BCode0 = (V\==W, BCode)). 1853 1854 /************* 1855 * sed * 1856 *************/ 1857 1858% ?- expand_phrase(sed(@(s/"a"/"b")), [], G, L, []). 1859% ?- phrase(sed(w("[afl]") >> [[]]), `abcdefghijklmn`, V), basic:smash(V). 1860% ?- phrase(sed(w(".+", A)>> pred(A, [[A,A]])), `ab`, V), basic:smash(V). 1861% ?- phrase(sed((w(".", A), w(".", B))>> pred([A,B],([C]:- append(B, A, C)))), `ab12`, V), basic:smash(V). 1862% ?- phrase(sed((w(".", A), w(".", B))>> append(B, A)), `abcdefghijklmn`, V), basic:smash(V). 1863% ?- phrase(sed(w("[afl]")>> pred([[]])), `abcdefghijklmn`, V), basic:smash(V). 1864% ?- phrase(sed(wl("\\\\[a-zA-Z]*")>> pred([[]])), `\\abcdefghijklmn`, V), basic:smash(V). 1865% ?- phrase(sed(w("a")>>(user:pred([`x`]))), `abaaa`, V), basic:smash(V). 1866% ?- show(phrase(sed(w("a")>>pred([`x`])))). 1867% ?- show_phrase(sed((w(".", A), w(".", B))>>append(B, A))). 1868% ?- show_phrase(sed(w("a")>>pred([`x`]))). 1869% ?- show_phrase(w("a*")). 1870% ?- show_am("\\\\[a-zA-Z]*"). 1871% ?- show_am("[a-zA-Z]*"). 1872 1873expand_recognize_act(Vars, Words, Words_in_pac, Mod, Rec_Act, List, List3):- 1874 recognize_act(Vars, Words, Words_in_pac, Mod, R_A, List, List1), 1875 expand_core( rec(Sed_name, Vars, 1876 ([[acc(Acc)|M], M, acc(Acc,[]), []]) 1877 & ([M, M, [], []]) 1878 & ( [L, M, P, Q] :- call(R_A, L, L0, P, P0), !, 1879 call(Sed_name, L0, M, P0, Q)) 1880 & ( [[C|Z0], Z, [C|P], Q]:- !, call(Sed_name, Z0, Z, P, Q)) 1881 & ( [[C|Z0], Z, acc(V,[C|P]), Q]:- 1882 call(Sed_name, Z0, Z, acc(V, P), Q)) 1883 ), 1884 Mod, Sed_main, List1, List2), 1885 expand_core( pred(Vars, [U,V]:- call(Sed_main, V, [], U, [])), 1886 Mod, Rec_Act, List2, List3). 1887 1888% The prefix 'user:' is for get_acc to be found in runtime . 1889userget_acc(V, acc(V,L), L):-!. 1890userget_acc([], L, L). 1891% 1892userget_acc(V, _, acc(V,L), L):-!. 1893userget_acc(I, I, L, L). 1894% 1895userset_acc(V, L, acc(V, L)). 1896 1897% ?- recognize_act([], "a", "b", user, A, P, []). 1898recognize_act(Vars, Words, Action, Mod, Recog_Act, List, List3):- 1899 once(expand_sed_act(Action, Mod, Action_expanded, List, List0)), 1900 lazy_prepend(Action_expanded, Action_slim, L, L0), 1901 expand_phrase(Words, Mod, Phrase, List0, List1), 1902 phrase_to_pred(Phrase, Mod, ([P, P0]:- Expanded_phrase), List1, List2), 1903 expand_core(pred(Vars, ([L, L0, P, P0]:- 1904 once(Expanded_phrase), once(Action_slim))), 1905 Mod, Recog_Act, List2, List3). 1906 1907% 1908expand_sed_act(X, _, X, L, L):- (var(X); number(X); string(X); is_list(X)), !. 1909expand_sed_act(X + Y, M, X0 + Y0, L, L0):- 1910 expand_sed_act(X, M, X0, L, L1), 1911 expand_sed_act(Y, M, Y0, L1, L0). 1912expand_sed_act(X, M, Y, L, L0):- expand_arg(X, M, Y, L, L0). 1913 1914% ?- expand_head_sed([], ("a"), "b", user, G, List, []), pac:show(G, List). 1915% ?- expand_head_sed([], ("a"), "b", user, G, List, []), !, maplist(assert, List), call(G, X, `a`, []). 1916% ?- expand_head_sed([A], ("a"), "b", user, G, List, []), !, maplist(assert, List), call(G, X, `a`, []). 1917 1918 1919expand_head_sed(Vars, Words, Action, Mod, G_callable, List, List3):- 1920 expand_phrase(Words, Mod, Phrase, List, List0), 1921 expand_sed_act(Action, Mod, Action_expanded, List0, List1), 1922 lazy_prepend_slim(Action_expanded, Action_slim, L, []), 1923 phrase_to_pred(Phrase, Mod, 1924 [P, P0]:- Expanded_phrase, List1, List2), 1925 expand_core(pred(Vars, ([L, P, P0]:- Expanded_phrase, Action_slim)), 1926 Mod, G_callable, List2, List3). 1927 1928% ?- word((=([a,b]), =([c,d])), X, []). 1929word((A, B), X, Y):- word(A, X, Z), word(B, Z, Y). 1930word(A, X, Y):- string(A), string_codes(A, C), append(C, Y, X). 1931word(A, X, Y):- call(A, S), append(S, Y, X).
lazy_prepend_slim("abc", A, V, V0).
?- lazy_prepend_slim([abc], A, V, V0).
?- lazy_prepend_slim(abc, A, V, V0).
?- lazy_prepend_slim(abc+xyz, A, V, V0).
?- lazy_prepend_slim(X+Y, A, V, V0).1940lazy_prepend_slim(E, A, V, V0):- once(lazy_prepend(E, B, V, V0)), 1941 slim_goal(B, A). 1942% 1943lazy_prepend(X, basic:prepend(X, Y, Z), Y, Z):- var(X), !. 1944lazy_prepend(X, true, P, Q):- is_list(X), !, basic:prepend(X, P, Q). 1945lazy_prepend(X, true, [X|Y], Y):- string(X), !. 1946lazy_prepend(X, true, [X0|Y], Y):- number(X), !, number_string(X,X0). 1947lazy_prepend(X + Y, (A, B), P, Q):- lazy_prepend(X, A, P, P0), 1948 lazy_prepend(Y, B, P0, Q). 1949lazy_prepend(X, (C, basic:prepend(Z, P, Q)), P, Q):- complete_args(X, [Z], C). 1950 1951% ?- phrase(sed(b/"a"/"hello"), ` a a `, R), basic:smash(R). 1952% ?- phrase(sed(a/"a"/"hello"), ` a a `, R), basic:smash(R). 1953% ?- phrase(sed(w/"a"/"hello "/" world"), ` a a `, R), basic:smash(R). 1954% ?- phrase(sed(wl/"a"/"hello "/" world"), ` a a `, R), basic:smash(R). 1955% ?- sed((wl/"a"/"hello "/" world"), ` a a `, R), basic:smash(R). 1956% ?- sed((wl/("a", X)/"hello "/" world"), ` a a `, R), basic:smash(R). % << error test. 1957 1958 1959 1960 /*************** 1961 * regex * 1962 ***************/
1971% ?- phrase((w(*(.), X), w(*(.), Y)), [a,b,c], []). 1972% ?- phrase((wl(*(.), X), wl(*(.), Y)), [a,b,c], []). 1973 1974% ?- expand_w("a*$", [], G, P, []). 1975% ?- phrase(w("a*"), `aaaaab`, R). 1976% ?- expand_w("a*", A, [], [], G, P, []). 1977 1978expand_w(X, _, call(X), P, P):-var(X). % @ meta call 1979expand_w(X, M, G, P, Q):- 1980 regex_coalgebra_code(X, coa(C, I, _)), 1981 expand_coa(0, C, I, M, G, P, Q).
1989expand_w(X, A, B, _, call(X, A, B), P, P):- var(X). % @ meta call 1990expand_w(X, A, B, M, G, P, Q):- 1991 regex_coalgebra_code(X, coa(C, I, _)), 1992 expand_coa(2, C, I, M, G0, P, Q), 1993 complete_args(G0, [A, B], G).
2001expand_wl(X, _, call(X), P, P):-var(X). % @ meta call 2002expand_wl(X, M, G, P, Q):- 2003 regex_coalgebra_code(X, coa(C, I, _)), 2004 null_last_coa(C, C0), 2005 expand_coa(0, C0, I, M, G, P, Q).
2013expand_wl(X, A, B, _, call(X, A, B), P, P):- var(X). % @ meta call 2014expand_wl(X, A, B, M, G, P, Q):- 2015 regex_coalgebra_code(X, coa(C, I, _)), 2016 null_last_coa(C, C0), 2017 expand_coa(2, C0, I, M, G0, P, Q), 2018 complete_args(G0, [A, B], G). 2019 2020% 2021null_last_coa(X, Y):- maplist(null_last_coa_state, X, Y). 2022 2023% 2024null_last_coa_state(A-B, A-C):- reverse(B, C). 2025 2026 /*********************** 2027 * compare regex * 2028 ***********************/ 2029 2030% ?- regex_compare(C, "a", "a"). 2031% ?- regex_compare(C, "a", "b"). 2032% ?- regex_compare(C, "a*", "a"). 2033regex_compare(C, X, Y):- regex_normal_am_list([X,Y], [X0, Y0]), 2034 once(am_compare(C, X0, Y0)). 2035 2036% ?- regex_normal_am_list(["a", "b"], R). 2037% ?- regex_normal_am_list(["(ab)*", "b"], R). 2038 2039regex_normal_am_list(X, Y):- regex_word(regexlist(X), regexlist(X0)), 2040 maplist(word_normal_am, X0, Y). 2041 2042 2043 /*************************** 2044 * bisimilarity test * 2045 ***************************/ 2046 2047% ?- am_bisimilar(coa([], 0), coa([], 1)). 2048% ?- am_bisimilar(coa([1-[[]]], 1), coa([1-[[]]], 1)). 2049% ?- (regex_am("a", R), am_bisimilar(R, R)). 2050% ?- (regex_am(a+ (+a), R), regex_am((+a)+a, S), !, am_bisimilar(R, S)). 2051% ?- (regex_am(a+ (+a), R), regex_am((+a)+a+a, S), !, am_bisimilar(R, S)). 2052 2053am_bisimilar(coa([], _), coa([], _)). 2054am_bisimilar(coa(E, I), coa(F, J)):- 2055 once(bisimilar(I, J, [], _, E, F)). 2056 2057% 2058bisimilar(I, J, Done, Done, _, _):- memberchk(I-J, Done). 2059bisimilar(I, J, Done , Done0, E, F):- 2060 memberchk(I-G, E), 2061 memberchk(J-H, F), 2062 bisimilar_down(G, H, [I-J|Done], Done0, E, F). 2063% 2064bisimilar_down([], [], Done, Done, _, _). 2065bisimilar_down([[]|R], [[]|S], Done, Done0, E, F):- 2066 bisimilar_down(R, S, Done, Done0, E, F). 2067bisimilar_down([C-I|R], [C-J|S], Done, Done0, E, F):- 2068 bisimilar(I, J, Done, Done1, E, F), 2069 bisimilar_down(R, S, Done1, Done0, E, F). 2070 2071 /********************************* 2072 * one-way similarity test * 2073 *********************************/ 2074 2075% ?- (regex_am("a", A), regex_am("b", B), am_compare(C, A, B)). 2076% ?- (regex_am("a", A), regex_am("a", B), am_compare(C, A, B)). 2077% ?- (regex_am("a", A), regex_am("a*", B), am_compare(C, A, B)). 2078% ?- (regex_am("a*", A), regex_am("a", B), am_compare(C, A, B)). 2079am_compare(C, A, B):- once(am_similar(A, B)), 2080 ( am_similar(B, A) 2081 -> C = (=) 2082 ; C = (<) 2083 ). 2084am_compare(C, A, B):- am_similar(B, A) -> C = (>); C = incomparable. 2085 2086% 2087am_similar(coa([], _), coa([], _)). 2088am_similar(coa(E, I), coa(F, J)):- 2089 similar(I, J, [], _, E, F). 2090 2091% 2092similar(I, J, Done, Done, _, _):- memberchk(I-J, Done). 2093similar(I, J, Done , Done0, E, F):- 2094 memberchk(I-G, E), 2095 memberchk(J-H, F), 2096 once(similar_down(G, H, [I-J|Done], Done0, E, F)). 2097% 2098similar_down([], _, Done, Done, _, _). 2099similar_down([[]|R], [[]|S], Done, Done0, E, F):- 2100 similar_down(R, S, Done, Done0, E, F). 2101similar_down([C-I|R], [C-J|S], Done, Done0, E, F):- 2102 similar(I, J, Done, Done1, E, F), 2103 similar_down(R, S, Done1, Done0, E, F). 2104similar_down(R, [_|S], Done, Done0, E, F):- 2105 similar_down(R, S, Done, Done0, E, F)