File size: 7,599 Bytes
ffc07fb | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | ! Layer 4 — Sovereign IDE Incremental Parser (Tree-sitter / GLR)
! Maps to: snapkitty-resonance-isa Abjad VM IR, j-matrix-twin SUBLEQ
MODULE sovereign_parser
USE iso_c_binding
USE sovereign_runtime, ONLY: runtime_panic, str_intern
USE sovereign_text_buffer, ONLY: text_buffer_t, buffer_slice, buffer_length
IMPLICIT NONE
PRIVATE
! ── Token kinds ───────────────────────────────────────────────────────────
INTEGER, PARAMETER :: TOK_EOF = 0
INTEGER, PARAMETER :: TOK_IDENT = 1
INTEGER, PARAMETER :: TOK_NUMBER = 2
INTEGER, PARAMETER :: TOK_STRING = 3
INTEGER, PARAMETER :: TOK_OP = 4
INTEGER, PARAMETER :: TOK_NEWLINE = 5
INTEGER, PARAMETER :: TOK_ERROR = 255
! ── CST node ──────────────────────────────────────────────────────────────
INTEGER, PARAMETER :: MAX_CST_NODES = 2097152
INTEGER, PARAMETER :: MAX_CST_CHILDREN = 16
TYPE :: cst_node_t
INTEGER(C_INT32_T) :: kind = 0 ! grammar symbol ID
INTEGER :: start_byte = 0
INTEGER :: end_byte = 0
INTEGER :: parent = 0
INTEGER :: children(MAX_CST_CHILDREN) = 0
INTEGER :: n_children = 0
LOGICAL :: is_error = .FALSE.
INTEGER :: ir_opcode = 0 ! Abjad VM IR opcode (resonance-isa)
END TYPE cst_node_t
! ── Grammar rule ──────────────────────────────────────────────────────────
INTEGER, PARAMETER :: MAX_RULES = 4096
INTEGER, PARAMETER :: MAX_RHS = 16
TYPE :: grammar_rule_t
INTEGER(C_INT32_T) :: lhs = 0
INTEGER(C_INT32_T) :: rhs(MAX_RHS) = 0
INTEGER :: rhs_len = 0
INTEGER :: action = 0
END TYPE grammar_rule_t
! ── Parse table (GLR) ─────────────────────────────────────────────────────
INTEGER, PARAMETER :: MAX_STATES = 1024
TYPE :: parse_table_t
INTEGER :: rules(MAX_STATES, 256) ! state × lookahead → action
INTEGER :: rule_count = 0
LOGICAL :: worm_sealed = .FALSE. ! bifrost: sealed after grammar load
END TYPE parse_table_t
! ── Parser context ────────────────────────────────────────────────────────
TYPE :: parser_ctx_t
TYPE(cst_node_t) :: nodes(MAX_CST_NODES)
INTEGER :: node_count = 0
INTEGER :: root = 0
TYPE(parse_table_t) :: table
LOGICAL :: dirty = .TRUE.
END TYPE parser_ctx_t
PUBLIC :: parser_init
PUBLIC :: parser_load_grammar
PUBLIC :: parser_parse_full
PUBLIC :: parser_parse_incremental
PUBLIC :: parser_node_text
PUBLIC :: parser_find_node_at
CONTAINS
! ---------------------------------------------------------------------------
SUBROUTINE parser_init(ctx)
TYPE(parser_ctx_t), INTENT(INOUT) :: ctx
ctx%node_count = 0
ctx%root = 0
ctx%dirty = .TRUE.
ctx%table%rule_count = 0
ctx%table%worm_sealed = .FALSE.
ctx%table%rules = 0
WRITE(*,'(A)') '[parser] init'
END SUBROUTINE parser_init
! ---------------------------------------------------------------------------
! Load grammar from file; WORM-seal the table after load
SUBROUTINE parser_load_grammar(ctx, grammar_path)
TYPE(parser_ctx_t), INTENT(INOUT) :: ctx
CHARACTER(LEN=*), INTENT(IN) :: grammar_path
! TODO: read grammar file, build GLR table
! TODO: call bifrost_worm_seal on table after verification
ctx%table%worm_sealed = .TRUE.
WRITE(*,'(A,A)') '[parser] grammar loaded from ', TRIM(grammar_path)
END SUBROUTINE parser_load_grammar
! ---------------------------------------------------------------------------
! Full parse of entire buffer
SUBROUTINE parser_parse_full(ctx, buf)
TYPE(parser_ctx_t), INTENT(INOUT) :: ctx
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER :: n
n = buffer_length(buf)
ctx%node_count = 0
ctx%root = glr_parse(ctx, buf, 0, n)
ctx%dirty = .FALSE.
WRITE(*,'(A,I0,A)') '[parser] full parse: ', ctx%node_count, ' nodes'
END SUBROUTINE parser_parse_full
! ---------------------------------------------------------------------------
! Incremental reparse for edit region [edit_start, edit_end)
SUBROUTINE parser_parse_incremental(ctx, buf, edit_start, edit_end)
TYPE(parser_ctx_t), INTENT(INOUT) :: ctx
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER, INTENT(IN) :: edit_start, edit_end
! TODO: locate affected subtree, re-enter GLR at boundary
ctx%dirty = .FALSE.
WRITE(*,'(A,I0,A,I0)') '[parser] incremental reparse: ', &
edit_start, ' → ', edit_end
END SUBROUTINE parser_parse_incremental
! ---------------------------------------------------------------------------
SUBROUTINE parser_node_text(ctx, buf, node_idx, text)
TYPE(parser_ctx_t), INTENT(IN) :: ctx
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER, INTENT(IN) :: node_idx
CHARACTER(LEN=*), INTENT(OUT) :: text
INTEGER :: s, e
s = ctx%nodes(node_idx)%start_byte
e = ctx%nodes(node_idx)%end_byte
CALL buffer_slice(buf, s, e - s, text)
END SUBROUTINE parser_node_text
! ---------------------------------------------------------------------------
! Find deepest CST node containing byte offset
FUNCTION parser_find_node_at(ctx, offset) RESULT(idx)
TYPE(parser_ctx_t), INTENT(IN) :: ctx
INTEGER, INTENT(IN) :: offset
INTEGER :: idx
idx = find_recursive(ctx, ctx%root, offset)
END FUNCTION parser_find_node_at
! ── Internal GLR skeleton ─────────────────────────────────────────────────
RECURSIVE FUNCTION glr_parse(ctx, buf, start, end_b) RESULT(node_idx)
TYPE(parser_ctx_t), INTENT(INOUT) :: ctx
TYPE(text_buffer_t), INTENT(IN) :: buf
INTEGER, INTENT(IN) :: start, end_b
INTEGER :: node_idx
! TODO: full GLR implementation
! Stub: create a single leaf error node
ctx%node_count = ctx%node_count + 1
node_idx = ctx%node_count
ctx%nodes(node_idx)%start_byte = start
ctx%nodes(node_idx)%end_byte = end_b
ctx%nodes(node_idx)%is_error = .FALSE.
END FUNCTION glr_parse
RECURSIVE FUNCTION find_recursive(ctx, idx, offset) RESULT(found)
TYPE(parser_ctx_t), INTENT(IN) :: ctx
INTEGER, INTENT(IN) :: idx, offset
INTEGER :: found, i, child
found = idx
IF (idx == 0) RETURN
DO i = 1, ctx%nodes(idx)%n_children
child = ctx%nodes(idx)%children(i)
IF (ctx%nodes(child)%start_byte <= offset .AND. &
ctx%nodes(child)%end_byte > offset) THEN
found = find_recursive(ctx, child, offset)
RETURN
END IF
END DO
END FUNCTION find_recursive
END MODULE sovereign_parser
|