1?- use_module(library(lists)).    2
    3guardedexpr_a(node(guardedexpr_a,[[a]],8), A, B) :-
    4        c(A, a, B).
    5guardedexpr_a(node(guardedexpr_a,[[a],A],9), B, C) :-
    6        c(B, a, D),
    7        expr(A, D, C).
    8
    9char(A, B) :-
   10        integer(A),
   11        A<256, !,
   12        name(B, [A]).
   13
   14c([A|B], A, B).
   15
   16dctg_rule_info(guardedexpr_b, 11, guardedexpr_b(node(_,_,11),_,_), 3, nonterminal).
   17dctg_rule_info(guardedexpr_a, 9, guardedexpr_a(node(_,_,9),_,_), 3, nonterminal).
   18dctg_rule_info(noniter_expr, 5, noniter_expr(node(_,_,5),_,_), 3, nonterminal).
   19dctg_rule_info(expr, 0, expr(node(_,_,0),_,_), 3, nonterminal).
   20dctg_rule_info(expr, 1, expr(node(_,_,1),_,_), 2, nonterminal).
   21dctg_rule_info(noniter_expr, 4, noniter_expr(node(_,_,4),_,_), 2, nonterminal).
   22dctg_rule_info(iter_expr, 6, iter_expr(node(_,_,6),_,_), 2, nonterminal).
   23dctg_rule_info(iter_expr, 7, iter_expr(node(_,_,7),_,_), 2, nonterminal).
   24dctg_rule_info(probval, 13, probval(node(_,_,13),_,_), 1, terminal).
   25dctg_rule_info(intval, 12, intval(node(_,_,12),_,_), 1, terminal).
   26dctg_rule_info(guardedexpr_b, 10, guardedexpr_b(node(_,_,10),_,_), 1, terminal).
   27dctg_rule_info(guardedexpr_a, 8, guardedexpr_a(node(_,_,8),_,_), 1, terminal).
   28dctg_rule_info(noniter_expr, 3, noniter_expr(node(_,_,3),_,_), 1, terminal).
   29dctg_rule_info(noniter_expr, 2, noniter_expr(node(_,_,2),_,_), 1, terminal).
   30
   31library_directory('c:/program files/sicstus prolog/library').
   32
   33sre_pp_l([A]) :-
   34        sre_pp(A), !.
   35sre_pp_l([A|B]) :-
   36        write('['),
   37        sre_pp(A),
   38        write(+),
   39        sre_pp_l(B),
   40        write(']'), !.
   41
   42sre2b(A) :-
   43        generate_tree(expr, grow, 8, _, B, _),
   44        B^^construct(C),
   45        B^^recognize(A,D,1.0,E),
   46        nl,
   47        sre_pp(C),
   48        nl,
   49        write('Prob = '),
   50        write(E),
   51        nl,
   52        write('Leftover = '),
   53        write(D),
   54        nl.
   55
   56sre2c(A, B, C) :-
   57        repeat,
   58        (   A=full
   59        ;   A=grow
   60        ),
   61        generate_tree(expr, A, 12, _, D, _),
   62        D^^construct(B),
   63        nl,
   64        write(A),
   65        nl,
   66        sre_pp(B),
   67        nl,
   68        bagof(E, user:(D^^recognize(C,[],1.0,E)), F),
   69        write('Pr list: '),
   70        nl,
   71        writelist(F),
   72        nl.
   73
   74sre2(A, B, C) :-
   75        repeat,
   76        (   A=full
   77        ;   A=grow
   78        ),
   79        generate_tree(expr, A, 12, _, D, _),
   80        D^^construct(B),
   81        nl,
   82        write(A),
   83        nl,
   84        sre_pp(B),
   85        nl,
   86        bagof((E,F), user:(D^^recognize(C,E,1.0,F)), G),
   87        write('Recog list: '),
   88        nl,
   89        writelist(G),
   90        nl.
   91
   92sre_pp(A*B) :-
   93        write('('),
   94        sre_pp(A),
   95        write(')*'),
   96        write(B), !.
   97sre_pp(A+B) :-
   98        write('('),
   99        sre_pp(A),
  100        write(')+'),
  101        write(B), !.
  102sre_pp(A:B) :-
  103        sre_pp(A),
  104        write(:),
  105        sre_pp(B), !.
  106sre_pp([A|B]) :-
  107        sre_pp_l([A|B]), !.
  108sre_pp((A,B)) :-
  109        write('('),
  110        sre_pp(A),
  111        write(','),
  112        write(B),
  113        write(')'), !.
  114sre_pp(A) :-
  115        write(A).
  116
  117select_kth_term([A], _, B, B, A) :- !.
  118select_kth_term([A|_], B, C, C, A) :-
  119        A>=B, !.
  120select_kth_term([_|A], B, C, D, E) :-
  121        F is C+1,
  122        select_kth_term(A, B, F, D, E).
  123
  124sumlist([], [], A, A).
  125sumlist([A|B], [C|D], E, F) :-
  126        C is E+A,
  127        sumlist(B, D, C, F).
  128
  129int_range(0, 1000).
  130
  131is_a_probability(A) :-
  132        float(A), !.
  133is_a_probability(A) :-
  134        random:random(B),
  135        A is truncate(B*100)/100.
  136
  137is_an_integer(A) :-
  138        integer(A), !.
  139is_an_integer(A) :-
  140        int_range(B, C),
  141        random:random(B, C, A).
  142
  143recognize_loop(_, A, [], [], B, C) :- !,
  144        C is B*(1.0-A),
  145        check_prob(C).
  146recognize_loop(_, A, B, B, C, D) :-
  147        D is C*(1.0-A),
  148        check_prob(D).
  149recognize_loop(A, B, C, D, E, F) :-
  150        G is E*B,
  151        check_prob(G),
  152        A^^recognize(C,H,G,I),
  153        \+C=H,
  154        check_prob(I),
  155        recognize_loop(A, B, H, D, I, F).
  156
  157raw_gen_loop(A, B, C, D, E, F) :-
  158        E<C,
  159        maybe(B),
  160        A^^raw_generate(G,E,H),
  161        raw_gen_loop(A, B, C, I, H, F),
  162        lists:append(G, I, D), !.
  163raw_gen_loop(_, _, _, [], A, A) :- !.
  164
  165probval(node(probval,[[A]],13), B, C) :-
  166        c(B, A, C),
  167        is_a_probability(A).
  168
  169raw_select_term(A, B) :-
  170        sumlist(A, C, 0, D),
  171        random:random(0, D, E),
  172        select_kth_term(C, E, 1, B, _), !.
  173
  174guardedexpr_b(node(guardedexpr_b,[[b]],10), A, B) :-
  175        c(A, b, B).
  176guardedexpr_b(node(guardedexpr_b,[[b],A],11), B, C) :-
  177        c(B, b, D),
  178        expr(A, D, C).
  179
  180intval(node(intval,[[A]],12), B, C) :-
  181        c(B, A, C),
  182        is_an_integer(A).
  183
  184noniter_expr(node(noniter_expr,[[a]],2), A, B) :-
  185        c(A, a, B).
  186noniter_expr(node(noniter_expr,[[b]],3), A, B) :-
  187        c(A, b, B).
  188noniter_expr(node(noniter_expr,[A,B,C,D],4), E, F) :-
  189        guardedexpr_a(A, E, G),
  190        intval(B, G, H),
  191        guardedexpr_b(C, H, I),
  192        intval(D, I, F).
  193noniter_expr(node(noniter_expr,[A,B],5), C, D) :-
  194        expr(A, C, E),
  195        expr(B, E, D).
  196
  197check_prob(A) :-
  198        min_grammar_prob_P(B),
  199        A>B, !.
  200
  201iter_expr(node(iter_expr,[A,B],6), C, D) :-
  202        noniter_expr(A, C, E),
  203        probval(B, E, D).
  204iter_expr(node(iter_expr,[A,B],7), C, D) :-
  205        noniter_expr(A, C, E),
  206        probval(B, E, D).
  207
  208identify_type([], [], []).
  209identify_type([A|B], [A|C], D) :-
  210        dctg_rule_info(_, A, _, _, terminal), !,
  211        identify_type(B, C, D).
  212identify_type([A|B], C, [A|D]) :-
  213        identify_type(B, C, D).
  214
  215get_rule_stuff(A, B) :-
  216        clause(user:semantic_rule(B,_,C,_), _),
  217        C=..[A|_].
  218
  219make_id_entries([]) :- !.
  220make_id_entries([(A,B)|C]) :-
  221        assert(user:dctg_id_table(A,B,_,_)),
  222        make_id_entries(C), !.
  223
  224make_rule_id_list2(A, B) :-
  225        bagof(C, user:get_rule_stuff(A,C), D),
  226        rem_dups(D, B).
  227
  228same_goal(A, B) :-
  229        A=..[C|_],
  230        B=..[C|_], !.
  231
  232abstract_member2(A, [B|_]) :-
  233        same_goal(A, B).
  234abstract_member2(A, [_|B]) :-
  235        abstract_member2(A, B).
  236
  237goal_type(A, B, _, C, D, E, C, D, [A|E]) :-
  238        (   B=(F,_) ->
  239            true
  240        ;   B=F
  241        ),
  242        (   abstract_member2(F, E)
  243        ;   same_goal(A, F)
  244        ), !.
  245goal_type(A, B, C, D, E, F, [A|D], E, F) :-
  246        (   B=(G,_) ->
  247            true
  248        ;   B=G
  249        ),
  250        (   abstract_member2(G, D)
  251        ;   abstract_member2(G, C)
  252        ), !.
  253goal_type(A, (_,B), C, D, E, F, G, H, I) :- !,
  254        goal_type(A, B, C, D, E, F, G, H, I).
  255goal_type(A, _, _, B, C, D, B, [A|C], D).
  256
  257user_override(A, B, C, [A|B], C) :-
  258        A=..[D|_],
  259        dctg_override_P(E, _),
  260        lists:member(D, E), !.
  261user_override(A, B, C, B, [A|C]) :-
  262        A=..[D|_],
  263        dctg_override_P(_, E),
  264        lists:member(D, E), !.
  265
  266grammar_type_loop([], A, B, C, A, B, C) :- !.
  267grammar_type_loop([A|B], C, D, E, F, G, H) :-
  268        user_override(A, D, E, I, J),
  269        grammar_type_loop(B, C, I, J, F, G, H).
  270grammar_type_loop([A|B], C, D, E, F, G, H) :-
  271        copy_term(A, I),
  272        clause(user:I, J),
  273        goal_type(A, J, B, C, D, E, K, L, M),
  274        grammar_type_loop(B, K, L, M, F, G, H).
  275
  276find_minimum_depth(_, [], A, A).
  277find_minimum_depth(A, [(B,C)|D], E, F) :-
  278        B=..[A|_],
  279        G is min(C,E),
  280        find_minimum_depth(A, D, G, F), !.
  281find_minimum_depth(A, [_|B], C, D) :-
  282        find_minimum_depth(A, B, C, D), !.
  283
  284abstract_member(A, [(B,_)|_]) :-
  285        B=..[A|_].
  286abstract_member(A, [_|B]) :-
  287        abstract_member(A, B).
  288
  289find_min_depth(A, [(B,C)|_], C) :-
  290        A=..[B|_], !.
  291find_min_depth(A, [_|B], C) :-
  292        find_min_depth(A, B, C), !.
  293
  294is_a_rule_call(A) :-
  295        A=..[B|_],
  296        dctg_id_table(B, _, _, _), !.
  297
  298find_min_depth_body((A,B), C, D, E) :-
  299        is_a_rule_call(A), !,
  300        find_min_depth(A, C, F),
  301        G is max(F,D),
  302        find_min_depth_body(B, C, G, E).
  303find_min_depth_body((_,A), B, C, D) :- !,
  304        find_min_depth_body(A, B, C, D).
  305find_min_depth_body(A, B, C, D) :-
  306        is_a_rule_call(A), !,
  307        find_min_depth(A, B, E),
  308        D is max(E,C).
  309find_min_depth_body(_, _, A, A) :- !.
  310
  311find_rule_mins([], A, A) :- !.
  312find_rule_mins([(A,B)|C], D, E) :-
  313        A=..[F|_],
  314        \+member((F,_),D), !,
  315        find_rule_mins(C, [(F,B)|D], E).
  316find_rule_mins([_|A], B, C) :-
  317        find_rule_mins(A, B, C).
  318
  319process_rules([], A, _, B, A, B) :- !.
  320process_rules([A|B], C, D, E, F, G) :-
  321        copy_term(A, H),
  322        clause(user:H, I),
  323        find_min_depth_body(I, D, 0, J), !,
  324        K is J+1,
  325        process_rules(B, [(A,K)|C], D, E, F, G).
  326process_rules([A|B], C, D, E, F, G) :- !,
  327        process_rules(B, C, D, [A|E], F, G).
  328
  329set_rule_data([], _) :- !.
  330set_rule_data([(A,B)|C], D) :-
  331        A=..[E|F],
  332        lists:append(_, [node(_,_,G),_,_], F),
  333        (   lists:member(A, D) ->
  334            H=terminal
  335        ;   H=nonterminal
  336        ),
  337        assert(user:dctg_rule_info(E,G,A,B,H)),
  338        set_rule_data(C, D), !.
  339
  340grammar_type_top_loop(A, B, C, D) :-
  341        grammar_type_loop(A, [], B, C, E, F, G),
  342        (   length(A, H),
  343            length(E, H) ->
  344            F=D
  345        ;   grammar_type_top_loop(E, F, G, D)
  346        ), !.
  347
  348grammar_depth_top_loop([], A, _, A) :- !.
  349grammar_depth_top_loop(A, B, C, D) :-
  350        process_rules(A, B, C, [], E, F),
  351        find_rule_mins(E, C, G),
  352        (   length(A, H),
  353            length(F, H) ->
  354            write('Problem - '),
  355            write(H),
  356            write(' rules cannot terminate:'),
  357            nl,
  358            writelist(F),
  359            nl,
  360            write('these terminated - '),
  361            nl,
  362            writelist(E),
  363            nl,
  364            write('These are mincalls - '),
  365            nl,
  366            writelist(G),
  367            nl,
  368            fail
  369        ;   grammar_depth_top_loop(F, E, G, D)
  370        ), !.
  371
  372clone_list([], []) :- !.
  373clone_list([_|A], [_|B]) :-
  374        clone_list(A, B), !.
  375
  376get_rule_name(A) :-
  377        clause(user:semantic_rule(B,_,C,_), _),
  378        C=..[D|E],
  379        clone_list(E, F),
  380        lists:append(F, [node(_,_,B),_,_], G),
  381        A=..[D|G].
  382
  383dctg_id_table(expr, [0,1], [], [0,1]).
  384dctg_id_table(guardedexpr_a, [8,9], [8], [9]).
  385dctg_id_table(guardedexpr_b, [10,11], [10], [11]).
  386dctg_id_table(intval, [12], [12], []).
  387dctg_id_table(iter_expr, [6,7], [], [6,7]).
  388dctg_id_table(noniter_expr, [2,3,4,5], [2,3], [4,5]).
  389dctg_id_table(probval, [13], [13], []).
  390
  391enhance_rule_id_list :-
  392        retract(user:dctg_id_table(A,B,_,_)),
  393        identify_type(B, C, D),
  394        assert(user:dctg_id_table(A,B,C,D)),
  395        fail.
  396enhance_rule_id_list.
  397
  398generate_rule_data :-
  399        findall(A, user:get_rule_name(A), B),
  400        rem_dups(B, C),
  401        grammar_depth_top_loop(C, [], [], D),
  402        grammar_type_top_loop(C, [], [], E),
  403        set_rule_data(D, E), !.
  404
  405make_rule_id_list :-
  406        findall((A,B), user:make_rule_id_list2(A,B), C),
  407        make_id_entries(C), !.
  408
  409cleanup_grammar_data :-
  410        retractall(user:dctg_rule_info(_,_,_,_)),
  411        retractall(user:dctg_id_table(_,_,_,_)), !.
  412
  413make_grammar_table :-
  414        cleanup_grammar_data,
  415        make_rule_id_list,
  416        generate_rule_data,
  417        enhance_rule_id_list, !.
  418
  419file_search_path(library, A) :-
  420        library_directory(A).
  421file_search_path(system, A) :-
  422        prolog_flag(host_type, A).
  423
  424eval_with_ID_P(no).
  425
  426negsetsize_P(30).
  427
  428elite_migrate_P(0, no).
  429
  430unique_guards_P(no).
  431
  432min_skip_prob_P(1.0e-004).
  433
  434min_grammar_prob_P(1.0e-004).
  435
  436gen_set_size_P(1000).
  437
  438sre_mintestcnt_P(2).
  439
  440mutation_range_P(0.1).
  441
  442dctg_override_P([], []).
  443
  444expr(node(expr,[A],0), B, C) :-
  445        iter_expr(A, B, C).
  446expr(node(expr,[A],1), B, C) :-
  447        noniter_expr(A, B, C).
  448
  449dctg_root_P(expr).
  450
  451user_args_P([]).
  452
  453reprod_verif_P(no).
  454
  455evaluator_reset_P(generate_testset, 100).
  456
  457gen_type_P(steadystate).
  458
  459popn_dump_P(no).
  460
  461max_string_length_P(20).
  462
  463rep_limit_P(2).
  464
  465trace_limit_P(0, 0).
  466
  467unique_population_P(yes).
  468
  469lamarckian_P(0.0, 10, best, 0.1).
  470
  471tournament_size_P(4, 4).
  472
  473error_tolerance_P(0).
  474
  475max_depth_P(10, 17).
  476
  477prob_terminal_mutation_P(0.75).
  478
  479prob_internal_crossover_P(0.9).
  480
  481reprod_P(3).
  482
  483prob_crossover_P(0.9).
  484
  485prob_grow_P(0.5).
  486
  487max_runs_P(1, solution, 3).
  488
  489cull_method_P(elite).
  490
  491population_size_P(75, 50).
  492
  493dctg_file_P('sre3.pl').
  494
  495fitness_func_P('reg_gram_1').
  496
  497wd_P('c:/research/sre_dna_fastX').
  498
  499seed_P(random, (_,_,_)).
  500
  501rule_number(14).
  502
  503semantic_rule(0, construct(A), expr, [B]) :- !,
  504        B^^construct(A).
  505semantic_rule(0, raw_generate(A,B,C), expr, [D]) :- !,
  506        D^^raw_generate(A,B,C).
  507semantic_rule(0, recognize(A,B,C,D), expr, [E]) :- !,
  508        check_prob(C),
  509        E^^recognize(A,B,C,D).
  510semantic_rule(1, construct(A), expr, [B]) :- !,
  511        B^^construct(A).
  512semantic_rule(1, raw_generate(A,B,C), expr, [D]) :- !,
  513        D^^raw_generate(A,B,C).
  514semantic_rule(1, recognize(A,B,C,D), expr, [E]) :- !,
  515        check_prob(C),
  516        E^^recognize(A,B,C,D).
  517semantic_rule(2, construct(a), noniter_expr, [[a]]) :- !,
  518        true.
  519semantic_rule(2, raw_generate([a],A,B), noniter_expr, [[a]]) :- !,
  520        B is A+1.
  521semantic_rule(2, recognize([a|A],A,B,B), noniter_expr, [[a]]) :- !,
  522        check_prob(B).
  523semantic_rule(3, construct(b), noniter_expr, [[b]]) :- !,
  524        true.
  525semantic_rule(3, raw_generate([b],A,B), noniter_expr, [[b]]) :- !,
  526        B is A+1.
  527semantic_rule(3, recognize([b|A],A,B,B), noniter_expr, [[b]]) :- !,
  528        check_prob(B).
  529semantic_rule(4, construct([(A,B),(C,D)]), noniter_expr, [E,F,G,H]) :- !,
  530        E^^construct(A),
  531        F^^construct(B),
  532        G^^construct(C),
  533        H^^construct(D).
  534semantic_rule(4, raw_generate(A,B,C), noniter_expr, [D,E,F,G]) :- !,
  535        E^^construct(H),
  536        G^^construct(I),
  537        (   raw_select_term([H,I], 1) ->
  538            D^^raw_generate(A,B,C)
  539        ;   F^^raw_generate(A,B,C)
  540        ).
  541semantic_rule(4, recognize(A,B,C,D), noniter_expr, [E,F,_,G]) :- !,
  542        F^^construct(H),
  543        G^^construct(I),
  544        J is C*H/(H+I),
  545        check_prob(J),
  546        E^^recognize(A,B,J,D).
  547semantic_rule(4, recognize(A,B,C,D), noniter_expr, [_,E,F,G]) :- !,
  548        E^^construct(H),
  549        G^^construct(I),
  550        J is C*I/(H+I),
  551        check_prob(J),
  552        F^^recognize(A,B,J,D).
  553semantic_rule(5, construct(A:B), noniter_expr, [C,D]) :- !,
  554        C^^construct(A),
  555        D^^construct(B).
  556semantic_rule(5, raw_generate(A,B,C), noniter_expr, [D,E]) :- !,
  557        D^^raw_generate(F,B,G),
  558        E^^raw_generate(H,G,C),
  559        lists:append(F, H, A).
  560semantic_rule(5, recognize(A,B,C,D), noniter_expr, [E,F]) :- !,
  561        check_prob(C),
  562        E^^recognize(A,G,C,H),
  563        check_prob(H),
  564        F^^recognize(G,B,H,D).
  565semantic_rule(6, construct(A*B), iter_expr, [C,D]) :- !,
  566        C^^construct(A),
  567        D^^construct(B).
  568semantic_rule(6, raw_generate(A,B,C), iter_expr, [D,E]) :- !,
  569        E^^construct(F),
  570        max_string_length_P(G),
  571        raw_gen_loop(D, F, G, A, B, C).
  572semantic_rule(6, recognize(A,B,C,D), iter_expr, [E,F]) :- !,
  573        check_prob(C),
  574        F^^construct(G),
  575        recognize_loop(E, G, A, B, C, D).
  576semantic_rule(7, construct(A+B), iter_expr, [C,D]) :- !,
  577        C^^construct(A),
  578        D^^construct(B).
  579semantic_rule(7, raw_generate(A,B,C), iter_expr, [D,E]) :- !,
  580        D^^raw_generate(F,B,G),
  581        E^^construct(H),
  582        max_string_length_P(I),
  583        raw_gen_loop(D, H, I, J, G, C),
  584        lists:append(F, J, A), !.
  585semantic_rule(7, recognize(A,B,C,D), iter_expr, [E,F]) :- !,
  586        check_prob(C),
  587        E^^recognize(A,G,C,H),
  588        \+A=G,
  589        check_prob(H),
  590        F^^construct(I),
  591        recognize_loop(E, I, G, B, H, D).
  592semantic_rule(8, construct(a), guardedexpr_a, [[a]]) :- !,
  593        true.
  594semantic_rule(8, raw_generate([a],A,B), guardedexpr_a, [[a]]) :- !,
  595        B is A+1.
  596semantic_rule(8, recognize([a|A],A,B,B), guardedexpr_a, [[a]]) :- !,
  597        check_prob(B).
  598semantic_rule(9, construct(a:A), guardedexpr_a, [[a],B]) :- !,
  599        B^^construct(A).
  600semantic_rule(9, raw_generate([a|A],B,C), guardedexpr_a, [[a],D]) :- !,
  601        D^^raw_generate(A,B,E),
  602        C is E+1.
  603semantic_rule(9, recognize([a|A],B,C,D), guardedexpr_a, [[a],E]) :- !,
  604        check_prob(C),
  605        E^^recognize(A,B,C,D).
  606semantic_rule(10, construct(b), guardedexpr_b, [[b]]) :- !,
  607        true.
  608semantic_rule(10, raw_generate([b],A,B), guardedexpr_b, [[b]]) :- !,
  609        B is A+1.
  610semantic_rule(10, recognize([b|A],A,B,B), guardedexpr_b, [[b]]) :- !,
  611        check_prob(B).
  612semantic_rule(11, construct(b:A), guardedexpr_b, [[b],B]) :- !,
  613        B^^construct(A).
  614semantic_rule(11, raw_generate([b|A],B,C), guardedexpr_b, [[b],D]) :- !,
  615        D^^raw_generate(A,B,E),
  616        C is E+1.
  617semantic_rule(11, recognize([b|A],B,C,D), guardedexpr_b, [[b],E]) :- !,
  618        check_prob(C),
  619        E^^recognize(A,B,C,D).
  620semantic_rule(12, construct(A), intval, [[A]]) :- !,
  621        true.
  622semantic_rule(13, construct(A), probval, [[A]]) :- !,
  623        true.
  624
  625process(A) :-
  626        (   A=(B<:>C)
  627        ;   A=(B::=C)
  628        ), !,
  629        translate_rule(A, D),
  630        assertz(user:D), !.
  631process((:-A)) :- !,
  632        call(user:A).
  633process((A:-B)) :- !,
  634        assertz(user:(A:-B)).
  635process(A) :-
  636        assertz(user:A).
  637
  638check_it(A) :-
  639        A=end_of_file, !.
  640check_it(A) :-
  641        process(A),
  642        fail.
  643
  644consume :-
  645        repeat,
  646        read(A),
  647        check_it(A).
  648
  649grammar(A) :-
  650        seeing(B),
  651        see(A),
  652        consume,
  653        seen,
  654        see(B).
  655
  656add_extra_args(A, B, C) :-
  657        B=..D,
  658        lists:append(D, A, E),
  659        C=..E.
  660
  661assert_semantic_rule(A, B, C, (D,E)) :- !,
  662        (   D=(F::-G)
  663        ;   F=D,
  664            G=true
  665        ),
  666        assert(user:(semantic_rule(A,F,B,C):-!,G)),
  667        assert_semantic_rule(A, B, C, E).
  668assert_semantic_rule(A, B, C, D) :-
  669        (   D=(E::-F)
  670        ;   E=D,
  671            F=true
  672        ),
  673        assert(user:(semantic_rule(A,E,B,C):-!,F)).
  674
  675prod_number(A) :-
  676        retract(user:rule_number(A)),
  677        B is A+1,
  678        assert(user:rule_number(B)).
  679
  680tidy(((A,B),C), D) :-
  681        tidy((A,B,C), D).
  682tidy((A,B), (C,D)) :- !,
  683        tidy(A, C),
  684        tidy(B, D).
  685tidy(A, A) :- !.
  686
  687t_rp(!, A, A, B, B, !) :- !.
  688t_rp([], A, [[]|A], B, C, B=C) :- !.
  689t_rp([A], B, [[C]|B], D, E, c(D,A,E)) :-
  690        char(A, C).
  691t_rp([A], B, [[A]|B], C, D, c(C,A,D)) :- !.
  692t_rp([A|B], C, [[D|E]|C], F, G, (c(F,A,H),I)) :-
  693        char(A, D),
  694        t_rp(B, C, [E|C], H, G, I).
  695t_rp([A|B], C, [[A|B]|C], D, E, (c(D,A,F),G)) :- !,
  696        t_rp(B, C, [B|C], F, E, G).
  697t_rp({A}, B, B, C, C, A) :- !.
  698t_rp((A,B), C, D, E, F, (G,H)) :- !,
  699        t_rp(A, C, I, E, J, G),
  700        t_rp(B, I, D, J, F, H).
  701t_rp(A^^B, C, [B|C], D, E, F) :-
  702        add_extra_args([B,D,E], A, F).
  703t_rp(A, B, [C|B], D, E, F) :-
  704        add_extra_args([C,D,E], A, F).
  705
  706t_lp((A,B), C, D, E, F, G) :-
  707        lists:append(B, E, H),
  708        prod_number(I),
  709        assert_semantic_rule(I, A, C, F),
  710        add_extra_args([node(A,C,I),D,H], A, G).
  711t_lp(A, B, C, D, E, F) :-
  712        prod_number(G),
  713        assert_semantic_rule(G, A, B, E),
  714        add_extra_args([node(A,B,G),C,D], A, F).
  715
  716translate_rule((A::=[]<:>B), C) :- !,
  717        t_lp(A, [], D, D, B, C).
  718translate_rule((A::=[]), B) :- !,
  719        t_lp(A, [], C, C, [], B).
  720translate_rule((A::=B<:>C), (D:-E)) :- !,
  721        t_rp(B, [], F, G, H, I),
  722        lists:reverse(F, J),
  723        t_lp(A, J, G, H, C, D),
  724        tidy(I, E).
  725translate_rule((A::=B), (C:-D)) :-
  726        translate_rule((A::=B<:>[]), (C:-D)).
  727
  728node(A,B,C)^^D :-
  729        semantic_rule(C, D, A, B).
  730
  731sre(A, B, C, D) :-
  732        repeat,
  733        (   A=full
  734        ;   A=grow
  735        ),
  736        generate_tree(expr, A, 12, _, E, _),
  737        E