| 1 | ! ===================================== |
| 2 | ! Command Tree Module - Abstract Syntax Tree for Shell Commands |
| 3 | ! ===================================== |
| 4 | ! Defines command tree structures for grammar-aware parser |
| 5 | ! Part of the parser rewrite project |
| 6 | ! |
| 7 | ! Status: PHASE 2 - Full AST implementation |
| 8 | ! Author: Parser Rewrite Team |
| 9 | ! Created: 2025-11-05 |
| 10 | |
| 11 | module command_tree |
| 12 | use iso_fortran_env |
| 13 | use shell_types |
| 14 | implicit none |
| 15 | private |
| 16 | |
| 17 | ! Public types |
| 18 | public :: command_node_t |
| 19 | public :: command_node_ptr_t |
| 20 | public :: simple_command_data_t |
| 21 | public :: pipeline_data_t |
| 22 | public :: list_data_t |
| 23 | public :: if_data_t |
| 24 | public :: while_data_t |
| 25 | public :: for_data_t |
| 26 | public :: for_arith_data_t |
| 27 | public :: case_data_t |
| 28 | public :: case_item_t |
| 29 | public :: function_def_data_t |
| 30 | public :: coproc_data_t |
| 31 | public :: heredoc_info_t |
| 32 | |
| 33 | ! Public functions |
| 34 | public :: create_simple_command |
| 35 | public :: create_pipeline |
| 36 | public :: create_list |
| 37 | public :: create_if_statement |
| 38 | public :: create_while_loop |
| 39 | public :: create_for_loop |
| 40 | public :: create_for_arith_loop |
| 41 | public :: create_case_statement |
| 42 | public :: create_subshell |
| 43 | public :: create_brace_group |
| 44 | public :: create_function_def |
| 45 | public :: create_coproc |
| 46 | public :: destroy_command_node |
| 47 | public :: print_command_tree |
| 48 | |
| 49 | ! Public constants |
| 50 | public :: LIST_SEP_SEQUENTIAL, LIST_SEP_AND, LIST_SEP_OR, LIST_SEP_BACKGROUND |
| 51 | |
| 52 | ! Node type constants (these are already in shell_types, but we alias them here) |
| 53 | integer, parameter :: NODE_SIMPLE = CMD_SIMPLE |
| 54 | integer, parameter :: NODE_PIPELINE = CMD_PIPELINE |
| 55 | integer, parameter :: NODE_LIST = CMD_LIST |
| 56 | integer, parameter :: NODE_IF = CMD_IF_STATEMENT |
| 57 | integer, parameter :: NODE_WHILE = CMD_WHILE_LOOP |
| 58 | integer, parameter :: NODE_UNTIL = CMD_UNTIL_LOOP |
| 59 | integer, parameter :: NODE_FOR = CMD_FOR_LOOP |
| 60 | integer, parameter :: NODE_CASE = CMD_CASE_STATEMENT |
| 61 | integer, parameter :: NODE_SUBSHELL = CMD_SUBSHELL |
| 62 | integer, parameter :: NODE_BRACE_GROUP = CMD_BRACE_GROUP |
| 63 | integer, parameter :: NODE_FUNCTION_DEF = CMD_FUNCTION_DEF |
| 64 | integer, parameter :: NODE_FOR_ARITH = CMD_FOR_ARITH |
| 65 | integer, parameter :: NODE_COPROC = CMD_COPROC |
| 66 | |
| 67 | ! List separator types |
| 68 | integer, parameter :: LIST_SEP_SEQUENTIAL = 1 ! ; |
| 69 | integer, parameter :: LIST_SEP_AND = 2 ! && |
| 70 | integer, parameter :: LIST_SEP_OR = 3 ! || |
| 71 | integer, parameter :: LIST_SEP_BACKGROUND = 4 ! & |
| 72 | |
| 73 | ! Pointer wrapper for arrays of command nodes |
| 74 | type :: command_node_ptr_t |
| 75 | type(command_node_t), pointer :: ptr => null() |
| 76 | end type command_node_ptr_t |
| 77 | |
| 78 | ! ===================================== |
| 79 | ! Heredoc Info - for collecting multiple heredocs during parsing |
| 80 | ! ===================================== |
| 81 | type :: heredoc_info_t |
| 82 | character(len=MAX_TOKEN_LEN) :: delimiter = '' ! Delimiter word (EOF, END, etc.) |
| 83 | logical :: quoted = .false. ! Was delimiter quoted? (suppress expansion) |
| 84 | logical :: strip_tabs = .false. ! True for <<- (strip leading tabs) |
| 85 | type(command_node_t), pointer :: target_cmd => null() ! Command this heredoc belongs to |
| 86 | character(len=:), allocatable :: content ! Heredoc content (filled after parsing) |
| 87 | end type heredoc_info_t |
| 88 | |
| 89 | ! ===================================== |
| 90 | ! Simple Command Data |
| 91 | ! ===================================== |
| 92 | type :: simple_command_data_t |
| 93 | character(len=:), allocatable :: words(:) ! Command words (deferred-length) |
| 94 | integer, allocatable :: word_lengths(:) ! Actual length of each word (for trailing space preservation) |
| 95 | logical, allocatable :: word_was_quoted(:) ! Track quoted tokens for old executor |
| 96 | logical, allocatable :: word_was_escaped(:) ! Track escaped tokens (prevent glob expansion) |
| 97 | integer, allocatable :: word_quote_type(:) ! Track quote type (QUOTE_* constant) |
| 98 | integer :: num_words = 0 |
| 99 | type(redirection_t), allocatable :: redirects(:) ! Redirections |
| 100 | integer :: num_redirects = 0 |
| 101 | character(len=MAX_TOKEN_LEN), allocatable :: assignments(:) ! VAR=value |
| 102 | integer, allocatable :: assignment_lengths(:) ! Actual length of each assignment |
| 103 | integer :: num_assignments = 0 |
| 104 | ! Heredoc support (delimiter only, content handled at execution) |
| 105 | character(len=MAX_TOKEN_LEN) :: heredoc_delimiter = '' ! Delimiter word (EOF) |
| 106 | logical :: heredoc_quoted = .false. ! Was delimiter quoted? (suppress expansion) |
| 107 | logical :: heredoc_strip_tabs = .false. ! True for <<- (strip leading tabs) |
| 108 | ! Pre-expansion flag for pipeline stages |
| 109 | logical :: pre_expanded = .false. ! True if words already expanded |
| 110 | end type simple_command_data_t |
| 111 | |
| 112 | ! ===================================== |
| 113 | ! Pipeline Data |
| 114 | ! ===================================== |
| 115 | type :: pipeline_data_t |
| 116 | type(command_node_t), pointer :: commands(:) => null() ! Pipeline commands |
| 117 | integer :: num_commands = 0 |
| 118 | logical :: negate = .false. ! ! pipeline |
| 119 | logical :: background = .false. ! pipeline & |
| 120 | end type pipeline_data_t |
| 121 | |
| 122 | ! ===================================== |
| 123 | ! List Data (command sequences) |
| 124 | ! ===================================== |
| 125 | type :: list_data_t |
| 126 | type(command_node_t), pointer :: left => null() ! Left command |
| 127 | type(command_node_t), pointer :: right => null() ! Right command |
| 128 | integer :: separator = LIST_SEP_SEQUENTIAL ! && || ; & |
| 129 | end type list_data_t |
| 130 | |
| 131 | ! ===================================== |
| 132 | ! If Statement Data |
| 133 | ! ===================================== |
| 134 | type :: if_data_t |
| 135 | type(command_node_t), pointer :: condition => null() ! if condition |
| 136 | type(command_node_t), pointer :: then_part => null() ! then commands |
| 137 | type(command_node_t), pointer :: elif_parts(:) => null() ! elif branches (pairs of condition+then) |
| 138 | integer :: num_elifs = 0 |
| 139 | type(command_node_t), pointer :: else_part => null() ! else commands |
| 140 | end type if_data_t |
| 141 | |
| 142 | ! ===================================== |
| 143 | ! While/Until Loop Data |
| 144 | ! ===================================== |
| 145 | type :: while_data_t |
| 146 | type(command_node_t), pointer :: condition => null() ! Loop condition |
| 147 | type(command_node_t), pointer :: body => null() ! Loop body |
| 148 | logical :: is_until = .false. ! True for until loops |
| 149 | end type while_data_t |
| 150 | |
| 151 | ! ===================================== |
| 152 | ! For Loop Data |
| 153 | ! ===================================== |
| 154 | type :: for_data_t |
| 155 | character(len=MAX_TOKEN_LEN) :: variable ! Loop variable |
| 156 | character(len=MAX_TOKEN_LEN), allocatable :: words(:) ! for x in word1 word2 ... |
| 157 | logical, allocatable :: words_was_quoted(:) ! Track if each word was quoted |
| 158 | integer :: num_words = 0 |
| 159 | type(command_node_t), pointer :: body => null() ! Loop body |
| 160 | end type for_data_t |
| 161 | |
| 162 | ! ===================================== |
| 163 | ! Arithmetic For Loop Data (C-style) |
| 164 | ! ===================================== |
| 165 | type :: for_arith_data_t |
| 166 | character(len=MAX_TOKEN_LEN) :: init_expr ! e.g., "i=0" |
| 167 | character(len=MAX_TOKEN_LEN) :: cond_expr ! e.g., "i<3" |
| 168 | character(len=MAX_TOKEN_LEN) :: incr_expr ! e.g., "i++" |
| 169 | type(command_node_t), pointer :: body => null() ! Loop body |
| 170 | end type for_arith_data_t |
| 171 | |
| 172 | ! ===================================== |
| 173 | ! Coproc Data |
| 174 | ! ===================================== |
| 175 | type :: coproc_data_t |
| 176 | character(len=256) :: name = 'COPROC' ! Coproc name |
| 177 | type(command_node_t), pointer :: command => null() ! Command to run |
| 178 | end type coproc_data_t |
| 179 | |
| 180 | ! ===================================== |
| 181 | ! Case Statement Item |
| 182 | ! ===================================== |
| 183 | type :: case_item_t |
| 184 | character(len=MAX_TOKEN_LEN), allocatable :: patterns(:) ! Case patterns |
| 185 | integer :: num_patterns = 0 |
| 186 | type(command_node_t), pointer :: commands => null() ! Commands for this case |
| 187 | end type case_item_t |
| 188 | |
| 189 | ! ===================================== |
| 190 | ! Case Statement Data |
| 191 | ! ===================================== |
| 192 | type :: case_data_t |
| 193 | character(len=MAX_TOKEN_LEN) :: word ! case $word in |
| 194 | integer :: word_len = 0 ! Actual word length (preserves whitespace) |
| 195 | type(case_item_t), allocatable :: items(:) ! Case items |
| 196 | integer :: num_items = 0 |
| 197 | end type case_data_t |
| 198 | |
| 199 | ! ===================================== |
| 200 | ! Function Definition Data |
| 201 | ! ===================================== |
| 202 | type :: function_def_data_t |
| 203 | character(len=MAX_TOKEN_LEN) :: name ! Function name |
| 204 | type(command_node_t), pointer :: body => null() ! Function body |
| 205 | end type function_def_data_t |
| 206 | |
| 207 | ! ===================================== |
| 208 | ! Main Command Node (Union-like structure) |
| 209 | ! ===================================== |
| 210 | type :: command_node_t |
| 211 | integer :: node_type = 0 ! NODE_* constant |
| 212 | integer :: line = 0 ! Line number for errors |
| 213 | integer :: column = 0 ! Column for errors |
| 214 | |
| 215 | ! Type-specific data (only one will be used based on node_type) |
| 216 | type(simple_command_data_t), pointer :: simple_cmd => null() |
| 217 | type(pipeline_data_t), pointer :: pipeline => null() |
| 218 | type(list_data_t), pointer :: list => null() |
| 219 | type(if_data_t), pointer :: if_stmt => null() |
| 220 | type(while_data_t), pointer :: while_loop => null() |
| 221 | type(for_data_t), pointer :: for_loop => null() |
| 222 | type(case_data_t), pointer :: case_stmt => null() |
| 223 | type(function_def_data_t), pointer :: function_def => null() |
| 224 | type(for_arith_data_t), pointer :: for_arith => null() |
| 225 | type(coproc_data_t), pointer :: coproc => null() |
| 226 | type(command_node_t), pointer :: subshell => null() ! For subshells/groups |
| 227 | |
| 228 | ! Redirections (can apply to any command type, not just simple commands) |
| 229 | type(redirection_t), allocatable :: redirects(:) |
| 230 | integer :: num_redirects = 0 |
| 231 | end type command_node_t |
| 232 | |
| 233 | contains |
| 234 | |
| 235 | ! ===================================== |
| 236 | ! Constructor Functions |
| 237 | ! ===================================== |
| 238 | |
| 239 | function create_simple_command(words, num_words) result(node) |
| 240 | character(len=*), intent(in) :: words(:) |
| 241 | integer, intent(in) :: num_words |
| 242 | type(command_node_t), pointer :: node |
| 243 | integer :: i |
| 244 | |
| 245 | allocate(node) |
| 246 | node%node_type = NODE_SIMPLE |
| 247 | allocate(node%simple_cmd) |
| 248 | allocate(character(len=MAX_TOKEN_LEN) :: node%simple_cmd%words(num_words)) |
| 249 | node%simple_cmd%num_words = num_words |
| 250 | do i = 1, num_words |
| 251 | node%simple_cmd%words(i) = words(i) |
| 252 | end do |
| 253 | end function create_simple_command |
| 254 | |
| 255 | function create_pipeline(commands, num_commands, negate) result(node) |
| 256 | type(command_node_t), pointer, intent(in) :: commands(:) |
| 257 | integer, intent(in) :: num_commands |
| 258 | logical, intent(in) :: negate |
| 259 | type(command_node_t), pointer :: node |
| 260 | |
| 261 | allocate(node) |
| 262 | node%node_type = NODE_PIPELINE |
| 263 | allocate(node%pipeline) |
| 264 | ! Take ownership of the commands array |
| 265 | node%pipeline%commands => commands |
| 266 | node%pipeline%num_commands = num_commands |
| 267 | node%pipeline%negate = negate |
| 268 | end function create_pipeline |
| 269 | |
| 270 | function create_list(left, right, separator) result(node) |
| 271 | type(command_node_t), pointer, intent(in) :: left, right |
| 272 | integer, intent(in) :: separator |
| 273 | type(command_node_t), pointer :: node |
| 274 | |
| 275 | allocate(node) |
| 276 | node%node_type = NODE_LIST |
| 277 | allocate(node%list) |
| 278 | node%list%left => left |
| 279 | node%list%right => right |
| 280 | node%list%separator = separator |
| 281 | end function create_list |
| 282 | |
| 283 | function create_if_statement(condition, then_part, else_part) result(node) |
| 284 | type(command_node_t), pointer, intent(in) :: condition, then_part |
| 285 | type(command_node_t), pointer, intent(in), optional :: else_part |
| 286 | type(command_node_t), pointer :: node |
| 287 | |
| 288 | allocate(node) |
| 289 | node%node_type = NODE_IF |
| 290 | allocate(node%if_stmt) |
| 291 | node%if_stmt%condition => condition |
| 292 | node%if_stmt%then_part => then_part |
| 293 | if (present(else_part)) then |
| 294 | node%if_stmt%else_part => else_part |
| 295 | end if |
| 296 | end function create_if_statement |
| 297 | |
| 298 | function create_while_loop(condition, body, is_until) result(node) |
| 299 | type(command_node_t), pointer, intent(in) :: condition, body |
| 300 | logical, intent(in) :: is_until |
| 301 | type(command_node_t), pointer :: node |
| 302 | |
| 303 | allocate(node) |
| 304 | if (is_until) then |
| 305 | node%node_type = NODE_UNTIL |
| 306 | else |
| 307 | node%node_type = NODE_WHILE |
| 308 | end if |
| 309 | allocate(node%while_loop) |
| 310 | node%while_loop%condition => condition |
| 311 | node%while_loop%body => body |
| 312 | node%while_loop%is_until = is_until |
| 313 | end function create_while_loop |
| 314 | |
| 315 | function create_for_loop(variable, words, num_words, body, quote_types) result(node) |
| 316 | character(len=*), intent(in) :: variable |
| 317 | character(len=*), intent(in) :: words(:) |
| 318 | integer, intent(in) :: num_words |
| 319 | type(command_node_t), pointer, intent(in) :: body |
| 320 | integer, intent(in), optional :: quote_types(:) |
| 321 | type(command_node_t), pointer :: node |
| 322 | integer :: i |
| 323 | |
| 324 | allocate(node) |
| 325 | node%node_type = NODE_FOR |
| 326 | allocate(node%for_loop) |
| 327 | node%for_loop%variable = variable |
| 328 | allocate(node%for_loop%words(num_words)) |
| 329 | allocate(node%for_loop%words_was_quoted(num_words)) |
| 330 | node%for_loop%num_words = num_words |
| 331 | do i = 1, num_words |
| 332 | node%for_loop%words(i) = words(i) |
| 333 | if (present(quote_types)) then |
| 334 | node%for_loop%words_was_quoted(i) = (quote_types(i) /= QUOTE_NONE) |
| 335 | else |
| 336 | node%for_loop%words_was_quoted(i) = .false. |
| 337 | end if |
| 338 | end do |
| 339 | node%for_loop%body => body |
| 340 | end function create_for_loop |
| 341 | |
| 342 | function create_for_arith_loop(init_expr, cond_expr, incr_expr, body) result(node) |
| 343 | character(len=*), intent(in) :: init_expr, cond_expr, incr_expr |
| 344 | type(command_node_t), pointer, intent(in) :: body |
| 345 | type(command_node_t), pointer :: node |
| 346 | |
| 347 | allocate(node) |
| 348 | node%node_type = NODE_FOR_ARITH |
| 349 | allocate(node%for_arith) |
| 350 | node%for_arith%init_expr = init_expr |
| 351 | node%for_arith%cond_expr = cond_expr |
| 352 | node%for_arith%incr_expr = incr_expr |
| 353 | node%for_arith%body => body |
| 354 | end function create_for_arith_loop |
| 355 | |
| 356 | function create_coproc(name, command) result(node) |
| 357 | character(len=*), intent(in) :: name |
| 358 | type(command_node_t), pointer, intent(in) :: command |
| 359 | type(command_node_t), pointer :: node |
| 360 | |
| 361 | allocate(node) |
| 362 | node%node_type = NODE_COPROC |
| 363 | allocate(node%coproc) |
| 364 | node%coproc%name = name |
| 365 | node%coproc%command => command |
| 366 | end function create_coproc |
| 367 | |
| 368 | function create_case_statement(word, word_len, items, num_items) result(node) |
| 369 | character(len=*), intent(in) :: word |
| 370 | integer, intent(in) :: word_len |
| 371 | type(case_item_t), intent(in) :: items(:) |
| 372 | integer, intent(in) :: num_items |
| 373 | type(command_node_t), pointer :: node |
| 374 | |
| 375 | allocate(node) |
| 376 | node%node_type = NODE_CASE |
| 377 | allocate(node%case_stmt) |
| 378 | node%case_stmt%word = word |
| 379 | node%case_stmt%word_len = word_len |
| 380 | allocate(node%case_stmt%items(num_items)) |
| 381 | node%case_stmt%items = items |
| 382 | node%case_stmt%num_items = num_items |
| 383 | end function create_case_statement |
| 384 | |
| 385 | function create_subshell(commands) result(node) |
| 386 | type(command_node_t), pointer, intent(in) :: commands |
| 387 | type(command_node_t), pointer :: node |
| 388 | |
| 389 | allocate(node) |
| 390 | node%node_type = NODE_SUBSHELL |
| 391 | node%subshell => commands |
| 392 | end function create_subshell |
| 393 | |
| 394 | function create_brace_group(commands) result(node) |
| 395 | type(command_node_t), pointer, intent(in) :: commands |
| 396 | type(command_node_t), pointer :: node |
| 397 | |
| 398 | allocate(node) |
| 399 | node%node_type = NODE_BRACE_GROUP |
| 400 | node%subshell => commands ! Reuse subshell pointer for brace groups |
| 401 | end function create_brace_group |
| 402 | |
| 403 | function create_function_def(name, body) result(node) |
| 404 | character(len=*), intent(in) :: name |
| 405 | type(command_node_t), pointer, intent(in) :: body |
| 406 | type(command_node_t), pointer :: node |
| 407 | |
| 408 | allocate(node) |
| 409 | node%node_type = NODE_FUNCTION_DEF |
| 410 | allocate(node%function_def) |
| 411 | node%function_def%name = name |
| 412 | node%function_def%body => body |
| 413 | end function create_function_def |
| 414 | |
| 415 | ! ===================================== |
| 416 | ! Destructor Function |
| 417 | ! ===================================== |
| 418 | |
| 419 | recursive subroutine destroy_command_node(node) |
| 420 | type(command_node_t), pointer, intent(inout) :: node |
| 421 | |
| 422 | if (.not. associated(node)) return |
| 423 | |
| 424 | select case(node%node_type) |
| 425 | case(NODE_SIMPLE) |
| 426 | if (associated(node%simple_cmd)) then |
| 427 | if (allocated(node%simple_cmd%words)) deallocate(node%simple_cmd%words) |
| 428 | if (allocated(node%simple_cmd%word_lengths)) deallocate(node%simple_cmd%word_lengths) |
| 429 | if (allocated(node%simple_cmd%redirects)) deallocate(node%simple_cmd%redirects) |
| 430 | if (allocated(node%simple_cmd%assignments)) deallocate(node%simple_cmd%assignments) |
| 431 | deallocate(node%simple_cmd) |
| 432 | end if |
| 433 | |
| 434 | case(NODE_PIPELINE) |
| 435 | if (associated(node%pipeline)) then |
| 436 | if (associated(node%pipeline%commands)) then |
| 437 | ! Just deallocate the array, not the individual nodes |
| 438 | ! (nodes are allocated separately and may be shared/reused) |
| 439 | deallocate(node%pipeline%commands) |
| 440 | end if |
| 441 | deallocate(node%pipeline) |
| 442 | end if |
| 443 | |
| 444 | case(NODE_LIST) |
| 445 | if (associated(node%list)) then |
| 446 | call destroy_command_node(node%list%left) |
| 447 | call destroy_command_node(node%list%right) |
| 448 | deallocate(node%list) |
| 449 | end if |
| 450 | |
| 451 | case(NODE_IF) |
| 452 | if (associated(node%if_stmt)) then |
| 453 | call destroy_command_node(node%if_stmt%condition) |
| 454 | call destroy_command_node(node%if_stmt%then_part) |
| 455 | if (associated(node%if_stmt%else_part)) call destroy_command_node(node%if_stmt%else_part) |
| 456 | deallocate(node%if_stmt) |
| 457 | end if |
| 458 | |
| 459 | case(NODE_WHILE, NODE_UNTIL) |
| 460 | if (associated(node%while_loop)) then |
| 461 | call destroy_command_node(node%while_loop%condition) |
| 462 | call destroy_command_node(node%while_loop%body) |
| 463 | deallocate(node%while_loop) |
| 464 | end if |
| 465 | |
| 466 | case(NODE_FOR) |
| 467 | if (associated(node%for_loop)) then |
| 468 | if (allocated(node%for_loop%words)) deallocate(node%for_loop%words) |
| 469 | call destroy_command_node(node%for_loop%body) |
| 470 | deallocate(node%for_loop) |
| 471 | end if |
| 472 | |
| 473 | case(NODE_CASE) |
| 474 | if (associated(node%case_stmt)) then |
| 475 | if (allocated(node%case_stmt%items)) deallocate(node%case_stmt%items) |
| 476 | deallocate(node%case_stmt) |
| 477 | end if |
| 478 | |
| 479 | case(NODE_SUBSHELL, NODE_BRACE_GROUP) |
| 480 | call destroy_command_node(node%subshell) |
| 481 | |
| 482 | case(NODE_FUNCTION_DEF) |
| 483 | if (associated(node%function_def)) then |
| 484 | call destroy_command_node(node%function_def%body) |
| 485 | deallocate(node%function_def) |
| 486 | end if |
| 487 | |
| 488 | case(NODE_FOR_ARITH) |
| 489 | if (associated(node%for_arith)) then |
| 490 | call destroy_command_node(node%for_arith%body) |
| 491 | deallocate(node%for_arith) |
| 492 | end if |
| 493 | |
| 494 | case(NODE_COPROC) |
| 495 | if (associated(node%coproc)) then |
| 496 | call destroy_command_node(node%coproc%command) |
| 497 | deallocate(node%coproc) |
| 498 | end if |
| 499 | end select |
| 500 | |
| 501 | ! Clean up node-level redirections |
| 502 | if (allocated(node%redirects)) deallocate(node%redirects) |
| 503 | |
| 504 | deallocate(node) |
| 505 | nullify(node) |
| 506 | end subroutine destroy_command_node |
| 507 | |
| 508 | ! ===================================== |
| 509 | ! Debug Print Function |
| 510 | ! ===================================== |
| 511 | |
| 512 | recursive subroutine print_command_tree(node, indent) |
| 513 | type(command_node_t), pointer, intent(in) :: node |
| 514 | integer, intent(in), optional :: indent |
| 515 | integer :: ind, i |
| 516 | character(len=100) :: indent_str |
| 517 | |
| 518 | if (.not. associated(node)) return |
| 519 | |
| 520 | ind = 0 |
| 521 | if (present(indent)) ind = indent |
| 522 | indent_str = repeat(' ', ind) |
| 523 | |
| 524 | select case(node%node_type) |
| 525 | case(NODE_SIMPLE) |
| 526 | write(*, '(A,A)') trim(indent_str), 'SIMPLE_COMMAND:' |
| 527 | if (associated(node%simple_cmd)) then |
| 528 | do i = 1, node%simple_cmd%num_words |
| 529 | write(*, '(A,A,A)') trim(indent_str), ' ', trim(node%simple_cmd%words(i)) |
| 530 | end do |
| 531 | end if |
| 532 | |
| 533 | case(NODE_PIPELINE) |
| 534 | write(*, '(A,A)') trim(indent_str), 'PIPELINE:' |
| 535 | if (associated(node%pipeline)) then |
| 536 | if (associated(node%pipeline%commands)) then |
| 537 | do i = 1, node%pipeline%num_commands |
| 538 | call print_command_tree(node%pipeline%commands(i), ind + 1) |
| 539 | end do |
| 540 | end if |
| 541 | end if |
| 542 | |
| 543 | case(NODE_LIST) |
| 544 | write(*, '(A,A)') trim(indent_str), 'LIST:' |
| 545 | if (associated(node%list)) then |
| 546 | call print_command_tree(node%list%left, ind + 1) |
| 547 | call print_command_tree(node%list%right, ind + 1) |
| 548 | end if |
| 549 | |
| 550 | case(NODE_IF) |
| 551 | write(*, '(A,A)') trim(indent_str), 'IF:' |
| 552 | if (associated(node%if_stmt)) then |
| 553 | write(*, '(A,A)') trim(indent_str), ' condition:' |
| 554 | call print_command_tree(node%if_stmt%condition, ind + 2) |
| 555 | write(*, '(A,A)') trim(indent_str), ' then:' |
| 556 | call print_command_tree(node%if_stmt%then_part, ind + 2) |
| 557 | if (associated(node%if_stmt%else_part)) then |
| 558 | write(*, '(A,A)') trim(indent_str), ' else:' |
| 559 | call print_command_tree(node%if_stmt%else_part, ind + 2) |
| 560 | end if |
| 561 | end if |
| 562 | |
| 563 | case(NODE_WHILE) |
| 564 | write(*, '(A,A)') trim(indent_str), 'WHILE:' |
| 565 | if (associated(node%while_loop)) then |
| 566 | call print_command_tree(node%while_loop%condition, ind + 1) |
| 567 | call print_command_tree(node%while_loop%body, ind + 1) |
| 568 | end if |
| 569 | |
| 570 | case(NODE_FOR) |
| 571 | write(*, '(A,A,A)') trim(indent_str), 'FOR: ', trim(node%for_loop%variable) |
| 572 | if (associated(node%for_loop)) then |
| 573 | call print_command_tree(node%for_loop%body, ind + 1) |
| 574 | end if |
| 575 | |
| 576 | case default |
| 577 | write(*, '(A,A,I0)') trim(indent_str), 'UNKNOWN_NODE_TYPE: ', node%node_type |
| 578 | end select |
| 579 | end subroutine print_command_tree |
| 580 | |
| 581 | end module command_tree |
| 582 |