fortbite Public

Watch 0 Fork 0 Star 0
Fortran · 11533 bytes Raw Blame History
1 !> I/O and REPL interface module for FORTBITE
2 !>
3 !> Handles user input/output, command processing, and the main REPL loop.
4 module fortbite_io_m
5 use fortbite_precision_m, only: get_precision_info, precision_info_t
6 use iso_fortran_env, only: real32, real64, real128
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
13 implicit none
14 private
15
16 public :: repl_loop, print_banner, print_help
17 public :: parse_command, is_command
18
19 ! Maximum input line length
20 integer, parameter :: MAX_LINE_LENGTH = 1000
21
22 contains
23
24 !> Print the FORTBITE banner
25 subroutine print_banner()
26 write(*, '(A)') ''
27 write(*, '(A)') '======================================'
28 write(*, '(A)') ' FORTBITE '
29 write(*, '(A)') ' High-Precision Calculator '
30 write(*, '(A)') ' Modern Fortran Edition '
31 write(*, '(A)') '======================================'
32 write(*, '(A)') ''
33 write(*, '(A)') 'Type "help" for commands or "exit" to quit.'
34 write(*, '(A)') 'Use :: for precision (e.g., 3.14159::100)'
35 write(*, '(A)') 'Use := for assignment (e.g., x := 42)'
36 write(*, '(A)') ''
37 end subroutine print_banner
38
39 !> Print help information
40 subroutine print_help()
41 type(precision_info_t) :: info
42
43 write(*, '(A)') 'FORTBITE Commands:'
44 write(*, '(A)') ' Basic arithmetic: +, -, *, /, ** (power)'
45 write(*, '(A)') ' Variables: x := value'
46 write(*, '(A)') ' Precision: value::digits (e.g., pi::50)'
47 write(*, '(A)') ' Complex: 3+4i, (3,4), cmplx(3,4)'
48 write(*, '(A)') ' Functions: sin, cos, tan, log, exp, sqrt, abs'
49 write(*, '(A)') ' Constants: pi, e, i'
50 write(*, '(A)') ' Matrices: [1,2;3,4], zeros(3,3), ones(2,2)'
51 write(*, '(A)') ' Commands: help, exit, clear, precision, info'
52 write(*, '(A)') ''
53
54 ! Show current precision info
55 info = get_precision_info(real64)
56 write(*, '(A,A)') 'Current precision: ', trim(info%name)
57 write(*, '(A,I0,A)') 'Decimal digits: ', info%decimal_digits, ''
58 write(*, '(A,I0,A)') 'Exponent range: ±', info%exponent_range, ''
59 write(*, '(A)') ''
60 end subroutine print_help
61
62 !> Check if input is a command
63 logical function is_command(input)
64 character(len=*), intent(in) :: input
65 character(len=len_trim(input)) :: trimmed_input
66
67 trimmed_input = trim(adjustl(input))
68
69 if (len_trim(trimmed_input) == 0) then
70 is_command = .false.
71 return
72 end if
73
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)
81
82 ! Everything else is treated as a mathematical expression
83 end function is_command
84
85 !> Parse and execute a command
86 logical function parse_command(input, variables) result(continue_repl)
87 character(len=*), intent(in) :: input
88 type(variable_t), pointer, intent(inout) :: variables
89
90 character(len=len_trim(input)) :: command
91 character(len=100) :: arg
92 integer :: space_pos
93
94 continue_repl = .true.
95 command = trim(adjustl(input))
96
97 ! Split command and arguments
98 space_pos = index(command, ' ')
99 if (space_pos > 0) then
100 arg = command(space_pos+1:)
101 command = command(1:space_pos-1)
102 else
103 arg = ''
104 end if
105
106 ! Convert to lowercase for case-insensitive commands
107 call to_lowercase(command)
108
109 select case (trim(command))
110 case ('help', 'h', '?')
111 call print_help()
112
113 case ('exit', 'quit', 'q')
114 write(*, '(A)') 'Goodbye!'
115 continue_repl = .false.
116
117 case ('clear', 'cls')
118 call clear_screen()
119
120 case ('precision')
121 call handle_precision_command(arg)
122
123 case ('info')
124 call show_system_info()
125
126 case ('vars', 'variables')
127 call show_variables(variables)
128
129 case default
130 write(*, '(A,A,A)') 'Unknown command: "', trim(command), '"'
131 write(*, '(A)') 'Type "help" for available commands.'
132 end select
133 end function parse_command
134
135 !> Main REPL (Read-Eval-Print Loop)
136 subroutine repl_loop()
137 character(len=MAX_LINE_LENGTH) :: input
138 type(variable_t), pointer :: variables => null()
139 type(evaluation_context_t) :: context
140 logical :: continue_loop
141 integer :: ios
142
143 call print_banner()
144 context = create_context()
145 continue_loop = .true.
146
147 do while (continue_loop)
148 write(*, '(A)', advance='no') 'fortbite> '
149 read(*, '(A)', iostat=ios) input
150
151 if (ios /= 0) then
152 ! Handle end of file (Ctrl+D)
153 write(*, *)
154 write(*, '(A)') 'Goodbye!'
155 exit
156 end if
157
158 ! Skip empty lines
159 if (len_trim(input) == 0) cycle
160
161 if (is_command(input)) then
162 continue_loop = parse_command(input, variables)
163 else
164 ! Handle mathematical expression
165 call evaluate_math_expression(trim(input), context)
166 end if
167 end do
168
169 ! Clean up
170 call destroy_context(context)
171 call cleanup_variables(variables)
172 end subroutine repl_loop
173
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
212 !> Convert string to lowercase
213 subroutine to_lowercase(str)
214 character(len=*), intent(inout) :: str
215 integer :: i
216
217 do i = 1, len(str)
218 if (str(i:i) >= 'A' .and. str(i:i) <= 'Z') then
219 str(i:i) = achar(iachar(str(i:i)) + 32)
220 end if
221 end do
222 end subroutine to_lowercase
223
224 !> Clear the screen (ANSI escape codes)
225 subroutine clear_screen()
226 write(*, '(A)') achar(27) // '[2J' // achar(27) // '[H'
227 end subroutine clear_screen
228
229 !> Handle precision command
230 subroutine handle_precision_command(arg)
231 character(len=*), intent(in) :: arg
232 type(precision_info_t) :: info
233 integer :: precision_digits, ios
234
235 if (len_trim(arg) == 0) then
236 ! Show current precision
237 info = get_precision_info(real64)
238 write(*, '(A,A)') 'Current precision: ', trim(info%name)
239 write(*, '(A,I0)') 'Decimal digits: ', info%decimal_digits
240 write(*, '(A,I0)') 'Exponent range: ±', info%exponent_range
241 else
242 ! Set new precision
243 read(arg, *, iostat=ios) precision_digits
244 if (ios == 0 .and. precision_digits > 0) then
245 write(*, '(A,I0,A)') 'Setting precision to ', precision_digits, ' decimal digits...'
246 write(*, '(A)') '(Note: Precision changes will be implemented in Phase 2)'
247 else
248 write(*, '(A)') 'Invalid precision specification. Use: precision <digits>'
249 end if
250 end if
251 end subroutine handle_precision_command
252
253 !> Show system information
254 subroutine show_system_info()
255 type(precision_info_t) :: info
256
257 write(*, '(A)') 'FORTBITE System Information:'
258 write(*, '(A)') ' Version: 1.0.0'
259 write(*, '(A)') ' Language: Modern Fortran'
260 write(*, '(A)') ''
261
262 write(*, '(A)') 'Available Precisions:'
263
264 info = get_precision_info(real32)
265 write(*, '(A,I0,A)') ' Single: ', precision(1.0_real32), ' digits'
266
267 info = get_precision_info(real64)
268 write(*, '(A,I0,A)') ' Double: ', precision(1.0_real64), ' digits'
269
270 ! Only show quad if available
271 if (real128 > 0) then
272 info = get_precision_info(real128)
273 write(*, '(A,I0,A)') ' Quad: ', precision(1.0_real128), ' digits'
274 end if
275
276 write(*, '(A)') ''
277 end subroutine show_system_info
278
279 !> Show current variables
280 subroutine show_variables(variables)
281 type(variable_t), pointer, intent(in) :: variables
282 type(variable_t), pointer :: current
283
284 current => variables
285
286 if (.not. associated(current)) then
287 write(*, '(A)') 'No variables defined.'
288 return
289 end if
290
291 write(*, '(A)') 'Current variables:'
292 do while (associated(current))
293 write(*, '(A,A,A)', advance='no') ' ', current%name, ' = '
294 call print_value(current%value)
295 current => current%next
296 end do
297 end subroutine show_variables
298
299 !> Clean up variable linked list
300 subroutine cleanup_variables(variables)
301 type(variable_t), pointer, intent(inout) :: variables
302 type(variable_t), pointer :: current, next
303
304 current => variables
305 do while (associated(current))
306 next => current%next
307 deallocate(current)
308 current => next
309 end do
310 nullify(variables)
311 end subroutine cleanup_variables
312
313 end module fortbite_io_m