This is recursive procedure to tour a given syntax tree.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(tree_node_t), | intent(in) | :: | nodes(:) | |||
integer, | intent(in) | :: | idx | |||
type(literal_t), | intent(inout) | :: | lit |
pure recursive subroutine best_factor(nodes, idx, lit) implicit none type(tree_node_t), intent(in) :: nodes(:) integer, intent(in) :: idx type(literal_t), intent(inout) :: lit type(literal_t) :: lit_l, lit_r type(tree_node_t) :: curr integer :: i curr = nodes(idx) curr%c = nodes(idx)%c lit%all%c = theta lit%pref%c = theta lit%suff%c = theta lit%fact%c = theta if (curr%op == op_union .or. curr%op == op_concat) then call best_factor(nodes, curr%left_i, lit_l) call best_factor(nodes, curr%right_i, lit_r) end if select case (curr%op) case(op_union) lit%pref%c = same_part_of_prefix(lit_l%pref%c, lit_r%pref%c) lit%suff%c = same_part_of_suffix(lit_l%suff%c, lit_r%suff%c) lit%flag_closure = .true. case(op_concat) ! #ifdef IMPURE ! write(0,*) "L103: ", lit_l%flag_class, lit_r%flag_class, lit_l%flag_closure, lit_r%flag_closure ! #endif lit%flag_class = lit_l%flag_class .or. lit_r%flag_class lit%flag_closure = lit_l%flag_closure .or. lit_r%flag_closure select case (return_class_closure(lit_l%flag_class, lit_r%flag_class, lit_l%flag_closure, lit_r%flag_closure)) case (lt_N_class_N_closure) lit%all%c = lit_l%all%c//lit_r%all%c lit%pref%c = best(lit_l%pref%c, lit_l%all%c//lit_r%pref%c) lit%suff%c = best(lit_r%suff%c, lit_l%suff%c//lit_r%all%c) case (lt_N_class_R_closure) lit%pref%c = lit_l%all%c//lit_r%pref%c lit%suff%c = lit_r%suff%c case (lt_N_class_L_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_l%suff%c//lit_r%all%c case (lt_N_class_LR_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c ! following 12 cases are not tested enough. !===========================================================================! case (lt_R_class_N_closure) lit%pref%c = best(lit_l%pref%c, lit_l%all%c//lit_r%pref%c) lit%suff%c = lit_r%suff%c case (lt_R_class_R_closure) lit%pref%c = best(lit_l%pref%c, lit_l%all%c//lit_r%pref%c) lit%suff%c = lit_r%suff%c case (lt_R_class_L_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c ! lit%fact%c = best(lit_r%suff%c, lit_l%suff%c//lit_r%all%c) case (lt_R_class_LR_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c !===========================================================================! case (lt_L_class_N_closure) lit%pref%c = lit_l%pref%c lit%suff%c = best(lit_r%suff%c, lit_l%suff%c//lit_r%all%c) case (lt_L_class_R_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c continue case (lt_L_class_L_closure) lit%pref%c = lit_l%pref%c lit%suff%c = best(lit_r%suff%c, lit_l%suff%c//lit_r%all%c) continue case (lt_L_class_LR_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c continue !===========================================================================! case (lt_LR_class_N_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c continue case (lt_LR_class_R_closure) lit%pref%c = lit_l%pref%c lit%pref%c = lit_l%pref%c continue case (lt_LR_class_L_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c continue case (lt_LR_class_LR_closure) lit%pref%c = lit_l%pref%c lit%suff%c = lit_r%suff%c continue end select !== Intermediate literals (factors) are not implemented and tested yet. ! lit%fact%c = best(best(lit_l%fact%c, lit_r%fact%c), lit_l%suff%c//lit_r%pref%c) case (op_closure) lit%flag_closure = .true. case (op_char) if (curr%c%single_flag) then lit%all%c = char_utf8(curr%c%first()) lit%pref%c = char_utf8(curr%c%first()) lit%suff%c = char_utf8(curr%c%first()) lit%fact%c = char_utf8(curr%c%first()) else lit%flag_class = .true. end if case (op_repeat) block type(tree_node_t) :: next_l ! Is the flag_class of the next node flagged? call best_factor(nodes, curr%left_i, lit_l) lit%flag_class = lit_l%flag_class do i = 1, curr%min_repeat call best_factor(nodes, curr%left_i, lit_l) lit%all%c = lit%all%c//lit_l%all%c lit%pref%c = lit%pref%c//lit_l%pref%c lit%suff%c = lit%suff%c//lit_l%suff%c lit%fact%c = lit%fact%c//lit_l%fact%c lit%flag_class = lit%flag_class .or. lit_l%flag_class if (lit_l%flag_closure) exit end do if (curr%min_repeat /= curr%max_repeat) lit%all%c = '' lit%flag_closure = curr%min_repeat /= curr%max_repeat lit%flag_closure = lit%flag_closure .or. lit_l%flag_closure end block case default lit%flag_closure = .true. end select end subroutine best_factor