
# --- split_structure: Tokenize a structure string ---
# Recognizes #N tags and {}-groups (with nesting) as tokens.
# Everything else is a separator.
# Returns list(tokens, seps) with length(seps) == length(tokens) + 1
split_structure <- function(s) {
  chars <- strsplit(s, "")[[1]]
  n <- length(chars)
  tokens <- character(0)
  seps <- character(0)
  buf <- ""
  i <- 1L

  while (i <= n) {
    ch <- chars[i]

    if (ch == "#") {
      seps <- c(seps, buf)
      buf <- ""
      rt <- read_tag(chars, i)
      tokens <- c(tokens, rt$tag)
      i <- rt$next_i

    } else if (ch == "{") {
      seps <- c(seps, buf)
      buf <- ""
      depth <- 1L
      group <- "{"
      i <- i + 1L
      while (i <= n && depth > 0) {
        if (chars[i] == "{") depth <- depth + 1L
        if (chars[i] == "}") depth <- depth - 1L
        group <- paste0(group, chars[i])
        i <- i + 1L
      }
      tokens <- c(tokens, group)

    } else {
      buf <- paste0(buf, ch)
      i <- i + 1L
    }
  }

  seps <- c(seps, buf)
  list(tokens = tokens, seps = seps)
}


# --- merge_at: merge two adjacent positions j, j+1 into one ---
# Used by combine_group() for composition rules.
merge_at <- function(tokens, types, seps, j, new_tok, new_type) {
  tokens <- c(tokens[seq_len(j - 1)],
              new_tok,
              if (j + 1 < length(tokens)) tokens[(j + 2):length(tokens)] else character(0))

  types <- c(types[seq_len(j - 1)],
             new_type,
             if (j + 1 < length(types)) types[(j + 2):length(types)] else character(0))

  rm_sep <- j + 1
  seps <- c(seps[seq_len(rm_sep - 1)],
            if (rm_sep + 1 <= length(seps)) seps[(rm_sep + 1):length(seps)] else character(0))

  list(tokens = tokens, types = types, seps = seps)
}


# --- combine_op: merge operator at j with its arguments ---
# Merges tokens from (j - n_left) to (j + n_right) into one {}-group.
# Arguments are wrapped in {}, operator stays bare.
combine_op <- function(tokens, types, seps, j, n_left, n_right, new_type) {
  start <- j - n_left
  end   <- j + n_right

  # Build parts: wrap arguments, keep operator bare
  parts <- character(end - start + 1)
  for (k in start:end) {
    tok <- tokens[k]
    if (k != j && !startsWith(tok, "{")) tok <- paste0("{", tok, "}")
    parts[k - start + 1] <- tok
  }

  # Assemble with internal separators
  new_tok <- parts[1]
  for (k in 2:length(parts)) {
    new_tok <- paste0(new_tok, seps[start + k - 1], parts[k])
  }
  new_tok <- paste0("{", new_tok, "}")

  # Build result arrays
  new_tokens <- c(if (start > 1) tokens[1:(start - 1)] else character(0),
                  new_tok,
                  if (end < length(tokens)) tokens[(end + 1):length(tokens)] else character(0))
  new_types <- c(if (start > 1) types[1:(start - 1)] else character(0),
                 new_type,
                 if (end < length(types)) types[(end + 1):length(types)] else character(0))
  new_seps <- c(seps[seq_len(start)],
                if (end + 1 <= length(seps)) seps[(end + 1):length(seps)] else character(0))

  list(tokens = new_tokens, types = new_types, seps = new_seps)
}


# --- combine_group: merge tokens[i] and tokens[i+1] for composition ---
# Wraps bare tags in {} so grammatical_structure can type them individually.
combine_group <- function(tokens, types, seps, i, new_type) {
  tok1 <- tokens[i]
  tok2 <- tokens[i + 1]
  if (!startsWith(tok1, "{")) tok1 <- paste0("{", tok1, "}")
  if (!startsWith(tok2, "{")) tok2 <- paste0("{", tok2, "}")
  new_tok <- paste0("{", tok1, seps[i + 1], tok2, "}")

  merge_at(tokens, types, seps, i, new_tok, new_type)
}


add_brackets <- function(s, type) {

  sp <- split_structure(s)
  tokens <- sp$tokens
  seps   <- sp$seps

  if (length(tokens) == 0)
    return(list(string = s, type = NA_character_))

  # Helper: build result from single remaining token
  make_result <- function()
    list(string = paste0(seps[1], tokens[1], seps[2]), type = types[1])

  # Step 0: Determine types, recursively process {} groups,
  #         and build parsed-type lookup for bare tags
  types <- character(length(tokens))
  parsed_list <- list()
  for (k in seq_along(tokens)) {
    if (startsWith(tokens[k], "{")) {
      inner <- substring(tokens[k], 2, nchar(tokens[k]) - 1)
      res <- add_brackets(inner, type)
      if (identical(res$type, "ERROR")) return(res)
      tokens[k] <- paste0("{", res$string, "}")
      types[k] <- res$type
    } else {
      tag_num <- as.integer(sub("#", "", tokens[k]))
      parsed <- parse_type(type[tag_num])
      types[k] <- get_result_type(parsed)
      parsed_list[[tokens[k]]] <- parsed
    }
  }

  if (length(tokens) == 1) return(make_result())

  get_parsed <- function(tok) parsed_list[[tok]]

  # Helper: TRUE if the token is a bare (unbound) operator tag.
  # Bare operator tags must never be used as arguments.
  is_bare_op <- function(tok) {
    p <- get_parsed(tok)
    !is.null(p) && p$is_operator
  }

  # --- Rule factories ---

  # Operator rule: binds an operator to its argument(s).
  # need_left/need_right = number of arguments on that side (0, 1, or 2).
  op_rule <- function(need_left, need_right) {
    function(j) {
      p <- get_parsed(tokens[j])
      if (is.null(p) || !p$is_operator) return(NULL)
      if (nchar(p$left_arg) != need_left) return(NULL)
      if (nchar(p$right_arg) != need_right) return(NULL)
      # Check left neighbors (first char of left_arg = furthest argument)
      for (k in seq_len(need_left)) {
        if (j - k < 1) return(NULL)
        if (is_bare_op(tokens[j - k])) return(NULL)
        if (!type_matches(types[j - k], str_sub(p$left_arg, need_left - k + 1, need_left - k + 1))) return(NULL)
      }
      # Check right neighbors (first char of right_arg = nearest argument)
      for (k in seq_len(need_right)) {
        if (j + k > length(tokens)) return(NULL)
        if (is_bare_op(tokens[j + k])) return(NULL)
        if (!type_matches(types[j + k], str_sub(p$right_arg, k, k))) return(NULL)
      }
      # Type inheritance: if result is a base type, inherit extension
      # from the first argument that has the same base type.
      result_type <- p$result
      if (!grepl("[a-z]", result_type)) {
        arg_positions <- c(
          if (need_left > 0) (j - need_left):(j - 1) else integer(0),
          if (need_right > 0) (j + 1):(j + need_right) else integer(0)
        )
        for (pos in arg_positions) {
          if (has_base_type(types[pos], result_type) && types[pos] != result_type) {
            result_type <- types[pos]
            break
          }
        }
      }
      combine_op(tokens, types, seps, j, need_left, need_right, result_type)
    }
  }


  # Pipe rule: like op_rule, but only matches if the first argument's
  # base type equals the result's base type (the type "flows through").
  # Rejects operators that change the base type (e.g. Sx->V with arg S).
  pipe_rule <- function(need_left, need_right) {
    inner <- op_rule(need_left, need_right)
    function(j) {
      p <- get_parsed(tokens[j])
      if (is.null(p) || !p$is_operator) return(NULL)
      # Determine first argument position
      first_pos <- if (need_left > 0) j - need_left else j + 1L
      if (first_pos < 1 || first_pos > length(tokens)) return(NULL)
      if (!has_base_type(types[first_pos], base_type(p$result))) return(NULL)
      inner(j)
    }
  }

  # Explicit rule: binds one specific operator (e.g. "xS->A").
  # The op_type string is parsed once; only operators whose left_arg,
  # right_arg, and result match exactly are considered.
  explicit_rule <- function(op_type) {
    ref   <- parse_type(op_type)
    inner <- op_rule(nchar(ref$left_arg), nchar(ref$right_arg))
    function(j) {
      p <- get_parsed(tokens[j])
      if (is.null(p) || !p$is_operator) return(NULL)
      if (p$left_arg != ref$left_arg || p$right_arg != ref$right_arg ||
          p$result != ref$result) return(NULL)
      inner(j)
    }
  }

  # Composition rule: groups two adjacent tokens by type.
  # Bare operator tags are rejected -- they must bind via operator rules.
  comp_rule <- function(t1, t2, result, sep_cond = NULL) {
    function(j) {
      if (j >= length(tokens)) return(NULL)
      if (is_bare_op(tokens[j]) || is_bare_op(tokens[j + 1])) return(NULL)
      if (!type_matches(types[j], t1) || !type_matches(types[j + 1], t2)) return(NULL)
      if (!is.null(sep_cond) && !sep_cond(seps[j + 1])) return(NULL)
      combine_group(tokens, types, seps, j, result)
    }
  }

  # --- Rules (applied in priority order) ---
  rules <- list(
    pipe_rule(need_left = 1, need_right = 0),                                   # Sx->S
    pipe_rule(need_left = 0, need_right = 1),                                   # xS->S
    pipe_rule(need_left = 1, need_right = 1),                                   # SxV->S
    pipe_rule(need_left = 2, need_right = 0),                                   # SSx->S
    pipe_rule(need_left = 0, need_right = 2),                                   # xSS->S
	explicit_rule("xS->A"),
    op_rule(need_left = 1, need_right = 0),                                   # Sx->R
    op_rule(need_left = 0, need_right = 1),                                   # xS->R
    op_rule(need_left = 1, need_right = 1),                                   # SxV->R
    op_rule(need_left = 2, need_right = 0),                                   # SSx->R
    op_rule(need_left = 0, need_right = 2),                                   # xSS->R
    comp_rule("S", "A", "S"),                                                 # S + A -> S
    comp_rule("S", "S", "S", function(s) str_detect(s, fixed(","))),          # S, S -> S
    comp_rule("S", "Vt", "Vi"),                                                # S + Vt -> Vi
    comp_rule("S", "S", "S", function(s) !str_detect(s, "[.,;:!?0-9N\u00a4]")),  # S + S -> S
    comp_rule("S", "Vi", "SEN"),                                               # S + Vi -> SEN
    comp_rule("S", "V", "SEN"),                                                # S + V -> SEN
    comp_rule("SEN", "SEN", "SEN")                                            # SEN + SEN -> SEN
  )

  # Apply rules: try each rule in order, restart after each match
  changed <- TRUE
  while (changed && length(tokens) > 1) {
    changed <- FALSE
    for (rule in rules) {
      for (j in seq_along(tokens)) {
        res <- rule(j)
        if (!is.null(res)) {
          tokens <- res$tokens; types <- res$types; seps <- res$seps
          changed <- TRUE
          break
        }
      }
      if (changed) break
    }
  }

  if (length(tokens) != 1) {
    # Check for unbound operators to give a specific error message
    for (k in seq_along(tokens)) {
      if (is_bare_op(tokens[k])) {
        tag_num <- as.integer(sub("#", "", tokens[k]))
        p <- get_parsed(tokens[k])
        side <- if (nchar(p$left_arg) > 0) "left" else "right"
        return(list(string = paste0("Operator ", type[tag_num],
                      " (position ", tag_num, ") has no argument to its ", side),
                    type = "ERROR"))
      }
    }
    remaining <- paste(types, collapse = " + ")
    return(list(string = paste0("Cannot group remaining elements: ", remaining),
                type = "ERROR"))
  }

  make_result()
}
