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