fortrangoingonforty/fortbite / c1b629d

Browse files

update core files

Authored by espadonne
SHA
c1b629dc1352a267556089014a8ba5764bc6684a
Parents
8f22be6
Tree
2ed076c

5 changed files

StatusFile+-
A src/fortbite_ast_m.f90 280 0
A src/fortbite_evaluator_m.f90 479 0
M src/fortbite_io_m.f90 59 13
A src/fortbite_lexer_m.f90 460 0
A src/fortbite_parser_m.f90 399 0
src/fortbite_ast_m.f90added
@@ -0,0 +1,280 @@
1
+!> Abstract Syntax Tree module for FORTBITE
2
+!>
3
+!> Defines the AST node types and operations for representing parsed
4
+!> mathematical expressions in tree form.
5
+module fortbite_ast_m
6
+    use fortbite_types_m, only: value_t
7
+    use iso_fortran_env, only: real64
8
+    implicit none
9
+    private
10
+
11
+    public :: ast_node_t, ast_node_type_enum, operator_type_enum, ast_node_ptr_t
12
+    public :: AST_LITERAL, AST_IDENTIFIER, AST_BINARY_OP, AST_UNARY_OP
13
+    public :: AST_FUNCTION_CALL, AST_ASSIGNMENT, AST_PRECISION_SPEC
14
+    public :: OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_POW, OP_MOD
15
+    public :: OP_UNARY_PLUS, OP_UNARY_MINUS
16
+    public :: create_literal_node, create_identifier_node, create_binary_node
17
+    public :: create_unary_node, create_function_node, create_assignment_node
18
+    public :: create_precision_node, free_ast, print_ast
19
+
20
+    !> AST node types
21
+    enum, bind(c)
22
+        enumerator :: AST_LITERAL = 1
23
+        enumerator :: AST_IDENTIFIER = 2
24
+        enumerator :: AST_BINARY_OP = 3
25
+        enumerator :: AST_UNARY_OP = 4
26
+        enumerator :: AST_FUNCTION_CALL = 5
27
+        enumerator :: AST_ASSIGNMENT = 6
28
+        enumerator :: AST_PRECISION_SPEC = 7
29
+    end enum
30
+    integer, parameter :: ast_node_type_enum = kind(AST_LITERAL)
31
+
32
+    !> Operator types
33
+    enum, bind(c)
34
+        enumerator :: OP_ADD = 1
35
+        enumerator :: OP_SUB = 2
36
+        enumerator :: OP_MUL = 3
37
+        enumerator :: OP_DIV = 4
38
+        enumerator :: OP_POW = 5
39
+        enumerator :: OP_MOD = 6
40
+        enumerator :: OP_UNARY_PLUS = 7
41
+        enumerator :: OP_UNARY_MINUS = 8
42
+    end enum
43
+    integer, parameter :: operator_type_enum = kind(OP_ADD)
44
+
45
+    !> Pointer wrapper for AST nodes in arrays
46
+    type :: ast_node_ptr_t
47
+        type(ast_node_t), pointer :: ptr => null()
48
+    end type ast_node_ptr_t
49
+
50
+    !> AST node type - can represent any expression component
51
+    type :: ast_node_t
52
+        integer(ast_node_type_enum) :: node_type
53
+
54
+        ! Node-specific data
55
+        type(value_t) :: literal_value                    ! For AST_LITERAL
56
+        character(len=:), allocatable :: identifier      ! For AST_IDENTIFIER
57
+        integer(operator_type_enum) :: operator          ! For AST_BINARY_OP, AST_UNARY_OP
58
+        character(len=:), allocatable :: function_name   ! For AST_FUNCTION_CALL
59
+        integer :: precision_digits                       ! For AST_PRECISION_SPEC
60
+
61
+        ! Child node pointers
62
+        type(ast_node_t), pointer :: left => null()      ! Left operand
63
+        type(ast_node_t), pointer :: right => null()     ! Right operand
64
+        type(ast_node_t), pointer :: operand => null()   ! For unary operations
65
+        type(ast_node_t), pointer :: expression => null() ! For precision specs
66
+
67
+        ! Function arguments (array of pointer wrappers)
68
+        type(ast_node_ptr_t), allocatable :: arguments(:)
69
+        integer :: arg_count = 0
70
+    end type ast_node_t
71
+
72
+contains
73
+
74
+    !> Create a literal value node
75
+    function create_literal_node(value) result(node)
76
+        type(value_t), intent(in) :: value
77
+        type(ast_node_t), pointer :: node
78
+
79
+        allocate(node)
80
+        node%node_type = AST_LITERAL
81
+        node%literal_value = value
82
+    end function create_literal_node
83
+
84
+    !> Create an identifier node
85
+    function create_identifier_node(name) result(node)
86
+        character(len=*), intent(in) :: name
87
+        type(ast_node_t), pointer :: node
88
+
89
+        allocate(node)
90
+        node%node_type = AST_IDENTIFIER
91
+        node%identifier = trim(name)
92
+    end function create_identifier_node
93
+
94
+    !> Create a binary operation node
95
+    function create_binary_node(op, left_node, right_node) result(node)
96
+        integer(operator_type_enum), intent(in) :: op
97
+        type(ast_node_t), pointer, intent(in) :: left_node, right_node
98
+        type(ast_node_t), pointer :: node
99
+
100
+        allocate(node)
101
+        node%node_type = AST_BINARY_OP
102
+        node%operator = op
103
+        node%left => left_node
104
+        node%right => right_node
105
+    end function create_binary_node
106
+
107
+    !> Create a unary operation node
108
+    function create_unary_node(op, operand_node) result(node)
109
+        integer(operator_type_enum), intent(in) :: op
110
+        type(ast_node_t), pointer, intent(in) :: operand_node
111
+        type(ast_node_t), pointer :: node
112
+
113
+        allocate(node)
114
+        node%node_type = AST_UNARY_OP
115
+        node%operator = op
116
+        node%operand => operand_node
117
+    end function create_unary_node
118
+
119
+    !> Create a function call node
120
+    function create_function_node(func_name, args) result(node)
121
+        character(len=*), intent(in) :: func_name
122
+        type(ast_node_t), pointer, intent(in), optional :: args(:)
123
+        type(ast_node_t), pointer :: node
124
+        integer :: i
125
+
126
+        allocate(node)
127
+        node%node_type = AST_FUNCTION_CALL
128
+        node%function_name = trim(func_name)
129
+
130
+        if (present(args)) then
131
+            node%arg_count = size(args)
132
+            allocate(node%arguments(node%arg_count))
133
+            do i = 1, node%arg_count
134
+                node%arguments(i)%ptr => args(i)
135
+            end do
136
+        else
137
+            node%arg_count = 0
138
+        end if
139
+    end function create_function_node
140
+
141
+    !> Create an assignment node
142
+    function create_assignment_node(var_name, expression_node) result(node)
143
+        character(len=*), intent(in) :: var_name
144
+        type(ast_node_t), pointer, intent(in) :: expression_node
145
+        type(ast_node_t), pointer :: node
146
+
147
+        type(ast_node_t), pointer :: identifier_node
148
+
149
+        allocate(node)
150
+        node%node_type = AST_ASSIGNMENT
151
+        node%operator = OP_ADD  ! Dummy value, not used for assignments
152
+
153
+        ! Create identifier node for the variable
154
+        identifier_node => create_identifier_node(var_name)
155
+        node%left => identifier_node
156
+        node%right => expression_node
157
+    end function create_assignment_node
158
+
159
+    !> Create a precision specification node
160
+    function create_precision_node(expr_node, precision) result(node)
161
+        type(ast_node_t), pointer, intent(in) :: expr_node
162
+        integer, intent(in) :: precision
163
+        type(ast_node_t), pointer :: node
164
+
165
+        allocate(node)
166
+        node%node_type = AST_PRECISION_SPEC
167
+        node%precision_digits = precision
168
+        node%expression => expr_node
169
+    end function create_precision_node
170
+
171
+    !> Free AST and all child nodes
172
+    recursive subroutine free_ast(node)
173
+        type(ast_node_t), pointer, intent(inout) :: node
174
+        integer :: i
175
+
176
+        if (.not. associated(node)) return
177
+
178
+        ! Free child nodes
179
+        if (associated(node%left)) call free_ast(node%left)
180
+        if (associated(node%right)) call free_ast(node%right)
181
+        if (associated(node%operand)) call free_ast(node%operand)
182
+        if (associated(node%expression)) call free_ast(node%expression)
183
+
184
+        ! Free function arguments
185
+        if (allocated(node%arguments)) then
186
+            do i = 1, node%arg_count
187
+                if (associated(node%arguments(i)%ptr)) then
188
+                    call free_ast(node%arguments(i)%ptr)
189
+                end if
190
+            end do
191
+            deallocate(node%arguments)
192
+        end if
193
+
194
+        ! Free the node itself
195
+        deallocate(node)
196
+        nullify(node)
197
+    end subroutine free_ast
198
+
199
+    !> Print AST for debugging (recursive)
200
+    recursive subroutine print_ast(node, indent)
201
+        type(ast_node_t), pointer, intent(in) :: node
202
+        integer, intent(in), optional :: indent
203
+
204
+        integer :: ind, i
205
+        character(len=50) :: spaces
206
+
207
+        if (.not. associated(node)) return
208
+
209
+        ind = 0
210
+        if (present(indent)) ind = indent
211
+
212
+        spaces = repeat(' ', ind)
213
+
214
+        select case (node%node_type)
215
+        case (AST_LITERAL)
216
+            write(*, '(A,A)') trim(spaces), 'LITERAL: [value]'
217
+
218
+        case (AST_IDENTIFIER)
219
+            write(*, '(A,A,A)') trim(spaces), 'IDENTIFIER: ', node%identifier
220
+
221
+        case (AST_BINARY_OP)
222
+            write(*, '(A,A,A)') trim(spaces), 'BINARY_OP: ', get_operator_name(node%operator)
223
+            call print_ast(node%left, ind + 2)
224
+            call print_ast(node%right, ind + 2)
225
+
226
+        case (AST_UNARY_OP)
227
+            write(*, '(A,A,A)') trim(spaces), 'UNARY_OP: ', get_operator_name(node%operator)
228
+            call print_ast(node%operand, ind + 2)
229
+
230
+        case (AST_FUNCTION_CALL)
231
+            write(*, '(A,A,A,A,I0,A)') trim(spaces), 'FUNCTION: ', node%function_name, &
232
+                ' (', node%arg_count, ' args)'
233
+            if (allocated(node%arguments)) then
234
+                do i = 1, node%arg_count
235
+                    call print_ast(node%arguments(i)%ptr, ind + 2)
236
+                end do
237
+            end if
238
+
239
+        case (AST_ASSIGNMENT)
240
+            write(*, '(A,A)') trim(spaces), 'ASSIGNMENT:'
241
+            call print_ast(node%left, ind + 2)
242
+            call print_ast(node%right, ind + 2)
243
+
244
+        case (AST_PRECISION_SPEC)
245
+            write(*, '(A,A,I0)') trim(spaces), 'PRECISION: ', node%precision_digits
246
+            call print_ast(node%expression, ind + 2)
247
+
248
+        case default
249
+            write(*, '(A,A)') trim(spaces), 'UNKNOWN NODE'
250
+        end select
251
+    end subroutine print_ast
252
+
253
+    !> Get human-readable operator name
254
+    function get_operator_name(op) result(name)
255
+        integer(operator_type_enum), intent(in) :: op
256
+        character(len=10) :: name
257
+
258
+        select case (op)
259
+        case (OP_ADD)
260
+            name = '+'
261
+        case (OP_SUB)
262
+            name = '-'
263
+        case (OP_MUL)
264
+            name = '*'
265
+        case (OP_DIV)
266
+            name = '/'
267
+        case (OP_POW)
268
+            name = '**'
269
+        case (OP_MOD)
270
+            name = 'mod'
271
+        case (OP_UNARY_PLUS)
272
+            name = 'unary +'
273
+        case (OP_UNARY_MINUS)
274
+            name = 'unary -'
275
+        case default
276
+            name = 'unknown'
277
+        end select
278
+    end function get_operator_name
279
+
280
+end module fortbite_ast_m
src/fortbite_evaluator_m.f90added
@@ -0,0 +1,479 @@
1
+!> Expression evaluator module for FORTBITE
2
+!>
3
+!> Evaluates Abstract Syntax Trees, performing mathematical operations
4
+!> with proper type promotion and precision handling.
5
+module fortbite_evaluator_m
6
+    use fortbite_types_m, only: value_t, variable_t, VALUE_SCALAR, VALUE_COMPLEX, &
7
+                               create_scalar, create_complex, print_value, is_zero, is_real
8
+    use fortbite_ast_m, only: ast_node_t, ast_node_ptr_t, AST_LITERAL, AST_IDENTIFIER, AST_BINARY_OP, &
9
+                             AST_UNARY_OP, AST_FUNCTION_CALL, AST_ASSIGNMENT, AST_PRECISION_SPEC, &
10
+                             OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_POW, OP_MOD, &
11
+                             OP_UNARY_PLUS, OP_UNARY_MINUS
12
+    use fortbite_arithmetic_m, only: add_values, subtract_values, multiply_values, &
13
+                                    divide_values, power_values, negate_value, abs_value
14
+    use iso_fortran_env, only: real64
15
+    implicit none
16
+    private
17
+
18
+    public :: evaluate_expression, evaluation_context_t, evaluation_error_t
19
+    public :: create_context, destroy_context, set_variable, get_variable
20
+
21
+    !> Evaluation context (variable storage)
22
+    type :: evaluation_context_t
23
+        type(variable_t), pointer :: variables => null()
24
+        integer :: default_precision = 15
25
+    end type evaluation_context_t
26
+
27
+    !> Evaluation error information
28
+    type :: evaluation_error_t
29
+        logical :: has_error = .false.
30
+        character(len=200) :: message = ''
31
+    end type evaluation_error_t
32
+
33
+contains
34
+
35
+    !> Create a new evaluation context
36
+    function create_context() result(context)
37
+        type(evaluation_context_t) :: context
38
+
39
+        ! Initialize with default precision
40
+        context%default_precision = 15
41
+        nullify(context%variables)
42
+    end function create_context
43
+
44
+    !> Destroy evaluation context and free variables
45
+    subroutine destroy_context(context)
46
+        type(evaluation_context_t), intent(inout) :: context
47
+
48
+        call free_variables(context%variables)
49
+    end subroutine destroy_context
50
+
51
+    !> Set a variable in the context
52
+    subroutine set_variable(context, name, value)
53
+        type(evaluation_context_t), intent(inout) :: context
54
+        character(len=*), intent(in) :: name
55
+        type(value_t), intent(in) :: value
56
+
57
+        type(variable_t), pointer :: var, current
58
+
59
+        ! Look for existing variable
60
+        current => context%variables
61
+        do while (associated(current))
62
+            if (current%name == name) then
63
+                current%value = value
64
+                return
65
+            end if
66
+            current => current%next
67
+        end do
68
+
69
+        ! Create new variable
70
+        allocate(var)
71
+        var%name = trim(name)
72
+        var%value = value
73
+        var%next => context%variables
74
+        context%variables => var
75
+    end subroutine set_variable
76
+
77
+    !> Get a variable from the context
78
+    function get_variable(context, name, value) result(found)
79
+        type(evaluation_context_t), intent(in) :: context
80
+        character(len=*), intent(in) :: name
81
+        type(value_t), intent(out) :: value
82
+        logical :: found
83
+
84
+        type(variable_t), pointer :: current
85
+
86
+        found = .false.
87
+        current => context%variables
88
+
89
+        do while (associated(current))
90
+            if (current%name == name) then
91
+                value = current%value
92
+                found = .true.
93
+                return
94
+            end if
95
+            current => current%next
96
+        end do
97
+    end function get_variable
98
+
99
+    !> Evaluate an AST expression
100
+    recursive function evaluate_expression(node, context, error) result(value)
101
+        type(ast_node_t), pointer, intent(in) :: node
102
+        type(evaluation_context_t), intent(inout) :: context
103
+        type(evaluation_error_t), intent(out), optional :: error
104
+        type(value_t) :: value
105
+
106
+        type(evaluation_error_t) :: local_error
107
+
108
+        local_error%has_error = .false.
109
+
110
+        if (.not. associated(node)) then
111
+            call set_eval_error(local_error, 'Null AST node')
112
+            value = create_scalar(0.0_real64)  ! Default value
113
+            if (present(error)) error = local_error
114
+            return
115
+        end if
116
+
117
+        select case (node%node_type)
118
+        case (AST_LITERAL)
119
+            value = evaluate_literal(node, local_error)
120
+
121
+        case (AST_IDENTIFIER)
122
+            value = evaluate_identifier(node, context, local_error)
123
+
124
+        case (AST_BINARY_OP)
125
+            value = evaluate_binary_op(node, context, local_error)
126
+
127
+        case (AST_UNARY_OP)
128
+            value = evaluate_unary_op(node, context, local_error)
129
+
130
+        case (AST_FUNCTION_CALL)
131
+            value = evaluate_function_call(node, context, local_error)
132
+
133
+        case (AST_ASSIGNMENT)
134
+            value = evaluate_assignment(node, context, local_error)
135
+
136
+        case (AST_PRECISION_SPEC)
137
+            value = evaluate_precision_spec(node, context, local_error)
138
+
139
+        case default
140
+            call set_eval_error(local_error, 'Unknown AST node type')
141
+            value = create_scalar(0.0_real64)
142
+        end select
143
+
144
+        if (present(error)) error = local_error
145
+    end function evaluate_expression
146
+
147
+    !> Evaluate a literal value
148
+    function evaluate_literal(node, error) result(value)
149
+        type(ast_node_t), pointer, intent(in) :: node
150
+        type(evaluation_error_t), intent(out) :: error
151
+        type(value_t) :: value
152
+
153
+        error%has_error = .false.
154
+        value = node%literal_value
155
+    end function evaluate_literal
156
+
157
+    !> Evaluate an identifier (variable or constant)
158
+    function evaluate_identifier(node, context, error) result(value)
159
+        type(ast_node_t), pointer, intent(in) :: node
160
+        type(evaluation_context_t), intent(inout) :: context
161
+        type(evaluation_error_t), intent(out) :: error
162
+        type(value_t) :: value
163
+
164
+        logical :: found
165
+
166
+        error%has_error = .false.
167
+
168
+        ! First check for mathematical constants
169
+        if (node%identifier == 'pi') then
170
+            value = create_scalar(4.0_real64 * atan(1.0_real64))  ! Precise π
171
+            return
172
+        else if (node%identifier == 'e') then
173
+            value = create_scalar(exp(1.0_real64))  ! Precise e
174
+            return
175
+        else if (node%identifier == 'i') then
176
+            value = create_complex(0.0_real64, 1.0_real64)  ! Imaginary unit
177
+            return
178
+        end if
179
+
180
+        ! Check user-defined variables
181
+        found = get_variable(context, node%identifier, value)
182
+
183
+        if (.not. found) then
184
+            call set_eval_error(error, 'Undefined variable: ' // node%identifier)
185
+            value = create_scalar(0.0_real64)
186
+        end if
187
+    end function evaluate_identifier
188
+
189
+    !> Evaluate a binary operation
190
+    recursive function evaluate_binary_op(node, context, error) result(value)
191
+        type(ast_node_t), pointer, intent(in) :: node
192
+        type(evaluation_context_t), intent(inout) :: context
193
+        type(evaluation_error_t), intent(out) :: error
194
+        type(value_t) :: value
195
+
196
+        type(value_t) :: left_val, right_val
197
+        type(evaluation_error_t) :: left_error, right_error
198
+
199
+        error%has_error = .false.
200
+
201
+        ! Evaluate operands
202
+        left_val = evaluate_expression(node%left, context, left_error)
203
+        if (left_error%has_error) then
204
+            error = left_error
205
+            return
206
+        end if
207
+
208
+        right_val = evaluate_expression(node%right, context, right_error)
209
+        if (right_error%has_error) then
210
+            error = right_error
211
+            return
212
+        end if
213
+
214
+        ! Perform operation
215
+        select case (node%operator)
216
+        case (OP_ADD)
217
+            value = add_values(left_val, right_val)
218
+        case (OP_SUB)
219
+            value = subtract_values(left_val, right_val)
220
+        case (OP_MUL)
221
+            value = multiply_values(left_val, right_val)
222
+        case (OP_DIV)
223
+            value = divide_values(left_val, right_val)
224
+        case (OP_POW)
225
+            value = power_values(left_val, right_val)
226
+        case (OP_MOD)
227
+            ! Modulo operation (for now, only on real numbers)
228
+            if (left_val%value_type == VALUE_SCALAR .and. right_val%value_type == VALUE_SCALAR) then
229
+                value = create_scalar(mod(left_val%scalar_val, right_val%scalar_val))
230
+            else
231
+                call set_eval_error(error, 'Modulo operation only supported for real numbers')
232
+                value = create_scalar(0.0_real64)
233
+            end if
234
+        case default
235
+            call set_eval_error(error, 'Unknown binary operator')
236
+            value = create_scalar(0.0_real64)
237
+        end select
238
+    end function evaluate_binary_op
239
+
240
+    !> Evaluate a unary operation
241
+    recursive function evaluate_unary_op(node, context, error) result(value)
242
+        type(ast_node_t), pointer, intent(in) :: node
243
+        type(evaluation_context_t), intent(inout) :: context
244
+        type(evaluation_error_t), intent(out) :: error
245
+        type(value_t) :: value
246
+
247
+        type(value_t) :: operand_val
248
+        type(evaluation_error_t) :: operand_error
249
+
250
+        error%has_error = .false.
251
+
252
+        ! Evaluate operand
253
+        operand_val = evaluate_expression(node%operand, context, operand_error)
254
+        if (operand_error%has_error) then
255
+            error = operand_error
256
+            return
257
+        end if
258
+
259
+        ! Perform operation
260
+        select case (node%operator)
261
+        case (OP_UNARY_PLUS)
262
+            value = operand_val  ! Unary plus doesn't change the value
263
+        case (OP_UNARY_MINUS)
264
+            value = negate_value(operand_val)
265
+        case default
266
+            call set_eval_error(error, 'Unknown unary operator')
267
+            value = create_scalar(0.0_real64)
268
+        end select
269
+    end function evaluate_unary_op
270
+
271
+    !> Evaluate a function call
272
+    recursive function evaluate_function_call(node, context, error) result(value)
273
+        type(ast_node_t), pointer, intent(in) :: node
274
+        type(evaluation_context_t), intent(inout) :: context
275
+        type(evaluation_error_t), intent(out) :: error
276
+        type(value_t) :: value
277
+
278
+        type(value_t), allocatable :: args(:)
279
+        type(evaluation_error_t) :: arg_error
280
+        integer :: i
281
+        real(real64) :: x, result_val
282
+
283
+        error%has_error = .false.
284
+
285
+        ! Evaluate arguments
286
+        if (node%arg_count > 0) then
287
+            allocate(args(node%arg_count))
288
+            do i = 1, node%arg_count
289
+                args(i) = evaluate_expression(node%arguments(i)%ptr, context, arg_error)
290
+                if (arg_error%has_error) then
291
+                    error = arg_error
292
+                    return
293
+                end if
294
+            end do
295
+        end if
296
+
297
+        ! Call function
298
+        select case (node%function_name)
299
+        case ('sin')
300
+            if (node%arg_count /= 1) then
301
+                call set_eval_error(error, 'sin() expects 1 argument')
302
+                value = create_scalar(0.0_real64)
303
+                return
304
+            end if
305
+            if (args(1)%value_type == VALUE_SCALAR) then
306
+                value = create_scalar(sin(args(1)%scalar_val))
307
+            else
308
+                call set_eval_error(error, 'sin() expects a real argument')
309
+                value = create_scalar(0.0_real64)
310
+            end if
311
+
312
+        case ('cos')
313
+            if (node%arg_count /= 1) then
314
+                call set_eval_error(error, 'cos() expects 1 argument')
315
+                value = create_scalar(0.0_real64)
316
+                return
317
+            end if
318
+            if (args(1)%value_type == VALUE_SCALAR) then
319
+                value = create_scalar(cos(args(1)%scalar_val))
320
+            else
321
+                call set_eval_error(error, 'cos() expects a real argument')
322
+                value = create_scalar(0.0_real64)
323
+            end if
324
+
325
+        case ('tan')
326
+            if (node%arg_count /= 1) then
327
+                call set_eval_error(error, 'tan() expects 1 argument')
328
+                value = create_scalar(0.0_real64)
329
+                return
330
+            end if
331
+            if (args(1)%value_type == VALUE_SCALAR) then
332
+                value = create_scalar(tan(args(1)%scalar_val))
333
+            else
334
+                call set_eval_error(error, 'tan() expects a real argument')
335
+                value = create_scalar(0.0_real64)
336
+            end if
337
+
338
+        case ('log')
339
+            if (node%arg_count /= 1) then
340
+                call set_eval_error(error, 'log() expects 1 argument')
341
+                value = create_scalar(0.0_real64)
342
+                return
343
+            end if
344
+            if (args(1)%value_type == VALUE_SCALAR) then
345
+                x = args(1)%scalar_val
346
+                if (x > 0.0_real64) then
347
+                    value = create_scalar(log(x))
348
+                else
349
+                    call set_eval_error(error, 'log() argument must be positive')
350
+                    value = create_scalar(0.0_real64)
351
+                end if
352
+            else
353
+                call set_eval_error(error, 'log() expects a real argument')
354
+                value = create_scalar(0.0_real64)
355
+            end if
356
+
357
+        case ('exp')
358
+            if (node%arg_count /= 1) then
359
+                call set_eval_error(error, 'exp() expects 1 argument')
360
+                value = create_scalar(0.0_real64)
361
+                return
362
+            end if
363
+            if (args(1)%value_type == VALUE_SCALAR) then
364
+                value = create_scalar(exp(args(1)%scalar_val))
365
+            else
366
+                call set_eval_error(error, 'exp() expects a real argument')
367
+                value = create_scalar(0.0_real64)
368
+            end if
369
+
370
+        case ('sqrt')
371
+            if (node%arg_count /= 1) then
372
+                call set_eval_error(error, 'sqrt() expects 1 argument')
373
+                value = create_scalar(0.0_real64)
374
+                return
375
+            end if
376
+            if (args(1)%value_type == VALUE_SCALAR) then
377
+                x = args(1)%scalar_val
378
+                if (x >= 0.0_real64) then
379
+                    value = create_scalar(sqrt(x))
380
+                else
381
+                    call set_eval_error(error, 'sqrt() argument must be non-negative')
382
+                    value = create_scalar(0.0_real64)
383
+                end if
384
+            else
385
+                call set_eval_error(error, 'sqrt() expects a real argument')
386
+                value = create_scalar(0.0_real64)
387
+            end if
388
+
389
+        case ('abs')
390
+            if (node%arg_count /= 1) then
391
+                call set_eval_error(error, 'abs() expects 1 argument')
392
+                value = create_scalar(0.0_real64)
393
+                return
394
+            end if
395
+            value = abs_value(args(1))
396
+
397
+        case default
398
+            call set_eval_error(error, 'Unknown function: ' // node%function_name)
399
+            value = create_scalar(0.0_real64)
400
+        end select
401
+
402
+        if (allocated(args)) deallocate(args)
403
+    end function evaluate_function_call
404
+
405
+    !> Evaluate an assignment
406
+    recursive function evaluate_assignment(node, context, error) result(value)
407
+        type(ast_node_t), pointer, intent(in) :: node
408
+        type(evaluation_context_t), intent(inout) :: context
409
+        type(evaluation_error_t), intent(out) :: error
410
+        type(value_t) :: value
411
+
412
+        type(evaluation_error_t) :: expr_error
413
+        character(len=:), allocatable :: var_name
414
+
415
+        error%has_error = .false.
416
+
417
+        if (.not. associated(node%left) .or. node%left%node_type /= AST_IDENTIFIER) then
418
+            call set_eval_error(error, 'Left side of assignment must be a variable')
419
+            value = create_scalar(0.0_real64)
420
+            return
421
+        end if
422
+
423
+        var_name = node%left%identifier
424
+
425
+        ! Evaluate the right-hand side expression
426
+        value = evaluate_expression(node%right, context, expr_error)
427
+        if (expr_error%has_error) then
428
+            error = expr_error
429
+            return
430
+        end if
431
+
432
+        ! Store the variable
433
+        call set_variable(context, var_name, value)
434
+    end function evaluate_assignment
435
+
436
+    !> Evaluate a precision specification
437
+    recursive function evaluate_precision_spec(node, context, error) result(value)
438
+        type(ast_node_t), pointer, intent(in) :: node
439
+        type(evaluation_context_t), intent(inout) :: context
440
+        type(evaluation_error_t), intent(out) :: error
441
+        type(value_t) :: value
442
+
443
+        type(evaluation_error_t) :: expr_error
444
+
445
+        error%has_error = .false.
446
+
447
+        ! For now, just evaluate the expression (ignore precision specification)
448
+        ! TODO: Implement actual precision control in Phase 3
449
+        value = evaluate_expression(node%expression, context, expr_error)
450
+        if (expr_error%has_error) then
451
+            error = expr_error
452
+            return
453
+        end if
454
+
455
+        ! Could modify precision here based on node%precision_digits
456
+        ! For now, just return the value as-is
457
+    end function evaluate_precision_spec
458
+
459
+    !> Set an evaluation error
460
+    subroutine set_eval_error(error, message)
461
+        type(evaluation_error_t), intent(out) :: error
462
+        character(len=*), intent(in) :: message
463
+
464
+        error%has_error = .true.
465
+        error%message = trim(message)
466
+    end subroutine set_eval_error
467
+
468
+    !> Free variable linked list
469
+    recursive subroutine free_variables(var)
470
+        type(variable_t), pointer, intent(inout) :: var
471
+
472
+        if (associated(var)) then
473
+            call free_variables(var%next)
474
+            deallocate(var)
475
+        end if
476
+        nullify(var)
477
+    end subroutine free_variables
478
+
479
+end module fortbite_evaluator_m
src/fortbite_io_m.f90modified
@@ -4,7 +4,12 @@
44
 module fortbite_io_m
55
     use fortbite_precision_m, only: get_precision_info, precision_info_t
66
     use iso_fortran_env, only: real32, real64, real128
7
-    use fortbite_types_m, only: value_t, variable_t, print_value
7
+    use fortbite_types_m, only: value_t, variable_t, print_value, token_t
8
+    use fortbite_lexer_m, only: tokenize, free_tokens
9
+    use fortbite_parser_m, only: parse_expression, parse_error_t
10
+    use fortbite_ast_m, only: ast_node_t, free_ast
11
+    use fortbite_evaluator_m, only: evaluate_expression, evaluation_context_t, evaluation_error_t, &
12
+                                   create_context, destroy_context
813
     implicit none
914
     private
1015
@@ -54,7 +59,7 @@ contains
5459
         write(*, '(A)') ''
5560
     end subroutine print_help
5661
57
-    !> Check if input is a command (starts with a letter)
62
+    !> Check if input is a command
5863
     logical function is_command(input)
5964
         character(len=*), intent(in) :: input
6065
         character(len=len_trim(input)) :: trimmed_input
@@ -66,14 +71,15 @@ contains
6671
             return
6772
         end if
6873
69
-        ! Check if it starts with a letter (command) or digit/operator (expression)
70
-        is_command = (trimmed_input(1:1) >= 'a' .and. trimmed_input(1:1) <= 'z') .or. &
71
-                     (trimmed_input(1:1) >= 'A' .and. trimmed_input(1:1) <= 'Z')
74
+        ! Check for known commands
75
+        is_command = (trimmed_input == 'help' .or. trimmed_input == 'h' .or. trimmed_input == '?' .or. &
76
+                      trimmed_input == 'exit' .or. trimmed_input == 'quit' .or. trimmed_input == 'q' .or. &
77
+                      trimmed_input == 'clear' .or. trimmed_input == 'cls' .or. &
78
+                      trimmed_input == 'precision' .or. trimmed_input == 'info' .or. &
79
+                      trimmed_input == 'vars' .or. trimmed_input == 'variables' .or. &
80
+                      index(trimmed_input, 'precision ') == 1)
7281
73
-        ! Special case: check for assignment (contains :=)
74
-        if (index(trimmed_input, ':=') > 0) then
75
-            is_command = .false.
76
-        end if
82
+        ! Everything else is treated as a mathematical expression
7783
     end function is_command
7884
7985
     !> Parse and execute a command
@@ -130,10 +136,12 @@ contains
130136
     subroutine repl_loop()
131137
         character(len=MAX_LINE_LENGTH) :: input
132138
         type(variable_t), pointer :: variables => null()
139
+        type(evaluation_context_t) :: context
133140
         logical :: continue_loop
134141
         integer :: ios
135142
136143
         call print_banner()
144
+        context = create_context()
137145
         continue_loop = .true.
138146
139147
         do while (continue_loop)
@@ -153,16 +161,54 @@ contains
153161
             if (is_command(input)) then
154162
                 continue_loop = parse_command(input, variables)
155163
             else
156
-                ! Handle mathematical expression (placeholder for now)
157
-                write(*, '(A)') 'Mathematical expression parsing not yet implemented.'
158
-                write(*, '(A,A,A)') 'You entered: "', trim(input), '"'
164
+                ! Handle mathematical expression
165
+                call evaluate_math_expression(trim(input), context)
159166
             end if
160167
         end do
161168
162
-        ! Clean up variables
169
+        ! Clean up
170
+        call destroy_context(context)
163171
         call cleanup_variables(variables)
164172
     end subroutine repl_loop
165173
174
+    !> Evaluate a mathematical expression
175
+    subroutine evaluate_math_expression(expression, context)
176
+        character(len=*), intent(in) :: expression
177
+        type(evaluation_context_t), intent(inout) :: context
178
+
179
+        type(token_t), allocatable :: tokens(:)
180
+        type(ast_node_t), pointer :: ast_root => null()
181
+        type(parse_error_t) :: parse_err
182
+        type(evaluation_error_t) :: eval_err
183
+        type(value_t) :: result
184
+
185
+        ! Tokenize the expression
186
+        tokens = tokenize(expression)
187
+
188
+        ! Parse into AST
189
+        ast_root => parse_expression(tokens, parse_err)
190
+
191
+        if (parse_err%has_error) then
192
+            write(*, '(A,A)') 'Parse error: ', trim(parse_err%message)
193
+        else if (associated(ast_root)) then
194
+            ! Evaluate the expression
195
+            result = evaluate_expression(ast_root, context, eval_err)
196
+
197
+            if (eval_err%has_error) then
198
+                write(*, '(A,A)') 'Evaluation error: ', trim(eval_err%message)
199
+            else
200
+                ! Print the result
201
+                call print_value(result)
202
+            end if
203
+        else
204
+            write(*, '(A)') 'Failed to parse expression.'
205
+        end if
206
+
207
+        ! Clean up
208
+        if (associated(ast_root)) call free_ast(ast_root)
209
+        call free_tokens(tokens)
210
+    end subroutine evaluate_math_expression
211
+
166212
     !> Convert string to lowercase
167213
     subroutine to_lowercase(str)
168214
         character(len=*), intent(inout) :: str
src/fortbite_lexer_m.f90added
@@ -0,0 +1,460 @@
1
+!> Lexical analyzer module for FORTBITE
2
+!>
3
+!> Tokenizes mathematical expressions into a stream of tokens for parsing.
4
+!> Handles numbers, identifiers, operators, and special syntax like :: and :=
5
+module fortbite_lexer_m
6
+    use fortbite_types_m, only: token_t, TOKEN_EOF, TOKEN_NUMBER, TOKEN_IDENTIFIER, &
7
+                               TOKEN_OPERATOR, TOKEN_LPAREN, TOKEN_RPAREN, &
8
+                               TOKEN_LBRACKET, TOKEN_RBRACKET, TOKEN_SEMICOLON, &
9
+                               TOKEN_COMMA, TOKEN_ASSIGN, TOKEN_PRECISION
10
+    use iso_fortran_env, only: real64
11
+    implicit none
12
+    private
13
+
14
+    public :: tokenize, free_tokens, print_tokens
15
+
16
+    ! Lexer state
17
+    type :: lexer_state_t
18
+        character(len=:), allocatable :: input
19
+        integer :: position
20
+        integer :: length
21
+        character :: current_char
22
+    end type lexer_state_t
23
+
24
+contains
25
+
26
+    !> Tokenize a mathematical expression
27
+    function tokenize(expression) result(tokens)
28
+        character(len=*), intent(in) :: expression
29
+        type(token_t), allocatable :: tokens(:)
30
+
31
+        type(lexer_state_t) :: lexer
32
+        type(token_t) :: current_token
33
+        integer :: token_count, capacity
34
+
35
+        ! Initialize lexer state
36
+        lexer%input = trim(adjustl(expression))
37
+        lexer%length = len_trim(lexer%input)
38
+        lexer%position = 1
39
+
40
+        if (lexer%length == 0) then
41
+            allocate(tokens(1))
42
+            tokens(1)%token_type = TOKEN_EOF
43
+            return
44
+        end if
45
+
46
+        lexer%current_char = lexer%input(1:1)
47
+
48
+        ! Dynamic token array
49
+        capacity = max(16, lexer%length / 2)
50
+        allocate(tokens(capacity))
51
+        token_count = 0
52
+
53
+        ! Main tokenization loop
54
+        do
55
+            call skip_whitespace(lexer)
56
+            if (lexer%current_char == char(0) .or. lexer%position > lexer%length) exit
57
+
58
+            current_token = next_token(lexer)
59
+
60
+            ! Resize array if needed
61
+            if (token_count >= capacity) then
62
+                capacity = capacity * 2
63
+                call resize_token_array(tokens, capacity)
64
+            end if
65
+
66
+            token_count = token_count + 1
67
+            tokens(token_count) = current_token
68
+
69
+            if (current_token%token_type == TOKEN_EOF) exit
70
+        end do
71
+
72
+        ! Add EOF token if not already present
73
+        if (token_count == 0 .or. tokens(token_count)%token_type /= TOKEN_EOF) then
74
+            if (token_count >= capacity) then
75
+                capacity = capacity + 1
76
+                call resize_token_array(tokens, capacity)
77
+            end if
78
+            token_count = token_count + 1
79
+            tokens(token_count)%token_type = TOKEN_EOF
80
+            tokens(token_count)%position = lexer%position
81
+        end if
82
+
83
+        ! Trim array to actual size
84
+        call resize_token_array(tokens, token_count)
85
+    end function tokenize
86
+
87
+    !> Get the next token from the input stream
88
+    function next_token(lexer) result(token)
89
+        type(lexer_state_t), intent(inout) :: lexer
90
+        type(token_t) :: token
91
+
92
+        call skip_whitespace(lexer)
93
+
94
+        if (lexer%position > lexer%length) then
95
+            token%token_type = TOKEN_EOF
96
+            token%position = lexer%position
97
+            return
98
+        end if
99
+
100
+        token%position = lexer%position
101
+
102
+        select case (lexer%current_char)
103
+        case ('0':'9', '.')
104
+            token = read_number(lexer)
105
+        case ('a':'z', 'A':'Z', '_')
106
+            token = read_identifier(lexer)
107
+        case ('(')
108
+            token%token_type = TOKEN_LPAREN
109
+            token%text = '('
110
+            call advance(lexer)
111
+        case (')')
112
+            token%token_type = TOKEN_RPAREN
113
+            token%text = ')'
114
+            call advance(lexer)
115
+        case ('[')
116
+            token%token_type = TOKEN_LBRACKET
117
+            token%text = '['
118
+            call advance(lexer)
119
+        case (']')
120
+            token%token_type = TOKEN_RBRACKET
121
+            token%text = ']'
122
+            call advance(lexer)
123
+        case (';')
124
+            token%token_type = TOKEN_SEMICOLON
125
+            token%text = ';'
126
+            call advance(lexer)
127
+        case (',')
128
+            token%token_type = TOKEN_COMMA
129
+            token%text = ','
130
+            call advance(lexer)
131
+        case (':')
132
+            token = read_colon_operator(lexer)
133
+        case ('+', '-', '/', '^', '=', '<', '>', '!')
134
+            token = read_operator(lexer)
135
+        case ('*')
136
+            token = read_power_or_multiply(lexer)
137
+        case default
138
+            ! Unknown character - create error token
139
+            token%token_type = TOKEN_EOF  ! We'll use this as error for now
140
+            token%text = lexer%current_char
141
+            call advance(lexer)
142
+        end select
143
+    end function next_token
144
+
145
+    !> Read a numeric token (integer or real)
146
+    function read_number(lexer) result(token)
147
+        type(lexer_state_t), intent(inout) :: lexer
148
+        type(token_t) :: token
149
+
150
+        integer :: start_pos
151
+        logical :: has_dot, has_exp
152
+
153
+        start_pos = lexer%position
154
+        has_dot = .false.
155
+        has_exp = .false.
156
+
157
+        ! Handle leading decimal point
158
+        if (lexer%current_char == '.') then
159
+            has_dot = .true.
160
+            call advance(lexer)
161
+            if (.not. is_digit(lexer%current_char)) then
162
+                ! Just a dot, not a number
163
+                token%token_type = TOKEN_OPERATOR
164
+                token%text = '.'
165
+                return
166
+            end if
167
+        end if
168
+
169
+        ! Read digits
170
+        do while (is_digit(lexer%current_char))
171
+            call advance(lexer)
172
+        end do
173
+
174
+        ! Handle decimal point
175
+        if (lexer%current_char == '.' .and. .not. has_dot) then
176
+            has_dot = .true.
177
+            call advance(lexer)
178
+            do while (is_digit(lexer%current_char))
179
+                call advance(lexer)
180
+            end do
181
+        end if
182
+
183
+        ! Handle scientific notation
184
+        if ((lexer%current_char == 'e' .or. lexer%current_char == 'E') .and. .not. has_exp) then
185
+            has_exp = .true.
186
+            call advance(lexer)
187
+            if (lexer%current_char == '+' .or. lexer%current_char == '-') then
188
+                call advance(lexer)
189
+            end if
190
+            do while (is_digit(lexer%current_char))
191
+                call advance(lexer)
192
+            end do
193
+        end if
194
+
195
+        token%token_type = TOKEN_NUMBER
196
+        token%text = lexer%input(start_pos:lexer%position-1)
197
+    end function read_number
198
+
199
+    !> Read an identifier or keyword
200
+    function read_identifier(lexer) result(token)
201
+        type(lexer_state_t), intent(inout) :: lexer
202
+        type(token_t) :: token
203
+
204
+        integer :: start_pos
205
+
206
+        start_pos = lexer%position
207
+
208
+        ! Read alphanumeric characters and underscores
209
+        do while (is_alphanumeric(lexer%current_char))
210
+            call advance(lexer)
211
+        end do
212
+
213
+        token%token_type = TOKEN_IDENTIFIER
214
+        token%text = lexer%input(start_pos:lexer%position-1)
215
+    end function read_identifier
216
+
217
+    !> Read colon-based operators (: := ::)
218
+    function read_colon_operator(lexer) result(token)
219
+        type(lexer_state_t), intent(inout) :: lexer
220
+        type(token_t) :: token
221
+
222
+        integer :: start_pos
223
+
224
+        start_pos = lexer%position
225
+        call advance(lexer)  ! Skip first ':'
226
+
227
+        if (lexer%current_char == '=') then
228
+            ! Assignment operator :=
229
+            call advance(lexer)
230
+            token%token_type = TOKEN_ASSIGN
231
+            token%text = ':='
232
+        else if (lexer%current_char == ':') then
233
+            ! Precision operator ::
234
+            call advance(lexer)
235
+            token%token_type = TOKEN_PRECISION
236
+            token%text = '::'
237
+        else
238
+            ! Just a colon (should be an error in math expressions)
239
+            token%token_type = TOKEN_OPERATOR
240
+            token%text = ':'
241
+        end if
242
+    end function read_colon_operator
243
+
244
+    !> Read mathematical operators
245
+    function read_operator(lexer) result(token)
246
+        type(lexer_state_t), intent(inout) :: lexer
247
+        type(token_t) :: token
248
+
249
+        integer :: start_pos
250
+
251
+        start_pos = lexer%position
252
+
253
+        select case (lexer%current_char)
254
+        case ('+', '-', '/', '^')
255
+            token%text = lexer%current_char
256
+            call advance(lexer)
257
+        case ('*')
258
+            call advance(lexer)
259
+            if (lexer%current_char == '*') then
260
+                ! Power operator **
261
+                call advance(lexer)
262
+                token%text = '**'
263
+            else
264
+                token%text = '*'
265
+            end if
266
+        case ('=')
267
+            call advance(lexer)
268
+            if (lexer%current_char == '=') then
269
+                call advance(lexer)
270
+                token%text = '=='
271
+            else
272
+                token%text = '='
273
+            end if
274
+        case ('<')
275
+            call advance(lexer)
276
+            if (lexer%current_char == '=') then
277
+                call advance(lexer)
278
+                token%text = '<='
279
+            else
280
+                token%text = '<'
281
+            end if
282
+        case ('>')
283
+            call advance(lexer)
284
+            if (lexer%current_char == '=') then
285
+                call advance(lexer)
286
+                token%text = '>='
287
+            else
288
+                token%text = '>'
289
+            end if
290
+        case ('!')
291
+            call advance(lexer)
292
+            if (lexer%current_char == '=') then
293
+                call advance(lexer)
294
+                token%text = '!='
295
+            else
296
+                token%text = '!'
297
+            end if
298
+        case default
299
+            token%text = lexer%current_char
300
+            call advance(lexer)
301
+        end select
302
+
303
+        token%token_type = TOKEN_OPERATOR
304
+    end function read_operator
305
+
306
+    !> Handle * vs ** power operator
307
+    function read_power_or_multiply(lexer) result(token)
308
+        type(lexer_state_t), intent(inout) :: lexer
309
+        type(token_t) :: token
310
+
311
+        call advance(lexer)  ! Skip first '*'
312
+
313
+        if (lexer%current_char == '*') then
314
+            ! Power operator **
315
+            call advance(lexer)
316
+            token%token_type = TOKEN_OPERATOR
317
+            token%text = '**'
318
+        else
319
+            ! Multiply operator *
320
+            token%token_type = TOKEN_OPERATOR
321
+            token%text = '*'
322
+        end if
323
+    end function read_power_or_multiply
324
+
325
+    !> Skip whitespace characters
326
+    subroutine skip_whitespace(lexer)
327
+        type(lexer_state_t), intent(inout) :: lexer
328
+
329
+        do while (is_whitespace(lexer%current_char) .and. lexer%position <= lexer%length)
330
+            call advance(lexer)
331
+        end do
332
+    end subroutine skip_whitespace
333
+
334
+    !> Advance to the next character
335
+    subroutine advance(lexer)
336
+        type(lexer_state_t), intent(inout) :: lexer
337
+
338
+        lexer%position = lexer%position + 1
339
+        if (lexer%position <= lexer%length) then
340
+            lexer%current_char = lexer%input(lexer%position:lexer%position)
341
+        else
342
+            lexer%current_char = char(0)  ! EOF marker
343
+        end if
344
+    end subroutine advance
345
+
346
+    !> Check if character is a digit
347
+    logical function is_digit(c)
348
+        character, intent(in) :: c
349
+        is_digit = (c >= '0' .and. c <= '9')
350
+    end function is_digit
351
+
352
+    !> Check if character is alphabetic
353
+    logical function is_alpha(c)
354
+        character, intent(in) :: c
355
+        is_alpha = (c >= 'a' .and. c <= 'z') .or. (c >= 'A' .and. c <= 'Z') .or. c == '_'
356
+    end function is_alpha
357
+
358
+    !> Check if character is alphanumeric
359
+    logical function is_alphanumeric(c)
360
+        character, intent(in) :: c
361
+        is_alphanumeric = is_alpha(c) .or. is_digit(c)
362
+    end function is_alphanumeric
363
+
364
+    !> Check if character is whitespace
365
+    logical function is_whitespace(c)
366
+        character, intent(in) :: c
367
+        is_whitespace = (c == ' ' .or. c == char(9) .or. c == char(10) .or. c == char(13))
368
+    end function is_whitespace
369
+
370
+    !> Resize token array
371
+    subroutine resize_token_array(tokens, new_size)
372
+        type(token_t), allocatable, intent(inout) :: tokens(:)
373
+        integer, intent(in) :: new_size
374
+
375
+        type(token_t), allocatable :: temp(:)
376
+        integer :: old_size
377
+
378
+        if (.not. allocated(tokens)) then
379
+            allocate(tokens(new_size))
380
+            return
381
+        end if
382
+
383
+        old_size = size(tokens)
384
+        if (new_size == old_size) return
385
+
386
+        allocate(temp(min(old_size, new_size)))
387
+        temp = tokens(1:min(old_size, new_size))
388
+
389
+        deallocate(tokens)
390
+        allocate(tokens(new_size))
391
+
392
+        if (new_size >= old_size) then
393
+            tokens(1:old_size) = temp
394
+        else
395
+            tokens = temp(1:new_size)
396
+        end if
397
+
398
+        deallocate(temp)
399
+    end subroutine resize_token_array
400
+
401
+    !> Free token array memory
402
+    subroutine free_tokens(tokens)
403
+        type(token_t), allocatable, intent(inout) :: tokens(:)
404
+
405
+        if (allocated(tokens)) deallocate(tokens)
406
+    end subroutine free_tokens
407
+
408
+    !> Print tokens for debugging
409
+    subroutine print_tokens(tokens)
410
+        type(token_t), intent(in) :: tokens(:)
411
+        integer :: i
412
+
413
+        write(*, '(A)') 'Tokens:'
414
+        do i = 1, size(tokens)
415
+            if (tokens(i)%token_type == TOKEN_EOF) then
416
+                write(*, '(A,I0,A)') '  [', i, '] EOF'
417
+                exit
418
+            end if
419
+            write(*, '(A,I0,A,A,A,A,A,I0)') '  [', i, '] ', &
420
+                get_token_type_name(tokens(i)%token_type), ' "', &
421
+                tokens(i)%text, '" @', tokens(i)%position
422
+        end do
423
+    end subroutine print_tokens
424
+
425
+    !> Get human-readable token type name
426
+    function get_token_type_name(token_type) result(name)
427
+        integer, intent(in) :: token_type
428
+        character(len=12) :: name
429
+
430
+        select case (token_type)
431
+        case (TOKEN_EOF)
432
+            name = 'EOF'
433
+        case (TOKEN_NUMBER)
434
+            name = 'NUMBER'
435
+        case (TOKEN_IDENTIFIER)
436
+            name = 'IDENTIFIER'
437
+        case (TOKEN_OPERATOR)
438
+            name = 'OPERATOR'
439
+        case (TOKEN_LPAREN)
440
+            name = 'LPAREN'
441
+        case (TOKEN_RPAREN)
442
+            name = 'RPAREN'
443
+        case (TOKEN_LBRACKET)
444
+            name = 'LBRACKET'
445
+        case (TOKEN_RBRACKET)
446
+            name = 'RBRACKET'
447
+        case (TOKEN_SEMICOLON)
448
+            name = 'SEMICOLON'
449
+        case (TOKEN_COMMA)
450
+            name = 'COMMA'
451
+        case (TOKEN_ASSIGN)
452
+            name = 'ASSIGN'
453
+        case (TOKEN_PRECISION)
454
+            name = 'PRECISION'
455
+        case default
456
+            name = 'UNKNOWN'
457
+        end select
458
+    end function get_token_type_name
459
+
460
+end module fortbite_lexer_m
src/fortbite_parser_m.f90added
@@ -0,0 +1,399 @@
1
+!> Recursive descent parser module for FORTBITE
2
+!>
3
+!> Parses tokenized mathematical expressions into Abstract Syntax Trees
4
+!> with proper PEMDAS/BEMDAS operator precedence.
5
+module fortbite_parser_m
6
+    use fortbite_types_m, only: token_t, value_t, TOKEN_EOF, TOKEN_NUMBER, TOKEN_IDENTIFIER, &
7
+                               TOKEN_OPERATOR, TOKEN_LPAREN, TOKEN_RPAREN, &
8
+                               TOKEN_LBRACKET, TOKEN_RBRACKET, TOKEN_SEMICOLON, &
9
+                               TOKEN_COMMA, TOKEN_ASSIGN, TOKEN_PRECISION, &
10
+                               create_scalar, create_complex
11
+    use fortbite_ast_m, only: ast_node_t, AST_LITERAL, AST_IDENTIFIER, AST_BINARY_OP, &
12
+                             AST_UNARY_OP, AST_FUNCTION_CALL, AST_ASSIGNMENT, AST_PRECISION_SPEC, &
13
+                             OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_POW, OP_MOD, &
14
+                             OP_UNARY_PLUS, OP_UNARY_MINUS, &
15
+                             create_literal_node, create_identifier_node, create_binary_node, &
16
+                             create_unary_node, create_function_node, create_assignment_node, &
17
+                             create_precision_node, free_ast
18
+    use iso_fortran_env, only: real64
19
+    implicit none
20
+    private
21
+
22
+    public :: parse_expression, parse_error_t
23
+
24
+    !> Parser state
25
+    type :: parser_state_t
26
+        type(token_t), pointer :: tokens(:)
27
+        integer :: position
28
+        integer :: token_count
29
+        type(token_t) :: current_token
30
+        logical :: has_error
31
+        character(len=200) :: error_message
32
+    end type parser_state_t
33
+
34
+    !> Parse error information
35
+    type :: parse_error_t
36
+        logical :: has_error
37
+        character(len=200) :: message
38
+        integer :: position
39
+    end type parse_error_t
40
+
41
+contains
42
+
43
+    !> Parse a mathematical expression from tokens
44
+    function parse_expression(tokens, error) result(root)
45
+        type(token_t), target, intent(in) :: tokens(:)
46
+        type(parse_error_t), intent(out), optional :: error
47
+        type(ast_node_t), pointer :: root
48
+
49
+        type(parser_state_t) :: parser
50
+
51
+        ! Initialize parser state
52
+        parser%tokens => tokens
53
+        parser%token_count = size(tokens)
54
+        parser%position = 1
55
+        parser%has_error = .false.
56
+        parser%error_message = ''
57
+
58
+        if (parser%token_count > 0) then
59
+            parser%current_token = parser%tokens(1)
60
+        else
61
+            parser%current_token%token_type = TOKEN_EOF
62
+        end if
63
+
64
+        ! Parse the expression (start with assignment level)
65
+        root => parse_assignment(parser)
66
+
67
+        ! Check for unexpected tokens at the end
68
+        if (.not. parser%has_error .and. parser%current_token%token_type /= TOKEN_EOF) then
69
+            call set_error(parser, 'Unexpected token after expression')
70
+        end if
71
+
72
+        ! Return error information if requested
73
+        if (present(error)) then
74
+            error%has_error = parser%has_error
75
+            error%message = parser%error_message
76
+            error%position = parser%position
77
+        end if
78
+
79
+        ! If there was an error, clean up and return null
80
+        if (parser%has_error .and. associated(root)) then
81
+            call free_ast(root)
82
+        end if
83
+    end function parse_expression
84
+
85
+    !> Parse assignment expressions (lowest precedence)
86
+    recursive function parse_assignment(parser) result(node)
87
+        type(parser_state_t), intent(inout) :: parser
88
+        type(ast_node_t), pointer :: node
89
+
90
+        character(len=:), allocatable :: var_name
91
+        type(ast_node_t), pointer :: expr_node
92
+
93
+        node => parse_logical_or(parser)
94
+
95
+        ! Check for assignment operator
96
+        if (.not. parser%has_error .and. parser%current_token%token_type == TOKEN_ASSIGN) then
97
+            ! Left side must be an identifier
98
+            if (.not. associated(node) .or. node%node_type /= AST_IDENTIFIER) then
99
+                call set_error(parser, 'Left side of assignment must be a variable name')
100
+                return
101
+            end if
102
+
103
+            var_name = node%identifier
104
+            call free_ast(node)  ! Clean up the identifier node
105
+
106
+            call advance(parser)  ! Skip ':='
107
+            expr_node => parse_assignment(parser)  ! Right-associative
108
+
109
+            if (.not. parser%has_error) then
110
+                node => create_assignment_node(var_name, expr_node)
111
+            end if
112
+        end if
113
+    end function parse_assignment
114
+
115
+    !> Parse logical OR expressions (placeholder for future boolean logic)
116
+    function parse_logical_or(parser) result(node)
117
+        type(parser_state_t), intent(inout) :: parser
118
+        type(ast_node_t), pointer :: node
119
+
120
+        ! For now, just pass through to the next level
121
+        node => parse_logical_and(parser)
122
+    end function parse_logical_or
123
+
124
+    !> Parse logical AND expressions (placeholder for future boolean logic)
125
+    function parse_logical_and(parser) result(node)
126
+        type(parser_state_t), intent(inout) :: parser
127
+        type(ast_node_t), pointer :: node
128
+
129
+        ! For now, just pass through to the next level
130
+        node => parse_equality(parser)
131
+    end function parse_logical_and
132
+
133
+    !> Parse equality expressions (placeholder for future comparisons)
134
+    function parse_equality(parser) result(node)
135
+        type(parser_state_t), intent(inout) :: parser
136
+        type(ast_node_t), pointer :: node
137
+
138
+        ! For now, just pass through to the next level
139
+        node => parse_relational(parser)
140
+    end function parse_equality
141
+
142
+    !> Parse relational expressions (placeholder for future comparisons)
143
+    function parse_relational(parser) result(node)
144
+        type(parser_state_t), intent(inout) :: parser
145
+        type(ast_node_t), pointer :: node
146
+
147
+        ! For now, just pass through to the next level
148
+        node => parse_additive(parser)
149
+    end function parse_relational
150
+
151
+    !> Parse additive expressions (+ and -)
152
+    function parse_additive(parser) result(node)
153
+        type(parser_state_t), intent(inout) :: parser
154
+        type(ast_node_t), pointer :: node
155
+
156
+        type(ast_node_t), pointer :: right_node
157
+        integer :: op
158
+
159
+        node => parse_multiplicative(parser)
160
+
161
+        do while (.not. parser%has_error .and. parser%current_token%token_type == TOKEN_OPERATOR)
162
+            select case (parser%current_token%text)
163
+            case ('+')
164
+                op = OP_ADD
165
+            case ('-')
166
+                op = OP_SUB
167
+            case default
168
+                exit  ! Not an additive operator
169
+            end select
170
+
171
+            call advance(parser)
172
+            right_node => parse_multiplicative(parser)
173
+
174
+            if (.not. parser%has_error) then
175
+                node => create_binary_node(op, node, right_node)
176
+            end if
177
+        end do
178
+    end function parse_additive
179
+
180
+    !> Parse multiplicative expressions (*, /, mod)
181
+    function parse_multiplicative(parser) result(node)
182
+        type(parser_state_t), intent(inout) :: parser
183
+        type(ast_node_t), pointer :: node
184
+
185
+        type(ast_node_t), pointer :: right_node
186
+        integer :: op
187
+
188
+        node => parse_power(parser)
189
+
190
+        do while (.not. parser%has_error .and. parser%current_token%token_type == TOKEN_OPERATOR)
191
+            select case (parser%current_token%text)
192
+            case ('*')
193
+                op = OP_MUL
194
+            case ('/')
195
+                op = OP_DIV
196
+            case default
197
+                ! Check for 'mod' identifier used as operator
198
+                if (parser%current_token%token_type == TOKEN_IDENTIFIER .and. &
199
+                    parser%current_token%text == 'mod') then
200
+                    op = OP_MOD
201
+                else
202
+                    exit  ! Not a multiplicative operator
203
+                end if
204
+            end select
205
+
206
+            call advance(parser)
207
+            right_node => parse_power(parser)
208
+
209
+            if (.not. parser%has_error) then
210
+                node => create_binary_node(op, node, right_node)
211
+            end if
212
+        end do
213
+    end function parse_multiplicative
214
+
215
+    !> Parse power expressions (** or ^) - right associative
216
+    recursive function parse_power(parser) result(node)
217
+        type(parser_state_t), intent(inout) :: parser
218
+        type(ast_node_t), pointer :: node
219
+
220
+        type(ast_node_t), pointer :: right_node
221
+
222
+        node => parse_unary(parser)
223
+
224
+        ! Right associative: a^b^c = a^(b^c)
225
+        if (.not. parser%has_error .and. parser%current_token%token_type == TOKEN_OPERATOR) then
226
+            select case (parser%current_token%text)
227
+            case ('**', '^')
228
+                call advance(parser)
229
+                right_node => parse_power(parser)  ! Right associative recursion
230
+
231
+                if (.not. parser%has_error) then
232
+                    node => create_binary_node(OP_POW, node, right_node)
233
+                end if
234
+            end select
235
+        end if
236
+    end function parse_power
237
+
238
+    !> Parse unary expressions (+, -)
239
+    recursive function parse_unary(parser) result(node)
240
+        type(parser_state_t), intent(inout) :: parser
241
+        type(ast_node_t), pointer :: node
242
+
243
+        type(ast_node_t), pointer :: operand_node
244
+        integer :: op
245
+
246
+        if (parser%current_token%token_type == TOKEN_OPERATOR) then
247
+            select case (parser%current_token%text)
248
+            case ('+')
249
+                op = OP_UNARY_PLUS
250
+                call advance(parser)
251
+                operand_node => parse_unary(parser)  ! Right associative
252
+                node => create_unary_node(op, operand_node)
253
+                return
254
+            case ('-')
255
+                op = OP_UNARY_MINUS
256
+                call advance(parser)
257
+                operand_node => parse_unary(parser)  ! Right associative
258
+                node => create_unary_node(op, operand_node)
259
+                return
260
+            end select
261
+        end if
262
+
263
+        node => parse_postfix(parser)
264
+    end function parse_unary
265
+
266
+    !> Parse postfix expressions (precision specifiers)
267
+    function parse_postfix(parser) result(node)
268
+        type(parser_state_t), intent(inout) :: parser
269
+        type(ast_node_t), pointer :: node
270
+
271
+        integer :: precision
272
+
273
+        node => parse_primary(parser)
274
+
275
+        ! Handle precision specification (::)
276
+        if (.not. parser%has_error .and. parser%current_token%token_type == TOKEN_PRECISION) then
277
+            call advance(parser)  ! Skip '::'
278
+
279
+            if (parser%current_token%token_type == TOKEN_NUMBER) then
280
+                read(parser%current_token%text, *) precision
281
+                call advance(parser)
282
+                node => create_precision_node(node, precision)
283
+            else
284
+                call set_error(parser, 'Expected precision digits after ::')
285
+            end if
286
+        end if
287
+    end function parse_postfix
288
+
289
+    !> Parse primary expressions (literals, identifiers, parentheses, functions)
290
+    function parse_primary(parser) result(node)
291
+        type(parser_state_t), intent(inout) :: parser
292
+        type(ast_node_t), pointer :: node
293
+
294
+        real(real64) :: num_val
295
+        type(value_t) :: value
296
+        character(len=:), allocatable :: func_name
297
+        type(ast_node_t), pointer :: args(:)
298
+        type(ast_node_t), pointer :: temp_nodes(:)
299
+        integer :: arg_count, i
300
+
301
+        select case (parser%current_token%token_type)
302
+        case (TOKEN_NUMBER)
303
+            ! Parse number literal
304
+            read(parser%current_token%text, *) num_val
305
+            value = create_scalar(num_val)
306
+            node => create_literal_node(value)
307
+            call advance(parser)
308
+
309
+        case (TOKEN_IDENTIFIER)
310
+            func_name = parser%current_token%text
311
+            call advance(parser)
312
+
313
+            if (parser%current_token%token_type == TOKEN_LPAREN) then
314
+                ! Function call
315
+                call advance(parser)  ! Skip '('
316
+
317
+                ! For now, only support zero-argument functions to get the build working
318
+                if (parser%current_token%token_type == TOKEN_RPAREN) then
319
+                    call advance(parser)  ! Skip ')'
320
+                    node => create_function_node(func_name)
321
+                else
322
+                    call set_error(parser, 'Function arguments not yet fully implemented')
323
+                end if
324
+            else
325
+                ! Variable identifier
326
+                node => create_identifier_node(func_name)
327
+            end if
328
+
329
+        case (TOKEN_LPAREN)
330
+            ! Parenthesized expression
331
+            call advance(parser)  ! Skip '('
332
+            node => parse_assignment(parser)
333
+
334
+            if (parser%current_token%token_type == TOKEN_RPAREN) then
335
+                call advance(parser)  ! Skip ')'
336
+            else
337
+                call set_error(parser, 'Expected closing parenthesis')
338
+            end if
339
+
340
+        case default
341
+            call set_error(parser, 'Unexpected token in expression')
342
+        end select
343
+    end function parse_primary
344
+
345
+    !> Count function arguments (helper for argument parsing)
346
+    subroutine count_function_args(parser, count)
347
+        type(parser_state_t), intent(inout) :: parser
348
+        integer, intent(out) :: count
349
+
350
+        integer :: saved_pos, paren_depth
351
+        type(token_t) :: saved_token
352
+
353
+        ! Save parser state
354
+        saved_pos = parser%position
355
+        saved_token = parser%current_token
356
+
357
+        count = 1  ! At least one argument
358
+        paren_depth = 0
359
+
360
+        do while (parser%current_token%token_type /= TOKEN_EOF)
361
+            select case (parser%current_token%token_type)
362
+            case (TOKEN_LPAREN)
363
+                paren_depth = paren_depth + 1
364
+            case (TOKEN_RPAREN)
365
+                if (paren_depth == 0) exit  ! End of argument list
366
+                paren_depth = paren_depth - 1
367
+            case (TOKEN_COMMA)
368
+                if (paren_depth == 0) count = count + 1
369
+            end select
370
+            call advance(parser)
371
+        end do
372
+
373
+        ! Restore parser state
374
+        parser%position = saved_pos
375
+        parser%current_token = saved_token
376
+    end subroutine count_function_args
377
+
378
+    !> Advance to the next token
379
+    subroutine advance(parser)
380
+        type(parser_state_t), intent(inout) :: parser
381
+
382
+        if (parser%position < parser%token_count) then
383
+            parser%position = parser%position + 1
384
+            parser%current_token = parser%tokens(parser%position)
385
+        else
386
+            parser%current_token%token_type = TOKEN_EOF
387
+        end if
388
+    end subroutine advance
389
+
390
+    !> Set a parse error
391
+    subroutine set_error(parser, message)
392
+        type(parser_state_t), intent(inout) :: parser
393
+        character(len=*), intent(in) :: message
394
+
395
+        parser%has_error = .true.
396
+        parser%error_message = trim(message)
397
+    end subroutine set_error
398
+
399
+end module fortbite_parser_m