From 4c3ddf6dc38ed885a3cca0193a7568e774055f9d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 8 Jun 2024 11:53:48 -0400 Subject: [PATCH 001/137] wip, parse struct declarations --- samples/struct.syntran | 46 +++++++++++++++++++++++ src/consts.f90 | 12 +++++- src/eval.f90 | 6 +-- src/lex.f90 | 3 ++ src/parse.f90 | 6 +++ src/parse_fn.f90 | 85 ++++++++++++++++++++++++++++++++++++++++++ src/parse_misc.f90 | 2 + src/types.f90 | 3 ++ 8 files changed, 159 insertions(+), 4 deletions(-) create mode 100644 samples/struct.syntran diff --git a/samples/struct.syntran b/samples/struct.syntran new file mode 100644 index 00000000..1b38cf32 --- /dev/null +++ b/samples/struct.syntran @@ -0,0 +1,46 @@ + +let hh_glbl = 0; +let mm_glbl = 0; +let ss_glbl = 0.0; + +//******** +struct time +{ + hh: i32, + mm: i32, + ss: f32, // trailing comma is optional +} +//let t1 = time{hh = 9, mm = 20, ss = 0.030,}; +//t1.hh = 10; +//println("t1 = ", t1); +//fn print_time(t: time) +//{ +// println("h = ", t.hh); +// println("m = ", t.mm); +// println("s = ", t.ss); +// return; +//} +//******** + +fn set_time_glbl(h: i32, m: i32, s:f32) +{ + hh_glbl = h; + mm_glbl = m; + ss_glbl = s; + return; +} + +fn print_time_glbl() +{ + //println(hh_glbl, ":", mm_glbl, ":", ss_glbl); + println("h = ", hh_glbl); + println("m = ", mm_glbl); + println("s = ", ss_glbl); + return; +} + +set_time_glbl(10, 20, 0.030); +print_time_glbl(); + +return 0; + diff --git a/src/consts.f90 b/src/consts.f90 index c609bba6..7e050d51 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -9,12 +9,16 @@ module syntran__consts_m integer :: maxerr ! TODO: move this (not default) into a settings struct that gets passed around integer, parameter :: maxerr_def = 4 - ! Must be larger than largest token enum below + ! Must be larger than largest token enum below. TODO: add an init check for + ! this integer, parameter :: magic = 128 ! Token and syntax node kinds enum. Is there a better way to do this that ! allows re-ordering enums? Currently it would break kind_name() integer, parameter :: & + struct_declaration = 95, & + struct_keyword = 94, & + dot_token = 93, & return_statement = 92, & return_keyword = 91, & size_array = 90, & @@ -213,6 +217,9 @@ function kind_token(kind) "size_array ", & ! 90 "return ", & ! 91 "return statement ", & ! 92 + ". ", & ! 93 + "struct ", & ! 94 + "struct declaration ", & ! 95 "unknown " & ! inf ] @@ -326,6 +333,9 @@ function kind_name(kind) "size_array ", & ! 90 "return_keyword ", & ! 91 "return_statement ", & ! 92 + "comma_token ", & ! 93 + "struct_keyword ", & ! 94 + "struct_declaration ", & ! 95 "unknown " & ! inf (trailing comma hack) ] ! FIXME: update kind_tokens array too diff --git a/src/eval.f90 b/src/eval.f90 index a7011097..a5ea7432 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -1153,11 +1153,11 @@ subroutine eval_translation_unit(node, state, res) ! members only change the (vars) state or define fns do i = 1, size(node%members) - ! Only eval statements, not fns declarations. TODO: cycle structs - ! too. + ! Only eval statements, not fn or struct declarations ! ! TODO: is this where we should copy fn dict to array? - if (node%members(i)%kind == fn_declaration) cycle + if (node%members(i)%kind == fn_declaration ) cycle + if (node%members(i)%kind == struct_declaration) cycle call syntax_eval(node%members(i), state, res) diff --git a/src/lex.f90 b/src/lex.f90 index 70e64202..db5f82c1 100644 --- a/src/lex.f90 +++ b/src/lex.f90 @@ -329,6 +329,9 @@ function lex(lexer) result(token) case (",") token = new_token(comma_token, lexer%pos, lexer%current()) + case (".") + token = new_token(dot_token, lexer%pos, lexer%current()) + case ("#") token = new_token(hash_token, lexer%pos, lexer%current()) diff --git a/src/parse.f90 b/src/parse.f90 index 7a59713d..9b61f199 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -69,6 +69,7 @@ module syntran__parse_m parse_expr_statement, & parse_fn_call, & parse_fn_declaration, & + parse_struct_declaration, & parse_for_statement, & parse_if_statement, & parse_return_statement, & @@ -111,6 +112,11 @@ module subroutine parse_type(parser, type_text, rank) integer, intent(out) :: rank end subroutine parse_type + module function parse_struct_declaration(parser) result(decl) + class(parser_t) :: parser + type(syntax_node_t) :: decl + end function parse_struct_declaration + end interface !******** diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index f436b07b..336945d9 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -590,6 +590,91 @@ end function parse_fn_declaration !=============================================================================== +module function parse_struct_declaration(parser) result(decl) + + class(parser_t) :: parser + + type(syntax_node_t) :: decl + + !******** + + character(len = :), allocatable :: type_text + + integer :: pos0, rank + + type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & + colon, member, struct_kw + + !! TODO? + !call parser%vars%push_scope() + + struct_kw = parser%match(struct_keyword) + + identifier = parser%match(identifier_token) + print *, "parsing struct ", identifier%text + + lbrace = parser%match(lbrace_token) + + ! Structs use this syntax: + ! + ! struct time + ! { + ! hh: i32, + ! mm: i32, + ! ss: f32, + ! } + ! let t1 = time{hh = 9, mm = 20, ss = 0.030,}; + ! t1.hh = 10; + ! + ! A struct declaration is a lot like a fn declaration. Instead of a list of + ! fn parameters, we have a list of struct members. Unlike a fn declaration, + ! there is no "body" for a struct, only members. + + do while ( & + parser%current_kind() /= rbrace_token .and. & + parser%current_kind() /= eof_token) + + pos0 = parser%current_pos() + + !print *, 'matching member' + member = parser%match(identifier_token) + print *, "member = ", member%text + !print *, 'matching colon' + colon = parser%match(colon_token) + + call parser%parse_type(type_text, rank) + print *, "type = ", type_text + + !call member%push( member%text ) + !call types%push( type_text ) + !call ranks%push( rank ) + + !! This array is technically redundant but helps readability? + !call is_array%push( rank >= 0 ) + + if (parser%current_kind() /= rbrace_token) then + !print *, 'matching comma' + comma = parser%match(comma_token) + end if + + ! Break infinite loop + if (parser%current_pos() == pos0) dummy = parser%next() + + end do + + !print *, 'matching rbrace' + rbrace = parser%match(rbrace_token) + + ! TODO: insert struct into a new dict type + + decl%kind = struct_declaration + + print *, "done parsing struct" + +end function parse_struct_declaration + +!=============================================================================== + module subroutine parse_type(parser, type_text, rank) ! TODO: encapsulate out-args in struct if adding any more diff --git a/src/parse_misc.f90 b/src/parse_misc.f90 index d1427208..9ffc2012 100644 --- a/src/parse_misc.f90 +++ b/src/parse_misc.f90 @@ -380,6 +380,8 @@ module function parse_unit(parser) result(unit) if (parser%current_kind() == fn_keyword) then call members%push(parser%parse_fn_declaration()) + else if (parser%current_kind() == struct_keyword) then + call members%push(parser%parse_struct_declaration()) else call members%push(parser%parse_statement()) end if diff --git a/src/types.f90 b/src/types.f90 index 39b7cf0a..a9ed3568 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1162,6 +1162,9 @@ integer function get_keyword_kind(text) result(kind) case ("fn") kind = fn_keyword + case ("struct") + kind = struct_keyword + case ("include") kind = include_keyword From 3245ec3802449087e18710db735d0cbd0b76e2b4 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 8 Jun 2024 12:30:16 -0400 Subject: [PATCH 002/137] rename member to name --- src/parse_fn.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 336945d9..0df0ad63 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -603,7 +603,7 @@ module function parse_struct_declaration(parser) result(decl) integer :: pos0, rank type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & - colon, member, struct_kw + colon, name, struct_kw !! TODO? !call parser%vars%push_scope() @@ -636,16 +636,16 @@ module function parse_struct_declaration(parser) result(decl) pos0 = parser%current_pos() - !print *, 'matching member' - member = parser%match(identifier_token) - print *, "member = ", member%text + !print *, 'matching name' + name = parser%match(identifier_token) + print *, "name = ", name%text !print *, 'matching colon' colon = parser%match(colon_token) call parser%parse_type(type_text, rank) print *, "type = ", type_text - !call member%push( member%text ) + !call names%push( name%text ) !call types%push( type_text ) !call ranks%push( rank ) From 7ce31d7bf09907f1374bb1e41b84087c8f0b329a Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 8 Jun 2024 13:15:18 -0400 Subject: [PATCH 003/137] wip, save struct signature --- samples/struct.syntran | 12 ++++++ src/parse_fn.f90 | 94 ++++++++++++++++++++++++++++++++++++++---- src/types.f90 | 26 ++++++++++++ 3 files changed, 125 insertions(+), 7 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index 1b38cf32..ade45cdd 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -10,9 +10,13 @@ struct time mm: i32, ss: f32, // trailing comma is optional } + //let t1 = time{hh = 9, mm = 20, ss = 0.030,}; //t1.hh = 10; //println("t1 = ", t1); +// +//let t2 = time{hh = 13, mm = 37, ss = 0.069,}; +// //fn print_time(t: time) //{ // println("h = ", t.hh); @@ -20,6 +24,14 @@ struct time // println("s = ", t.ss); // return; //} + +struct date { + d: i32, + //m: stri, // err: bad type + m: str, + y: i64 +} + //******** fn set_time_glbl(h: i32, m: i32, s:f32) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 0df0ad63..40d9406e 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -465,7 +465,8 @@ module function parse_fn_declaration(parser) result(decl) if (itype == unknown_type) then ! TODO: make an array of pos's for each param to underline - ! individual param, not whole param list + ! individual param, not whole param list. Struct parser does this + ! slightly better span = new_span(pos1, pos2 - pos1 + 1) call parser%diagnostics%push(err_bad_type( & @@ -505,6 +506,8 @@ module function parse_fn_declaration(parser) result(decl) end do + ! Parse fn return type + ! Rust uses "->" as a delimiter between the fn and its return type. Here ! I choose ":" instead as it seems more consistent, at least for normal ! non-assignable fns. There is some discussion on the Rust reasoning here: @@ -600,11 +603,21 @@ module function parse_struct_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: pos0, rank + integer :: itype, i, pos0, pos1, pos2, rank + + type(struct_t) :: struct type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & colon, name, struct_kw + type(text_span_t) :: span + + type( string_vector_t) :: names, types + type(logical_vector_t) :: is_array + type(integer_vector_t) :: ranks, pos_mems + + type(value_t) :: val + !! TODO? !call parser%vars%push_scope() @@ -613,6 +626,8 @@ module function parse_struct_declaration(parser) result(decl) identifier = parser%match(identifier_token) print *, "parsing struct ", identifier%text + pos1 = parser%current_pos() + lbrace = parser%match(lbrace_token) ! Structs use this syntax: @@ -630,6 +645,15 @@ module function parse_struct_declaration(parser) result(decl) ! fn parameters, we have a list of struct members. Unlike a fn declaration, ! there is no "body" for a struct, only members. + ! Parse member names and types. Save in temp vectors initially + names = new_string_vector() + types = new_string_vector() + is_array = new_logical_vector() + ranks = new_integer_vector() + + ! For diagnostic text spans + pos_mems = new_integer_vector() + do while ( & parser%current_kind() /= rbrace_token .and. & parser%current_kind() /= eof_token) @@ -639,18 +663,19 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'matching name' name = parser%match(identifier_token) print *, "name = ", name%text + call pos_mems%push( name%pos ) !print *, 'matching colon' colon = parser%match(colon_token) call parser%parse_type(type_text, rank) print *, "type = ", type_text - !call names%push( name%text ) - !call types%push( type_text ) - !call ranks%push( rank ) + call names%push( name%text ) + call types%push( type_text ) + call ranks%push( rank ) - !! This array is technically redundant but helps readability? - !call is_array%push( rank >= 0 ) + ! This array is technically redundant but helps readability? + call is_array%push( rank >= 0 ) if (parser%current_kind() /= rbrace_token) then !print *, 'matching comma' @@ -664,6 +689,61 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'matching rbrace' rbrace = parser%match(rbrace_token) + call pos_mems%push( rbrace%pos ) + pos2 = parser%current_pos() - 1 + + ! Now that we have the number of members, save them + + allocate(struct%members( names%len_ )) + !allocate(decl %params( names%len_ )) ! if this is needed, we need a new + !! name. "members" already means the member statements of a block statement + + do i = 1, names%len_ + !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s + + struct%members(i)%name = names%v(i)%s + + itype = lookup_type( types%v(i)%s ) + if (itype == unknown_type) then + + !span = new_span(pos1, pos2 - pos1 - 1) + !span = new_span(lbrace%pos, rbrace%pos - lbrace%pos + 1) + span = new_span(pos_mems%v(i), pos_mems%v(i+1) - pos_mems%v(i)) + call parser%diagnostics%push(err_bad_type( & + parser%context(), span, types%v(i)%s)) + + end if + + if (is_array%v(i)) then + struct%members(i)%type = array_type + struct%members(i)%array_type = itype + struct%members(i)%rank = ranks%v(i) + !print *, "rank = ", struct%members(i)%rank + else + struct%members(i)%type = itype + !print *, "(scalar)" + end if + + ! Declare the parameter variable + parser%num_vars = parser%num_vars + 1 + + !! Save parameters by id_index + !decl%params(i) = parser%num_vars + + ! Create a value_t object to store the type + val%type = struct%members(i)%type + if (is_array%v(i)) then + if (allocated(val%array)) deallocate(val%array) + allocate(val%array) + val%array%type = struct%members(i)%array_type + val%array%rank = struct%members(i)%rank + !print *, "rank = ", val%array%rank + end if + + !print *, "insert var type ", kind_name(val%type) + call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) + + end do ! TODO: insert struct into a new dict type diff --git a/src/types.f90 b/src/types.f90 index a9ed3568..f3423eb5 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -12,6 +12,32 @@ module syntran__types_m !******** + type member_t + ! Struct member. Basically the same as a fn param_t + + integer :: type + character(len = :), allocatable :: name + + integer :: array_type, rank + + end type member_t + + !******** + + type struct_t + ! Structure declaration. Will this be different than a struct instance? + + !type(param_t), allocatable :: params(:) + type(member_t), allocatable :: members(:) + + !contains + ! procedure, pass(dst) :: copy => fn_copy + ! generic, public :: assignment(=) => copy + + end type struct_t + + !******** + type param_t ! Function parameter (argument) From 5ddb8f064d0cf9e57c0c52cf3ec676feffc71a68 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 8 Jun 2024 16:39:13 -0400 Subject: [PATCH 004/137] parse struct instantiator and break tests due to syntactic ambiguity --- samples/struct.syntran | 21 ++++++++---- src/consts.f90 | 3 ++ src/eval.f90 | 4 +++ src/parse.f90 | 19 +++++++---- src/parse_expr.f90 | 10 ++++-- src/parse_fn.f90 | 72 +++++++++++++++++++++++++++++++++++++++--- 6 files changed, 109 insertions(+), 20 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index ade45cdd..ca42a834 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -4,20 +4,25 @@ let mm_glbl = 0; let ss_glbl = 0.0; //******** -struct time +struct Time { hh: i32, mm: i32, ss: f32, // trailing comma is optional } -//let t1 = time{hh = 9, mm = 20, ss = 0.030,}; +//let t1 = Time(hh = 9, mm = 20, ss = 0.030,); +let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; + +//println("t1.hh = ", t1.hh); + //t1.hh = 10; +//println("t1.hh = ", t1.hh); //println("t1 = ", t1); -// -//let t2 = time{hh = 13, mm = 37, ss = 0.069,}; -// -//fn print_time(t: time) + +let t2 = Time{hh = 13, mm = 37, ss = 0.069,}; + +//fn print_time(t: Time) //{ // println("h = ", t.hh); // println("m = ", t.mm); @@ -25,13 +30,15 @@ struct time // return; //} -struct date { +struct Date { d: i32, //m: stri, // err: bad type m: str, y: i64 } +let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; + //******** fn set_time_glbl(h: i32, m: i32, s:f32) diff --git a/src/consts.f90 b/src/consts.f90 index 7e050d51..ee81d389 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -16,6 +16,7 @@ module syntran__consts_m ! Token and syntax node kinds enum. Is there a better way to do this that ! allows re-ordering enums? Currently it would break kind_name() integer, parameter :: & + struct_instance_expr = 96, & struct_declaration = 95, & struct_keyword = 94, & dot_token = 93, & @@ -220,6 +221,7 @@ function kind_token(kind) ". ", & ! 93 "struct ", & ! 94 "struct declaration ", & ! 95 + "struct instance expr ", & ! 96 "unknown " & ! inf ] @@ -336,6 +338,7 @@ function kind_name(kind) "comma_token ", & ! 93 "struct_keyword ", & ! 94 "struct_declaration ", & ! 95 + "struct_instance_expr", & ! 96 "unknown " & ! inf (trailing comma hack) ] ! FIXME: update kind_tokens array too diff --git a/src/eval.f90 b/src/eval.f90 index a5ea7432..4d7cb70f 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -106,6 +106,10 @@ recursive subroutine syntax_eval(node, state, res) case (fn_call_expr) call eval_fn_call(node, state, res) + case (struct_instance_expr) + !! TODO + !call eval_struct_instance(node, state, res) + case (name_expr) !print *, "name_expr" call eval_name_expr(node, state, res) diff --git a/src/parse.f90 b/src/parse.f90 index 9b61f199..b9e3e556 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -67,9 +67,10 @@ module syntran__parse_m parse_block_statement, & parse_expr, & parse_expr_statement, & - parse_fn_call, & parse_fn_declaration, & + parse_fn_call, & parse_struct_declaration, & + parse_struct_instance, & parse_for_statement, & parse_if_statement, & parse_return_statement, & @@ -96,27 +97,33 @@ module syntran__parse_m interface ! Implemented in parse_fn.f90 - module function parse_fn_call(parser) result(fn_call) - class(parser_t) :: parser - type(syntax_node_t) :: fn_call - end function parse_fn_call - module function parse_fn_declaration(parser) result(decl) class(parser_t) :: parser type(syntax_node_t) :: decl end function parse_fn_declaration + module function parse_fn_call(parser) result(fn_call) + class(parser_t) :: parser + type(syntax_node_t) :: fn_call + end function parse_fn_call + module subroutine parse_type(parser, type_text, rank) class(parser_t) :: parser character(len = :), intent(out), allocatable :: type_text integer, intent(out) :: rank end subroutine parse_type + ! TODO: move struct stuff to another translation unit module function parse_struct_declaration(parser) result(decl) class(parser_t) :: parser type(syntax_node_t) :: decl end function parse_struct_declaration + module function parse_struct_instance(parser) result(instance) + class(parser_t) :: parser + type(syntax_node_t) :: instance + end function parse_struct_instance + end interface !******** diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 1df1a9bf..e3ae6467 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -414,10 +414,14 @@ module function parse_primary_expr(parser) result(expr) case (identifier_token) - if (parser%peek_kind(1) /= lparen_token) then - expr = parser%parse_name_expr() - else + !print *, "parser%peek_kind(1) = ", kind_name(parser%peek_kind(1)) + + if (parser%peek_kind(1) == lparen_token) then expr = parser%parse_fn_call() + else if (parser%peek_kind(1) == lbrace_token) then + expr = parser%parse_struct_instance() + else + expr = parser%parse_name_expr() end if case (f32_token) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 40d9406e..9cd2b60d 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -662,13 +662,13 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'matching name' name = parser%match(identifier_token) - print *, "name = ", name%text + !print *, "name = ", name%text call pos_mems%push( name%pos ) !print *, 'matching colon' colon = parser%match(colon_token) call parser%parse_type(type_text, rank) - print *, "type = ", type_text + !print *, "type = ", type_text call names%push( name%text ) call types%push( type_text ) @@ -745,16 +745,80 @@ module function parse_struct_declaration(parser) result(decl) end do - ! TODO: insert struct into a new dict type + ! TODO: insert struct into a new dict type and save its members somewhere + !call parser%structs%insert(identifier%text, fn, decl%id_index) decl%kind = struct_declaration - print *, "done parsing struct" + !print *, "done parsing struct" end function parse_struct_declaration !=============================================================================== +module function parse_struct_instance(parser) result(instance) + + ! A struct instantiator initializes all the members of an instance of a + ! struct + + class(parser_t) :: parser + + type(syntax_node_t) :: instance + + !******** + + integer :: pos0 + + type(syntax_node_t) :: mem + type(syntax_node_vector_t) :: mems + + type(syntax_token_t) :: identifier, name, equals, comma, lbrace, rbrace, dummy + + !print *, "starting parse_struct_instance()" + + identifier = parser%match(identifier_token) + + !print *, 'identifier = ', identifier%text + + mems = new_syntax_node_vector() + lbrace = parser%match(lbrace_token) + + do while ( & + parser%current_kind() /= rbrace_token .and. & + parser%current_kind() /= eof_token) + + pos0 = parser%pos + + name = parser%match(identifier_token) + equals = parser%match(equals_token) + mem = parser%parse_expr() + + call mems%push(mem) + + if (parser%current_kind() /= rbrace_token) then + comma = parser%match(comma_token) + end if + + ! break infinite loop + if (parser%pos == pos0) dummy = parser%next() + + end do + + rbrace = parser%match(rbrace_token) + + instance%kind = struct_instance_expr + !instance%identifier = identifier + + ! TODO: save everything in the instance syntax node + + ! TODO: check number and type of members match + + !print *, "ending parse_struct_instance()" + +end function parse_struct_instance + +!=============================================================================== + module subroutine parse_type(parser, type_text, rank) ! TODO: encapsulate out-args in struct if adding any more From 15a4e67eff66f416f539d084efd42633089316c4 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 8 Jun 2024 17:08:55 -0400 Subject: [PATCH 005/137] fix tests; add struct dict types and insert/search --- src/core.f90 | 2 + src/eval.f90 | 2 + src/parse.f90 | 24 ++++ src/parse_expr.f90 | 24 +++- src/parse_fn.f90 | 10 +- src/types.f90 | 280 +++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 339 insertions(+), 3 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 65a7cc6d..6ab4ad3a 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -686,6 +686,8 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) ! TODO: take state struct instead of separate vars and fns members? + ! TODO: take structs arg (like existing fns arg) + character(len = *) :: str type(vars_t), intent(inout) :: vars diff --git a/src/eval.f90 b/src/eval.f90 index 4d7cb70f..b2c4b3ec 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -20,6 +20,8 @@ module syntran__eval_m type(fns_t) :: fns + type(structs_t) :: structs + type(vars_t) :: vars logical :: returned diff --git a/src/parse.f90 b/src/parse.f90 index b9e3e556..49549397 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -43,6 +43,9 @@ module syntran__parse_m type(fns_t) :: fns integer :: num_fns = 0 + type(structs_t) :: structs + integer :: num_structs = 0 + ! Set this to (the current) fn's return type. Check that each return ! statement matches while parsing. This is redundant since the fn ! syntax node also has the type, but it's easier to store it here than @@ -84,6 +87,8 @@ module syntran__parse_m parse_while_statement, & peek => peek_token, & peek_kind, & + peek_text, & + current_text, & peek_pos, & peek_unit, & preprocess, & @@ -286,6 +291,25 @@ end function peek_kind !=============================================================================== +function current_text(parser) + character(len = :), allocatable :: current_text + class(parser_t) :: parser + current_text = parser%peek_text(0) +end function current_text + +!******** + +function peek_text(parser, offset) + character(len = :), allocatable :: peek_text + class(parser_t) :: parser + type(syntax_token_t) :: peek + integer, intent(in) :: offset + peek = parser%peek(offset) + peek_text = peek%text +end function peek_text + +!=============================================================================== + function current_token(parser) class(parser_t) :: parser type(syntax_token_t) :: current_token diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index e3ae6467..d5162301 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -373,8 +373,12 @@ module function parse_primary_expr(parser) result(expr) !******** + integer :: io, dummy_id + logical :: bool + type(struct_t) :: dummy + type(syntax_token_t) :: left, right, keyword, token if (debug > 1) print *, 'parse_primary_expr' @@ -419,7 +423,25 @@ module function parse_primary_expr(parser) result(expr) if (parser%peek_kind(1) == lparen_token) then expr = parser%parse_fn_call() else if (parser%peek_kind(1) == lbrace_token) then - expr = parser%parse_struct_instance() + + !expr%val = parser%vars%search(identifier%text, expr%id_index, io) + !if (io /= exit_success) then + + ! Lookup identifier in structs. If it exists, parse struct + ! instance. Otherwise, parse name_expr like other default case + ! below + + print *, "text = ", parser%current_text() + + dummy = parser%structs%search(parser%current_text(), dummy_id, io) + print *, "io = ", io + + if (io == 0) then + expr = parser%parse_struct_instance() + else + expr = parser%parse_name_expr() + end if + else expr = parser%parse_name_expr() end if diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 9cd2b60d..84357ae8 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -745,8 +745,14 @@ module function parse_struct_declaration(parser) result(decl) end do - ! TODO: insert struct into a new dict type and save its members somewhere - !call parser%structs%insert(identifier%text, fn, decl%id_index) + ! Insert struct into dict + + parser%num_structs = parser%num_structs + 1 + decl%id_index = parser%num_structs + + call parser%structs%insert(identifier%text, struct, decl%id_index) + + ! TODO: save members somewhere decl%kind = struct_declaration diff --git a/src/types.f90 b/src/types.f90 index f3423eb5..0f6f8c58 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -143,6 +143,51 @@ module syntran__types_m !******** + type struct_ternary_tree_node_t + + character :: split_char = '' + type(struct_ternary_tree_node_t), allocatable :: left, mid, right + + type(struct_t), allocatable :: val + integer :: id_index + + contains + procedure, pass(dst) :: copy => struct_ternary_tree_copy + generic, public :: assignment(=) => copy + + end type struct_ternary_tree_node_t + + !******** + + type struct_dict_t + ! This is the struct dictionary of a single scope + type(struct_ternary_tree_node_t), allocatable :: root + end type struct_dict_t + + !******** + + type structs_t + + ! A list of struct dictionaries used during parsing + type(struct_dict_t) :: dicts(scope_max) + + ! Flat array of structs, used for efficient interpreted evaluation + type(struct_t), allocatable :: structs(:) + + ! TODO: is this needed for structs? Is it needed for fns? + integer :: scope = 1 + + ! TODO: scoping for nested structs? + contains + procedure :: & + insert => struct_insert, & + search => struct_search + ! push_scope, pop_scope + + end type structs_t + + !******** + type syntax_token_t integer :: kind @@ -2107,6 +2152,241 @@ end subroutine ternary_insert !=============================================================================== +recursive function struct_ternary_search(node, key, id_index, iostat) result(val) + + type(struct_ternary_tree_node_t), intent(in), allocatable :: node + character(len = *), intent(in) :: key + + integer, intent(out) :: id_index + integer, intent(out) :: iostat + type(struct_t) :: val + + !******** + + character :: k + character(len = :), allocatable :: ey + + !print *, 'searching key ', quote(key) + + iostat = exit_success + + if (.not. allocated(node)) then + ! Search key not found + iostat = exit_failure + return + end if + + ! :) + k = key(1:1) + ey = key(2:) + + if (k < node%split_char) then + val = struct_ternary_search(node%left , key, id_index, iostat) + return + else if (k > node%split_char) then + val = struct_ternary_search(node%right, key, id_index, iostat) + return + else if (len(ey) > 0) then + val = struct_ternary_search(node%mid , ey, id_index, iostat) + return + end if + + !print *, 'setting val' + + if (.not. allocated(node%val)) then + iostat = exit_failure + return + end if + + !allocate(val) + val = node%val + id_index = node%id_index + + !print *, 'done struct_ternary_search' + !print *, '' + +end function struct_ternary_search + +!=============================================================================== + +recursive subroutine struct_ternary_insert(node, key, val, id_index, iostat, overwrite) + + type(struct_ternary_tree_node_t), intent(inout), allocatable :: node + character(len = *), intent(in) :: key + type(struct_t), intent(in) :: val + integer, intent(in) :: id_index + + integer, intent(out) :: iostat + logical, intent(in) :: overwrite + + !******** + + character :: k + character(len = :), allocatable :: ey + + iostat = exit_success + + !print *, 'inserting key ', quote(key) + + ! key == k//ey. Get it? :) + k = key(1:1) + ey = key(2:) + + if (.not. allocated(node)) then + !print *, 'allocate' + allocate(node) + node%split_char = k + else if (k < node%split_char) then + !print *, 'left' + call struct_ternary_insert(node%left , key, val, id_index, iostat, overwrite) + return + else if (k > node%split_char) then + !print *, 'right' + call struct_ternary_insert(node%right, key, val, id_index, iostat, overwrite) + return + end if + + !print *, 'mid' + + if (len(ey) /= 0) then + call struct_ternary_insert(node%mid , ey, val, id_index, iostat, overwrite) + return + end if + + ! node%val doesn't really need to be declared as allocatable (it's + ! a scalar anyway), but it's just a convenient way to check if + ! a duplicate key has already been inserted or not. We could add + ! a separate logical member to node for this instead if needed + + ! This is not necessarily a failure unless we don't want to overwrite. In + ! the evaluator, we will insert values for vars which have already been + ! declared + if (allocated(node%val) .and. .not. overwrite) then + !print *, 'key already inserted' + iostat = exit_failure + return + end if + + allocate(node%val) + node%val = val + node%id_index = id_index + + !print *, 'done inserting' + !print *, '' + +end subroutine struct_ternary_insert + +!=============================================================================== + +recursive subroutine struct_ternary_tree_copy(dst, src) + + ! Deep copy. This overwrites dst with src. If dst had keys that weren't in + ! source, they will be gone! + ! + ! This should be avoided for efficient compilation, but the interactive + ! interpreter uses it to backup and restore the variable dict for + ! partially-evaluated continuation lines + + class(struct_ternary_tree_node_t), intent(inout) :: dst + class(struct_ternary_tree_node_t), intent(in) :: src + + !******** + + !print *, 'starting struct_ternary_tree_node_t()' + + dst%split_char = src%split_char + + dst%id_index = src%id_index + + if (allocated(src%val)) then + if (.not. allocated(dst%val)) allocate(dst%val) + dst%val = src%val + end if + + if (allocated(src%left)) then + if (.not. allocated(dst%left)) allocate(dst%left) + dst%left = src%left + end if + + if (allocated(src%mid)) then + if (.not. allocated(dst%mid)) allocate(dst%mid) + dst%mid = src%mid + end if + + if (allocated(src%right)) then + if (.not. allocated(dst%right)) allocate(dst%right) + dst%right = src%right + end if + + !print *, 'done struct_ternary_tree_node_t()' + +end subroutine struct_ternary_tree_copy + +!=============================================================================== + +subroutine struct_insert(dict, key, val, id_index, iostat, overwrite) + + class(structs_t) :: dict + character(len = *), intent(in) :: key + type(struct_t), intent(in) :: val + integer, intent(inout) :: id_index + + integer, intent(out), optional :: iostat + logical, intent(in), optional :: overwrite + + !******** + + integer :: i, io + logical :: overwritel + + !print *, 'inserting ', quote(key) + id_index = id_index + 1 + + overwritel = .true. + if (present(overwrite)) overwritel = overwrite + + i = dict%scope + call struct_ternary_insert(dict%dicts(i)%root, key, val, id_index, io, overwritel) + + if (present(iostat)) iostat = io + +end subroutine struct_insert + +!=============================================================================== + +function struct_search(dict, key, id_index, iostat) result(val) + + ! An id_index is not normally part of dictionary searching, but we use it + ! here for converting the dictionary into an array after parsing and before + ! evaluation for better performance + + class(structs_t), intent(in) :: dict + character(len = *), intent(in) :: key + integer, intent(out) :: id_index + type(struct_t) :: val + + integer, intent(out), optional :: iostat + + !******** + + integer :: i, io + + i = dict%scope + + val = struct_ternary_search(dict%dicts(i)%root, key, id_index, io) + + ! If not found in current scope, search parent scopes too + do while (io /= exit_success .and. i > 1) + i = i - 1 + val = struct_ternary_search(dict%dicts(i)%root, key, id_index, io) + end do + + if (present(iostat)) iostat = io + +end function struct_search + +!=============================================================================== + end module syntran__types_m !=============================================================================== From 883e7bb35c072f12846d6afb79887df5185268f5 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 9 Jun 2024 11:02:00 -0400 Subject: [PATCH 006/137] parse dot member access expressions --- samples/struct.syntran | 4 ++- src/eval.f90 | 51 +++++++++++++++++++++++++++++-- src/parse.f90 | 6 ++++ src/parse_array.f90 | 12 -------- src/parse_expr.f90 | 68 +++++++++++++++++++++++++++++++++++------- src/parse_fn.f90 | 6 ++++ 6 files changed, 122 insertions(+), 25 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index ca42a834..38085fcc 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -17,7 +17,8 @@ let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; //println("t1.hh = ", t1.hh); //t1.hh = 10; -//println("t1.hh = ", t1.hh); +println("t1.hh = ", t1.hh); +//let t3 = t1; //println("t1 = ", t1); let t2 = Time{hh = 13, mm = 37, ss = 0.069,}; @@ -51,6 +52,7 @@ fn set_time_glbl(h: i32, m: i32, s:f32) fn print_time_glbl() { + println("starting print_time_glbl()"); //println(hh_glbl, ":", mm_glbl, ":", ss_glbl); println("h = ", hh_glbl); println("m = ", mm_glbl); diff --git a/src/eval.f90 b/src/eval.f90 index b2c4b3ec..e498e9de 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -109,8 +109,7 @@ recursive subroutine syntax_eval(node, state, res) call eval_fn_call(node, state, res) case (struct_instance_expr) - !! TODO - !call eval_struct_instance(node, state, res) + call eval_struct_instance(node, state, res) case (name_expr) !print *, "name_expr" @@ -397,6 +396,54 @@ end subroutine eval_name_expr !=============================================================================== +subroutine eval_struct_instance(node, state, res) + + type(syntax_node_t), intent(in) :: node + + type(state_t), intent(inout) :: state + + type(value_t), intent(inout) :: res + + !******** + + print *, 'eval struct_instance_expr' + !print *, 'struct identifier = ', node%identifier%text + !print *, 'struct id_index = ', node%id_index + + res%type = node%val%type + + print *, 'res type = ', kind_name(res%type) + + !case default + ! ! User-defined function + ! if (.not. allocated(node%params)) then + ! write(*,*) err_int_prefix//'unexpected fn'//color_reset + ! call internal_error() + ! end if + ! !print *, 'fn name = ', node%identifier%text + ! !print *, 'fn idx = ', node%id_index + ! !print *, 'node type = ', node%val%type + ! !print *, 'size params = ', size(node%params) + ! !print *, 'param ids = ', node%params + ! ! Pass by value (for now, at least). Arguments are evaluated and + ! ! their values are copied to the fn parameters + ! do i = 1, size(node%params) + ! !print *, 'copying param ', i + ! call syntax_eval(node%args(i), state, tmp) + ! state%vars%vals( node%params(i) ) = tmp + ! !print *, "param type = ", kind_name(state%vars%vals( node%params(i) )%type) + ! !print *, "param rank = ", state%vars%vals( node%params(i) )%array%rank + ! !print *, "param size = ", state%vars%vals( node%params(i) )%array%size + ! end do + ! call syntax_eval(node%body, state, res) + ! !print *, "res rank = ", res%array%rank + ! !print *, 'res = ', res%to_str() + !end select + +end subroutine eval_struct_instance + +!=============================================================================== + subroutine eval_fn_call(node, state, res) type(syntax_node_t), intent(in) :: node diff --git a/src/parse.f90 b/src/parse.f90 index 49549397..2091cc74 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -82,6 +82,7 @@ module syntran__parse_m parse_size, & parse_statement, & parse_subscripts, & + parse_dot, & parse_type, & parse_unit, & parse_while_statement, & @@ -216,6 +217,11 @@ module function parse_name_expr(parser) result(expr) type(syntax_node_t) :: expr end function parse_name_expr + module subroutine parse_dot(parser, expr) + class(parser_t) :: parser + type(syntax_node_t), intent(inout) :: expr + end subroutine parse_dot + end interface !******** diff --git a/src/parse_array.f90 b/src/parse_array.f90 index adb2ebd5..d6632939 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -519,18 +519,6 @@ module subroutine parse_subscripts(parser, expr) rbracket = parser%match(rbracket_token) !print *, 'done' - ! TODO: check that num of subscripts matches array rank, both LHS and - ! RHS parsing. May need to pass identifier to this function. LHS and RHS - ! cases are different in tricky ways. RHS has already lookup up identifier - ! in vars dictionary when it calls parse_subscripts(), but LHS has not. - ! When LHS calls this, it does not yet know whether the identifier is an - ! array or a scalar or a function call in an expression statement. - ! - ! Check that the expr is actually an array (not a scalar), or do that next - ! to err_bad_sub_count() elsewhere - ! - ! So, only check rank match here if lsubscripts%len_ > 0 - call syntax_nodes_copy(expr%lsubscripts, & lsubscripts_vec%v( 1: lsubscripts_vec%len_ )) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index d5162301..1e540dc2 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -424,21 +424,35 @@ module function parse_primary_expr(parser) result(expr) expr = parser%parse_fn_call() else if (parser%peek_kind(1) == lbrace_token) then - !expr%val = parser%vars%search(identifier%text, expr%id_index, io) - !if (io /= exit_success) then - - ! Lookup identifier in structs. If it exists, parse struct - ! instance. Otherwise, parse name_expr like other default case - ! below - - print *, "text = ", parser%current_text() + ! There is an ambiguity here because struct instantiators and + ! block statements both look similar, using braces{}. Compare + ! an if statement: + ! + ! if my_bool + ! { ... + ! } + ! + ! + ! To a struct instantiator: + ! + ! let my_struct = Struct + ! { ... + ! }; + ! + ! We resolve this by looking up the identifier ("my_bool" vs + ! "Struct") in the structs dict. Alternatively, I could change + ! syntran to use a different token for struct instantiators, + ! e.g. `.{`, but I prefer this solution. dummy = parser%structs%search(parser%current_text(), dummy_id, io) - print *, "io = ", io + + !print *, "text = ", parser%current_text() + !print *, "io = ", io if (io == 0) then expr = parser%parse_struct_instance() else + ! Same as default case below expr = parser%parse_name_expr() end if @@ -491,7 +505,7 @@ module function parse_name_expr(parser) result(expr) identifier = parser%match(identifier_token) - !print *, 'RHS identifier = ', identifier%text + print *, 'RHS identifier = ', identifier%text !print *, '%current_kind() = ', kind_name(parser%current_kind()) !print *, 'searching' @@ -559,10 +573,44 @@ module function parse_name_expr(parser) result(expr) span, identifier%text)) end if + call parser%parse_dot(expr) + end function parse_name_expr !=============================================================================== +module subroutine parse_dot(parser, expr) + + class(parser_t) :: parser + + type(syntax_node_t), intent(inout) :: expr + + !******** + + type(syntax_token_t) :: dot, identifier + + if (parser%current_kind() /= dot_token) then + + !! The function has to return something. Caller deallocates + !allocate( expr%lsubscripts(0)) + return + + end if + + print *, "parsing dot" + + dot = parser%match(dot_token) + + ! TODO: can this handle recursion? `a.b.c` + + identifier = parser%match(identifier_token) + + print *, 'dot identifier = ', identifier%text + +end subroutine parse_dot + +!=============================================================================== + end submodule syntran__parse_expr !=============================================================================== diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 84357ae8..2f9eea02 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -740,6 +740,12 @@ module function parse_struct_declaration(parser) result(decl) !print *, "rank = ", val%array%rank end if + ! TODO: each struct should get its own dict of members. Create one and + ! insert the member name into that dict instead of the (global) vars + ! dict here. Might not need a new type, could probably just re-use the + ! `vars_t` type, just like `parser%vars`. Just add one inside of the + ! `struct_t` type. + ! !print *, "insert var type ", kind_name(val%type) call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) From 6e68a4e88bef509ef91ee414a3bf87fbc712446b Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 9 Jun 2024 14:23:56 -0400 Subject: [PATCH 007/137] insert each struct's members into a dict; workaround cursed memory bug --- samples/struct.syntran | 3 +- src/core.f90 | 16 ++- src/eval.f90 | 36 +----- src/parse_expr.f90 | 24 +++- src/parse_fn.f90 | 62 ++++++--- src/types.f90 | 288 ++++++++++++++++++++++++++++++++--------- 6 files changed, 307 insertions(+), 122 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index 38085fcc..ca6516a0 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -14,6 +14,8 @@ struct Time //let t1 = Time(hh = 9, mm = 20, ss = 0.030,); let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; +//let taoeu = Timeaoeu{hh = 9, mm = 20, ss = 0.030,}; + //println("t1.hh = ", t1.hh); //t1.hh = 10; @@ -37,7 +39,6 @@ struct Date { m: str, y: i64 } - let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; //******** diff --git a/src/core.f90 b/src/core.f90 index 6ab4ad3a..94229563 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -712,7 +712,10 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) type(fns_t) :: fns0 - type(parser_t) :: parser + ! Without `save`, gfortran crashes when this goes out of scope. Maybe I + ! need to work on a manual finalizer to deallocate ternary trees, not just + ! for structs but for the vars_t trees contained within + type(parser_t), save :: parser type(syntax_token_t) :: token @@ -929,6 +932,17 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) fns%fns( 1: size(fns0%fns) ) = fns0%fns end if + !if (allocated(parser%structs)) then + ! ! TODO: manually finalize recursively? + ! deallocate(parser%structs) + !end if + !print *, "size = ", size(parser%structs%structs) + !print *, "allocated = ", allocated(parser%structs%structs) + !print *, "size = ", size(parser%structs%dicts) + print *, "allocated = ", allocated(parser%structs%dict%root) + !deallocate(parser%structs%dict%root) + !call struct_ternary_tree_final(parser%structs%dict%root) + if (debug > 0) print *, 'done syntax_parse' end function syntax_parse diff --git a/src/eval.f90 b/src/eval.f90 index e498e9de..78b4837a 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -316,7 +316,6 @@ subroutine eval_name_expr(node, state, res) res%array%type = node%val%array%type res%array%rank = rank_res - !if (.not. allocated(res%array%size)) allocate(res%array%size( rank_res )) if (allocated(res%array%size)) deallocate(res%array%size) allocate(res%array%size( rank_res )) @@ -352,44 +351,13 @@ subroutine eval_name_expr(node, state, res) end if else + ! TODO: add another branch for dot member access expressions + !print *, "name expr without subscripts" !print *, "id_index = ", node%id_index !print *, "size(vals) = ", size(state%vars%vals) res = state%vars%vals(node%id_index) - !! How are these both void types??? - !!if (res%type == void_type) res%type = array_type - !print *, "res type = ", kind_name(res%type) - !print *, "var type = ", & - ! kind_name(state%vars%vals(node%id_index)%type), & - ! state%vars%vals(node%id_index)%type - - !! Deep copy of whole array instead of aliasing pointers - !! - !! I suspect that value_t now has a deep copy problem like syntax_node_t - !! does, and this may be why samples/array-fns.syntran doesn't work. May - !! need to convert return-by-value to subroutine out-arg as reference (or - !! override the copy operator, but that hasn't worked out so well for - !! syntax_node_t) - !if (res%type == array_type) then - ! !print *, 'array name_expr' - - ! if (allocated(res%array)) deallocate(res%array) - - ! allocate(res%array) - ! res%type = array_type - ! res%array = state%vars%vals(node%id_index)%array - - ! !! TODO: this might be unnecessary - ! res%array%rank = state%vars%vals(node%id_index)%array%rank - ! !!print *, "allocated(size j) = ", allocated(state%vars%vals(node%id_index)%array%size) - ! res%array%size = state%vars%vals(node%id_index)%array%size - ! !print *, "rank = ", res%array%rank, state%vars%vals(node%id_index)%array%rank - - !!else - !! print *, 'scalar name_expr' - !end if - end if end subroutine eval_name_expr diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 1e540dc2..90e507c9 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -375,9 +375,9 @@ module function parse_primary_expr(parser) result(expr) integer :: io, dummy_id - logical :: bool + logical :: bool, exists - type(struct_t) :: dummy + !type(struct_t) :: dummy type(syntax_token_t) :: left, right, keyword, token @@ -444,13 +444,23 @@ module function parse_primary_expr(parser) result(expr) ! syntran to use a different token for struct instantiators, ! e.g. `.{`, but I prefer this solution. - dummy = parser%structs%search(parser%current_text(), dummy_id, io) - - !print *, "text = ", parser%current_text() - !print *, "io = ", io + ! TODO: is the exists() method needed? Search will probably + ! work and simplify the code. I was experimenting while + ! debugging memory issue, but exists might not be necessary. On + ! the other hand, it might be more optimal to check existence + ! w/o copying an output val (which could containt big nested dict + ! types) + print *, "text = ", parser%current_text() + !dummy = parser%structs%search(parser%current_text(), dummy_id, io) + exists = parser%structs%exists(parser%current_text(), dummy_id, io) + !deallocate(dummy%members) + !deallocate(dummy%vars) + print *, "io = ", io if (io == 0) then + !if (exists) then expr = parser%parse_struct_instance() + print *, "back in parse_expr.f90" else ! Same as default case below expr = parser%parse_name_expr() @@ -607,6 +617,8 @@ module subroutine parse_dot(parser, expr) print *, 'dot identifier = ', identifier%text + ! TODO: save dot info in syntax node + end subroutine parse_dot !=============================================================================== diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 2f9eea02..0954e9a2 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -603,7 +603,7 @@ module function parse_struct_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: itype, i, pos0, pos1, pos2, rank + integer :: itype, i, io, pos0, pos1, pos2, rank type(struct_t) :: struct @@ -698,6 +698,8 @@ module function parse_struct_declaration(parser) result(decl) !allocate(decl %params( names%len_ )) ! if this is needed, we need a new !! name. "members" already means the member statements of a block statement + allocate(struct%vars) + do i = 1, names%len_ !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s @@ -724,8 +726,10 @@ module function parse_struct_declaration(parser) result(decl) !print *, "(scalar)" end if - ! Declare the parameter variable - parser%num_vars = parser%num_vars + 1 + ! Declare the member + !parser%num_vars = parser%num_vars + 1 + struct%num_vars = struct%num_vars + 1 + print *, "struct%num_vars = ", struct%num_vars !! Save parameters by id_index !decl%params(i) = parser%num_vars @@ -740,29 +744,51 @@ module function parse_struct_declaration(parser) result(decl) !print *, "rank = ", val%array%rank end if - ! TODO: each struct should get its own dict of members. Create one and - ! insert the member name into that dict instead of the (global) vars - ! dict here. Might not need a new type, could probably just re-use the - ! `vars_t` type, just like `parser%vars`. Just add one inside of the - ! `struct_t` type. - ! - !print *, "insert var type ", kind_name(val%type) - call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) + ! Each struct has its own dict of members. Create one and insert the + ! member name into that dict instead of the (global) vars dict here. + ! Might not need a new type, could probably just re-use the `vars_t` + ! type, just like `parser%vars`. Just add one inside of the `struct_t` + ! type. + + ! TODO: check for duplicate member names + + print *, "insert var type ", kind_name(val%type) + !call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) + !call struct%vars%insert(struct%members(i)%name, val, struct%num_vars) + + call struct%vars%insert(struct%members(i)%name, val, & + struct%num_vars, io, overwrite = .false.) + !print *, 'io = ', io + if (io /= exit_success) then + print *, "Error: re-declared struct member" + !span = new_span(identifier%pos, len(identifier%text)) + !call parser%diagnostics%push( & + ! err_redeclare_var(parser%context(), & + ! span, identifier%text)) + end if + + !call parser%vars%insert(identifier%text, expr%val, & + ! expr%id_index, io, overwrite = .false.) + !!print *, 'io = ', io + !if (io /= exit_success) then + ! span = new_span(identifier%pos, len(identifier%text)) + ! call parser%diagnostics%push( & + ! err_redeclare_var(parser%context(), & + ! span, identifier%text)) + !end if end do - ! Insert struct into dict + ! Insert struct into parser dict parser%num_structs = parser%num_structs + 1 decl%id_index = parser%num_structs call parser%structs%insert(identifier%text, struct, decl%id_index) - ! TODO: save members somewhere - decl%kind = struct_declaration - !print *, "done parsing struct" + print *, "done parsing struct" end function parse_struct_declaration @@ -786,11 +812,11 @@ module function parse_struct_instance(parser) result(instance) type(syntax_token_t) :: identifier, name, equals, comma, lbrace, rbrace, dummy - !print *, "starting parse_struct_instance()" + print *, "starting parse_struct_instance()" identifier = parser%match(identifier_token) - !print *, 'identifier = ', identifier%text + print *, 'identifier = ', identifier%text mems = new_syntax_node_vector() lbrace = parser%match(lbrace_token) @@ -825,7 +851,7 @@ module function parse_struct_instance(parser) result(instance) ! TODO: check number and type of members match - !print *, "ending parse_struct_instance()" + print *, "ending parse_struct_instance()" end function parse_struct_instance diff --git a/src/types.f90 b/src/types.f90 index 0f6f8c58..05334a6a 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -24,20 +24,6 @@ module syntran__types_m !******** - type struct_t - ! Structure declaration. Will this be different than a struct instance? - - !type(param_t), allocatable :: params(:) - type(member_t), allocatable :: members(:) - - !contains - ! procedure, pass(dst) :: copy => fn_copy - ! generic, public :: assignment(=) => copy - - end type struct_t - - !******** - type param_t ! Function parameter (argument) @@ -143,51 +129,6 @@ module syntran__types_m !******** - type struct_ternary_tree_node_t - - character :: split_char = '' - type(struct_ternary_tree_node_t), allocatable :: left, mid, right - - type(struct_t), allocatable :: val - integer :: id_index - - contains - procedure, pass(dst) :: copy => struct_ternary_tree_copy - generic, public :: assignment(=) => copy - - end type struct_ternary_tree_node_t - - !******** - - type struct_dict_t - ! This is the struct dictionary of a single scope - type(struct_ternary_tree_node_t), allocatable :: root - end type struct_dict_t - - !******** - - type structs_t - - ! A list of struct dictionaries used during parsing - type(struct_dict_t) :: dicts(scope_max) - - ! Flat array of structs, used for efficient interpreted evaluation - type(struct_t), allocatable :: structs(:) - - ! TODO: is this needed for structs? Is it needed for fns? - integer :: scope = 1 - - ! TODO: scoping for nested structs? - contains - procedure :: & - insert => struct_insert, & - search => struct_search - ! push_scope, pop_scope - - end type structs_t - - !******** - type syntax_token_t integer :: kind @@ -318,6 +259,75 @@ module syntran__types_m !******** + type struct_t + ! Structure declaration. Will this be different than a struct instance? + + !! TODO: do we need members inside struct_t? Or only a local var inside + !! parse_struct_instance? I think all the same info is also contained + !! in struct%vars + !type(param_t), allocatable :: params(:) + type(member_t), allocatable :: members(:) + + !type(vars_t) :: vars ! can't compile w/o allocatable if vars_t is defined below + type(vars_t), allocatable :: vars + integer :: num_vars = 0 + + contains + procedure, pass(dst) :: copy => struct_copy + generic, public :: assignment(=) => copy + + end type struct_t + + !******** + + type struct_ternary_tree_node_t + + character :: split_char = '' + type(struct_ternary_tree_node_t), allocatable :: left, mid, right + + type(struct_t), allocatable :: val + integer :: id_index + + contains + procedure, pass(dst) :: copy => struct_ternary_tree_copy + generic, public :: assignment(=) => copy + !final :: struct_ternary_tree_final + + end type struct_ternary_tree_node_t + + !******** + + type struct_dict_t + ! This is the struct dictionary of a single scope + type(struct_ternary_tree_node_t), allocatable :: root + end type struct_dict_t + + !******** + + type structs_t + + ! A list of struct dictionaries used during parsing + !type(struct_dict_t) :: dicts(scope_max) + type(struct_dict_t) :: dict + + !! Flat array of structs, used for efficient interpreted evaluation + !type(struct_t), allocatable :: structs(:) + + ! TODO: is this needed for structs? Is it needed for fns? + integer :: scope = 1 + + ! TODO: scoping for nested structs? + contains + procedure :: & + insert => struct_insert, & + exists => struct_exists, & + search => struct_search + ! push_scope, pop_scope + + end type structs_t + + !******** + type syntax_token_vector_t type(syntax_token_t), allocatable :: v(:) integer :: len_, cap @@ -340,6 +350,39 @@ module syntran__types_m !=============================================================================== +recursive subroutine struct_copy(dst, src) + + ! Deep copy. This overwrites dst with src + + class(struct_t), intent(inout) :: dst + class(struct_t), intent(in) :: src + + !******** + + !print *, 'starting struct_copy()' + + dst%num_vars = src%num_vars + + if (allocated(src%members)) then + if (.not. allocated(dst%members)) allocate(dst%members( size(src%members) )) + dst%members = src%members + else if (allocated(dst%members)) then + deallocate(dst%members) + end if + + if (allocated(src%vars)) then + if (.not. allocated(dst%vars)) allocate(dst%vars) + dst%vars = src%vars + else if (allocated(dst%vars)) then + deallocate(dst%vars) + end if + + !print *, 'done struct_copy()' + +end subroutine struct_copy + +!=============================================================================== + recursive subroutine fn_copy(dst, src) ! Deep copy. This overwrites dst with src @@ -2152,6 +2195,66 @@ end subroutine ternary_insert !=============================================================================== +recursive function struct_ternary_exists(node, key, id_index, iostat) result(exists) + + type(struct_ternary_tree_node_t), intent(in), allocatable :: node + character(len = *), intent(in) :: key + + integer, intent(out) :: id_index + integer, intent(out) :: iostat + !type(struct_t) :: val + logical :: exists + + !******** + + character :: k + character(len = :), allocatable :: ey + + !print *, 'searching key ', quote(key) + + iostat = exit_success + + if (.not. allocated(node)) then + ! Search key not found + iostat = exit_failure + return + end if + + ! :) + k = key(1:1) + ey = key(2:) + + if (k < node%split_char) then + exists = struct_ternary_exists(node%left , key, id_index, iostat) + return + else if (k > node%split_char) then + exists = struct_ternary_exists(node%right, key, id_index, iostat) + return + else if (len(ey) > 0) then + exists = struct_ternary_exists(node%mid , ey, id_index, iostat) + return + end if + + !print *, 'setting val' + + if (.not. allocated(node%val)) then + exists = .false. + iostat = exit_failure + return + end if + + !allocate(val) + !val = node%val + exists = .true. + id_index = node%id_index + + !print *, 'done struct_ternary_exists' + !print *, '' + +end function struct_ternary_exists + +!=============================================================================== + recursive function struct_ternary_search(node, key, id_index, iostat) result(val) type(struct_ternary_tree_node_t), intent(in), allocatable :: node @@ -2324,6 +2427,32 @@ end subroutine struct_ternary_tree_copy !=============================================================================== +recursive subroutine struct_ternary_tree_final(src) +!subroutine struct_ternary_tree_final(src) + + !class(struct_ternary_tree_node_t) :: src + type(struct_ternary_tree_node_t) :: src + + if (allocated(src%val)) then + deallocate(src%val) + end if + + if (allocated(src%left)) then + call struct_ternary_tree_final(src%left) + end if + + if (allocated(src%mid)) then + call struct_ternary_tree_final(src%mid) + end if + + if (allocated(src%right)) then + call struct_ternary_tree_final(src%right) + end if + +end subroutine struct_ternary_tree_final + +!=============================================================================== + subroutine struct_insert(dict, key, val, id_index, iostat, overwrite) class(structs_t) :: dict @@ -2346,7 +2475,7 @@ subroutine struct_insert(dict, key, val, id_index, iostat, overwrite) if (present(overwrite)) overwritel = overwrite i = dict%scope - call struct_ternary_insert(dict%dicts(i)%root, key, val, id_index, io, overwritel) + call struct_ternary_insert(dict%dict%root, key, val, id_index, io, overwritel) if (present(iostat)) iostat = io @@ -2354,6 +2483,41 @@ end subroutine struct_insert !=============================================================================== +function struct_exists(dict, key, id_index, iostat) result(exists) + + ! Check if a key exists, without copying an output val unlike + ! struct_search() + ! + ! TODO: some of these args (iostat at least) are unnecessary + + class(structs_t), intent(in) :: dict + character(len = *), intent(in) :: key + integer, intent(out) :: id_index + !type(struct_t) :: val + logical :: exists + + integer, intent(out), optional :: iostat + + !******** + + integer :: i, io + + i = dict%scope + + exists = struct_ternary_exists(dict%dict%root, key, id_index, io) + + ! If not found in current scope, search parent scopes too + do while (io /= exit_success .and. i > 1) + i = i - 1 + exists = struct_ternary_exists(dict%dict%root, key, id_index, io) + end do + + if (present(iostat)) iostat = io + +end function struct_exists + +!=============================================================================== + function struct_search(dict, key, id_index, iostat) result(val) ! An id_index is not normally part of dictionary searching, but we use it @@ -2373,12 +2537,12 @@ function struct_search(dict, key, id_index, iostat) result(val) i = dict%scope - val = struct_ternary_search(dict%dicts(i)%root, key, id_index, io) + val = struct_ternary_search(dict%dict%root, key, id_index, io) ! If not found in current scope, search parent scopes too do while (io /= exit_success .and. i > 1) i = i - 1 - val = struct_ternary_search(dict%dicts(i)%root, key, id_index, io) + val = struct_ternary_search(dict%dict%root, key, id_index, io) end do if (present(iostat)) iostat = io From edd4d96ddc7940f6eacf1204980992c060ac3e2c Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 9 Jun 2024 14:57:22 -0400 Subject: [PATCH 008/137] lookup struct members. works with ifx but not gfort --- samples/struct.syntran | 1 + src/parse_fn.f90 | 30 ++++++++++++++++++++++++++++-- src/types.f90 | 15 ++++++++------- 3 files changed, 37 insertions(+), 9 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index ca6516a0..a035e3cd 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -13,6 +13,7 @@ struct Time //let t1 = Time(hh = 9, mm = 20, ss = 0.030,); let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; +//let t1htns = Time{hh = 9, mm = 20, sshtns = 0.030,}; //let taoeu = Timeaoeu{hh = 9, mm = 20, ss = 0.030,}; diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 0954e9a2..e5c3bc2a 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -698,7 +698,7 @@ module function parse_struct_declaration(parser) result(decl) !allocate(decl %params( names%len_ )) ! if this is needed, we need a new !! name. "members" already means the member statements of a block statement - allocate(struct%vars) + !allocate(struct%vars) do i = 1, names%len_ !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s @@ -753,6 +753,7 @@ module function parse_struct_declaration(parser) result(decl) ! TODO: check for duplicate member names print *, "insert var type ", kind_name(val%type) + print *, "name = ", struct%members(i)%name !call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) !call struct%vars%insert(struct%members(i)%name, val, struct%num_vars) @@ -805,19 +806,27 @@ module function parse_struct_instance(parser) result(instance) !******** - integer :: pos0 + integer :: io, pos0, struct_id, member_id + + !type(struct_t), save :: struct + type(struct_t) :: struct type(syntax_node_t) :: mem type(syntax_node_vector_t) :: mems type(syntax_token_t) :: identifier, name, equals, comma, lbrace, rbrace, dummy + type(value_t) :: member + print *, "starting parse_struct_instance()" identifier = parser%match(identifier_token) print *, 'identifier = ', identifier%text + struct = parser%structs%search(identifier%text, struct_id, io) + print *, "struct io = ", io + mems = new_syntax_node_vector() lbrace = parser%match(lbrace_token) @@ -831,6 +840,23 @@ module function parse_struct_instance(parser) result(instance) equals = parser%match(equals_token) mem = parser%parse_expr() + print *, "name%text = ", name%text + + !call struct%vars%insert(struct%members(i)%name, val, & + ! struct%num_vars, io, overwrite = .false.) + + print *, "allocated = ", allocated(struct%vars%dicts(1)%root) + + member = struct%vars%search(name%text, member_id, io) + !member = parser%structs(struct_id)%vars%search(name%text, member_id, io) + print *, "member io = ", io + + if (io /= 0) then + ! TODO: diag + print *, "Error: member does not exist in struct" + stop + end if + call mems%push(mem) if (parser%current_kind() /= rbrace_token) then diff --git a/src/types.f90 b/src/types.f90 index 05334a6a..57c73458 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -268,8 +268,8 @@ module syntran__types_m !type(param_t), allocatable :: params(:) type(member_t), allocatable :: members(:) - !type(vars_t) :: vars ! can't compile w/o allocatable if vars_t is defined below - type(vars_t), allocatable :: vars + type(vars_t) :: vars ! can't compile w/o allocatable if vars_t is defined below + !type(vars_t), allocatable :: vars integer :: num_vars = 0 contains @@ -370,12 +370,13 @@ recursive subroutine struct_copy(dst, src) deallocate(dst%members) end if - if (allocated(src%vars)) then - if (.not. allocated(dst%vars)) allocate(dst%vars) + !if (allocated(src%vars)) then + ! if (.not. allocated(dst%vars)) allocate(dst%vars) dst%vars = src%vars - else if (allocated(dst%vars)) then - deallocate(dst%vars) - end if + ! !dst%vars%dicts = src%vars%dicts + !else if (allocated(dst%vars)) then + ! deallocate(dst%vars) + !end if !print *, 'done struct_copy()' From a1d11079115b99d6bbffb5b72928fb9a52e52a68 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 9 Jun 2024 18:05:31 -0400 Subject: [PATCH 009/137] make docker test less sensitive to debug logging --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 68162fb1..514b9bbf 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -35,7 +35,7 @@ docker run --entrypoint syntran sy --version \n docker run sy --version # syntran is already the default entrypoint \n docker run sy -c \"1 + 2;\" \n - ans=$(docker run sy -c \"1 + 2;\") \n + ans=$(docker run sy -c \"1 + 2;\" | tail -1) \n if [[ \"$ans\" == \" ans = \\`3\\`\" ]] ; then \n echo \"win\" \n exit 0 \n From a1890d90d189219618393f92caa3923f9abb3fa7 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 10 Jun 2024 11:30:13 -0400 Subject: [PATCH 010/137] evaluate struct instantiators --- samples/struct.syntran | 1 + src/consts.f90 | 3 +++ src/eval.f90 | 27 ++++++++++++++++++++++++++- src/parse_expr.f90 | 4 ++++ src/parse_fn.f90 | 39 ++++++++++++++++++++++++++++++++------- src/value.f90 | 10 ++++++++++ 6 files changed, 76 insertions(+), 8 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index a035e3cd..6d3c46f1 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -13,6 +13,7 @@ struct Time //let t1 = Time(hh = 9, mm = 20, ss = 0.030,); let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; +//let t1num = Time{hh = 9, mm = 20}; //let t1htns = Time{hh = 9, mm = 20, sshtns = 0.030,}; //let taoeu = Timeaoeu{hh = 9, mm = 20, ss = 0.030,}; diff --git a/src/consts.f90 b/src/consts.f90 index ee81d389..d26f1e69 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -16,6 +16,7 @@ module syntran__consts_m ! Token and syntax node kinds enum. Is there a better way to do this that ! allows re-ordering enums? Currently it would break kind_name() integer, parameter :: & + struct_type = 97, & struct_instance_expr = 96, & struct_declaration = 95, & struct_keyword = 94, & @@ -222,6 +223,7 @@ function kind_token(kind) "struct ", & ! 94 "struct declaration ", & ! 95 "struct instance expr ", & ! 96 + "struct type ", & ! 97 "unknown " & ! inf ] @@ -339,6 +341,7 @@ function kind_name(kind) "struct_keyword ", & ! 94 "struct_declaration ", & ! 95 "struct_instance_expr", & ! 96 + "struct_type ", & ! 97 "unknown " & ! inf (trailing comma hack) ] ! FIXME: update kind_tokens array too diff --git a/src/eval.f90 b/src/eval.f90 index 78b4837a..527862fa 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -101,10 +101,19 @@ recursive subroutine syntax_eval(node, state, res) ! Assign return value call syntax_eval(node%right, state, res) - !print *, 'assigning identifier ', quote(node%identifier%text) + print *, 'assigning identifier ', quote(node%identifier%text) state%vars%vals(node%id_index) = res + print *, "res type = ", kind_name(res%type) + print *, "allocated(struct) = ", allocated(res%struct) + if (res%type == struct_type) then + print *, "size struct = ", size(res%struct) + print *, "size struct = ", size( state%vars%vals(node%id_index)%struct ) + print *, "struct[1] = ", res%struct(1)%to_str() + print *, "struct[1] = ", state%vars%vals(node%id_index)%struct(1)%to_str() + end if + case (fn_call_expr) call eval_fn_call(node, state, res) @@ -374,13 +383,27 @@ subroutine eval_struct_instance(node, state, res) !******** + integer :: i + print *, 'eval struct_instance_expr' !print *, 'struct identifier = ', node%identifier%text !print *, 'struct id_index = ', node%id_index res%type = node%val%type + if (allocated(res%struct)) deallocate(res%struct) + allocate(res%struct( size(node%members) )) + print *, 'res type = ', kind_name(res%type) + print *, "num members = ", size(node%members) + print *, "num members = ", size(res%struct) + + do i = 1, size(node%members) + + call syntax_eval(node%members(i), state, res%struct(i)) + + print *, "mem[", str(i), "] = ", res%struct(i)%to_str() + end do !case default ! ! User-defined function @@ -1028,6 +1051,8 @@ subroutine eval_assignment_expr(node, state, res) res = state%vars%vals(node%id_index) !print *, 'done' + !print *, "node identifier = ", node%identifier%text + ! The difference between let and assign is inserting into the ! current scope (let) vs possibly searching parent scopes (assign). ! During evaluation we don't need any extra logic for scoping. The diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 90e507c9..9e4fc2f2 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -617,6 +617,10 @@ module subroutine parse_dot(parser, expr) print *, 'dot identifier = ', identifier%text + !! TODO + !!expr%kind = name_expr + !expr%kind = dot_expr + ! TODO: save dot info in syntax node end subroutine parse_dot diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index e5c3bc2a..f544f5eb 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -795,14 +795,14 @@ end function parse_struct_declaration !=============================================================================== -module function parse_struct_instance(parser) result(instance) +module function parse_struct_instance(parser) result(inst) ! A struct instantiator initializes all the members of an instance of a ! struct class(parser_t) :: parser - type(syntax_node_t) :: instance + type(syntax_node_t) :: inst !******** @@ -827,9 +827,23 @@ module function parse_struct_instance(parser) result(instance) struct = parser%structs%search(identifier%text, struct_id, io) print *, "struct io = ", io + ! TODO: do we need `mems`? Or just inst%members mems = new_syntax_node_vector() + lbrace = parser%match(lbrace_token) + inst%kind = struct_instance_expr + !inst%identifier = identifier + + ! Save everything in the inst syntax node + inst%val%type = struct_type + allocate(inst%val%struct( struct%num_vars )) + allocate(inst%members ( struct%num_vars )) + + ! TODO: each struct should get a different sub type (like array_type) for + ! type checking, so you don't try to assign one type of struct to another + ! struct + do while ( & parser%current_kind() /= rbrace_token .and. & parser%current_kind() /= eof_token) @@ -850,6 +864,7 @@ module function parse_struct_instance(parser) result(instance) member = struct%vars%search(name%text, member_id, io) !member = parser%structs(struct_id)%vars%search(name%text, member_id, io) print *, "member io = ", io + print *, "member id = ", member_id if (io /= 0) then ! TODO: diag @@ -857,6 +872,13 @@ module function parse_struct_instance(parser) result(instance) stop end if + ! TODO: add a size check here too + print *, "mem type = ", kind_name(mem%val%type) + + ! Members can be instantiated out of order + inst%val%struct( member_id ) = mem%val + inst%members( member_id ) = mem + call mems%push(mem) if (parser%current_kind() /= rbrace_token) then @@ -870,12 +892,15 @@ module function parse_struct_instance(parser) result(instance) rbrace = parser%match(rbrace_token) - instance%kind = struct_instance_expr - !instance%identifier = identifier - - ! TODO: save everything in the instance syntax node + print *, "size = ", struct%num_vars + print *, "size = ", mems%len_ + if (mems%len_ /= struct%num_vars) then + ! TODO: diag + print *, "Error: struct instance does not have the right number of members" + stop + end if - ! TODO: check number and type of members match + ! TODO: check type of members match print *, "ending parse_struct_instance()" diff --git a/src/value.f90 b/src/value.f90 index 6959141d..09bb4e8d 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -73,6 +73,10 @@ module syntran__value_m !******** + !type struct_val_t + ! type(value_t), allocatable :: vals(:) + !end type struct_val_t + type value_t integer :: type = unknown_type @@ -90,6 +94,10 @@ module syntran__value_m ! but two types containing each other is bad type(array_t), allocatable :: array + !type(struct_t), allocatable :: struct + !type(struct_val_t), allocatable :: struct + type(value_t), allocatable :: struct(:) + contains procedure :: to_str => value_to_str procedure :: to_f32 => value_to_f32 @@ -431,6 +439,8 @@ recursive function value_to_str(val) result(ans) select case (val%type) + ! TODO: add a case for struct_type + case (array_type) ! This whole case could be an array_to_str() fn From 4bba2bc34094666d4f8968d7a020cafa3209d6c8 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 10 Jun 2024 12:19:08 -0400 Subject: [PATCH 011/137] mvp structs; wonky asl --- samples/struct.syntran | 11 +++++++++- src/consts.f90 | 3 +++ src/eval.f90 | 23 +++++++++++++++++++ src/parse_expr.f90 | 50 +++++++++++++++++++++++++++++++++++++----- src/parse_fn.f90 | 7 ++++++ src/types.f90 | 14 ++++++++++++ src/value.f90 | 1 + 7 files changed, 103 insertions(+), 6 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index 6d3c46f1..dcf0de04 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -41,7 +41,16 @@ struct Date { m: str, y: i64 } -let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; + +//// TODO: expr is eval'd but not saved in struct +//let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; + +let d1 = Date{y = 1912, m = "Apr", d = 14}; +//d1.d = 1969; + +println("d1.y = ", d1.y); +println("d1.m = ", d1.m); +println("d1.d = ", d1.d); //******** diff --git a/src/consts.f90 b/src/consts.f90 index d26f1e69..a170d74e 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -16,6 +16,7 @@ module syntran__consts_m ! Token and syntax node kinds enum. Is there a better way to do this that ! allows re-ordering enums? Currently it would break kind_name() integer, parameter :: & + dot_expr = 98, & struct_type = 97, & struct_instance_expr = 96, & struct_declaration = 95, & @@ -224,6 +225,7 @@ function kind_token(kind) "struct declaration ", & ! 95 "struct instance expr ", & ! 96 "struct type ", & ! 97 + "dot expression ", & ! 98 "unknown " & ! inf ] @@ -342,6 +344,7 @@ function kind_name(kind) "struct_declaration ", & ! 95 "struct_instance_expr", & ! 96 "struct_type ", & ! 97 + "dot_expr ", & ! 98 "unknown " & ! inf (trailing comma hack) ] ! FIXME: update kind_tokens array too diff --git a/src/eval.f90 b/src/eval.f90 index 527862fa..3aee6453 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -124,6 +124,9 @@ recursive subroutine syntax_eval(node, state, res) !print *, "name_expr" call eval_name_expr(node, state, res) + case (dot_expr) + call eval_dot_expr(node, state, res) + case (unary_expr) call eval_unary_expr(node, state, res) @@ -373,6 +376,26 @@ end subroutine eval_name_expr !=============================================================================== +subroutine eval_dot_expr(node, state, res) + + type(syntax_node_t), intent(in) :: node + + type(state_t), intent(inout) :: state + + type(value_t), intent(inout) :: res + + !******** + + print *, "eval dot_expr" + + !!res = node%members%val(1) + !res = node%val%struct(1) + res = node%val%struct( node%right%id_index ) + +end subroutine eval_dot_expr + +!=============================================================================== + subroutine eval_struct_instance(node, state, res) type(syntax_node_t), intent(in) :: node diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 9e4fc2f2..1622e2e6 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -97,6 +97,14 @@ recursive module function parse_expr_statement(parser) result(expr) span, identifier%text)) end if + ! TODO: this should be unnecessary. Store the struct name in the value + ! instead + print *, "right type = ", kind_name(right%val%type) + if (right%val%type == struct_type) then + print *, "struct_name = ", right%struct_name + expr%struct_name = right%struct_name + end if + return end if @@ -597,8 +605,14 @@ module subroutine parse_dot(parser, expr) !******** + integer :: io, struct_id, member_id + + type(struct_t) :: struct + type(syntax_token_t) :: dot, identifier + type(value_t) :: member + if (parser%current_kind() /= dot_token) then !! The function has to return something. Caller deallocates @@ -615,13 +629,39 @@ module subroutine parse_dot(parser, expr) identifier = parser%match(identifier_token) - print *, 'dot identifier = ', identifier%text + print *, "dot identifier = ", identifier%text + !print *, "struct name = ", expr%struct_name + print *, "struct name = ", expr%val%struct_name + + !expr%kind = name_expr + expr%kind = dot_expr - !! TODO - !!expr%kind = name_expr - !expr%kind = dot_expr + ! Save dot info in syntax node + allocate(expr%right) + + !parser%vars%search(identifier%text, id_index, io) + !dummy = parser%structs%search(parser%current_text(), dummy_id, io) + + ! Is there a better way than looking up every struct by name again? + + !struct = parser%structs%search(parser%current_text(), struct_id, io) + struct = parser%structs%search(expr%val%struct_name, struct_id, io) + if (io /= 0) then + print *, "Error: unreachable struct lookup failure" + stop + end if + + !member = struct%vars%search(name%text, member_id, io) + member = struct%vars%search(identifier%text, member_id, io) + if (io /= 0) then + ! TODO: diag + print *, "Error: struct dot member does not exist" + stop + end if + print *, "member id = ", member_id - ! TODO: save dot info in syntax node + expr%right%id_index = member_id + !expr%right%id_index = 2 end subroutine parse_dot diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index f544f5eb..8f711798 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -840,6 +840,13 @@ module function parse_struct_instance(parser) result(inst) allocate(inst%val%struct( struct%num_vars )) allocate(inst%members ( struct%num_vars )) + !if (allocated(inst%struct)) deallocate(inst%struct) + !allocate(inst%struct) + !inst%struct = struct + inst%struct_name = identifier%text + + inst%val%struct_name = identifier%text + ! TODO: each struct should get a different sub type (like array_type) for ! type checking, so you don't try to assign one type of struct to another ! struct diff --git a/src/types.f90 b/src/types.f90 index 57c73458..fc9ad7a8 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -178,6 +178,9 @@ module syntran__types_m type(value_t) :: val + !type(struct_t), allocatable :: struct + character(len = :), allocatable :: struct_name + type(string_vector_t) :: diagnostics ! Only used to handle comment/whitespace lines for now @@ -701,6 +704,10 @@ recursive subroutine syntax_node_copy(dst, src) dst%identifier = src%identifier dst%id_index = src%id_index + if (allocated(src%struct_name)) then + dst%struct_name = src%struct_name + end if + dst%expecting = src%expecting dst%first_expecting = src%first_expecting @@ -761,6 +768,13 @@ recursive subroutine syntax_node_copy(dst, src) deallocate(dst%body) end if + !if (allocated(src%struct)) then + ! if (.not. allocated(dst%struct)) allocate(dst%struct) + ! dst%struct = src%struct + !else if (allocated(dst%struct)) then + ! deallocate(dst%struct) + !end if + if (allocated(src%array)) then if (.not. allocated(dst%array)) allocate(dst%array) dst%array = src%array diff --git a/src/value.f90 b/src/value.f90 index 09bb4e8d..1e402867 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -97,6 +97,7 @@ module syntran__value_m !type(struct_t), allocatable :: struct !type(struct_val_t), allocatable :: struct type(value_t), allocatable :: struct(:) + character(len = :), allocatable :: struct_name contains procedure :: to_str => value_to_str From 6a32f3f6aeaf6cf8a066e420afb17dc716586e29 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 10 Jun 2024 12:46:50 -0400 Subject: [PATCH 012/137] fix structs initialized by expressions --- samples/struct.syntran | 22 +++++++++++++++++----- src/eval.f90 | 37 ++++++++++++++++++++++++++++++++----- 2 files changed, 49 insertions(+), 10 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index dcf0de04..72a9a2aa 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -42,16 +42,28 @@ struct Date { y: i64 } -//// TODO: expr is eval'd but not saved in struct -//let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; +let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; -let d1 = Date{y = 1912, m = "Apr", d = 14}; +//let d1 = Date{y = 1912, m = "Apr", d = 14}; //d1.d = 1969; println("d1.y = ", d1.y); println("d1.m = ", d1.m); println("d1.d = ", d1.d); +println("t1.hh = ", t1.hh); +println("t1.mm = ", t1.mm); +println("t1.ss = ", t1.ss); + +println("t2.hh = ", t2.hh); +println("t2.mm = ", t2.mm); +println("t2.ss = ", t2.ss); + +d1 = Date{y = 1900 + 45, m = "Ma" + "y", d = 5*4}; +println("d1.y = ", d1.y); +println("d1.m = ", d1.m); +println("d1.d = ", d1.d); + //******** fn set_time_glbl(h: i32, m: i32, s:f32) @@ -72,8 +84,8 @@ fn print_time_glbl() return; } -set_time_glbl(10, 20, 0.030); -print_time_glbl(); +//set_time_glbl(10, 20, 0.030); +//print_time_glbl(); return 0; diff --git a/src/eval.f90 b/src/eval.f90 index 3aee6453..0ecccd09 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -48,6 +48,8 @@ recursive subroutine syntax_eval(node, state, res) !******** + integer :: i + !print *, 'starting syntax_eval()' ! if_statement and while_statement may return an uninitialized type @@ -110,8 +112,12 @@ recursive subroutine syntax_eval(node, state, res) if (res%type == struct_type) then print *, "size struct = ", size(res%struct) print *, "size struct = ", size( state%vars%vals(node%id_index)%struct ) - print *, "struct[1] = ", res%struct(1)%to_str() - print *, "struct[1] = ", state%vars%vals(node%id_index)%struct(1)%to_str() + + do i = 1, size(res%struct) + print *, "struct[", str(i), "] = ", res%struct(i)%to_str() + print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() + end do + end if case (fn_call_expr) @@ -386,11 +392,25 @@ subroutine eval_dot_expr(node, state, res) !******** - print *, "eval dot_expr" + type(value_t) :: tmp + + !print *, "eval dot_expr" !!res = node%members%val(1) !res = node%val%struct(1) - res = node%val%struct( node%right%id_index ) + !res = node%val%struct( node%right%id_index ) + + !call syntax_eval(node%members( node%right%id_index ), state, res) + + ! This won't work for struct literal member access. It only works for + ! `identifier.member` + res = state%vars%vals(node%id_index)%struct( node%right%id_index ) + + !print *, "struct[", str(i), "] = ", res%struct(i)%to_str() + !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() + + !call syntax_eval(node%members(i), state, res%struct(i)) + !call syntax_eval(node%members( node%right%id_index ), state, res) end subroutine eval_dot_expr @@ -406,6 +426,8 @@ subroutine eval_struct_instance(node, state, res) !******** + type(value_t) :: tmp + integer :: i print *, 'eval struct_instance_expr' @@ -423,9 +445,14 @@ subroutine eval_struct_instance(node, state, res) do i = 1, size(node%members) - call syntax_eval(node%members(i), state, res%struct(i)) + !call syntax_eval(node%members(i), state, res%struct(i)) + call syntax_eval(node%members(i), state, tmp) + res%struct(i) = tmp print *, "mem[", str(i), "] = ", res%struct(i)%to_str() + !res = node%val%struct( node%right%id_index ) + !node%members(i)%val = res + end do !case default From c9214525b21f11e36e88be29c05c3356a2127fce Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 10 Jun 2024 12:56:14 -0400 Subject: [PATCH 013/137] comments --- samples/struct.syntran | 12 +++++++++++ src/core.f90 | 49 ++++++++++++++++++++++++++---------------- 2 files changed, 43 insertions(+), 18 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index 72a9a2aa..903e8954 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -29,6 +29,7 @@ let t2 = Time{hh = 13, mm = 37, ss = 0.069,}; //fn print_time(t: Time) //{ +// // TODO // println("h = ", t.hh); // println("m = ", t.mm); // println("s = ", t.ss); @@ -59,11 +60,22 @@ println("t2.hh = ", t2.hh); println("t2.mm = ", t2.mm); println("t2.ss = ", t2.ss); +t2 = t1; +println("t2.hh = ", t2.hh); +println("t2.mm = ", t2.mm); +println("t2.ss = ", t2.ss); + d1 = Date{y = 1900 + 45, m = "Ma" + "y", d = 5*4}; println("d1.y = ", d1.y); println("d1.m = ", d1.m); println("d1.d = ", d1.d); +// TODO: date is cast as time by member indices! +t2 = d1; +println("t2.hh = ", t2.hh); +println("t2.mm = ", t2.mm); +println("t2.ss = ", t2.ss); + //******** fn set_time_glbl(h: i32, m: i32, s:f32) diff --git a/src/core.f90 b/src/core.f90 index 94229563..460e9d62 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -29,12 +29,25 @@ module syntran__core_m ! TODO: ! - structs + ! * mvp wip + ! * tbd: + ! + why does gfort crash but ifx works? + ! + LHS dot expr + ! + struct type checking + ! > check dot member types + ! > check mismatches of assigning one struct to another, or passing a + ! struct to a fn + ! + struct fn args + ! + struct fn return values + ! + nested structs + ! + structs of arrays + ! + arrays of structs ! - triage notes from AOC. many things are already fixed ! - jumping control flow: ! * fn return statement done ! * c continue (fortran cycle), c break (fortran loop exit) ! * (sys) exit done - ! > should final return value be used as an implicit sys exit value? + ! + should final return value be used as an implicit sys exit value? ! currently, default exit stat is 0, regardless of what syntran ! "main" returns ! - consider using subroutines with out-args instead of fn return vals for @@ -123,13 +136,13 @@ module syntran__core_m ! - substring indexing and slicing: ! * string arrays get an optional extra rank. omitting the extra rank ! refers to the whole string at that position in the array: - ! > str_vec[0] == str_vec[:,0] - ! > str_mat[0,0] == str_mat[:,0,0] - ! > etc. + ! + str_vec[0] == str_vec[:,0] + ! + str_mat[0,0] == str_mat[:,0,0] + ! + etc. ! * first, single-character indexing - ! > done + ! + done ! * then, range-based slicing - ! > done + ! + done ! - file reading/writing ! * binary file i/o ! * vectorized writes (and reads) for arrays without syntran loops. c.f. @@ -147,20 +160,20 @@ module syntran__core_m ! * check return value is correct type. return statements could help ! with this ! * intrinsic - ! > abs, norm, dot - ! > log - ! > trig: sin, cos, tan, asin, ... - ! > norm, product - ! > reshape - ! > system: multiple out args? iostat and stdout + ! + abs, norm, dot + ! + log + ! + trig: sin, cos, tan, asin, ... + ! + norm, product + ! + reshape + ! + system: multiple out args? iostat and stdout ! * recursive user-defined fns ! * done: - ! > exp (non-variadic, non-polymorphic) - ! > min, max, sum - ! > size (non-variadic but polymorphic) - ! > readln, writeln, println, open, close, str casting - ! > len (of str) - ! > non-recursive user-defined fns + ! + exp (non-variadic, non-polymorphic) + ! + min, max, sum + ! + size (non-variadic but polymorphic) + ! + readln, writeln, println, open, close, str casting + ! + len (of str) + ! + non-recursive user-defined fns ! - use more submodules ! * types.f90 is long and close to leaves of dependency tree. value.f90 ! is also highly depended upon From 0d883d18cd711bbcb16dffbb742e40de894faa7e Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 10 Jun 2024 17:06:52 -0400 Subject: [PATCH 014/137] remove unnecessary temp var --- src/core.f90 | 1 + src/eval.f90 | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 460e9d62..ddaab28c 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -32,6 +32,7 @@ module syntran__core_m ! * mvp wip ! * tbd: ! + why does gfort crash but ifx works? + ! + tests ! + LHS dot expr ! + struct type checking ! > check dot member types diff --git a/src/eval.f90 b/src/eval.f90 index 0ecccd09..a7662e2e 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -426,7 +426,7 @@ subroutine eval_struct_instance(node, state, res) !******** - type(value_t) :: tmp + !type(value_t) :: tmp integer :: i @@ -445,9 +445,9 @@ subroutine eval_struct_instance(node, state, res) do i = 1, size(node%members) - !call syntax_eval(node%members(i), state, res%struct(i)) - call syntax_eval(node%members(i), state, tmp) - res%struct(i) = tmp + call syntax_eval(node%members(i), state, res%struct(i)) + !call syntax_eval(node%members(i), state, tmp) + !res%struct(i) = tmp print *, "mem[", str(i), "] = ", res%struct(i)%to_str() !res = node%val%struct( node%right%id_index ) From e4bbbfdd090ab1f9ac0f8ed91ed7e6d53f34ca18 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 11 Jun 2024 16:26:46 -0400 Subject: [PATCH 015/137] wip, debug gfort, change fns to subroutines --- src/core.f90 | 18 ++++++-- src/parse_expr.f90 | 16 ++++--- src/parse_fn.f90 | 33 +++++++------ src/parse_misc.f90 | 6 +++ src/types.f90 | 113 +++++++++++++++++++++++++++++++-------------- 5 files changed, 126 insertions(+), 60 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index ddaab28c..97f21c54 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -726,10 +726,12 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) type(fns_t) :: fns0 - ! Without `save`, gfortran crashes when this goes out of scope. Maybe I - ! need to work on a manual finalizer to deallocate ternary trees, not just - ! for structs but for the vars_t trees contained within - type(parser_t), save :: parser + ! This no longer seems to make a difference. Previously, without `save`, + ! gfortran crashes when this goes out of scope. Maybe I need to work on a + ! manual finalizer to deallocate ternary trees, not just for structs but for + ! the vars_t trees contained within + type(parser_t) :: parser + !type(parser_t), save :: parser type(syntax_token_t) :: token @@ -868,6 +870,12 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) !******************************* ! Parse the tokens tree = parser%parse_unit() + + !print *, "" + !print *, "in core.f90:" + !print *, "parser structs root = ", parser%structs%dict%root%split_char + !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char + !******************************* tree%expecting = parser%expecting @@ -953,7 +961,7 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) !print *, "size = ", size(parser%structs%structs) !print *, "allocated = ", allocated(parser%structs%structs) !print *, "size = ", size(parser%structs%dicts) - print *, "allocated = ", allocated(parser%structs%dict%root) + !print *, "allocated = ", allocated(parser%structs%dict%root) !deallocate(parser%structs%dict%root) !call struct_ternary_tree_final(parser%structs%dict%root) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 1622e2e6..1ae9e809 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -161,7 +161,7 @@ recursive module function parse_expr_statement(parser) result(expr) ! Get the identifier's type and index from the dict and check that it ! has been declared - expr%val = parser%vars%search(identifier%text, expr%id_index, io) + call parser%vars%search(identifier%text, expr%id_index, io, expr%val) if (io /= exit_success) then span = new_span(identifier%pos, len(identifier%text)) @@ -519,6 +519,8 @@ module function parse_name_expr(parser) result(expr) type(syntax_token_t) :: identifier type(text_span_t) :: span + type(value_t) :: var + ! Variable name expression identifier = parser%match(identifier_token) @@ -527,8 +529,9 @@ module function parse_name_expr(parser) result(expr) !print *, '%current_kind() = ', kind_name(parser%current_kind()) !print *, 'searching' - expr = new_name_expr(identifier, & - parser%vars%search(identifier%text, id_index, io)) + + call parser%vars%search(identifier%text, id_index, io, var) + expr = new_name_expr(identifier, var) expr%id_index = id_index if (io /= exit_success) then @@ -644,15 +647,16 @@ module subroutine parse_dot(parser, expr) ! Is there a better way than looking up every struct by name again? - !struct = parser%structs%search(parser%current_text(), struct_id, io) - struct = parser%structs%search(expr%val%struct_name, struct_id, io) + !struct = parser%structs%search(expr%val%struct_name, struct_id, io) + call parser%structs%search(expr%val%struct_name, struct_id, io, struct) + if (io /= 0) then print *, "Error: unreachable struct lookup failure" stop end if !member = struct%vars%search(name%text, member_id, io) - member = struct%vars%search(identifier%text, member_id, io) + call struct%vars%search(identifier%text, member_id, io, member) if (io /= 0) then ! TODO: diag print *, "Error: struct dot member does not exist" diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 8f711798..9147e836 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -605,7 +605,8 @@ module function parse_struct_declaration(parser) result(decl) integer :: itype, i, io, pos0, pos1, pos2, rank - type(struct_t) :: struct + type(struct_t), save :: struct + !type(struct_t) :: struct type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & colon, name, struct_kw @@ -768,16 +769,6 @@ module function parse_struct_declaration(parser) result(decl) ! span, identifier%text)) end if - !call parser%vars%insert(identifier%text, expr%val, & - ! expr%id_index, io, overwrite = .false.) - !!print *, 'io = ', io - !if (io /= exit_success) then - ! span = new_span(identifier%pos, len(identifier%text)) - ! call parser%diagnostics%push( & - ! err_redeclare_var(parser%context(), & - ! span, identifier%text)) - !end if - end do ! Insert struct into parser dict @@ -785,8 +776,13 @@ module function parse_struct_declaration(parser) result(decl) parser%num_structs = parser%num_structs + 1 decl%id_index = parser%num_structs + print *, "inserting identifier ", identifier%text, " into parser structs" call parser%structs%insert(identifier%text, struct, decl%id_index) + !print *, "parser structs root = ", parser%structs%dict%root%split_char + !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char + !call ternary_tree_final(struct%vars%dicts(1)%root) + decl%kind = struct_declaration print *, "done parsing struct" @@ -824,7 +820,13 @@ module function parse_struct_instance(parser) result(inst) print *, 'identifier = ', identifier%text - struct = parser%structs%search(identifier%text, struct_id, io) + !print *, "" + !print *, "in parse_struct_instance():" + !print *, "parser structs root = ", parser%structs%dict%root%split_char + !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char + + !struct = parser%structs%search(identifier%text, struct_id, io) + call parser%structs%search(identifier%text, struct_id, io, struct) print *, "struct io = ", io ! TODO: do we need `mems`? Or just inst%members @@ -866,9 +868,12 @@ module function parse_struct_instance(parser) result(inst) !call struct%vars%insert(struct%members(i)%name, val, & ! struct%num_vars, io, overwrite = .false.) - print *, "allocated = ", allocated(struct%vars%dicts(1)%root) + !print *, "allocated = ", allocated(struct%vars%dicts(1)%root) + !print *, "char root = ", struct%vars%dicts(1)%root%split_char + !print *, "char mid = ", struct%vars%dicts(1)%root%mid%split_char + + call struct%vars%search(name%text, member_id, io, member) - member = struct%vars%search(name%text, member_id, io) !member = parser%structs(struct_id)%vars%search(name%text, member_id, io) print *, "member io = ", io print *, "member id = ", member_id diff --git a/src/parse_misc.f90 b/src/parse_misc.f90 index 9ffc2012..6bfbd1c8 100644 --- a/src/parse_misc.f90 +++ b/src/parse_misc.f90 @@ -382,6 +382,12 @@ module function parse_unit(parser) result(unit) call members%push(parser%parse_fn_declaration()) else if (parser%current_kind() == struct_keyword) then call members%push(parser%parse_struct_declaration()) + + !print *, "" + !print *, "in parse_misc.f90:" + !print *, "parser structs root = ", parser%structs%dict%root%split_char + !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char + else call members%push(parser%parse_statement()) end if diff --git a/src/types.f90 b/src/types.f90 index fc9ad7a8..d8c6340c 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -366,12 +366,13 @@ recursive subroutine struct_copy(dst, src) dst%num_vars = src%num_vars - if (allocated(src%members)) then - if (.not. allocated(dst%members)) allocate(dst%members( size(src%members) )) - dst%members = src%members - else if (allocated(dst%members)) then - deallocate(dst%members) - end if + !! TODO: re-enable this or delete members from fortran type + !if (allocated(src%members)) then + ! if (.not. allocated(dst%members)) allocate(dst%members( size(src%members) )) + ! dst%members = src%members + !else if (allocated(dst%members)) then + ! deallocate(dst%members) + !end if !if (allocated(src%vars)) then ! if (.not. allocated(dst%vars)) allocate(dst%vars) @@ -897,21 +898,25 @@ recursive subroutine ternary_tree_copy(dst, src) if (allocated(src%val)) then if (.not. allocated(dst%val)) allocate(dst%val) dst%val = src%val + !call ternary_tree_copy(dst%val, src%val) end if if (allocated(src%left)) then if (.not. allocated(dst%left)) allocate(dst%left) - dst%left = src%left + !dst%left = src%left + call ternary_tree_copy(dst%left, src%left) end if if (allocated(src%mid)) then if (.not. allocated(dst%mid)) allocate(dst%mid) - dst%mid = src%mid + !dst%mid = src%mid + call ternary_tree_copy(dst%mid, src%mid) end if if (allocated(src%right)) then if (.not. allocated(dst%right)) allocate(dst%right) - dst%right = src%right + !dst%right = src%right + call ternary_tree_copy(dst%right, src%right) end if end subroutine ternary_tree_copy @@ -960,7 +965,7 @@ end subroutine var_insert !=============================================================================== -function var_search(dict, key, id_index, iostat) result(val) +subroutine var_search(dict, key, id_index, iostat, val) ! An id_index is not normally part of dictionary searching, but we use it ! here for converting the dictionary into an array after parsing and before @@ -979,17 +984,17 @@ function var_search(dict, key, id_index, iostat) result(val) i = dict%scope - val = ternary_search(dict%dicts(i)%root, key, id_index, io) + call ternary_search(dict%dicts(i)%root, key, id_index, io, val) ! If not found in current scope, search parent scopes too do while (io /= exit_success .and. i > 1) i = i - 1 - val = ternary_search(dict%dicts(i)%root, key, id_index, io) + call ternary_search(dict%dicts(i)%root, key, id_index, io, val) end do if (present(iostat)) iostat = io -end function var_search +end subroutine var_search !=============================================================================== @@ -1362,7 +1367,7 @@ end function is_assignment_op !=============================================================================== -recursive function ternary_search(node, key, id_index, iostat) result(val) +recursive subroutine ternary_search(node, key, id_index, iostat, val) type(ternary_tree_node_t), intent(in), allocatable :: node character(len = *), intent(in) :: key @@ -1391,13 +1396,13 @@ recursive function ternary_search(node, key, id_index, iostat) result(val) ey = key(2:) if (k < node%split_char) then - val = ternary_search(node%left , key, id_index, iostat) + call ternary_search(node%left , key, id_index, iostat, val) return else if (k > node%split_char) then - val = ternary_search(node%right, key, id_index, iostat) + call ternary_search(node%right, key, id_index, iostat, val) return else if (len(ey) > 0) then - val = ternary_search(node%mid , ey, id_index, iostat) + call ternary_search(node%mid , ey, id_index, iostat, val) return end if @@ -1414,7 +1419,7 @@ recursive function ternary_search(node, key, id_index, iostat) result(val) !print *, 'done ternary_search' !print *, '' -end function ternary_search +end subroutine ternary_search !=============================================================================== @@ -2270,21 +2275,22 @@ end function struct_ternary_exists !=============================================================================== -recursive function struct_ternary_search(node, key, id_index, iostat) result(val) +!recursive function struct_ternary_search(node, key, id_index, iostat) result(val) +recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) type(struct_ternary_tree_node_t), intent(in), allocatable :: node character(len = *), intent(in) :: key integer, intent(out) :: id_index integer, intent(out) :: iostat - type(struct_t) :: val + type(struct_t) :: val ! intent inout? !******** character :: k character(len = :), allocatable :: ey - !print *, 'searching key ', quote(key) + print *, 'searching key ', quote(key) iostat = exit_success @@ -2299,17 +2305,20 @@ recursive function struct_ternary_search(node, key, id_index, iostat) result(val ey = key(2:) if (k < node%split_char) then - val = struct_ternary_search(node%left , key, id_index, iostat) + call struct_ternary_search(node%left , key, id_index, iostat, val) + print *, "return left" return else if (k > node%split_char) then - val = struct_ternary_search(node%right, key, id_index, iostat) + call struct_ternary_search(node%right, key, id_index, iostat, val) + print *, "return right" return else if (len(ey) > 0) then - val = struct_ternary_search(node%mid , ey, id_index, iostat) + call struct_ternary_search(node%mid , ey, id_index, iostat, val) + print *, "return mid" return end if - !print *, 'setting val' + print *, 'setting val' if (.not. allocated(node%val)) then iostat = exit_failure @@ -2320,10 +2329,37 @@ recursive function struct_ternary_search(node, key, id_index, iostat) result(val val = node%val id_index = node%id_index - !print *, 'done struct_ternary_search' + print *, 'done struct_ternary_search' !print *, '' -end function struct_ternary_search +!end function struct_ternary_search +end subroutine struct_ternary_search + +!=============================================================================== + +recursive subroutine ternary_tree_final(node) + type(ternary_tree_node_t), intent(inout), allocatable :: node + !type(ternary_tree_node_t), allocatable :: left, mid, right + !type(value_t), allocatable :: val + + if (.not. allocated(node)) return + + !if (allocated(node%val)) deallocate(node%val) + + if (allocated(node%left )) then + call ternary_tree_final(node%left ) + deallocate(node%left) + end if + if (allocated(node%mid )) then + call ternary_tree_final(node%mid ) + deallocate(node%mid) + end if + if (allocated(node%right)) then + call ternary_tree_final(node%right) + deallocate(node%right) + end if + +end subroutine ternary_tree_final !=============================================================================== @@ -2387,6 +2423,7 @@ recursive subroutine struct_ternary_insert(node, key, val, id_index, iostat, ove allocate(node%val) node%val = val + node%val%vars = val%vars node%id_index = id_index !print *, 'done inserting' @@ -2533,7 +2570,8 @@ end function struct_exists !=============================================================================== -function struct_search(dict, key, id_index, iostat) result(val) +!function struct_search(dict, key, id_index, iostat) result(val) +subroutine struct_search(dict, key, id_index, iostat, val) ! An id_index is not normally part of dictionary searching, but we use it ! here for converting the dictionary into an array after parsing and before @@ -2550,19 +2588,24 @@ function struct_search(dict, key, id_index, iostat) result(val) integer :: i, io + print *, "starting struct search" + i = dict%scope - val = struct_ternary_search(dict%dict%root, key, id_index, io) + !val = struct_ternary_search(dict%dict%root, key, id_index, io) + call struct_ternary_search(dict%dict%root, key, id_index, io, val) + print *, "io = ", io - ! If not found in current scope, search parent scopes too - do while (io /= exit_success .and. i > 1) - i = i - 1 - val = struct_ternary_search(dict%dict%root, key, id_index, io) - end do + !! If not found in current scope, search parent scopes too + !do while (io /= exit_success .and. i > 1) + ! i = i - 1 + ! val = struct_ternary_search(dict%dict%root, key, id_index, io) + !end do if (present(iostat)) iostat = io -end function struct_search +!end function struct_search +end subroutine struct_search !=============================================================================== From bd19bce4b32444eac0b23b5061a2c670f74eae42 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 11 Jun 2024 16:44:49 -0400 Subject: [PATCH 016/137] add premature tests; catch non-struct dot expr --- src/parse_expr.f90 | 9 ++++++++- src/parse_fn.f90 | 2 ++ src/tests/test.f90 | 39 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 49 insertions(+), 1 deletion(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 1ae9e809..eff24659 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -633,7 +633,14 @@ module subroutine parse_dot(parser, expr) identifier = parser%match(identifier_token) print *, "dot identifier = ", identifier%text - !print *, "struct name = ", expr%struct_name + print *, "type = ", kind_name(expr%val%type) + + if (expr%val%type /= struct_type) then + ! TODO: diag. Skip if unknown_type? Probably already threw a diag in caller + print *, "Error: variable in dot expr is not a struct" + return + end if + print *, "struct name = ", expr%val%struct_name !expr%kind = name_expr diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 9147e836..3cd20ef0 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -695,6 +695,8 @@ module function parse_struct_declaration(parser) result(decl) ! Now that we have the number of members, save them + struct%num_vars = 0 + if (allocated(struct%members)) deallocate(struct%members) allocate(struct%members( names%len_ )) !allocate(decl %params( names%len_ )) ! if this is needed, we need a new !! name. "members" already means the member statements of a block statement diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 8cfdfeaa..11a47f38 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2448,6 +2448,42 @@ end subroutine unit_test_return !=============================================================================== +subroutine unit_test_struct(npass, nfail) + + ! More advanced tests on longer scripts + + implicit none + + integer, intent(inout) :: npass, nfail + + !******** + + character(len = *), parameter :: label = 'structs' + + logical, parameter :: quiet = .false. + logical, allocatable :: tests(:) + + write(*,*) 'Unit testing '//label//' ...' + + ! TODO: more struct tests + + tests = & + [ & + eval('struct Date{y: i64, m: str, d: i32} let date = Date{y=1912, m="Apr", d=14}; date.y;', quiet) == '1912', & + eval('struct Date{y: i64, m: str, d: i32} let date = Date{y=1912, m="Apr", d=14}; date.m;', quiet) == 'Apr', & + eval('struct Date{y: i64, m: str, d: i32} let date = Date{y=1912, m="Apr", d=14}; date.d;', quiet) == '14', & + .false. & ! so I don't have to bother w/ trailing commas + ] + + ! Trim dummy false element + tests = tests(1: size(tests) - 1) + + call unit_test_coda(tests, label, npass, nfail) + +end subroutine unit_test_struct + +!=============================================================================== + subroutine unit_test_array_bool(npass, nfail) ! More advanced tests on longer scripts @@ -2628,6 +2664,7 @@ subroutine unit_tests(iostat) npass = 0 nfail = 0 + if (.false.) then ! TODO call unit_test_bin_arith (npass, nfail) call unit_test_paren_arith(npass, nfail) call unit_test_unary_arith(npass, nfail) @@ -2665,7 +2702,9 @@ subroutine unit_tests(iostat) call unit_test_arr_comp (npass, nfail) call unit_test_arr_op (npass, nfail) call unit_test_lhs_slc_1 (npass, nfail) + end if call unit_test_return (npass, nfail) + call unit_test_struct (npass, nfail) ! TODO: add tests that mock interpreting one line at a time (as opposed to ! whole files) From ea4078dcdeb0e7810aff07c49bb54b26d2ad739e Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 11 Jun 2024 17:10:23 -0400 Subject: [PATCH 017/137] fix gfort (holy fucking bingle) --- src/parse_fn.f90 | 4 ++-- src/types.f90 | 46 ++++++++++++++++++++++++++++++++++++ src/value.f90 | 61 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 109 insertions(+), 2 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 3cd20ef0..ff543af4 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -605,8 +605,8 @@ module function parse_struct_declaration(parser) result(decl) integer :: itype, i, io, pos0, pos1, pos2, rank - type(struct_t), save :: struct - !type(struct_t) :: struct + !type(struct_t), save :: struct + type(struct_t) :: struct type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & colon, name, struct_kw diff --git a/src/types.f90 b/src/types.f90 index d8c6340c..91c5f0e0 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -257,6 +257,8 @@ module syntran__types_m insert => var_insert, & search => var_search, & push_scope, pop_scope + procedure, pass(dst) :: copy => vars_copy + generic, public :: assignment(=) => copy end type vars_t @@ -353,6 +355,49 @@ module syntran__types_m !=============================================================================== +recursive subroutine vars_copy(dst, src) + + ! Deep copy. This overwrites dst with src + + class(vars_t), intent(inout) :: dst + class(vars_t), intent(in) :: src + + !******** + + integer :: i + + !print *, 'starting vars_copy()' + + !type vars_t + ! type(var_dict_t) :: dicts(scope_max) + ! type(value_t), allocatable :: vals(:) + ! integer :: scope = 1 + + dst%scope = src%scope + + !dst%dicts = src%dicts + do i = 1, size(src%dicts) + if (allocated(src%dicts(i)%root)) then + if (.not. allocated(dst%dicts(i)%root)) allocate(dst%dicts(i)%root) + dst%dicts(i)%root = src%dicts(i)%root + else if (allocated(dst%dicts(i)%root)) then + deallocate(dst%dicts(i)%root) + end if + end do + + if (allocated(src%vals)) then + if (.not. allocated(dst%vals)) allocate(dst%vals( size(src%vals) )) + dst%vals = src%vals + else if (allocated(dst%vals)) then + deallocate(dst%vals) + end if + + !print *, 'done vars_copy()' + +end subroutine vars_copy + +!=============================================================================== + recursive subroutine struct_copy(dst, src) ! Deep copy. This overwrites dst with src @@ -2205,6 +2250,7 @@ recursive subroutine ternary_insert(node, key, val, id_index, iostat, overwrite) return end if + allocate(node%val) node%val = val node%id_index = id_index diff --git a/src/value.f90 b/src/value.f90 index 1e402867..112e9a31 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -106,6 +106,8 @@ module syntran__value_m procedure :: to_i64 => value_to_i64 procedure :: to_i32_array => value_to_i32_array procedure :: to_i64_array => value_to_i64_array + procedure, pass(dst) :: copy => value_copy + generic, public :: assignment(=) => copy end type value_t @@ -115,6 +117,65 @@ module syntran__value_m !=============================================================================== +recursive subroutine value_copy(dst, src) + + ! Deep copy. Default Fortran assignment operator doesn't handle recursion + ! correctly for my node type, leaving dangling refs to src when it is + ! deallocated. + ! + ! Args have to be in the confusing dst, src order for overloading + + class(value_t), intent(inout) :: dst + class(value_t), intent(in) :: src + + !******** + + integer :: i + + if (debug > 3) print *, 'starting value_copy()' + + !type value_t + ! integer :: type = unknown_type + ! type(scalar_t) :: sca + ! type(array_t), allocatable :: array + ! type(value_t), allocatable :: struct(:) + ! character(len = :), allocatable :: struct_name + + dst%type = src%type + dst%sca = src%sca + + if (allocated(src%struct_name)) then + dst%struct_name = src%struct_name + end if + + if (allocated(src%array)) then + if (.not. allocated(dst%array)) allocate(dst%array) + dst%array = src%array + else if (allocated(dst%array)) then + deallocate(dst%array) + end if + + if (allocated(src%struct)) then + if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) + !dst%struct = src%struct + do i = 1, size(src%struct) + dst%struct(i) = src%struct(i) + end do + else if (allocated(dst%struct)) then + deallocate(dst%struct) + end if + + !if (allocated(src%left)) then + ! if (.not. allocated(dst%left)) allocate(dst%left) + ! dst%left = src%left + !else if (allocated(dst%left)) then + ! deallocate(dst%left) + !end if + +end subroutine value_copy + +!=============================================================================== + function mold(mold_, type_) result(array) ! Construct array meta-data, such as type, rank, and size, based on a given From eb16ba913d46200e9c2f227c9ae81fc26be0426d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 11 Jun 2024 17:20:43 -0400 Subject: [PATCH 018/137] add a couple more struct tests --- src/tests/test.f90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 11a47f38..5809230b 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2469,9 +2469,21 @@ subroutine unit_test_struct(npass, nfail) tests = & [ & - eval('struct Date{y: i64, m: str, d: i32} let date = Date{y=1912, m="Apr", d=14}; date.y;', quiet) == '1912', & - eval('struct Date{y: i64, m: str, d: i32} let date = Date{y=1912, m="Apr", d=14}; date.m;', quiet) == 'Apr', & - eval('struct Date{y: i64, m: str, d: i32} let date = Date{y=1912, m="Apr", d=14}; date.d;', quiet) == '14', & + eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=14}; d.y;', quiet) == '1912', & + eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=14}; d.m;', quiet) == 'Apr', & + eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=14}; d.d;', quiet) == '14', & + eval('struct D{y:i64, m:str, d:i32} let d = D{y=1900+12, m="Apr", d=14}; d.y;', quiet) == '1912', & + eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=7*2}; let e=d; e.d;', quiet) == '14', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let e=d;' & + //'e = D{y=1945, m="May", d=5*3};' & + //'e.d;', quiet) == '15', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let e=d;' & + //'e = D{y=1945, m="May", d=5*3};' & + //'d.d;', quiet) == '14', & .false. & ! so I don't have to bother w/ trailing commas ] From 404b02aea6e1a3dfb79f090d3f933e3581df56a7 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 11 Jun 2024 17:31:44 -0400 Subject: [PATCH 019/137] fix ifx bug; comments --- src/core.f90 | 6 ++++++ src/parse_expr.f90 | 4 ++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 97f21c54..3c13f089 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -32,7 +32,13 @@ module syntran__core_m ! * mvp wip ! * tbd: ! + why does gfort crash but ifx works? + ! > fixed by implementing value_copy() + ! > a lot of the other junk that i tried before stumbling onto + ! value_copy() can probably be reverted and cleaned up ! + tests + ! > moar + ! + remove unused things like mems/members copies in various + ! types/routines ! + LHS dot expr ! + struct type checking ! > check dot member types diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index eff24659..e3c7dbf2 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -101,8 +101,8 @@ recursive module function parse_expr_statement(parser) result(expr) ! instead print *, "right type = ", kind_name(right%val%type) if (right%val%type == struct_type) then - print *, "struct_name = ", right%struct_name - expr%struct_name = right%struct_name + !print *, "struct_name = ", right%struct_name + expr%struct_name = right%val%struct_name end if return From 1a1aff61ffd939293f43024e9c755b8105f2c127 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Wed, 12 Jun 2024 14:10:12 -0400 Subject: [PATCH 020/137] fix unset existance return value --- src/types.f90 | 1 + src/value.f90 | 17 +++++------------ 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/src/types.f90 b/src/types.f90 index 91c5f0e0..c0cec005 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -2279,6 +2279,7 @@ recursive function struct_ternary_exists(node, key, id_index, iostat) result(exi !print *, 'searching key ', quote(key) iostat = exit_success + exists = .false. if (.not. allocated(node)) then ! Search key not found diff --git a/src/value.f90 b/src/value.f90 index 112e9a31..3dfe689b 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -120,7 +120,7 @@ module syntran__value_m recursive subroutine value_copy(dst, src) ! Deep copy. Default Fortran assignment operator doesn't handle recursion - ! correctly for my node type, leaving dangling refs to src when it is + ! correctly for my types, leaving dangling refs to src when it is ! deallocated. ! ! Args have to be in the confusing dst, src order for overloading @@ -157,21 +157,14 @@ recursive subroutine value_copy(dst, src) if (allocated(src%struct)) then if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) - !dst%struct = src%struct - do i = 1, size(src%struct) - dst%struct(i) = src%struct(i) - end do + dst%struct = src%struct + !do i = 1, size(src%struct) + ! dst%struct(i) = src%struct(i) + !end do else if (allocated(dst%struct)) then deallocate(dst%struct) end if - !if (allocated(src%left)) then - ! if (.not. allocated(dst%left)) allocate(dst%left) - ! dst%left = src%left - !else if (allocated(dst%left)) then - ! deallocate(dst%left) - !end if - end subroutine value_copy !=============================================================================== From 79c39ab2289bad52d0ddc9e51e48ac1dc9d2d3ac Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Wed, 12 Jun 2024 14:24:38 -0400 Subject: [PATCH 021/137] remove intel classic ifort 2021.1 --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 514b9bbf..b6bc1e4a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -170,7 +170,7 @@ #{"compiler": "intel", "version": "2023.0"}, # crashes on ` do while (is_whitespace(context%text(j:j)))` #{"compiler": "intel", "version": "2022.2"}, # ifx 2022.2 doesn't have `do while ()` :( #{"compiler": "intel", "version": "2024.0"}, - {"compiler": "intel-classic", "version": "2021.1"}, + #{"compiler": "intel-classic", "version": "2021.1"}, # complains about coarrays??? {"compiler": "intel-classic", "version": "2021.10"}, #{"compiler": "nvidia-hpc", "version": "23.11"} # setup fails ] From c94098cc453e90be46001134a78a52a93b7221ec Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 21 Jun 2024 19:39:07 -0400 Subject: [PATCH 022/137] cleanup (mostly debug logging) --- src/core.f90 | 2 +- src/eval.f90 | 56 ++++++++++++---------------------------------- src/parse_expr.f90 | 24 ++++++++++---------- src/parse_fn.f90 | 31 ++++++++++++------------- src/tests/test.f90 | 2 -- src/types.f90 | 16 ++++++------- 6 files changed, 51 insertions(+), 80 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 3c13f089..be8e0627 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -29,7 +29,7 @@ module syntran__core_m ! TODO: ! - structs - ! * mvp wip + ! * mvp done ! * tbd: ! + why does gfort crash but ifx works? ! > fixed by implementing value_copy() diff --git a/src/eval.f90 b/src/eval.f90 index a7662e2e..13382677 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -103,22 +103,20 @@ recursive subroutine syntax_eval(node, state, res) ! Assign return value call syntax_eval(node%right, state, res) - print *, 'assigning identifier ', quote(node%identifier%text) + !print *, 'assigning identifier ', quote(node%identifier%text) state%vars%vals(node%id_index) = res - print *, "res type = ", kind_name(res%type) - print *, "allocated(struct) = ", allocated(res%struct) - if (res%type == struct_type) then - print *, "size struct = ", size(res%struct) - print *, "size struct = ", size( state%vars%vals(node%id_index)%struct ) - - do i = 1, size(res%struct) - print *, "struct[", str(i), "] = ", res%struct(i)%to_str() - print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() - end do - - end if + !print *, "res type = ", kind_name(res%type) + !print *, "allocated(struct) = ", allocated(res%struct) + !if (res%type == struct_type) then + ! print *, "size struct = ", size(res%struct) + ! print *, "size struct = ", size( state%vars%vals(node%id_index)%struct ) + ! do i = 1, size(res%struct) + ! print *, "struct[", str(i), "] = ", res%struct(i)%to_str() + ! print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() + ! end do + !end if case (fn_call_expr) call eval_fn_call(node, state, res) @@ -439,9 +437,9 @@ subroutine eval_struct_instance(node, state, res) if (allocated(res%struct)) deallocate(res%struct) allocate(res%struct( size(node%members) )) - print *, 'res type = ', kind_name(res%type) - print *, "num members = ", size(node%members) - print *, "num members = ", size(res%struct) + !print *, 'res type = ', kind_name(res%type) + !print *, "num members = ", size(node%members) + !print *, "num members = ", size(res%struct) do i = 1, size(node%members) @@ -455,32 +453,6 @@ subroutine eval_struct_instance(node, state, res) end do - !case default - ! ! User-defined function - ! if (.not. allocated(node%params)) then - ! write(*,*) err_int_prefix//'unexpected fn'//color_reset - ! call internal_error() - ! end if - ! !print *, 'fn name = ', node%identifier%text - ! !print *, 'fn idx = ', node%id_index - ! !print *, 'node type = ', node%val%type - ! !print *, 'size params = ', size(node%params) - ! !print *, 'param ids = ', node%params - ! ! Pass by value (for now, at least). Arguments are evaluated and - ! ! their values are copied to the fn parameters - ! do i = 1, size(node%params) - ! !print *, 'copying param ', i - ! call syntax_eval(node%args(i), state, tmp) - ! state%vars%vals( node%params(i) ) = tmp - ! !print *, "param type = ", kind_name(state%vars%vals( node%params(i) )%type) - ! !print *, "param rank = ", state%vars%vals( node%params(i) )%array%rank - ! !print *, "param size = ", state%vars%vals( node%params(i) )%array%size - ! end do - ! call syntax_eval(node%body, state, res) - ! !print *, "res rank = ", res%array%rank - ! !print *, 'res = ', res%to_str() - !end select - end subroutine eval_struct_instance !=============================================================================== diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index e3c7dbf2..1b4ba846 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -99,7 +99,7 @@ recursive module function parse_expr_statement(parser) result(expr) ! TODO: this should be unnecessary. Store the struct name in the value ! instead - print *, "right type = ", kind_name(right%val%type) + !print *, "right type = ", kind_name(right%val%type) if (right%val%type == struct_type) then !print *, "struct_name = ", right%struct_name expr%struct_name = right%val%struct_name @@ -458,17 +458,17 @@ module function parse_primary_expr(parser) result(expr) ! the other hand, it might be more optimal to check existence ! w/o copying an output val (which could containt big nested dict ! types) - print *, "text = ", parser%current_text() + !print *, "text = ", parser%current_text() !dummy = parser%structs%search(parser%current_text(), dummy_id, io) exists = parser%structs%exists(parser%current_text(), dummy_id, io) !deallocate(dummy%members) !deallocate(dummy%vars) - print *, "io = ", io + !print *, "io = ", io - if (io == 0) then - !if (exists) then + !if (io == 0) then + if (exists) then expr = parser%parse_struct_instance() - print *, "back in parse_expr.f90" + !print *, "back in parse_expr.f90" else ! Same as default case below expr = parser%parse_name_expr() @@ -525,7 +525,7 @@ module function parse_name_expr(parser) result(expr) identifier = parser%match(identifier_token) - print *, 'RHS identifier = ', identifier%text + !print *, 'RHS identifier = ', identifier%text !print *, '%current_kind() = ', kind_name(parser%current_kind()) !print *, 'searching' @@ -632,8 +632,8 @@ module subroutine parse_dot(parser, expr) identifier = parser%match(identifier_token) - print *, "dot identifier = ", identifier%text - print *, "type = ", kind_name(expr%val%type) + !print *, "dot identifier = ", identifier%text + !print *, "type = ", kind_name(expr%val%type) if (expr%val%type /= struct_type) then ! TODO: diag. Skip if unknown_type? Probably already threw a diag in caller @@ -641,7 +641,7 @@ module subroutine parse_dot(parser, expr) return end if - print *, "struct name = ", expr%val%struct_name + !print *, "struct name = ", expr%val%struct_name !expr%kind = name_expr expr%kind = dot_expr @@ -658,6 +658,7 @@ module subroutine parse_dot(parser, expr) call parser%structs%search(expr%val%struct_name, struct_id, io, struct) if (io /= 0) then + ! TODO: diag print *, "Error: unreachable struct lookup failure" stop end if @@ -669,10 +670,9 @@ module subroutine parse_dot(parser, expr) print *, "Error: struct dot member does not exist" stop end if - print *, "member id = ", member_id + !print *, "member id = ", member_id expr%right%id_index = member_id - !expr%right%id_index = 2 end subroutine parse_dot diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index ff543af4..7542a441 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -625,7 +625,7 @@ module function parse_struct_declaration(parser) result(decl) struct_kw = parser%match(struct_keyword) identifier = parser%match(identifier_token) - print *, "parsing struct ", identifier%text + !print *, "parsing struct ", identifier%text pos1 = parser%current_pos() @@ -732,7 +732,7 @@ module function parse_struct_declaration(parser) result(decl) ! Declare the member !parser%num_vars = parser%num_vars + 1 struct%num_vars = struct%num_vars + 1 - print *, "struct%num_vars = ", struct%num_vars + !print *, "struct%num_vars = ", struct%num_vars !! Save parameters by id_index !decl%params(i) = parser%num_vars @@ -755,8 +755,8 @@ module function parse_struct_declaration(parser) result(decl) ! TODO: check for duplicate member names - print *, "insert var type ", kind_name(val%type) - print *, "name = ", struct%members(i)%name + !print *, "insert var type ", kind_name(val%type) + print *, "insert var name = ", struct%members(i)%name !call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) !call struct%vars%insert(struct%members(i)%name, val, struct%num_vars) @@ -764,6 +764,7 @@ module function parse_struct_declaration(parser) result(decl) struct%num_vars, io, overwrite = .false.) !print *, 'io = ', io if (io /= exit_success) then + ! TODO: diag print *, "Error: re-declared struct member" !span = new_span(identifier%pos, len(identifier%text)) !call parser%diagnostics%push( & @@ -778,7 +779,7 @@ module function parse_struct_declaration(parser) result(decl) parser%num_structs = parser%num_structs + 1 decl%id_index = parser%num_structs - print *, "inserting identifier ", identifier%text, " into parser structs" + !print *, "inserting identifier ", identifier%text, " into parser structs" call parser%structs%insert(identifier%text, struct, decl%id_index) !print *, "parser structs root = ", parser%structs%dict%root%split_char @@ -787,7 +788,7 @@ module function parse_struct_declaration(parser) result(decl) decl%kind = struct_declaration - print *, "done parsing struct" + !print *, "done parsing struct" end function parse_struct_declaration @@ -816,11 +817,11 @@ module function parse_struct_instance(parser) result(inst) type(value_t) :: member - print *, "starting parse_struct_instance()" + !print *, "starting parse_struct_instance()" identifier = parser%match(identifier_token) - print *, 'identifier = ', identifier%text + print *, "parsing struct instance of identifier = ", identifier%text !print *, "" !print *, "in parse_struct_instance():" @@ -829,7 +830,7 @@ module function parse_struct_instance(parser) result(inst) !struct = parser%structs%search(identifier%text, struct_id, io) call parser%structs%search(identifier%text, struct_id, io, struct) - print *, "struct io = ", io + !print *, "struct io = ", io ! TODO: do we need `mems`? Or just inst%members mems = new_syntax_node_vector() @@ -877,8 +878,8 @@ module function parse_struct_instance(parser) result(inst) call struct%vars%search(name%text, member_id, io, member) !member = parser%structs(struct_id)%vars%search(name%text, member_id, io) - print *, "member io = ", io - print *, "member id = ", member_id + !print *, "member io = ", io + !print *, "member id = ", member_id if (io /= 0) then ! TODO: diag @@ -887,7 +888,7 @@ module function parse_struct_instance(parser) result(inst) end if ! TODO: add a size check here too - print *, "mem type = ", kind_name(mem%val%type) + !print *, "mem type = ", kind_name(mem%val%type) ! Members can be instantiated out of order inst%val%struct( member_id ) = mem%val @@ -906,8 +907,8 @@ module function parse_struct_instance(parser) result(inst) rbrace = parser%match(rbrace_token) - print *, "size = ", struct%num_vars - print *, "size = ", mems%len_ + !print *, "size = ", struct%num_vars + !print *, "size = ", mems%len_ if (mems%len_ /= struct%num_vars) then ! TODO: diag print *, "Error: struct instance does not have the right number of members" @@ -916,7 +917,7 @@ module function parse_struct_instance(parser) result(inst) ! TODO: check type of members match - print *, "ending parse_struct_instance()" + !print *, "ending parse_struct_instance()" end function parse_struct_instance diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 5809230b..948e6f3a 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2676,7 +2676,6 @@ subroutine unit_tests(iostat) npass = 0 nfail = 0 - if (.false.) then ! TODO call unit_test_bin_arith (npass, nfail) call unit_test_paren_arith(npass, nfail) call unit_test_unary_arith(npass, nfail) @@ -2714,7 +2713,6 @@ subroutine unit_tests(iostat) call unit_test_arr_comp (npass, nfail) call unit_test_arr_op (npass, nfail) call unit_test_lhs_slc_1 (npass, nfail) - end if call unit_test_return (npass, nfail) call unit_test_struct (npass, nfail) diff --git a/src/types.f90 b/src/types.f90 index c0cec005..4c22dfab 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -2337,7 +2337,7 @@ recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) character :: k character(len = :), allocatable :: ey - print *, 'searching key ', quote(key) + !print *, 'searching key ', quote(key) iostat = exit_success @@ -2353,19 +2353,19 @@ recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) if (k < node%split_char) then call struct_ternary_search(node%left , key, id_index, iostat, val) - print *, "return left" + !print *, "return left" return else if (k > node%split_char) then call struct_ternary_search(node%right, key, id_index, iostat, val) - print *, "return right" + !print *, "return right" return else if (len(ey) > 0) then call struct_ternary_search(node%mid , ey, id_index, iostat, val) - print *, "return mid" + !print *, "return mid" return end if - print *, 'setting val' + !print *, 'setting val' if (.not. allocated(node%val)) then iostat = exit_failure @@ -2376,7 +2376,7 @@ recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) val = node%val id_index = node%id_index - print *, 'done struct_ternary_search' + !print *, 'done struct_ternary_search' !print *, '' !end function struct_ternary_search @@ -2635,13 +2635,13 @@ subroutine struct_search(dict, key, id_index, iostat, val) integer :: i, io - print *, "starting struct search" + !print *, "starting struct search" i = dict%scope !val = struct_ternary_search(dict%dict%root, key, id_index, io) call struct_ternary_search(dict%dict%root, key, id_index, io, val) - print *, "io = ", io + !print *, "io = ", io !! If not found in current scope, search parent scopes too !do while (io /= exit_success .and. i > 1) From cf6c52145d11c5d62f729b04fd7f0998b6ed6871 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 21 Jun 2024 20:17:05 -0400 Subject: [PATCH 023/137] copy constructors can't be removed --- samples/struct.syntran | 28 ------------ src/consts.f90 | 4 +- src/core.f90 | 4 -- src/parse_misc.f90 | 15 +++---- src/types.f90 | 96 ++++++++++++++++++++++-------------------- src/value.f90 | 19 ++------- 6 files changed, 60 insertions(+), 106 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index 903e8954..f44dd363 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -1,9 +1,4 @@ -let hh_glbl = 0; -let mm_glbl = 0; -let ss_glbl = 0.0; - -//******** struct Time { hh: i32, @@ -76,28 +71,5 @@ println("t2.hh = ", t2.hh); println("t2.mm = ", t2.mm); println("t2.ss = ", t2.ss); -//******** - -fn set_time_glbl(h: i32, m: i32, s:f32) -{ - hh_glbl = h; - mm_glbl = m; - ss_glbl = s; - return; -} - -fn print_time_glbl() -{ - println("starting print_time_glbl()"); - //println(hh_glbl, ":", mm_glbl, ":", ss_glbl); - println("h = ", hh_glbl); - println("m = ", mm_glbl); - println("s = ", ss_glbl); - return; -} - -//set_time_glbl(10, 20, 0.030); -//print_time_glbl(); - return 0; diff --git a/src/consts.f90 b/src/consts.f90 index a170d74e..eaf34d84 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -20,8 +20,8 @@ module syntran__consts_m struct_type = 97, & struct_instance_expr = 96, & struct_declaration = 95, & - struct_keyword = 94, & - dot_token = 93, & + struct_keyword = 94, & + dot_token = 93, & return_statement = 92, & return_keyword = 91, & size_array = 90, & diff --git a/src/core.f90 b/src/core.f90 index be8e0627..1be229e2 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -31,10 +31,6 @@ module syntran__core_m ! - structs ! * mvp done ! * tbd: - ! + why does gfort crash but ifx works? - ! > fixed by implementing value_copy() - ! > a lot of the other junk that i tried before stumbling onto - ! value_copy() can probably be reverted and cleaned up ! + tests ! > moar ! + remove unused things like mems/members copies in various diff --git a/src/parse_misc.f90 b/src/parse_misc.f90 index 6bfbd1c8..700efe53 100644 --- a/src/parse_misc.f90 +++ b/src/parse_misc.f90 @@ -378,19 +378,14 @@ module function parse_unit(parser) result(unit) i = i + 1 !print *, ' statement ', i - if (parser%current_kind() == fn_keyword) then + select case (parser%current_kind()) + case (fn_keyword) call members%push(parser%parse_fn_declaration()) - else if (parser%current_kind() == struct_keyword) then + case (struct_keyword) call members%push(parser%parse_struct_declaration()) - - !print *, "" - !print *, "in parse_misc.f90:" - !print *, "parser structs root = ", parser%structs%dict%root%split_char - !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char - - else + case default call members%push(parser%parse_statement()) - end if + end select ! Break infinite loops if (parser%pos == pos0) dummy = parser%next() diff --git a/src/types.f90 b/src/types.f90 index 4c22dfab..18a43dad 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -257,6 +257,8 @@ module syntran__types_m insert => var_insert, & search => var_search, & push_scope, pop_scope + + ! This is required unfortunately procedure, pass(dst) :: copy => vars_copy generic, public :: assignment(=) => copy @@ -278,6 +280,7 @@ module syntran__types_m integer :: num_vars = 0 contains + ! This is also required unfortunately procedure, pass(dst) :: copy => struct_copy generic, public :: assignment(=) => copy @@ -294,6 +297,7 @@ module syntran__types_m integer :: id_index contains + ! This is also required unfortunately too procedure, pass(dst) :: copy => struct_ternary_tree_copy generic, public :: assignment(=) => copy !final :: struct_ternary_tree_final @@ -2384,29 +2388,29 @@ end subroutine struct_ternary_search !=============================================================================== -recursive subroutine ternary_tree_final(node) - type(ternary_tree_node_t), intent(inout), allocatable :: node - !type(ternary_tree_node_t), allocatable :: left, mid, right - !type(value_t), allocatable :: val - - if (.not. allocated(node)) return - - !if (allocated(node%val)) deallocate(node%val) - - if (allocated(node%left )) then - call ternary_tree_final(node%left ) - deallocate(node%left) - end if - if (allocated(node%mid )) then - call ternary_tree_final(node%mid ) - deallocate(node%mid) - end if - if (allocated(node%right)) then - call ternary_tree_final(node%right) - deallocate(node%right) - end if - -end subroutine ternary_tree_final +!recursive subroutine ternary_tree_final(node) +! type(ternary_tree_node_t), intent(inout), allocatable :: node +! !type(ternary_tree_node_t), allocatable :: left, mid, right +! !type(value_t), allocatable :: val +! +! if (.not. allocated(node)) return +! +! !if (allocated(node%val)) deallocate(node%val) +! +! if (allocated(node%left )) then +! call ternary_tree_final(node%left ) +! deallocate(node%left) +! end if +! if (allocated(node%mid )) then +! call ternary_tree_final(node%mid ) +! deallocate(node%mid) +! end if +! if (allocated(node%right)) then +! call ternary_tree_final(node%right) +! deallocate(node%right) +! end if +! +!end subroutine ternary_tree_final !=============================================================================== @@ -2526,29 +2530,29 @@ end subroutine struct_ternary_tree_copy !=============================================================================== -recursive subroutine struct_ternary_tree_final(src) -!subroutine struct_ternary_tree_final(src) - - !class(struct_ternary_tree_node_t) :: src - type(struct_ternary_tree_node_t) :: src - - if (allocated(src%val)) then - deallocate(src%val) - end if - - if (allocated(src%left)) then - call struct_ternary_tree_final(src%left) - end if - - if (allocated(src%mid)) then - call struct_ternary_tree_final(src%mid) - end if - - if (allocated(src%right)) then - call struct_ternary_tree_final(src%right) - end if - -end subroutine struct_ternary_tree_final +!recursive subroutine struct_ternary_tree_final(src) +!!subroutine struct_ternary_tree_final(src) +! +! !class(struct_ternary_tree_node_t) :: src +! type(struct_ternary_tree_node_t) :: src +! +! if (allocated(src%val)) then +! deallocate(src%val) +! end if +! +! if (allocated(src%left)) then +! call struct_ternary_tree_final(src%left) +! end if +! +! if (allocated(src%mid)) then +! call struct_ternary_tree_final(src%mid) +! end if +! +! if (allocated(src%right)) then +! call struct_ternary_tree_final(src%right) +! end if +! +!end subroutine struct_ternary_tree_final !=============================================================================== diff --git a/src/value.f90 b/src/value.f90 index 3dfe689b..30dfc737 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -73,10 +73,6 @@ module syntran__value_m !******** - !type struct_val_t - ! type(value_t), allocatable :: vals(:) - !end type struct_val_t - type value_t integer :: type = unknown_type @@ -94,8 +90,9 @@ module syntran__value_m ! but two types containing each other is bad type(array_t), allocatable :: array - !type(struct_t), allocatable :: struct - !type(struct_val_t), allocatable :: struct + ! i played with having a separate `struct_val_t` type and having an + ! array of those, but it works better just having a direct array of + ! `value_t`'s here instead type(value_t), allocatable :: struct(:) character(len = :), allocatable :: struct_name @@ -134,13 +131,6 @@ recursive subroutine value_copy(dst, src) if (debug > 3) print *, 'starting value_copy()' - !type value_t - ! integer :: type = unknown_type - ! type(scalar_t) :: sca - ! type(array_t), allocatable :: array - ! type(value_t), allocatable :: struct(:) - ! character(len = :), allocatable :: struct_name - dst%type = src%type dst%sca = src%sca @@ -158,9 +148,6 @@ recursive subroutine value_copy(dst, src) if (allocated(src%struct)) then if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) dst%struct = src%struct - !do i = 1, size(src%struct) - ! dst%struct(i) = src%struct(i) - !end do else if (allocated(dst%struct)) then deallocate(dst%struct) end if From 6a70e32ef7483dbb63261f26f29ea9705f5f5c09 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 10:58:29 -0400 Subject: [PATCH 024/137] add str conversion for printing structs --- src/parse_fn.f90 | 2 ++ src/value.f90 | 24 ++++++++++++++++++++++-- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 7542a441..766a2274 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -852,6 +852,8 @@ module function parse_struct_instance(parser) result(inst) inst%val%struct_name = identifier%text + !print *, "stuct name = ", inst%struct_name + ! TODO: each struct should get a different sub type (like array_type) for ! type checking, so you don't try to assign one type of struct to another ! struct diff --git a/src/value.f90 b/src/value.f90 index 30dfc737..b03b3b27 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -474,14 +474,34 @@ recursive function value_to_str(val) result(ans) !character(len = 16) :: buf16 integer :: j - integer(kind = 8) :: i8, prod + integer(kind = 8) :: i8, prod, n !type(string_vector_t) :: str_vec type(char_vector_t) :: str_vec select case (val%type) - ! TODO: add a case for struct_type + case (struct_type) + + ! Why is struct_name empty? + + str_vec = new_char_vector() + call str_vec%push(val%struct_name//"{") + + n = size(val%struct) + do i8 = 1, n + + ! It would be nice to label each member with its name + + !call str_vec%push( val%struct(i8)%struct_name ) + + call str_vec%push( trimw(val%struct(i8)%to_str()) ) + if (i8 < n) call str_vec%push(", ") + + end do + call str_vec%push("}") + !ans = str_vec%v( 1: str_vec%len_ ) + ans = str_vec%trim() case (array_type) From 1c2df1a29fff4b1878e9b6408be6a4d4e1507293 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 12:27:25 -0400 Subject: [PATCH 025/137] lhs dot expressions --- samples/struct.syntran | 1 + src/core.f90 | 1 + src/eval.f90 | 30 +++++++++++++++++- src/parse_expr.f90 | 72 +++++++++++++++++++++++++++++++++--------- src/types.f90 | 16 +++++++++- 5 files changed, 103 insertions(+), 17 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index f44dd363..018bfbb3 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -61,6 +61,7 @@ println("t2.mm = ", t2.mm); println("t2.ss = ", t2.ss); d1 = Date{y = 1900 + 45, m = "Ma" + "y", d = 5*4}; +d1.m = "June"; println("d1.y = ", d1.y); println("d1.m = ", d1.m); println("d1.d = ", d1.d); diff --git a/src/core.f90 b/src/core.f90 index 1be229e2..aa230294 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -40,6 +40,7 @@ module syntran__core_m ! > check dot member types ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn + ! + improved to_str() conversion with labels of struct name and member names ! + struct fn args ! + struct fn return values ! + nested structs diff --git a/src/eval.f90 b/src/eval.f90 index 13382677..23ea678f 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -1044,7 +1044,35 @@ subroutine eval_assignment_expr(node, state, res) type(value_t) :: array_val, tmp - if (.not. allocated(node%lsubscripts)) then + print *, "eval assignment_expr" + print *, "node identifier = ", node%identifier%text + print *, 'lhs type = ', kind_name( state%vars%vals(node%id_index)%type ) + !if (state%vars%vals(node%id_index)%type == struct_type) then + if (allocated( node%member )) then + print *, "mem index = ", node%member%id_index + end if + + !if (state%vars%vals(node%id_index)%type == struct_type) then + if (allocated( node%member )) then + print *, "assign dot member" + + call syntax_eval(node%right, state, res) + + ! !call compound_assign(state%vars%vals(node%id_index), res, node%op) + ! !res = state%vars%vals(node%id_index) + ! !res = state%vars%vals(node%id_index)%struct( node%right%id_index ) + + !state%vars%vals(node%id_index)%struct( node%member%id_index ) = res + call compound_assign( & + state%vars%vals(node%id_index)%struct( node%member%id_index ), & + res, & + node%op & + ) + + !res = state%vars%vals(node%id_index) + res = state%vars%vals(node%id_index)%struct( node%member%id_index ) + + else if (.not. allocated(node%lsubscripts)) then !! This deallocation will cause a crash when an array appears on both !! the LHS and RHS of fn_call assignment, e.g. `dv = diff_(dv, i)` in diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 1b4ba846..0d6f7675 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -24,15 +24,21 @@ recursive module function parse_expr_statement(parser) result(expr) !******** integer :: io, ltype, rtype, pos0, span0, span1, lrank, rrank, larrtype, & - rarrtype + rarrtype, id_index - type(syntax_node_t) :: right + logical :: is_dot + + type(syntax_node_t) :: right, member type(syntax_token_t) :: let, identifier, op type(text_span_t) :: span + type(value_t) :: var + !print *, 'starting parse_expr_statement()' + is_dot = .false. + ! TODO: provide a way to declare variable types without initializing them? ! Rust discourages mutability, instead preferring patterns like this: ! @@ -118,29 +124,54 @@ recursive module function parse_expr_statement(parser) result(expr) ! %pos is the lexer token index, %current_pos() is the character index! pos0 = parser%pos - !print *, 'assign expr' + print *, "assign expr" identifier = parser%match(identifier_token) + print *, "ident = ", identifier%text + ! Parse array subscript indices if present ! Subscript can appear in assignment expr but not let expr, because let - ! must initialize the whole array + ! must initialize the whole array. Similarly for dot member access span0 = parser%current_pos() call parser%parse_subscripts(expr) if (size(expr%lsubscripts) <= 0) deallocate(expr%lsubscripts) span1 = parser%current_pos() - 1 + if (parser%peek_kind(0) == dot_token) then + print *, "dot token" + is_dot = .true. + + !call parser%vars%search(identifier%text, id_index, io, var) + call parser%vars%search(identifier%text, id_index, io, var) + + !deallocate(expr%val) + expr%val = var + !expr%val%type = var%type + + call parser%parse_dot(expr) + member = expr%right ! swap because this will be re-used as RHS of whole expr + + allocate(expr%member) + expr%member = member ! TODO: could get rid of local member var + + print *, "index = ", expr%right%id_index + print *, "mndex = ", member%id_index + + end if + if (.not. is_assignment_op(parser%current_kind())) then ! Rewind and do the default case (same as outside the assignment if ! block). Could use goto or probably refactor somehow + print *, "rewinding" parser%pos = pos0 !print *, 'pos0 = ', pos0 expr = parser%parse_expr() return end if - !print *, 'parsing assignment' + print *, 'parsing assignment' op = parser%next() right = parser%parse_expr_statement() @@ -149,14 +180,14 @@ recursive module function parse_expr_statement(parser) result(expr) ! them are the same kind expr%kind = assignment_expr - allocate(expr%right) + if (.not. allocated(expr%right)) allocate(expr%right) expr%identifier = identifier expr%op = op expr%right = right - !print *, 'expr ident text = ', expr%identifier%text + print *, 'expr ident text = ', expr%identifier%text !print *, 'op = ', op%text ! Get the identifier's type and index from the dict and check that it @@ -218,18 +249,26 @@ recursive module function parse_expr_statement(parser) result(expr) ltype = expr%val%type rtype = expr%right%val%type + ! TODO: rename as *subtype instead of *arrtype larrtype = unknown_type rarrtype = unknown_type if (ltype == array_type) larrtype = expr%val%array%type if (rtype == array_type) rarrtype = expr%right%val%array%type - !print *, 'larrtype = ', kind_name(larrtype) - !print *, 'rarrtype = ', kind_name(rarrtype) + + ! !if (ltype == struct_type) larrtype = expr%val%struct(1)%type + ! !if (ltype == struct_type) larrtype = expr%val%struct( expr%right%id_index )%type + !if (ltype == struct_type) larrtype = expr%val%struct( member%id_index )%type + if (is_dot) larrtype = expr%val%struct( member%id_index )%type + + print *, "larrtype = ", kind_name(larrtype) + print *, "rarrtype = ", kind_name(rarrtype) + print *, "ltype = ", kind_name(ltype) ! This check could be moved inside of is_binary_op_allowed, but we would ! need to pass parser to it to push diagnostics if (.not. is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype)) then - !print *, 'bin not allowed in parse_expr_statement' + print *, 'bin not allowed in parse_expr_statement' span = new_span(op%pos, len(op%text)) call parser%diagnostics%push( & @@ -337,7 +376,7 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (.not. is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype)) then - !print *, 'bin not allowed in parse_expr' + print *, 'bin not allowed in parse_expr' span = new_span(op%pos, len(op%text)) call parser%diagnostics%push( & @@ -637,7 +676,8 @@ module subroutine parse_dot(parser, expr) if (expr%val%type /= struct_type) then ! TODO: diag. Skip if unknown_type? Probably already threw a diag in caller - print *, "Error: variable in dot expr is not a struct" + print *, err_prefix//"variable in dot expr is not a struct"//color_reset + print *, "type = ", kind_name(expr%val%type) return end if @@ -659,7 +699,7 @@ module subroutine parse_dot(parser, expr) if (io /= 0) then ! TODO: diag - print *, "Error: unreachable struct lookup failure" + print *, err_prefix//"unreachable struct lookup failure"//color_reset stop end if @@ -667,12 +707,14 @@ module subroutine parse_dot(parser, expr) call struct%vars%search(identifier%text, member_id, io, member) if (io /= 0) then ! TODO: diag - print *, "Error: struct dot member does not exist" + print *, err_prefix//"struct dot member does not exist"//color_reset stop end if - !print *, "member id = ", member_id + print *, "member id = ", member_id + print *, "mem type = ", kind_name(member%type) expr%right%id_index = member_id + print *, "index = ", expr%right%id_index end subroutine parse_dot diff --git a/src/types.f90 b/src/types.f90 index 18a43dad..88813909 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -156,7 +156,7 @@ module syntran__types_m ! allocated type(syntax_node_t), allocatable :: left, right, members(:), & - condition, if_clause, else_clause, body, array + condition, if_clause, else_clause, body, array, member ! Array expression syntax nodes. TODO: rename lbound, ubound to avoid ! conflicts w/ Fortran keywords @@ -918,6 +918,13 @@ recursive subroutine syntax_node_copy(dst, src) deallocate(dst%members) end if + if (allocated(src%member)) then + if (.not. allocated(dst%member)) allocate(dst%member) + dst%member = src%member + else if (allocated(dst%member)) then + deallocate(dst%member) + end if + if (debug > 3) print *, 'done syntax_node_copy()' end subroutine syntax_node_copy @@ -1566,10 +1573,17 @@ logical function is_binary_op_allowed(left, op, right, left_arr, right_arr) & allowed = & (is_int_type(left_arr) .and. is_int_type(right)) .or. & (left_arr == right) .or. (left == right) + + else if (left == struct_type) then + allowed = & + (is_int_type(left_arr) .and. is_int_type(right)) .or. & + (left_arr == right) .or. (left == right) + else allowed = & (is_int_type(left) .and. is_int_type(right)) .or. & (left == right) + end if case (eequals_token, bang_equals_token) From c1c260f33030b2a292d5422748e2c156cfb76812 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 13:41:03 -0400 Subject: [PATCH 026/137] fix type checking to allow `x = t1.m` --- src/parse_expr.f90 | 14 ++++++++++++-- src/types.f90 | 16 ++++++++++++---- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 0d6f7675..8cfe4c2c 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -257,12 +257,22 @@ recursive module function parse_expr_statement(parser) result(expr) ! !if (ltype == struct_type) larrtype = expr%val%struct(1)%type ! !if (ltype == struct_type) larrtype = expr%val%struct( expr%right%id_index )%type - !if (ltype == struct_type) larrtype = expr%val%struct( member%id_index )%type - if (is_dot) larrtype = expr%val%struct( member%id_index )%type + ! !if (ltype == struct_type) larrtype = expr%val%struct( member%id_index )%type + + !if (is_dot) larrtype = expr%val%struct( member%id_index )%type + if (is_dot) ltype = expr%val%struct( member%id_index )%type + + ! Descend similarly for rarrtype if dot expr + if (expr%right%kind == dot_expr) then + !rarrtype = expr%right%val%type + !rarrtype = expr%right%val%struct(expr%right%id_index)%type + rtype = expr%right%val%struct(expr%right%id_index)%type + end if print *, "larrtype = ", kind_name(larrtype) print *, "rarrtype = ", kind_name(rarrtype) print *, "ltype = ", kind_name(ltype) + print *, "rtype = ", kind_name(rtype) ! This check could be moved inside of is_binary_op_allowed, but we would ! need to pass parser to it to push diagnostics diff --git a/src/types.f90 b/src/types.f90 index 88813909..71085085 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1574,10 +1574,18 @@ logical function is_binary_op_allowed(left, op, right, left_arr, right_arr) & (is_int_type(left_arr) .and. is_int_type(right)) .or. & (left_arr == right) .or. (left == right) - else if (left == struct_type) then - allowed = & - (is_int_type(left_arr) .and. is_int_type(right)) .or. & - (left_arr == right) .or. (left == right) + !! TODO: just combine this with condition above + !else if (left == struct_type) then + ! allowed = & + ! (is_int_type(left_arr) .and. is_int_type(right)) .or. & + ! (left_arr == right) .or. (left == right) + + !else if (right == struct_type) then + ! ! I'm not sure about this one. It's needed at least for things + ! ! like `x = t1.m` but I think it's too broad and general + ! allowed = & + ! (is_int_type(left) .and. is_int_type(right_arr)) .or. & + ! (left == right_arr) .or. (left == right) else allowed = & From dcbf20f200eb5ef85315c2c414bef2196c37dc65 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 13:42:53 -0400 Subject: [PATCH 027/137] reduce debug logging --- src/eval.f90 | 18 +++++++++--------- src/parse_expr.f90 | 36 ++++++++++++++++++------------------ 2 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 23ea678f..520c3825 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -428,7 +428,7 @@ subroutine eval_struct_instance(node, state, res) integer :: i - print *, 'eval struct_instance_expr' + !print *, 'eval struct_instance_expr' !print *, 'struct identifier = ', node%identifier%text !print *, 'struct id_index = ', node%id_index @@ -447,7 +447,7 @@ subroutine eval_struct_instance(node, state, res) !call syntax_eval(node%members(i), state, tmp) !res%struct(i) = tmp - print *, "mem[", str(i), "] = ", res%struct(i)%to_str() + !print *, "mem[", str(i), "] = ", res%struct(i)%to_str() !res = node%val%struct( node%right%id_index ) !node%members(i)%val = res @@ -1044,17 +1044,17 @@ subroutine eval_assignment_expr(node, state, res) type(value_t) :: array_val, tmp - print *, "eval assignment_expr" - print *, "node identifier = ", node%identifier%text - print *, 'lhs type = ', kind_name( state%vars%vals(node%id_index)%type ) + !print *, "eval assignment_expr" + !print *, "node identifier = ", node%identifier%text + !print *, 'lhs type = ', kind_name( state%vars%vals(node%id_index)%type ) !if (state%vars%vals(node%id_index)%type == struct_type) then - if (allocated( node%member )) then - print *, "mem index = ", node%member%id_index - end if + !if (allocated( node%member )) then + ! print *, "mem index = ", node%member%id_index + !end if !if (state%vars%vals(node%id_index)%type == struct_type) then if (allocated( node%member )) then - print *, "assign dot member" + !print *, "assign dot member" call syntax_eval(node%right, state, res) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 8cfe4c2c..cbaca487 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -124,11 +124,11 @@ recursive module function parse_expr_statement(parser) result(expr) ! %pos is the lexer token index, %current_pos() is the character index! pos0 = parser%pos - print *, "assign expr" + !print *, "assign expr" identifier = parser%match(identifier_token) - print *, "ident = ", identifier%text + !print *, "ident = ", identifier%text ! Parse array subscript indices if present @@ -141,7 +141,7 @@ recursive module function parse_expr_statement(parser) result(expr) span1 = parser%current_pos() - 1 if (parser%peek_kind(0) == dot_token) then - print *, "dot token" + !print *, "dot token" is_dot = .true. !call parser%vars%search(identifier%text, id_index, io, var) @@ -157,21 +157,21 @@ recursive module function parse_expr_statement(parser) result(expr) allocate(expr%member) expr%member = member ! TODO: could get rid of local member var - print *, "index = ", expr%right%id_index - print *, "mndex = ", member%id_index + !print *, "index = ", expr%right%id_index + !print *, "mndex = ", member%id_index end if if (.not. is_assignment_op(parser%current_kind())) then ! Rewind and do the default case (same as outside the assignment if ! block). Could use goto or probably refactor somehow - print *, "rewinding" + !print *, "rewinding" parser%pos = pos0 !print *, 'pos0 = ', pos0 expr = parser%parse_expr() return end if - print *, 'parsing assignment' + !print *, 'parsing assignment' op = parser%next() right = parser%parse_expr_statement() @@ -187,7 +187,7 @@ recursive module function parse_expr_statement(parser) result(expr) expr%op = op expr%right = right - print *, 'expr ident text = ', expr%identifier%text + !print *, 'expr ident text = ', expr%identifier%text !print *, 'op = ', op%text ! Get the identifier's type and index from the dict and check that it @@ -269,16 +269,16 @@ recursive module function parse_expr_statement(parser) result(expr) rtype = expr%right%val%struct(expr%right%id_index)%type end if - print *, "larrtype = ", kind_name(larrtype) - print *, "rarrtype = ", kind_name(rarrtype) - print *, "ltype = ", kind_name(ltype) - print *, "rtype = ", kind_name(rtype) + !print *, "larrtype = ", kind_name(larrtype) + !print *, "rarrtype = ", kind_name(rarrtype) + !print *, "ltype = ", kind_name(ltype) + !print *, "rtype = ", kind_name(rtype) ! This check could be moved inside of is_binary_op_allowed, but we would ! need to pass parser to it to push diagnostics if (.not. is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype)) then - print *, 'bin not allowed in parse_expr_statement' + !print *, 'bin not allowed in parse_expr_statement' span = new_span(op%pos, len(op%text)) call parser%diagnostics%push( & @@ -386,7 +386,7 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (.not. is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype)) then - print *, 'bin not allowed in parse_expr' + !print *, 'bin not allowed in parse_expr' span = new_span(op%pos, len(op%text)) call parser%diagnostics%push( & @@ -673,7 +673,7 @@ module subroutine parse_dot(parser, expr) end if - print *, "parsing dot" + !print *, "parsing dot" dot = parser%match(dot_token) @@ -720,11 +720,11 @@ module subroutine parse_dot(parser, expr) print *, err_prefix//"struct dot member does not exist"//color_reset stop end if - print *, "member id = ", member_id - print *, "mem type = ", kind_name(member%type) + !print *, "member id = ", member_id + !print *, "mem type = ", kind_name(member%type) expr%right%id_index = member_id - print *, "index = ", expr%right%id_index + !print *, "index = ", expr%right%id_index end subroutine parse_dot From bff9a370ba2d6ea973823cfff9039ab9ebe3a66d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 14:10:11 -0400 Subject: [PATCH 028/137] fix more complex dot sub expressions --- src/parse_expr.f90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index cbaca487..454afc2d 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -261,6 +261,7 @@ recursive module function parse_expr_statement(parser) result(expr) !if (is_dot) larrtype = expr%val%struct( member%id_index )%type if (is_dot) ltype = expr%val%struct( member%id_index )%type + !if (expr%kind == dot_expr) ltype = expr%val%struct( member%id_index )%type ! Descend similarly for rarrtype if dot expr if (expr%right%kind == dot_expr) then @@ -381,6 +382,14 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (ltype == array_type) larrtype = expr%left %val%array%type if (rtype == array_type) rarrtype = expr%right%val%array%type + if (expr%left%kind == dot_expr) then + ltype = expr%left%val%struct(expr%left%id_index)%type + end if + + if (expr%right%kind == dot_expr) then + rtype = expr%right%val%struct(expr%right%id_index)%type + end if + !print *, 'larrtype = ', kind_name(larrtype) !print *, 'rarrtype = ', kind_name(rarrtype) From 010c76a857928fbbbf0838b75e54070689fbb721 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 14:15:46 -0400 Subject: [PATCH 029/137] add a few more short struct tests --- src/tests/test.f90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 948e6f3a..85467288 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2484,6 +2484,27 @@ subroutine unit_test_struct(npass, nfail) //'let e=d;' & //'e = D{y=1945, m="May", d=5*3};' & //'d.d;', quiet) == '14', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let x = 42;' & + //'x = d.d;' & + //'x;', quiet) == '14', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let x = d.y + 5;' & + //'x;', quiet) == '1917', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let x = 6 + d.y;' & + //'x;', quiet) == '1918', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'d.d = 18;' & + //'d.d;', quiet) == '18', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'d.d += 3;' & + //'d.d;', quiet) == '17', & .false. & ! so I don't have to bother w/ trailing commas ] From 2a19f9e4342e929d80ec3f197125252b29cb5869 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 14:37:17 -0400 Subject: [PATCH 030/137] fix member index bug and add more tests --- src/parse_expr.f90 | 14 +++++++++++--- src/tests/test.f90 | 6 ++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 454afc2d..673c5aa9 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -175,6 +175,7 @@ recursive module function parse_expr_statement(parser) result(expr) op = parser%next() right = parser%parse_expr_statement() + !print *, "1a right index = ", right%right%id_index ! regular vs compound assignment exprs are denoted by the op. all of ! them are the same kind @@ -267,7 +268,8 @@ recursive module function parse_expr_statement(parser) result(expr) if (expr%right%kind == dot_expr) then !rarrtype = expr%right%val%type !rarrtype = expr%right%val%struct(expr%right%id_index)%type - rtype = expr%right%val%struct(expr%right%id_index)%type + !print *, "1 right index = ", expr%right%right%id_index + rtype = expr%right%val%struct(expr%right%right%id_index)%type end if !print *, "larrtype = ", kind_name(larrtype) @@ -383,11 +385,17 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (rtype == array_type) rarrtype = expr%right%val%array%type if (expr%left%kind == dot_expr) then - ltype = expr%left%val%struct(expr%left%id_index)%type + ! The index that I need is nested in an insane way + + !print *, "left index = ", expr%left%id_index + !print *, "left index = ", expr%left%right%id_index + ltype = expr%left%val%struct(expr%left%right%id_index)%type end if if (expr%right%kind == dot_expr) then - rtype = expr%right%val%struct(expr%right%id_index)%type + !print *, "2 right index = ", expr%right%id_index + !rtype = expr%right%val%struct(expr%right%id_index)%type + rtype = expr%right%val%struct(expr%right%right%id_index)%type end if !print *, 'larrtype = ', kind_name(larrtype) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 85467288..f0287e94 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2505,6 +2505,12 @@ subroutine unit_test_struct(npass, nfail) //'let d = D{y=1912, m="Apr", d=7*2};' & //'d.d += 3;' & //'d.d;', quiet) == '17', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'d.m + "il";', quiet) == 'April', & + eval( 'struct D{y:i64, m:str, d:i32}' & + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'"month " + d.m;', quiet) == 'month Apr', & .false. & ! so I don't have to bother w/ trailing commas ] From f945f4a9bd4624f1710e4877114f11eb26e4f320 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 16:51:00 -0400 Subject: [PATCH 031/137] return early to avoid segfault --- src/parse_expr.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 673c5aa9..38888a27 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -152,6 +152,7 @@ recursive module function parse_expr_statement(parser) result(expr) !expr%val%type = var%type call parser%parse_dot(expr) + if (.not. allocated(expr%right)) return member = expr%right ! swap because this will be re-used as RHS of whole expr allocate(expr%member) From 1b070f3f1f08de76427c5169f04febf4bd32d27d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 17:17:10 -0400 Subject: [PATCH 032/137] decorate printed structs with their class name --- src/core.f90 | 1 - src/eval.f90 | 1 + src/parse_expr.f90 | 14 +++++++------- src/value.f90 | 4 +--- 4 files changed, 9 insertions(+), 11 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index aa230294..1f200019 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -35,7 +35,6 @@ module syntran__core_m ! > moar ! + remove unused things like mems/members copies in various ! types/routines - ! + LHS dot expr ! + struct type checking ! > check dot member types ! > check mismatches of assigning one struct to another, or passing a diff --git a/src/eval.f90 b/src/eval.f90 index 520c3825..5bc4cc4c 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -433,6 +433,7 @@ subroutine eval_struct_instance(node, state, res) !print *, 'struct id_index = ', node%id_index res%type = node%val%type + res%struct_name = node%struct_name if (allocated(res%struct)) deallocate(res%struct) allocate(res%struct( size(node%members) )) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 38888a27..4a915818 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -103,13 +103,13 @@ recursive module function parse_expr_statement(parser) result(expr) span, identifier%text)) end if - ! TODO: this should be unnecessary. Store the struct name in the value - ! instead - !print *, "right type = ", kind_name(right%val%type) - if (right%val%type == struct_type) then - !print *, "struct_name = ", right%struct_name - expr%struct_name = right%val%struct_name - end if + !! this should be unnecessary + !!print *, "right type = ", kind_name(right%val%type) + !if (right%val%type == struct_type) then + ! !print *, "struct_name = ", right%struct_name + ! !expr%struct_name = right%struct_name + ! !expr%val%struct_name = right%struct_name + !end if return diff --git a/src/value.f90 b/src/value.f90 index b03b3b27..3a37278b 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -483,8 +483,6 @@ recursive function value_to_str(val) result(ans) case (struct_type) - ! Why is struct_name empty? - str_vec = new_char_vector() call str_vec%push(val%struct_name//"{") @@ -493,7 +491,7 @@ recursive function value_to_str(val) result(ans) ! It would be nice to label each member with its name - !call str_vec%push( val%struct(i8)%struct_name ) + !call str_vec%push( val%struct(i8)%struct_name//" = " ) call str_vec%push( trimw(val%struct(i8)%to_str()) ) if (i8 < n) call str_vec%push(", ") From 444c7b12abd68efd11f11a5a744358eccb8b6403 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 20:17:08 -0400 Subject: [PATCH 033/137] fix bugs for dot exprs in fn args and bin exprs --- src/parse_expr.f90 | 2 ++ src/parse_fn.f90 | 21 ++++++++++++++++----- src/types.f90 | 19 +++++++++++++++++-- 3 files changed, 35 insertions(+), 7 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 4a915818..e1395bbc 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -401,6 +401,8 @@ recursive module function parse_expr(parser, parent_prec) result(expr) !print *, 'larrtype = ', kind_name(larrtype) !print *, 'rarrtype = ', kind_name(rarrtype) + !print *, 'ltype = ', kind_name(ltype) + !print *, 'rtype = ', kind_name(rtype) if (.not. is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype)) then diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 766a2274..1c462ce6 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -24,7 +24,10 @@ module function parse_fn_call(parser) result(fn_call) !******** character(len = :), allocatable :: param_type, arg_type - integer :: i, io, id_index, param_rank, arg_rank, ptype, atype, pos0, type_ + + integer :: i, io, id_index, param_rank, arg_rank, ptype, atype, pos0, & + type_, val_type + logical :: types_match type(fn_t) :: fn @@ -242,7 +245,15 @@ module function parse_fn_call(parser) result(fn_call) end if do i = 1, args%len_ - !print *, kind_name(args%v(i)%val%type) + + val_type = args%v(i)%val%type + + if (args%v(i)%kind == dot_expr) then + !print *, "dot_expr" + val_type = args%v(i)%val%struct( args%v(i)%right%id_index )%type + end if + + !print *, kind_name(val_type) !print *, kind_name(fn%params(i)%type) ! For variadic fns, check the argument type against the type @@ -267,7 +278,7 @@ module function parse_fn_call(parser) result(fn_call) !ptype = fn%params(j)%type types_match = & - ptype == any_type .or. ptype == args%v(i)%val%type + ptype == any_type .or. ptype == val_type !! make a fn for use here and for array `atype` below? this !! could be more easily extended if i add fn's with something @@ -277,7 +288,7 @@ module function parse_fn_call(parser) result(fn_call) !case (any_type) ! types_match = .true. !case default - ! types_match = ptype == args%v(i)%val%type + ! types_match = ptype == val_type !end select if (.not. types_match) then @@ -288,7 +299,7 @@ module function parse_fn_call(parser) result(fn_call) err_bad_arg_type(parser%context(), & span, identifier%text, i, fn%params(i)%name, & kind_name(ptype), & - kind_name(args%v(i)%val%type))) + kind_name(val_type))) return end if diff --git a/src/types.f90 b/src/types.f90 index 71085085..7248a6aa 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1788,7 +1788,7 @@ function new_binary_expr(left, op, right) result(expr) !******** - integer :: larrtype, rarrtype, type_ + integer :: larrtype, rarrtype, type_, ltype, rtype if (debug > 1) print *, 'new_binary_expr' if (debug > 1) print *, 'left = ', left %str() @@ -1813,8 +1813,23 @@ function new_binary_expr(left, op, right) result(expr) !print *, 'larrtype = ', kind_name(larrtype) + ! TODO: whatever i've done for structs in is_binary_op_allowed() and + ! get_binary_op_kind() will need to be applied for unary ops too + + ltype = left%val%type + if (left%kind == dot_expr) then + !print *, "left index = ", left%id_index + !print *, "left index = ", left%right%id_index + ltype = left%val%struct(left%right%id_index)%type + end if + + rtype = right%val%type + if (right%kind == dot_expr) then + rtype = right%val%struct(right%right%id_index)%type + end if + ! Pass the result value type up the tree for type checking in parent - type_ = get_binary_op_kind(left%val%type, op%kind, right%val%type, & + type_ = get_binary_op_kind(ltype, op%kind, rtype, & larrtype, rarrtype) !print *, 'type_ = ', kind_name(type_) From 7e938b0f6b6ab8cc389a137d0fecc359942ace82 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 20:17:32 -0400 Subject: [PATCH 034/137] add aoc example using structs --- .../long/aoc/2023/02/main-struct.syntran | 168 ++++++++++++++++++ 1 file changed, 168 insertions(+) create mode 100644 src/tests/long/aoc/2023/02/main-struct.syntran diff --git a/src/tests/long/aoc/2023/02/main-struct.syntran b/src/tests/long/aoc/2023/02/main-struct.syntran new file mode 100644 index 00000000..14a56539 --- /dev/null +++ b/src/tests/long/aoc/2023/02/main-struct.syntran @@ -0,0 +1,168 @@ + +// This is not my original implementation (see main.syntran), rather this is an +// alternative approach using structs + +#include("../../utils.syntran"); + +let infile = "src/tests/long/aoc/2023/02/test-input.txt"; +infile = "src/tests/long/aoc/2023/02/input.txt"; + +struct Subset +{ + red: i32, + green: i32, + blue: i32, +} + +fn part1(): i32 +{ + let sum = 0; + + let maxset = Subset{red = 12, green = 13, blue = 14}; + + let fid = open(infile); + let str_ = readln(fid); + let id = 0; + while (not eof(fid)) + { + id += 1; + + //println("str_ = ", str_); + let strs = split_(str_, ":"); + + let games = split_(strs[1], ";"); + //println("games[0] = ", games[0]); + + let possible = true; + for i in [0: size(games, 0)] + { + //println("game = ", games[i]); + + let subset = Subset{red = 0, green = 0, blue = 0}; + + let chunks = split_(games[i], ","); + for j in [0: size(chunks, 0)] + { + let num_color = split_(chunks[j], " "); + let num = parse_i32(num_color[0]); + let color = num_color[1]; + + if color == "red" + subset.red = num; + else if color == "green" + subset.green = num; + else if color == "blue" + subset.blue = num; + else + { + println("Error: bad color """, color, """"); + exit(-1); + } + } + //println("subset = ", subset); + + if not + ( + subset.red <= maxset.red and + subset.green <= maxset.green and + subset.blue <= maxset.blue + ) + { + possible = false; + } + } + if possible + sum += id; + + //println(); + str_ = readln(fid); + } + close(fid); + + println("part 1 = ", sum); + return sum; +} + +fn part2(): i32 +{ + let sum = 0; + + //let maxset = Subset{red = 12, green = 13, blue = 14}; + + let fid = open(infile); + let str_ = readln(fid); + let id = 0; + while (not eof(fid)) + { + id += 1; + let minset = Subset{red = 0, green = 0, blue = 0}; + + //println("str_ = ", str_); + let strs = split_(str_, ":"); + + let games = split_(strs[1], ";"); + //println("games[0] = ", games[0]); + + let possible = true; + for i in [0: size(games, 0)] + { + //println("game = ", games[i]); + + let subset = Subset{red = 0, green = 0, blue = 0}; + + let chunks = split_(games[i], ","); + for j in [0: size(chunks, 0)] + { + let num_color = split_(chunks[j], " "); + let num = parse_i32(num_color[0]); + let color = num_color[1]; + + if color == "red" + subset.red = num; + else if color == "green" + subset.green = num; + else if color == "blue" + subset.blue = num; + else + { + //println("Error: bad color """, color, """"); + exit(-1); + } + } + //println("subset = ", subset); + + minset.red = max(minset.red , subset.red ); + minset.green = max(minset.green, subset.green); + minset.blue = max(minset.blue , subset.blue ); + } + //println("minset = ", minset); + + let power = minset.red * minset.green * minset.blue; + //let power = 1; + //power = minset.red * minset.green; + //power = power * minset.blue; + //let power = (minset.red) * (minset.green) * (minset.blue); + + //println("power = ", power); + + sum += power; + + //println(); + str_ = readln(fid); + } + close(fid); + + println("part 2 = ", sum); + return sum; +} + +fn main(): i32 +{ + let sum = 0; + sum += part1(); + sum += part2(); + return sum; +} + +return main(); + From d09c63383fca670ad76fad3011bff557fabc595a Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 20:21:42 -0400 Subject: [PATCH 035/137] cleanup --- .../long/aoc/2023/02/main-struct.syntran | 24 ++++++++----------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/src/tests/long/aoc/2023/02/main-struct.syntran b/src/tests/long/aoc/2023/02/main-struct.syntran index 14a56539..bb30838c 100644 --- a/src/tests/long/aoc/2023/02/main-struct.syntran +++ b/src/tests/long/aoc/2023/02/main-struct.syntran @@ -87,8 +87,6 @@ fn part2(): i32 { let sum = 0; - //let maxset = Subset{red = 12, green = 13, blue = 14}; - let fid = open(infile); let str_ = readln(fid); let id = 0; @@ -125,7 +123,7 @@ fn part2(): i32 subset.blue = num; else { - //println("Error: bad color """, color, """"); + println("Error: bad color """, color, """"); exit(-1); } } @@ -138,11 +136,6 @@ fn part2(): i32 //println("minset = ", minset); let power = minset.red * minset.green * minset.blue; - //let power = 1; - //power = minset.red * minset.green; - //power = power * minset.blue; - //let power = (minset.red) * (minset.green) * (minset.blue); - //println("power = ", power); sum += power; @@ -156,13 +149,16 @@ fn part2(): i32 return sum; } -fn main(): i32 +fn main(): bool { - let sum = 0; - sum += part1(); - sum += part2(); - return sum; + let pass = true; + pass = pass and part1() == 2256; + pass = pass and part2() == 74229; + return pass; } -return main(); +if main() + return 0; +else + return -1; From 7eceb55d96b393efaffb39fed10b4d2219faf5da Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 24 Aug 2024 20:26:17 -0400 Subject: [PATCH 036/137] add tests to cover the bugs from 444c7b1 --- src/tests/test.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index f0287e94..a685535c 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2511,6 +2511,12 @@ subroutine unit_test_struct(npass, nfail) eval( 'struct D{y:i64, m:str, d:i32}' & //'let d = D{y=1912, m="Apr", d=7*2};' & //'"month " + d.m;', quiet) == 'month Apr', & + eval( 'struct C{r:i32, g:i32, b:i32}' & + //'let c = C{r = 32, g = 64, b = 128};' & + //'max(c.r, c.g);', quiet) == '64', & + eval( 'struct C{r:i32, g:i32, b:i32}' & + //'let c = C{r = 32, g = 64, b = 128};' & + //'c.r + c.g + c.b;', quiet) == '224', & .false. & ! so I don't have to bother w/ trailing commas ] From be5f089399eaa3e63b19643fca8e95ea39860c4e Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 11:54:49 -0400 Subject: [PATCH 037/137] allow structs as fn arguments --- src/core.f90 | 3 +- src/errors.f90 | 10 ++-- src/parse_expr.f90 | 10 ++-- src/parse_fn.f90 | 49 ++++++++++++++----- .../long/aoc/2023/02/main-struct.syntran | 2 + src/tests/test.f90 | 2 +- src/types.f90 | 23 ++++++++- 7 files changed, 75 insertions(+), 24 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 1f200019..0e07cc2f 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -31,6 +31,8 @@ module syntran__core_m ! - structs ! * mvp done ! * tbd: + ! + make aoc 2023 day 2 struct version as a test + ! + unary ops on dot exprs ! + tests ! > moar ! + remove unused things like mems/members copies in various @@ -40,7 +42,6 @@ module syntran__core_m ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names - ! + struct fn args ! + struct fn return values ! + nested structs ! + structs of arrays diff --git a/src/errors.f90 b/src/errors.f90 index 582a1394..308a09a9 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -59,10 +59,10 @@ function err_bad_int(context, span, num) result(err) character(len = :), allocatable :: err character(len = *), intent(in) :: num - err = err_prefix//'invalid i32 integer `'//num & + err = err_prefix//'bad i32 integer `'//num & //'` does not fit in 32 bits' & //underline(context, span) & - //' invalid integer'//color_reset + //' bad integer'//color_reset end function err_bad_int @@ -104,9 +104,9 @@ function err_bad_float(context, span, num) result(err) character(len = :), allocatable :: err character(len = *), intent(in) :: num - err = err_prefix//'invalid f32 float `'//num//'`' & + err = err_prefix//'bad f32 float `'//num//'`' & //underline(context, span) & - //' invalid float'//color_reset + //' bad float'//color_reset end function err_bad_float @@ -118,7 +118,7 @@ function err_bad_type(context, span, type) result(err) character(len = :), allocatable :: err character(len = *), intent(in) :: type - err = err_prefix//'invalid type annotation `'//type//'`' & + err = err_prefix//'bad type annotation `'//type//'`' & //underline(context, span) & //' bad type'//color_reset diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index e1395bbc..00562b4c 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -706,8 +706,8 @@ module subroutine parse_dot(parser, expr) if (expr%val%type /= struct_type) then ! TODO: diag. Skip if unknown_type? Probably already threw a diag in caller - print *, err_prefix//"variable in dot expr is not a struct"//color_reset - print *, "type = ", kind_name(expr%val%type) + write(*,*) err_prefix//"variable in dot expr is not a struct"//color_reset + !print *, "type = ", kind_name(expr%val%type) return end if @@ -724,12 +724,14 @@ module subroutine parse_dot(parser, expr) ! Is there a better way than looking up every struct by name again? + !print *, "struct_name = """, expr%val%struct_name, """" + !struct = parser%structs%search(expr%val%struct_name, struct_id, io) call parser%structs%search(expr%val%struct_name, struct_id, io, struct) if (io /= 0) then ! TODO: diag - print *, err_prefix//"unreachable struct lookup failure"//color_reset + write(*,*) err_prefix//"unreachable struct lookup failure"//color_reset stop end if @@ -737,7 +739,7 @@ module subroutine parse_dot(parser, expr) call struct%vars%search(identifier%text, member_id, io, member) if (io /= 0) then ! TODO: diag - print *, err_prefix//"struct dot member does not exist"//color_reset + write(*,*) err_prefix//"struct dot member does not exist"//color_reset stop end if !print *, "member id = ", member_id diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 1c462ce6..df010817 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -378,6 +378,8 @@ module function parse_fn_declaration(parser) result(decl) type(logical_vector_t) :: is_array type(integer_vector_t) :: ranks + type(struct_t) :: struct + type(syntax_node_t) :: body type(syntax_token_t) :: fn_kw, identifier, lparen, rparen, colon, & name, comma, dummy @@ -472,7 +474,8 @@ module function parse_fn_declaration(parser) result(decl) fn%params(i)%name = names%v(i)%s - itype = lookup_type( types%v(i)%s ) + itype = lookup_type(types%v(i)%s, parser%structs, struct) + !print *, "itype = ", itype if (itype == unknown_type) then ! TODO: make an array of pos's for each param to underline @@ -486,6 +489,29 @@ module function parse_fn_declaration(parser) result(decl) end if + if (itype == struct_type) then + !print *, "struct_type" + !print *, "struct num vars = ", struct%num_vars + !print *, "struct name = ", types%v(i)%s + + !! Save everything in the inst syntax node + !inst%kind = struct_instance_expr + !inst%val%type = struct_type + !allocate(inst%val%struct( struct%num_vars )) + !allocate(inst%members ( struct%num_vars )) + !inst%struct_name = identifier%text + !inst%val%struct_name = identifier%text + + !fn%params(i)%type = struct_type + !allocate(fn%params(i)%struct( struct%num_vars )) + !fn%params(i)%struct_name = types%v(i)%s + + val%struct_name = types%v(i)%s + allocate(val%struct( struct%num_vars )) + !val = struct + + end if + if (is_array%v(i)) then fn%params(i)%type = array_type fn%params(i)%array_type = itype @@ -536,7 +562,7 @@ module function parse_fn_declaration(parser) result(decl) call parser%parse_type(type_text, rank) pos2 = parser%current_pos() - itype = lookup_type(type_text) + itype = lookup_type(type_text, parser%structs, struct) if (itype == unknown_type) then span = new_span(pos1, pos2 - pos1 + 1) @@ -617,7 +643,7 @@ module function parse_struct_declaration(parser) result(decl) integer :: itype, i, io, pos0, pos1, pos2, rank !type(struct_t), save :: struct - type(struct_t) :: struct + type(struct_t) :: struct, dummy_struct type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & colon, name, struct_kw @@ -719,7 +745,8 @@ module function parse_struct_declaration(parser) result(decl) struct%members(i)%name = names%v(i)%s - itype = lookup_type( types%v(i)%s ) + ! TODO: consume dummy_struct for nested structs + itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) if (itype == unknown_type) then !span = new_span(pos1, pos2 - pos1 - 1) @@ -767,7 +794,7 @@ module function parse_struct_declaration(parser) result(decl) ! TODO: check for duplicate member names !print *, "insert var type ", kind_name(val%type) - print *, "insert var name = ", struct%members(i)%name + !print *, "insert var name = ", struct%members(i)%name !call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) !call struct%vars%insert(struct%members(i)%name, val, struct%num_vars) @@ -776,7 +803,7 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'io = ', io if (io /= exit_success) then ! TODO: diag - print *, "Error: re-declared struct member" + write(*,*) err_prefix//"re-declared struct member"//color_reset !span = new_span(identifier%pos, len(identifier%text)) !call parser%diagnostics%push( & ! err_redeclare_var(parser%context(), & @@ -832,7 +859,7 @@ module function parse_struct_instance(parser) result(inst) identifier = parser%match(identifier_token) - print *, "parsing struct instance of identifier = ", identifier%text + !print *, "parsing struct instance of identifier = ", identifier%text !print *, "" !print *, "in parse_struct_instance():" @@ -863,7 +890,7 @@ module function parse_struct_instance(parser) result(inst) inst%val%struct_name = identifier%text - !print *, "stuct name = ", inst%struct_name + !print *, "struct name = ", inst%struct_name ! TODO: each struct should get a different sub type (like array_type) for ! type checking, so you don't try to assign one type of struct to another @@ -879,7 +906,7 @@ module function parse_struct_instance(parser) result(inst) equals = parser%match(equals_token) mem = parser%parse_expr() - print *, "name%text = ", name%text + !print *, "name%text = ", name%text !call struct%vars%insert(struct%members(i)%name, val, & ! struct%num_vars, io, overwrite = .false.) @@ -896,7 +923,7 @@ module function parse_struct_instance(parser) result(inst) if (io /= 0) then ! TODO: diag - print *, "Error: member does not exist in struct" + write(*,*) err_prefix//"member does not exist in struct"//color_reset stop end if @@ -924,7 +951,7 @@ module function parse_struct_instance(parser) result(inst) !print *, "size = ", mems%len_ if (mems%len_ /= struct%num_vars) then ! TODO: diag - print *, "Error: struct instance does not have the right number of members" + write(*,*) err_prefix//"struct instance does not have the right number of members"//color_reset stop end if diff --git a/src/tests/long/aoc/2023/02/main-struct.syntran b/src/tests/long/aoc/2023/02/main-struct.syntran index bb30838c..97012ef4 100644 --- a/src/tests/long/aoc/2023/02/main-struct.syntran +++ b/src/tests/long/aoc/2023/02/main-struct.syntran @@ -1,4 +1,6 @@ +// TODO: make this a test + // This is not my original implementation (see main.syntran), rather this is an // alternative approach using structs diff --git a/src/tests/test.f90 b/src/tests/test.f90 index a685535c..3de76d76 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2460,7 +2460,7 @@ subroutine unit_test_struct(npass, nfail) character(len = *), parameter :: label = 'structs' - logical, parameter :: quiet = .false. + logical, parameter :: quiet = .true. logical, allocatable :: tests(:) write(*,*) 'Unit testing '//label//' ...' diff --git a/src/types.f90 b/src/types.f90 index 7248a6aa..d6320cb2 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1209,10 +1209,18 @@ end function new_token !=============================================================================== -integer function lookup_type(name) result(type) +integer function lookup_type(name, structs, struct) result(type) character(len = *), intent(in) :: name + type(structs_t), intent(in) :: structs + + type(struct_t), intent(out) :: struct + + !******** + + integer :: io, struct_id + ! Immo also has an "any" type. Should I allow that? select case (name) @@ -1231,7 +1239,18 @@ integer function lookup_type(name) result(type) type = str_type case default - type = unknown_type + + !call parser%structs%search(identifier%text, struct_id, io, struct) + call structs%search(name, struct_id, io, struct) + !print *, "struct search io = ", io + + if (io == 0) then + type = struct_type + !print *, "struct num vars = ", struct%num_vars + else + type = unknown_type + end if + end select !print *, 'lookup_type = ', type From b9fba828d340f37a2187e26353eb48243354ee18 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 12:08:11 -0400 Subject: [PATCH 038/137] throw error for re-declared fns --- src/errors.f90 | 14 ++++++++++++++ src/parse_fn.f90 | 16 ++++++++++++---- src/types.f90 | 4 +++- 3 files changed, 29 insertions(+), 5 deletions(-) diff --git a/src/errors.f90 b/src/errors.f90 index 308a09a9..3cfa6148 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -169,6 +169,20 @@ end function err_redeclare_var !=============================================================================== +function err_redeclare_fn(context, span, fn) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: fn + err = err_prefix & + //'function `'//fn//'` has already been declared' & + //underline(context, span)//" function already declared"//color_reset + +end function err_redeclare_fn + +!=============================================================================== + function err_undeclare_var(context, span, var) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index df010817..ab6a72d3 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -370,7 +370,7 @@ module function parse_fn_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: i, pos0, pos1, pos2, rank, itype, fn_beg, fn_name_end + integer :: i, io, pos0, pos1, pos2, rank, itype, fn_beg, fn_name_end type(fn_t) :: fn @@ -619,9 +619,17 @@ module function parse_fn_declaration(parser) result(decl) allocate(fn%node) fn%node = decl - call parser%fns%insert(identifier%text, fn, decl%id_index) - ! TODO: error if fn already declared. be careful in future if fn prototypes - ! are added + call parser%fns%insert(identifier%text, fn, decl%id_index, io) + !print *, "fn insert io = ", io + + ! error if fn already declared. be careful in future if fn prototypes are + ! added + if (io /= 0) then + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push( & + err_redeclare_fn(parser%context(), & + span, identifier%text)) + end if !print *, 'size(decl%params) = ', size(decl%params) !print *, 'decl%params = ', decl%params diff --git a/src/types.f90 b/src/types.f90 index d6320cb2..261ae5d8 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -574,7 +574,7 @@ subroutine fn_insert(dict, key, val, id_index, iostat, overwrite) !print *, 'inserting ', quote(key) id_index = id_index + 1 - overwritel = .true. + overwritel = .false. if (present(overwrite)) overwritel = overwrite i = dict%scope @@ -1009,6 +1009,7 @@ subroutine var_insert(dict, key, val, id_index, iostat, overwrite) !print *, 'inserting ', quote(key) !print *, 'val = ', val%to_str() + ! Note that this is different than the fn insert default overwritel = .true. if (present(overwrite)) overwritel = overwrite @@ -2630,6 +2631,7 @@ subroutine struct_insert(dict, key, val, id_index, iostat, overwrite) !print *, 'inserting ', quote(key) id_index = id_index + 1 + ! TODO: flip this like fns to check for redeclared structs. Catch in caller overwritel = .true. if (present(overwrite)) overwritel = overwrite From b80604bee9d158ff7b32842c16d039763699e5fa Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 12:27:44 -0400 Subject: [PATCH 039/137] comment on perf --- src/eval.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/eval.f90 b/src/eval.f90 index 5bc4cc4c..a246e6eb 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -817,6 +817,11 @@ subroutine eval_fn_call(node, state, res) ! a stack in which we store each nested arg in different copies of ! tmp. if you try to store them all in the same state var at ! multiple stack levels it breaks? + ! + ! this also seems to have led to a dramatic perf improvement for + ! intel compilers in commit 324ad414, running full tests in ~25 + ! minutes instead of 50. gfortran perf remains good and unchanged + ! call syntax_eval(node%args(i), state, tmp) state%vars%vals( node%params(i) ) = tmp From 8f9cfc1af9f7ed0f829bfdac5babe8f9969dca56 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 12:40:23 -0400 Subject: [PATCH 040/137] Revert "make res intent(inout), not sure if i'll keep it" This reverts commit 993345addc9a1f89818cc324d1335493bab46cf4. --- src/eval.f90 | 48 +++++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 29 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index a246e6eb..afad8c5c 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -43,8 +43,8 @@ recursive subroutine syntax_eval(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res - !type(value_t), intent(out) :: res + !type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -153,7 +153,7 @@ subroutine eval_binary_expr(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -246,7 +246,7 @@ subroutine eval_name_expr(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -326,15 +326,13 @@ subroutine eval_name_expr(node, state, res) !print *, 'len_ = ', node%val%array%len_ !print *, 'cap = ', node%val%array%cap - if (.not. allocated(res%array)) allocate(res%array) + allocate(res%array) res%type = array_type res%array%kind = expl_array res%array%type = node%val%array%type res%array%rank = rank_res - if (allocated(res%array%size)) deallocate(res%array%size) allocate(res%array%size( rank_res )) - idim_res = 1 do idim_ = 1, size(lsubs) select case (node%lsubscripts(idim_)%sub_kind) @@ -464,7 +462,7 @@ subroutine eval_fn_call(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -860,7 +858,7 @@ subroutine eval_for_statement(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1040,7 +1038,7 @@ subroutine eval_assignment_expr(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1240,7 +1238,7 @@ subroutine eval_translation_unit(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1290,7 +1288,7 @@ subroutine eval_array_expr(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1412,7 +1410,7 @@ subroutine eval_array_expr(node, state, res) allocate(array%size( array%rank )) array%size = array%len_ - if (.not. allocated(res%array)) allocate(res%array) + allocate(res%array) res%type = array_type res%array = array @@ -1496,7 +1494,7 @@ subroutine eval_array_expr(node, state, res) call internal_error() end select - if (.not. allocated(res%array)) allocate(res%array) + allocate(res%array) res%type = array_type res%array = array @@ -1586,7 +1584,7 @@ subroutine eval_array_expr(node, state, res) end if !print *, 'copying array' - if (.not. allocated(res%array)) allocate(res%array) + allocate(res%array) res%type = array_type res%array = array !print *, 'done' @@ -1614,7 +1612,7 @@ subroutine eval_array_expr(node, state, res) array%size = array%len_ !print *, 'copying array' - if (.not. allocated(res%array)) allocate(res%array) + allocate(res%array) res%type = array_type res%array = array !print *, 'done' @@ -1633,7 +1631,7 @@ subroutine eval_while_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1655,7 +1653,7 @@ subroutine eval_if_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1683,7 +1681,7 @@ subroutine eval_return_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1709,7 +1707,7 @@ subroutine eval_block_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1760,7 +1758,7 @@ subroutine eval_unary_expr(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -1816,24 +1814,16 @@ subroutine allocate_array(array, cap) array%cap = cap - ! this could potentially be optimized by only re-allocating if over previous - ! cap (or change of type?) - select case (array%type) case (i32_type) - if (allocated(array%i32)) deallocate(array%i32) allocate(array%i32( cap )) case (i64_type) - if (allocated(array%i64)) deallocate(array%i64) allocate(array%i64( cap )) case (f32_type) - if (allocated(array%f32)) deallocate(array%f32) allocate(array%f32( cap )) case (bool_type) - if (allocated(array%bool)) deallocate(array%bool) allocate(array%bool( cap )) case (str_type) - if (allocated(array%str)) deallocate(array%str) allocate(array%str( cap )) case default write(*,*) err_int_prefix//'cannot allocate array of type `' & From 17545b8e90965538e722823b969851a355c56140 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 15:36:32 -0400 Subject: [PATCH 041/137] comments --- src/core.f90 | 6 +++++- src/eval.f90 | 5 ++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 0e07cc2f..cd7178e6 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -31,6 +31,8 @@ module syntran__core_m ! - structs ! * mvp done ! * tbd: + ! + struct fn return values + ! * this already works! wtf? test more ! + make aoc 2023 day 2 struct version as a test ! + unary ops on dot exprs ! + tests @@ -42,9 +44,11 @@ module syntran__core_m ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names - ! + struct fn return values ! + nested structs ! + structs of arrays + ! * kinda works if you statically initialize the whole array in the + ! struct and only refer to the whole array later. doesn't work if + ! you try to subscript anything inside a struct ! + arrays of structs ! - triage notes from AOC. many things are already fixed ! - jumping control flow: diff --git a/src/eval.f90 b/src/eval.f90 index afad8c5c..8f45ba67 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -43,7 +43,10 @@ recursive subroutine syntax_eval(node, state, res) type(state_t), intent(inout) :: state - !type(value_t), intent(inout) :: res + ! I experimented with making res intent(inout) in commit 993345ad, but it + ! had a negative imact on perf, making gfortran about twice as slow on aoc + ! tests, likely due to the extra work of checking `if allocated(...) + ! deallocate` in lots of places type(value_t), intent(out) :: res !******** From 567f122a19bf53335666838feedd5da5362648e7 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 16:52:12 -0400 Subject: [PATCH 042/137] fix bugs for type checking and returning dot exprs in fns --- src/parse_control.f90 | 15 +++++++++++++-- src/parse_expr.f90 | 4 ++++ src/parse_fn.f90 | 26 ++++++++++++++------------ src/types.f90 | 5 ++++- 4 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/parse_control.f90 b/src/parse_control.f90 index 7a6db7d0..aeaca077 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -58,13 +58,24 @@ module function parse_return_statement(parser) result(statement) end if semi = parser%match(semicolon_token) + act_type = statement%right%val%type + if (act_type == struct_type) then + print *, "return struct type" + end if + if (statement%right%kind == dot_expr) then + print *, "return dot expr" + !if (expr%right%kind == dot_expr) then + !rtype = expr%right%val%struct(expr%right%right%id_index)%type + act_type = statement%right%val%struct( statement%right%right%id_index )%type + end if + ! Check return type (unless we're at global level ifn == 1). That's half ! the point of return statements ! ! There should also be a check that every branch of a fn has a return ! statement, but that seems more difficult types_match = & - parser%fn_type == any_type .or. parser%fn_type == statement%right%val%type + parser%fn_type == any_type .or. parser%fn_type == act_type if (.not. types_match) then span = new_span(right_beg, right_end - right_beg + 1) @@ -72,7 +83,7 @@ module function parse_return_statement(parser) result(statement) err_bad_ret_type(parser%context(), & span, parser%fn_name, & kind_name(parser%fn_type), & - kind_name(statement%right%val%type))) + kind_name(act_type))) return end if diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 00562b4c..3065b362 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -748,6 +748,10 @@ module subroutine parse_dot(parser, expr) expr%right%id_index = member_id !print *, "index = ", expr%right%id_index + ! TODO: can we set the expr%val%type to the member's type here? Currently I + ! have to do a lot of checks for `if kind == dot_expr` in other places that + ! seem unnecessary + end subroutine parse_dot !=============================================================================== diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index ab6a72d3..073cee58 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -370,7 +370,7 @@ module function parse_fn_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: i, io, pos0, pos1, pos2, rank, itype, fn_beg, fn_name_end + integer :: i, j, io, pos0, pos1, pos2, rank, itype, fn_beg, fn_name_end type(fn_t) :: fn @@ -494,21 +494,23 @@ module function parse_fn_declaration(parser) result(decl) !print *, "struct num vars = ", struct%num_vars !print *, "struct name = ", types%v(i)%s - !! Save everything in the inst syntax node - !inst%kind = struct_instance_expr - !inst%val%type = struct_type - !allocate(inst%val%struct( struct%num_vars )) - !allocate(inst%members ( struct%num_vars )) - !inst%struct_name = identifier%text - !inst%val%struct_name = identifier%text - - !fn%params(i)%type = struct_type - !allocate(fn%params(i)%struct( struct%num_vars )) - !fn%params(i)%struct_name = types%v(i)%s + !! members are allocated here, vars%vals are not. probably ok, maybe + !! need a deep copy if the vars dict is really needed + !print *, "allocated = ", allocated(struct%members) + !print *, "allocated = ", allocated(struct%vars%vals) val%struct_name = types%v(i)%s allocate(val%struct( struct%num_vars )) + !allocate(val%members( struct%num_vars )) !val = struct + do j = 1, struct%num_vars + !val%struct(j) = struct%members(j)%val + val%struct(j)%type = struct%members(j)%type + !val%struct(j) = struct%vars%vals(j) + + !inst%val%struct( member_id ) = mem%val + + end do end if diff --git a/src/types.f90 b/src/types.f90 index 261ae5d8..732ac232 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -2435,7 +2435,9 @@ recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) !allocate(val) val = node%val + !val%vars = node%val%vars id_index = node%id_index + val%members = node%val%members !print *, 'done struct_ternary_search' !print *, '' @@ -2531,8 +2533,9 @@ recursive subroutine struct_ternary_insert(node, key, val, id_index, iostat, ove allocate(node%val) node%val = val - node%val%vars = val%vars + !node%val%vars = val%vars node%id_index = id_index + node%val%members = val%members !print *, 'done inserting' !print *, '' From ee56276cc23c0821dd950429e6f90729b120908e Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 16:57:07 -0400 Subject: [PATCH 043/137] reformat inline struct tests with line breaks --- src/tests/test.f90 | 43 +++++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 16 deletions(-) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 3de76d76..18d22de3 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2469,52 +2469,62 @@ subroutine unit_test_struct(npass, nfail) tests = & [ & - eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=14}; d.y;', quiet) == '1912', & - eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=14}; d.m;', quiet) == 'Apr', & - eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=14}; d.d;', quiet) == '14', & - eval('struct D{y:i64, m:str, d:i32} let d = D{y=1900+12, m="Apr", d=14}; d.y;', quiet) == '1912', & - eval('struct D{y:i64, m:str, d:i32} let d = D{y=1912, m="Apr", d=7*2}; let e=d; e.d;', quiet) == '14', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 1 + //'let d = D{y=1912, m="Apr", d=14};' & + //'d.y;', quiet) == '1912', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 2 + //'let d = D{y=1912, m="Apr", d=14};' & + //'d.m;', quiet) == 'Apr', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 3 + //'let d = D{y=1912, m="Apr", d=14};' & + //'d.d;', quiet) == '14', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 4 + //'let d = D{y=1900+12, m="Apr", d=14};' & + //'d.y;', quiet) == '1912', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 5 + //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let e=d; e.d;', quiet) == '14', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 6 //'let d = D{y=1912, m="Apr", d=7*2};' & //'let e=d;' & //'e = D{y=1945, m="May", d=5*3};' & //'e.d;', quiet) == '15', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 7 //'let d = D{y=1912, m="Apr", d=7*2};' & //'let e=d;' & //'e = D{y=1945, m="May", d=5*3};' & //'d.d;', quiet) == '14', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 8 //'let d = D{y=1912, m="Apr", d=7*2};' & //'let x = 42;' & //'x = d.d;' & //'x;', quiet) == '14', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 9 //'let d = D{y=1912, m="Apr", d=7*2};' & //'let x = d.y + 5;' & //'x;', quiet) == '1917', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 10 //'let d = D{y=1912, m="Apr", d=7*2};' & //'let x = 6 + d.y;' & //'x;', quiet) == '1918', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 11 //'let d = D{y=1912, m="Apr", d=7*2};' & //'d.d = 18;' & //'d.d;', quiet) == '18', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 12 //'let d = D{y=1912, m="Apr", d=7*2};' & //'d.d += 3;' & //'d.d;', quiet) == '17', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 13 //'let d = D{y=1912, m="Apr", d=7*2};' & //'d.m + "il";', quiet) == 'April', & - eval( 'struct D{y:i64, m:str, d:i32}' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 14 //'let d = D{y=1912, m="Apr", d=7*2};' & //'"month " + d.m;', quiet) == 'month Apr', & - eval( 'struct C{r:i32, g:i32, b:i32}' & + eval( 'struct C{r:i32, g:i32, b:i32}' & ! 15 //'let c = C{r = 32, g = 64, b = 128};' & //'max(c.r, c.g);', quiet) == '64', & - eval( 'struct C{r:i32, g:i32, b:i32}' & + eval( 'struct C{r:i32, g:i32, b:i32}' & ! 16 //'let c = C{r = 32, g = 64, b = 128};' & //'c.r + c.g + c.b;', quiet) == '224', & .false. & ! so I don't have to bother w/ trailing commas @@ -2522,6 +2532,7 @@ subroutine unit_test_struct(npass, nfail) ! Trim dummy false element tests = tests(1: size(tests) - 1) + !print *, "number of struct tests = ", size(tests) call unit_test_coda(tests, label, npass, nfail) From 8ac771f707f4f874f104fe429e671ad79bdd1379 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 17:06:17 -0400 Subject: [PATCH 044/137] add a bunch of struct fn tests --- src/tests/test.f90 | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 18d22de3..6f4b7935 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2527,6 +2527,34 @@ subroutine unit_test_struct(npass, nfail) eval( 'struct C{r:i32, g:i32, b:i32}' & ! 16 //'let c = C{r = 32, g = 64, b = 128};' & //'c.r + c.g + c.b;', quiet) == '224', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 17 + //'fn x_year(dd: D): i64 {return dd.y;}' & + //'let d = D{y=1884, m="Apr", d=7*2};' & + //'x_year(d);', quiet) == '1884', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 18 + //'fn x_year(dd: D): i64 {return dd.y;}' & + //'let d = D{y=1776, m="Jul", d=3+1};' & + //'x_year(d);', quiet) == '1776', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 19 + //'fn x_day(dd: D): i32 {return dd.d;}' & + //'let d = D{y=1884, m="Apr", d=7*2};' & + //'x_day(d);', quiet) == '14', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 20 + //'fn x_day(dd: D): i32 {return dd.d;}' & + //'let d = D{y=1776, m="Jul", d=3+1};' & + //'x_day(d);', quiet) == '4', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 21 + //'fn x_mon(dd: D): str {return dd.m;}' & + //'let d = D{y=1884, m="Apr", d=7*2};' & + //'x_mon(d);', quiet) == 'Apr', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 22 + //'fn x_mon(dd: D): str {return dd.m;}' & + //'let d = D{y=1776, m="Jul", d=3+1};' & + //'x_mon(d);', quiet) == 'Jul', & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 23 + //'let glbl = D{y=i64(1883), m="Apr", d=7*2};' & + //'fn x_year(): i64 {return glbl.y;}' & + //'x_year();', .false.) == '1883', & .false. & ! so I don't have to bother w/ trailing commas ] From 70860ba664aa1cb0b038475eb93aa7ea53707125 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 17:09:43 -0400 Subject: [PATCH 045/137] most of those tests only worked cause i'm not checking sub-types in struct instantiations --- src/tests/test.f90 | 54 +++++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 6f4b7935..fe3f0763 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2469,57 +2469,57 @@ subroutine unit_test_struct(npass, nfail) tests = & [ & - eval( 'struct D{y:i64, m:str, d:i32}' & ! 1 - //'let d = D{y=1912, m="Apr", d=14};' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 1 + //'let d = D{y=i64(1912), m="Apr", d=14};' & //'d.y;', quiet) == '1912', & - eval( 'struct D{y:i64, m:str, d:i32}' & ! 2 - //'let d = D{y=1912, m="Apr", d=14};' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 2 + //'let d = D{y=i64(1912), m="Apr", d=14};' & //'d.m;', quiet) == 'Apr', & - eval( 'struct D{y:i64, m:str, d:i32}' & ! 3 - //'let d = D{y=1912, m="Apr", d=14};' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 3 + //'let d = D{y=i64(1912), m="Apr", d=14};' & //'d.d;', quiet) == '14', & - eval( 'struct D{y:i64, m:str, d:i32}' & ! 4 - //'let d = D{y=1900+12, m="Apr", d=14};' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 4 + //'let d = D{y=i64(1900)+12, m="Apr", d=14};' & //'d.y;', quiet) == '1912', & - eval( 'struct D{y:i64, m:str, d:i32}' & ! 5 - //'let d = D{y=1912, m="Apr", d=7*2};' & + eval( 'struct D{y:i64, m:str, d:i32}' & ! 5 + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d; e.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 6 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d;' & - //'e = D{y=1945, m="May", d=5*3};' & + //'e = D{y=i64(1945), m="May", d=5*3};' & //'e.d;', quiet) == '15', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 7 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d;' & - //'e = D{y=1945, m="May", d=5*3};' & + //'e = D{y=i64(1945), m="May", d=5*3};' & //'d.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 8 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = 42;' & //'x = d.d;' & //'x;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 9 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = d.y + 5;' & //'x;', quiet) == '1917', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 10 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = 6 + d.y;' & //'x;', quiet) == '1918', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 11 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.d = 18;' & //'d.d;', quiet) == '18', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 12 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.d += 3;' & //'d.d;', quiet) == '17', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 13 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.m + "il";', quiet) == 'April', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 14 - //'let d = D{y=1912, m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'"month " + d.m;', quiet) == 'month Apr', & eval( 'struct C{r:i32, g:i32, b:i32}' & ! 15 //'let c = C{r = 32, g = 64, b = 128};' & @@ -2529,27 +2529,27 @@ subroutine unit_test_struct(npass, nfail) //'c.r + c.g + c.b;', quiet) == '224', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 17 //'fn x_year(dd: D): i64 {return dd.y;}' & - //'let d = D{y=1884, m="Apr", d=7*2};' & + //'let d = D{y=i64(1884), m="Apr", d=7*2};' & //'x_year(d);', quiet) == '1884', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 18 //'fn x_year(dd: D): i64 {return dd.y;}' & - //'let d = D{y=1776, m="Jul", d=3+1};' & + //'let d = D{y=i64(1776), m="Jul", d=3+1};' & //'x_year(d);', quiet) == '1776', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 19 //'fn x_day(dd: D): i32 {return dd.d;}' & - //'let d = D{y=1884, m="Apr", d=7*2};' & + //'let d = D{y=i64(1884), m="Apr", d=7*2};' & //'x_day(d);', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 20 //'fn x_day(dd: D): i32 {return dd.d;}' & - //'let d = D{y=1776, m="Jul", d=3+1};' & + //'let d = D{y=i64(1776), m="Jul", d=3+1};' & //'x_day(d);', quiet) == '4', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 21 //'fn x_mon(dd: D): str {return dd.m;}' & - //'let d = D{y=1884, m="Apr", d=7*2};' & + //'let d = D{y=i64(1884), m="Apr", d=7*2};' & //'x_mon(d);', quiet) == 'Apr', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 22 //'fn x_mon(dd: D): str {return dd.m;}' & - //'let d = D{y=1776, m="Jul", d=3+1};' & + //'let d = D{y=i64(1776), m="Jul", d=3+1};' & //'x_mon(d);', quiet) == 'Jul', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 23 //'let glbl = D{y=i64(1883), m="Apr", d=7*2};' & From b10d63fdd4044b9e0802535e38a71951ebe3d315 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 25 Aug 2024 19:19:43 -0400 Subject: [PATCH 046/137] add struct version of aoc 2023/02 as a test --- samples/struct.syntran | 6 ++-- src/core.f90 | 9 +++--- src/parse_control.f90 | 10 +++---- src/tests/long.f90 | 1 + .../long/aoc/2023/02/main-struct.syntran | 28 ++++++++++--------- 5 files changed, 27 insertions(+), 27 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index 018bfbb3..da97c77e 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -38,9 +38,9 @@ struct Date { y: i64 } -let d1 = Date{y = 1900 + 12, m = "Apr", d = 14}; +let d1 = Date{y = i64(1900) + 12, m = "Apr", d = 14}; -//let d1 = Date{y = 1912, m = "Apr", d = 14}; +//let d1 = Date{y = i64(1912), m = "Apr", d = 14}; //d1.d = 1969; println("d1.y = ", d1.y); @@ -60,7 +60,7 @@ println("t2.hh = ", t2.hh); println("t2.mm = ", t2.mm); println("t2.ss = ", t2.ss); -d1 = Date{y = 1900 + 45, m = "Ma" + "y", d = 5*4}; +d1 = Date{y = i64(1900) + 45, m = "Ma" + "y", d = 5*4}; d1.m = "June"; println("d1.y = ", d1.y); println("d1.m = ", d1.m); diff --git a/src/core.f90 b/src/core.f90 index cd7178e6..c4b2f6e8 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -29,18 +29,17 @@ module syntran__core_m ! TODO: ! - structs - ! * mvp done - ! * tbd: + ! * mvp done: ! + struct fn return values - ! * this already works! wtf? test more - ! + make aoc 2023 day 2 struct version as a test + ! * tbd: ! + unary ops on dot exprs ! + tests ! > moar ! + remove unused things like mems/members copies in various ! types/routines + ! > currently using members for fn param declarations ! + struct type checking - ! > check dot member types + ! > check dot member types in instantiation ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names diff --git a/src/parse_control.f90 b/src/parse_control.f90 index aeaca077..e449db13 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -59,13 +59,11 @@ module function parse_return_statement(parser) result(statement) semi = parser%match(semicolon_token) act_type = statement%right%val%type - if (act_type == struct_type) then - print *, "return struct type" - end if + !if (act_type == struct_type) then + ! print *, "return struct type" + !end if if (statement%right%kind == dot_expr) then - print *, "return dot expr" - !if (expr%right%kind == dot_expr) then - !rtype = expr%right%val%struct(expr%right%right%id_index)%type + !print *, "return dot expr" act_type = statement%right%val%struct( statement%right%right%id_index )%type end if diff --git a/src/tests/long.f90 b/src/tests/long.f90 index 6e1f3ae3..5e4f4ec6 100644 --- a/src/tests/long.f90 +++ b/src/tests/long.f90 @@ -39,6 +39,7 @@ subroutine unit_test_aoc_2023(npass, nfail) [ & interpret_file(path//"01/main.syntran", quiet = .true., chdir_ = .true.) == '107443', & interpret_file(path//"02/main.syntran", quiet = .true., chdir_ = .true.) == '76485', & + interpret_file(path//"02/main-struct.syntran", quiet = .true., chdir_ = .true.) == '76485', & interpret_file(path//"03/main.syntran", quiet = .true., chdir_ = .true.) == '88145909', & interpret_file(path//"04/main.syntran", quiet = .true., chdir_ = .true.) == '6311320', & interpret_file(path//"05/main.syntran", quiet = .true., chdir_ = .true.) == '261668924', & diff --git a/src/tests/long/aoc/2023/02/main-struct.syntran b/src/tests/long/aoc/2023/02/main-struct.syntran index 97012ef4..a434e419 100644 --- a/src/tests/long/aoc/2023/02/main-struct.syntran +++ b/src/tests/long/aoc/2023/02/main-struct.syntran @@ -1,13 +1,13 @@ -// TODO: make this a test - // This is not my original implementation (see main.syntran), rather this is an // alternative approach using structs #include("../../utils.syntran"); -let infile = "src/tests/long/aoc/2023/02/test-input.txt"; -infile = "src/tests/long/aoc/2023/02/input.txt"; +//let infile = "src/tests/long/aoc/2023/02/test-input.txt"; +//infile = "src/tests/long/aoc/2023/02/input.txt"; +let infile = "test-input.txt"; +infile = "input.txt"; struct Subset { @@ -151,16 +151,18 @@ fn part2(): i32 return sum; } -fn main(): bool +fn main(): i32 { - let pass = true; - pass = pass and part1() == 2256; - pass = pass and part2() == 74229; - return pass; + println(); + println("Starting AOC syntran main-struct 2023/02"); + let sum = 0; + sum += part1(); + sum += part2(); + + println("Ending AOC syntran main-struct"); + println(); + return sum; } -if main() - return 0; -else - return -1; +return main(); From 0fe7304fa540a857705cdc2e79dd09276251217c Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 26 Aug 2024 20:08:10 -0400 Subject: [PATCH 047/137] refactor and simplify dot expr type handling --- src/consts.f90 | 2 +- src/eval.f90 | 15 ++---- src/parse_control.f90 | 8 +-- src/parse_expr.f90 | 111 ++++++++++++++++++++---------------------- src/parse_fn.f90 | 8 +-- src/types.f90 | 16 +++--- 6 files changed, 75 insertions(+), 85 deletions(-) diff --git a/src/consts.f90 b/src/consts.f90 index eaf34d84..29aff2f5 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -16,7 +16,7 @@ module syntran__consts_m ! Token and syntax node kinds enum. Is there a better way to do this that ! allows re-ordering enums? Currently it would break kind_name() integer, parameter :: & - dot_expr = 98, & + dot_expr = 98, & ! TODO: rename to rhs_dot_expr struct_type = 97, & struct_instance_expr = 96, & struct_declaration = 95, & diff --git a/src/eval.f90 b/src/eval.f90 index 8f45ba67..8614943f 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -383,6 +383,8 @@ end subroutine eval_name_expr subroutine eval_dot_expr(node, state, res) + ! This is an RHS dot expr. LHS dots are handled in eval_assignment_expr(). + type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state @@ -395,22 +397,13 @@ subroutine eval_dot_expr(node, state, res) !print *, "eval dot_expr" - !!res = node%members%val(1) - !res = node%val%struct(1) - !res = node%val%struct( node%right%id_index ) - - !call syntax_eval(node%members( node%right%id_index ), state, res) - ! This won't work for struct literal member access. It only works for ! `identifier.member` - res = state%vars%vals(node%id_index)%struct( node%right%id_index ) + res = state%vars%vals(node%id_index)%struct( node%member%id_index ) !print *, "struct[", str(i), "] = ", res%struct(i)%to_str() !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() - !call syntax_eval(node%members(i), state, res%struct(i)) - !call syntax_eval(node%members( node%right%id_index ), state, res) - end subroutine eval_dot_expr !=============================================================================== @@ -1061,7 +1054,7 @@ subroutine eval_assignment_expr(node, state, res) !if (state%vars%vals(node%id_index)%type == struct_type) then if (allocated( node%member )) then - !print *, "assign dot member" + !print *, "assign LHS dot member" call syntax_eval(node%right, state, res) diff --git a/src/parse_control.f90 b/src/parse_control.f90 index e449db13..4bdf66c6 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -62,10 +62,10 @@ module function parse_return_statement(parser) result(statement) !if (act_type == struct_type) then ! print *, "return struct type" !end if - if (statement%right%kind == dot_expr) then - !print *, "return dot expr" - act_type = statement%right%val%struct( statement%right%right%id_index )%type - end if + !if (statement%right%kind == dot_expr) then + ! !print *, "return dot expr" + ! act_type = statement%right%val%struct( statement%right%right%id_index )%type + !end if ! Check return type (unless we're at global level ifn == 1). That's half ! the point of return statements diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 3065b362..3f0f66dc 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -26,8 +26,6 @@ recursive module function parse_expr_statement(parser) result(expr) integer :: io, ltype, rtype, pos0, span0, span1, lrank, rrank, larrtype, & rarrtype, id_index - logical :: is_dot - type(syntax_node_t) :: right, member type(syntax_token_t) :: let, identifier, op @@ -37,8 +35,6 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'starting parse_expr_statement()' - is_dot = .false. - ! TODO: provide a way to declare variable types without initializing them? ! Rust discourages mutability, instead preferring patterns like this: ! @@ -142,24 +138,20 @@ recursive module function parse_expr_statement(parser) result(expr) if (parser%peek_kind(0) == dot_token) then !print *, "dot token" - is_dot = .true. - - !call parser%vars%search(identifier%text, id_index, io, var) - call parser%vars%search(identifier%text, id_index, io, var) - !deallocate(expr%val) - expr%val = var - !expr%val%type = var%type + !call parser%vars%search(identifier%text, expr%id_index, io, var) + !expr%val = var + call parser%vars%search(identifier%text, expr%id_index, io, expr%val) call parser%parse_dot(expr) - if (.not. allocated(expr%right)) return - member = expr%right ! swap because this will be re-used as RHS of whole expr + if (.not. allocated(expr%member)) return - allocate(expr%member) - expr%member = member ! TODO: could get rid of local member var + !allocate(expr%member) + !!member = expr%right + !!expr%member = member + !expr%member = expr%right ! swap because this will be re-used as RHS of whole expr - !print *, "index = ", expr%right%id_index - !print *, "mndex = ", member%id_index + !print *, "index = ", expr%member%id_index end if @@ -194,13 +186,14 @@ recursive module function parse_expr_statement(parser) result(expr) ! Get the identifier's type and index from the dict and check that it ! has been declared - call parser%vars%search(identifier%text, expr%id_index, io, expr%val) - - if (io /= exit_success) then - span = new_span(identifier%pos, len(identifier%text)) - call parser%diagnostics%push( & - err_undeclare_var(parser%context(), & - span, identifier%text)) + if (.not. allocated(expr%member)) then + call parser%vars%search(identifier%text, expr%id_index, io, expr%val) + if (io /= exit_success) then + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push( & + err_undeclare_var(parser%context(), & + span, identifier%text)) + end if end if !print *, 'type = ', kind_name(expr%val%type) @@ -257,21 +250,15 @@ recursive module function parse_expr_statement(parser) result(expr) if (ltype == array_type) larrtype = expr%val%array%type if (rtype == array_type) rarrtype = expr%right%val%array%type - ! !if (ltype == struct_type) larrtype = expr%val%struct(1)%type - ! !if (ltype == struct_type) larrtype = expr%val%struct( expr%right%id_index )%type - ! !if (ltype == struct_type) larrtype = expr%val%struct( member%id_index )%type - - !if (is_dot) larrtype = expr%val%struct( member%id_index )%type - if (is_dot) ltype = expr%val%struct( member%id_index )%type - !if (expr%kind == dot_expr) ltype = expr%val%struct( member%id_index )%type + !if (allocated(expr%member)) ltype = expr%val%struct( member%id_index )%type - ! Descend similarly for rarrtype if dot expr - if (expr%right%kind == dot_expr) then - !rarrtype = expr%right%val%type - !rarrtype = expr%right%val%struct(expr%right%id_index)%type - !print *, "1 right index = ", expr%right%right%id_index - rtype = expr%right%val%struct(expr%right%right%id_index)%type - end if + !! Descend similarly for rarrtype if dot expr + !if (expr%right%kind == dot_expr) then + ! !rarrtype = expr%right%val%type + ! !rarrtype = expr%right%val%struct(expr%right%id_index)%type + ! !print *, "1 right index = ", expr%right%right%id_index + ! rtype = expr%right%val%struct(expr%right%right%id_index)%type + !end if !print *, "larrtype = ", kind_name(larrtype) !print *, "rarrtype = ", kind_name(rarrtype) @@ -385,19 +372,19 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (ltype == array_type) larrtype = expr%left %val%array%type if (rtype == array_type) rarrtype = expr%right%val%array%type - if (expr%left%kind == dot_expr) then - ! The index that I need is nested in an insane way + !if (expr%left%kind == dot_expr) then + ! ! The index that I need is nested in an insane way - !print *, "left index = ", expr%left%id_index - !print *, "left index = ", expr%left%right%id_index - ltype = expr%left%val%struct(expr%left%right%id_index)%type - end if + ! !print *, "left index = ", expr%left%id_index + ! !print *, "left index = ", expr%left%right%id_index + ! ltype = expr%left%val%struct(expr%left%right%id_index)%type + !end if - if (expr%right%kind == dot_expr) then - !print *, "2 right index = ", expr%right%id_index - !rtype = expr%right%val%struct(expr%right%id_index)%type - rtype = expr%right%val%struct(expr%right%right%id_index)%type - end if + !if (expr%right%kind == dot_expr) then + ! !print *, "2 right index = ", expr%right%id_index + ! !rtype = expr%right%val%struct(expr%right%id_index)%type + ! rtype = expr%right%val%struct(expr%right%right%id_index)%type + !end if !print *, 'larrtype = ', kind_name(larrtype) !print *, 'rarrtype = ', kind_name(rarrtype) @@ -713,11 +700,12 @@ module subroutine parse_dot(parser, expr) !print *, "struct name = ", expr%val%struct_name - !expr%kind = name_expr + ! For RHS dots, this will stick. For LHS dots, this will be shortly + ! overwritten as assignment_expr in the caller expr%kind = dot_expr - ! Save dot info in syntax node - allocate(expr%right) + ! Save dot info in member syntax node + allocate(expr%member) !parser%vars%search(identifier%text, id_index, io) !dummy = parser%structs%search(parser%current_text(), dummy_id, io) @@ -745,12 +733,21 @@ module subroutine parse_dot(parser, expr) !print *, "member id = ", member_id !print *, "mem type = ", kind_name(member%type) - expr%right%id_index = member_id - !print *, "index = ", expr%right%id_index + expr%member%id_index = member_id + !print *, "index = ", expr%member%id_index - ! TODO: can we set the expr%val%type to the member's type here? Currently I - ! have to do a lot of checks for `if kind == dot_expr` in other places that - ! seem unnecessary + ! Can we set the expr%val%type to the member's type here? Currently I have + ! to do a lot of checks for `if kind == dot_expr` in other places that seem + ! unnecessary + ! + ! Seems to work + expr%val%type = member%type + + ! TODO: I think this needs a recursive call to `parse_dot()` right here to + ! handle things like `a.b.c`. There should probably be a parse_subscripts() + ! call here too. For both, might need to differentiate between lvalues and + ! rvalues, i.e. use separate parse_ldot(), parse_rdot(), + ! parse_lsubscripts(), ... end subroutine parse_dot diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 073cee58..f54ffafc 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -248,10 +248,10 @@ module function parse_fn_call(parser) result(fn_call) val_type = args%v(i)%val%type - if (args%v(i)%kind == dot_expr) then - !print *, "dot_expr" - val_type = args%v(i)%val%struct( args%v(i)%right%id_index )%type - end if + !if (args%v(i)%kind == dot_expr) then + ! !print *, "dot_expr" + ! val_type = args%v(i)%val%struct( args%v(i)%right%id_index )%type + !end if !print *, kind_name(val_type) !print *, kind_name(fn%params(i)%type) diff --git a/src/types.f90 b/src/types.f90 index 732ac232..373cab17 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1837,16 +1837,16 @@ function new_binary_expr(left, op, right) result(expr) ! get_binary_op_kind() will need to be applied for unary ops too ltype = left%val%type - if (left%kind == dot_expr) then - !print *, "left index = ", left%id_index - !print *, "left index = ", left%right%id_index - ltype = left%val%struct(left%right%id_index)%type - end if + !if (left%kind == dot_expr) then + ! !print *, "left index = ", left%id_index + ! !print *, "left index = ", left%right%id_index + ! ltype = left%val%struct(left%right%id_index)%type + !end if rtype = right%val%type - if (right%kind == dot_expr) then - rtype = right%val%struct(right%right%id_index)%type - end if + !if (right%kind == dot_expr) then + ! rtype = right%val%struct(right%right%id_index)%type + !end if ! Pass the result value type up the tree for type checking in parent type_ = get_binary_op_kind(ltype, op%kind, rtype, & From ef3f17fb4734b91503eb9c55b96833404ca2a872 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 26 Aug 2024 21:06:10 -0400 Subject: [PATCH 048/137] here's a bunch of shit but i probably only need the loop in value_copy() --- src/eval.f90 | 6 +++-- src/parse.f90 | 12 +++++----- src/parse_array.f90 | 16 ++++++------- src/parse_control.f90 | 8 +++---- src/parse_expr.f90 | 54 ++++++++++++++++++++++++++++++------------- src/parse_fn.f90 | 12 +++++----- src/types.f90 | 2 +- src/value.f90 | 10 ++++++-- 8 files changed, 75 insertions(+), 45 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 8614943f..5ec0687b 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -53,7 +53,8 @@ recursive subroutine syntax_eval(node, state, res) integer :: i - !print *, 'starting syntax_eval()' + !print *, "starting syntax_eval()" + !print *, "node kind = ", kind_name(node%kind) ! if_statement and while_statement may return an uninitialized type ! otherwise if their conditions are false @@ -1760,8 +1761,9 @@ subroutine eval_unary_expr(node, state, res) type(value_t) :: right + !print *, "eval right" call syntax_eval(node%right, state, right) - !print *, 'right = ', right + !print *, "right = ", right%to_str() res%type = right%type diff --git a/src/parse.f90 b/src/parse.f90 index 2091cc74..01205724 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -196,16 +196,16 @@ end function parse_statement interface ! Implemented in parse_expr.f90 - recursive module function parse_expr_statement(parser) result(expr) + recursive module subroutine parse_expr_statement(parser, expr) class(parser_t) :: parser - type(syntax_node_t) :: expr - end function parse_expr_statement + type(syntax_node_t), intent(out) :: expr + end subroutine parse_expr_statement - recursive module function parse_expr(parser, parent_prec) result(expr) + recursive module subroutine parse_expr(parser, expr, parent_prec) class(parser_t) :: parser + type(syntax_node_t), intent(out) :: expr integer, optional, intent(in) :: parent_prec - type(syntax_node_t) :: expr - end function parse_expr + end subroutine parse_expr module function parse_primary_expr(parser) result(expr) class(parser_t) :: parser diff --git a/src/parse_array.f90 b/src/parse_array.f90 index d6632939..321768b1 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -78,7 +78,7 @@ module function parse_array_expr(parser) result(expr) span_beg = parser%peek_pos(0) lb_beg = span_beg - lbound_ = parser%parse_expr() + call parser%parse_expr(lbound_) span_end = parser%peek_pos(0) - 1 lb_end = span_end @@ -151,7 +151,7 @@ module function parse_array_expr(parser) result(expr) span_beg = parser%peek_pos(0) ub_beg = span_beg - ubound_ = parser%parse_expr() + call parser%parse_expr(ubound_) span_end = parser%peek_pos(0) - 1 ub_end = span_end @@ -178,7 +178,7 @@ module function parse_array_expr(parser) result(expr) colon = parser%match(colon_token) span_beg = parser%peek_pos(0) - ubound_ = parser%parse_expr() + call parser%parse_expr(ubound_) span_end = parser%peek_pos(0) - 1 if (.not. is_num_type(ubound_%val%type)) then @@ -242,7 +242,7 @@ module function parse_array_expr(parser) result(expr) semicolon = parser%match(semicolon_token) span_beg = parser%peek_pos(0) - len_ = parser%parse_expr() + call parser%parse_expr(len_) span_end = parser%peek_pos(0) - 1 !print *, 'len_ = ', parser%text(span_beg, span_end) @@ -356,7 +356,7 @@ module function parse_array_expr(parser) result(expr) comma = parser%match(comma_token) span_beg = parser%peek_pos(0) - elem = parser%parse_expr() + call parser%parse_expr(elem) span_end = parser%peek_pos(0) - 1 !print *, 'elem ', elem%val%str() @@ -473,7 +473,7 @@ module subroutine parse_subscripts(parser, expr) lsubscript%sub_kind = all_sub else - lsubscript = parser%parse_expr() + call parser%parse_expr(lsubscript) !print *, 'lsubscript = ', lsubscript%str() !print *, 'lsubscript = ', parser%text(span0, parser%current_pos()-1) @@ -490,7 +490,7 @@ module subroutine parse_subscripts(parser, expr) colon = parser%match(colon_token) lsubscript%sub_kind = range_sub - usubscript = parser%parse_expr() + call parser%parse_expr(usubscript) ! TODO: type check i32 else @@ -551,7 +551,7 @@ module function parse_size(parser) result(size) pos0 = parser%pos span_beg = parser%peek_pos(0) - len = parser%parse_expr() + call parser%parse_expr(len) span_end = parser%peek_pos(0) - 1 !print *, 'len = ', parser%text(span_beg, span_end) diff --git a/src/parse_control.f90 b/src/parse_control.f90 index 4bdf66c6..a7bf0720 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -52,7 +52,7 @@ module function parse_return_statement(parser) result(statement) else ! expr or statement? right_beg = parser%peek_pos(0) - statement%right = parser%parse_expr() + call parser%parse_expr(statement%right) right_end = parser%peek_pos(0) - 1 end if @@ -141,7 +141,7 @@ module function parse_if_statement(parser) result(statement) if_token = parser%match(if_keyword) cond_beg = parser%peek_pos(0) - condition = parser%parse_expr() + call parser%parse_expr(condition) !cond_end = parser%peek_pos(-1) cond_end = parser%peek_pos(0) - 1 @@ -310,7 +310,7 @@ module function parse_while_statement(parser) result(statement) while_token = parser%match(while_keyword) cond_beg = parser%peek_pos(0) - condition = parser%parse_expr() + call parser%parse_expr(condition) cond_end = parser%peek_pos(0) - 1 ! Check that condition type is bool @@ -413,7 +413,7 @@ module function parse_statement(parser) result(statement) statement = parser%parse_return_statement() case default - statement = parser%parse_expr_statement() + call parser%parse_expr_statement(statement) semi = parser%match(semicolon_token) end select diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 3f0f66dc..cd95bacc 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -15,11 +15,11 @@ !=============================================================================== -recursive module function parse_expr_statement(parser) result(expr) +recursive module subroutine parse_expr_statement(parser, expr) class(parser_t) :: parser - type(syntax_node_t) :: expr + type(syntax_node_t), intent(out) :: expr !******** @@ -63,8 +63,8 @@ recursive module function parse_expr_statement(parser) result(expr) identifier = parser%next() op = parser%next() - right = parser%parse_expr_statement() - !right = parser%parse_expr() + call parser%parse_expr_statement(right) + !call parser%parse_expr(right) !! I think the way to get conditional initialization like rust is !! something like this. May need to peek current and check if it's @@ -72,7 +72,21 @@ recursive module function parse_expr_statement(parser) result(expr) !right = parser%parse_statement() !!semi = parser%match(semicolon_token) - expr = new_declaration_expr(identifier, op, right) + !expr = new_declaration_expr(identifier, op, right) + !******** + ! new_declaration_expr() inlined + expr%kind = let_expr + + allocate(expr%right) + + expr%identifier = identifier + + expr%op = op + expr%right = right + + ! Pass the result value type up the tree for type checking in parent + expr%val = right%val + !******** !print *, 'expr ident text = ', expr%identifier%text @@ -161,13 +175,14 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, "rewinding" parser%pos = pos0 !print *, 'pos0 = ', pos0 - expr = parser%parse_expr() + call parser%parse_expr(expr) + !print *, "here" return end if !print *, 'parsing assignment' op = parser%next() - right = parser%parse_expr_statement() + call parser%parse_expr_statement(right) !print *, "1a right index = ", right%right%id_index ! regular vs compound assignment exprs are denoted by the op. all of @@ -299,14 +314,15 @@ recursive module function parse_expr_statement(parser) result(expr) end if - expr = parser%parse_expr() + call parser%parse_expr(expr) !semi = parser%match(semicolon_token) -end function parse_expr_statement +end subroutine parse_expr_statement !=============================================================================== -recursive module function parse_expr(parser, parent_prec) result(expr) +!recursive module function parse_expr(parser, parent_prec) result(expr) +recursive module subroutine parse_expr(parser, expr, parent_prec) ! In episode 3, Immo renamed this fn to "ParseBinaryExpression()", but ! I consider that confusing because the result could be either unary or @@ -316,7 +332,8 @@ recursive module function parse_expr(parser, parent_prec) result(expr) integer, optional, intent(in) :: parent_prec - type(syntax_node_t) :: expr + !type(syntax_node_t) :: expr + type(syntax_node_t), intent(out) :: expr !******** @@ -337,7 +354,7 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (prec /= 0 .and. prec >= parent_precl) then op = parser%next() - right = parser%parse_expr(prec) + call parser%parse_expr(right, prec) expr = new_unary_expr(op, right) rtype = right%val%type @@ -361,7 +378,7 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (prec == 0 .or. prec <= parent_precl) exit op = parser%next() - right = parser%parse_expr(prec) + call parser%parse_expr(right, prec) expr = new_binary_expr(expr, op, right) ltype = expr%left %val%type @@ -425,7 +442,10 @@ recursive module function parse_expr(parser, parent_prec) result(expr) end do -end function parse_expr + !print *, "ending parse_expr" + +!end function parse_expr +end subroutine parse_expr !=============================================================================== @@ -459,8 +479,8 @@ module function parse_primary_expr(parser) result(expr) ! These two lines are the difference between allowing statement ! "a = (b = 1)" or not. Note that "a = b = 1" is allowed either way - !expr = parser%parse_expr() - expr = parser%parse_expr_statement() + !call parser%parse_expr(expr) + call parser%parse_expr_statement(expr) right = parser%match(rparen_token) @@ -558,6 +578,8 @@ module function parse_primary_expr(parser) result(expr) end select + !print *, "ending parse_primary_expr" + end function parse_primary_expr !=============================================================================== diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index f54ffafc..853b0c69 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -51,7 +51,7 @@ module function parse_fn_call(parser) result(fn_call) parser%current_kind() /= eof_token) pos0 = parser%pos - arg = parser%parse_expr() + call parser%parse_expr(arg) call args%push(arg) !! TODO: we need a delete method for syntax_node_t (i.e. @@ -869,7 +869,7 @@ module function parse_struct_instance(parser) result(inst) identifier = parser%match(identifier_token) - !print *, "parsing struct instance of identifier = ", identifier%text + print *, "parsing struct instance of identifier = ", identifier%text !print *, "" !print *, "in parse_struct_instance():" @@ -914,9 +914,9 @@ module function parse_struct_instance(parser) result(inst) name = parser%match(identifier_token) equals = parser%match(equals_token) - mem = parser%parse_expr() + call parser%parse_expr(mem) - !print *, "name%text = ", name%text + print *, "name%text = ", name%text !call struct%vars%insert(struct%members(i)%name, val, & ! struct%num_vars, io, overwrite = .false.) @@ -957,7 +957,7 @@ module function parse_struct_instance(parser) result(inst) rbrace = parser%match(rbrace_token) - !print *, "size = ", struct%num_vars + print *, "size = ", struct%num_vars !print *, "size = ", mems%len_ if (mems%len_ /= struct%num_vars) then ! TODO: diag @@ -967,7 +967,7 @@ module function parse_struct_instance(parser) result(inst) ! TODO: check type of members match - !print *, "ending parse_struct_instance()" + print *, "ending parse_struct_instance()" end function parse_struct_instance diff --git a/src/types.f90 b/src/types.f90 index 373cab17..2bc9e7c6 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1395,7 +1395,7 @@ end function get_keyword_kind function new_declaration_expr(identifier, op, right) result(expr) ! TODO: IMO this fn is overly abstracted. It's only used once, so - ! just paste it their and delete the fn. That will make it easier to + ! just paste it there and delete the fn. That will make it easier to ! refactor and consolidate declaration_expr and assignment_expr parsing type(syntax_token_t), intent(in) :: identifier, op diff --git a/src/value.f90 b/src/value.f90 index 3a37278b..0039adcc 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -129,7 +129,7 @@ recursive subroutine value_copy(dst, src) integer :: i - if (debug > 3) print *, 'starting value_copy()' + if (debug > 1) print *, 'starting value_copy()' dst%type = src%type dst%sca = src%sca @@ -147,11 +147,17 @@ recursive subroutine value_copy(dst, src) if (allocated(src%struct)) then if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) - dst%struct = src%struct + !dst%struct = src%struct + do i = 1, size(src%struct) + dst%struct(i) = src%struct(i) + end do + else if (allocated(dst%struct)) then deallocate(dst%struct) end if + if (debug > 1) print *, 'ending value_copy()' + end subroutine value_copy !=============================================================================== From 9ad4ac9299629e727548af6ecc73cf495cf2f459 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 26 Aug 2024 21:06:36 -0400 Subject: [PATCH 049/137] Revert "here's a bunch of shit but i probably only need the loop in value_copy()" This reverts commit ef3f17fb4734b91503eb9c55b96833404ca2a872. --- src/eval.f90 | 6 ++--- src/parse.f90 | 12 +++++----- src/parse_array.f90 | 16 ++++++------- src/parse_control.f90 | 8 +++---- src/parse_expr.f90 | 54 +++++++++++++------------------------------ src/parse_fn.f90 | 12 +++++----- src/types.f90 | 2 +- src/value.f90 | 10 ++------ 8 files changed, 45 insertions(+), 75 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 5ec0687b..8614943f 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -53,8 +53,7 @@ recursive subroutine syntax_eval(node, state, res) integer :: i - !print *, "starting syntax_eval()" - !print *, "node kind = ", kind_name(node%kind) + !print *, 'starting syntax_eval()' ! if_statement and while_statement may return an uninitialized type ! otherwise if their conditions are false @@ -1761,9 +1760,8 @@ subroutine eval_unary_expr(node, state, res) type(value_t) :: right - !print *, "eval right" call syntax_eval(node%right, state, right) - !print *, "right = ", right%to_str() + !print *, 'right = ', right res%type = right%type diff --git a/src/parse.f90 b/src/parse.f90 index 01205724..2091cc74 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -196,16 +196,16 @@ end function parse_statement interface ! Implemented in parse_expr.f90 - recursive module subroutine parse_expr_statement(parser, expr) + recursive module function parse_expr_statement(parser) result(expr) class(parser_t) :: parser - type(syntax_node_t), intent(out) :: expr - end subroutine parse_expr_statement + type(syntax_node_t) :: expr + end function parse_expr_statement - recursive module subroutine parse_expr(parser, expr, parent_prec) + recursive module function parse_expr(parser, parent_prec) result(expr) class(parser_t) :: parser - type(syntax_node_t), intent(out) :: expr integer, optional, intent(in) :: parent_prec - end subroutine parse_expr + type(syntax_node_t) :: expr + end function parse_expr module function parse_primary_expr(parser) result(expr) class(parser_t) :: parser diff --git a/src/parse_array.f90 b/src/parse_array.f90 index 321768b1..d6632939 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -78,7 +78,7 @@ module function parse_array_expr(parser) result(expr) span_beg = parser%peek_pos(0) lb_beg = span_beg - call parser%parse_expr(lbound_) + lbound_ = parser%parse_expr() span_end = parser%peek_pos(0) - 1 lb_end = span_end @@ -151,7 +151,7 @@ module function parse_array_expr(parser) result(expr) span_beg = parser%peek_pos(0) ub_beg = span_beg - call parser%parse_expr(ubound_) + ubound_ = parser%parse_expr() span_end = parser%peek_pos(0) - 1 ub_end = span_end @@ -178,7 +178,7 @@ module function parse_array_expr(parser) result(expr) colon = parser%match(colon_token) span_beg = parser%peek_pos(0) - call parser%parse_expr(ubound_) + ubound_ = parser%parse_expr() span_end = parser%peek_pos(0) - 1 if (.not. is_num_type(ubound_%val%type)) then @@ -242,7 +242,7 @@ module function parse_array_expr(parser) result(expr) semicolon = parser%match(semicolon_token) span_beg = parser%peek_pos(0) - call parser%parse_expr(len_) + len_ = parser%parse_expr() span_end = parser%peek_pos(0) - 1 !print *, 'len_ = ', parser%text(span_beg, span_end) @@ -356,7 +356,7 @@ module function parse_array_expr(parser) result(expr) comma = parser%match(comma_token) span_beg = parser%peek_pos(0) - call parser%parse_expr(elem) + elem = parser%parse_expr() span_end = parser%peek_pos(0) - 1 !print *, 'elem ', elem%val%str() @@ -473,7 +473,7 @@ module subroutine parse_subscripts(parser, expr) lsubscript%sub_kind = all_sub else - call parser%parse_expr(lsubscript) + lsubscript = parser%parse_expr() !print *, 'lsubscript = ', lsubscript%str() !print *, 'lsubscript = ', parser%text(span0, parser%current_pos()-1) @@ -490,7 +490,7 @@ module subroutine parse_subscripts(parser, expr) colon = parser%match(colon_token) lsubscript%sub_kind = range_sub - call parser%parse_expr(usubscript) + usubscript = parser%parse_expr() ! TODO: type check i32 else @@ -551,7 +551,7 @@ module function parse_size(parser) result(size) pos0 = parser%pos span_beg = parser%peek_pos(0) - call parser%parse_expr(len) + len = parser%parse_expr() span_end = parser%peek_pos(0) - 1 !print *, 'len = ', parser%text(span_beg, span_end) diff --git a/src/parse_control.f90 b/src/parse_control.f90 index a7bf0720..4bdf66c6 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -52,7 +52,7 @@ module function parse_return_statement(parser) result(statement) else ! expr or statement? right_beg = parser%peek_pos(0) - call parser%parse_expr(statement%right) + statement%right = parser%parse_expr() right_end = parser%peek_pos(0) - 1 end if @@ -141,7 +141,7 @@ module function parse_if_statement(parser) result(statement) if_token = parser%match(if_keyword) cond_beg = parser%peek_pos(0) - call parser%parse_expr(condition) + condition = parser%parse_expr() !cond_end = parser%peek_pos(-1) cond_end = parser%peek_pos(0) - 1 @@ -310,7 +310,7 @@ module function parse_while_statement(parser) result(statement) while_token = parser%match(while_keyword) cond_beg = parser%peek_pos(0) - call parser%parse_expr(condition) + condition = parser%parse_expr() cond_end = parser%peek_pos(0) - 1 ! Check that condition type is bool @@ -413,7 +413,7 @@ module function parse_statement(parser) result(statement) statement = parser%parse_return_statement() case default - call parser%parse_expr_statement(statement) + statement = parser%parse_expr_statement() semi = parser%match(semicolon_token) end select diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index cd95bacc..3f0f66dc 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -15,11 +15,11 @@ !=============================================================================== -recursive module subroutine parse_expr_statement(parser, expr) +recursive module function parse_expr_statement(parser) result(expr) class(parser_t) :: parser - type(syntax_node_t), intent(out) :: expr + type(syntax_node_t) :: expr !******** @@ -63,8 +63,8 @@ recursive module subroutine parse_expr_statement(parser, expr) identifier = parser%next() op = parser%next() - call parser%parse_expr_statement(right) - !call parser%parse_expr(right) + right = parser%parse_expr_statement() + !right = parser%parse_expr() !! I think the way to get conditional initialization like rust is !! something like this. May need to peek current and check if it's @@ -72,21 +72,7 @@ recursive module subroutine parse_expr_statement(parser, expr) !right = parser%parse_statement() !!semi = parser%match(semicolon_token) - !expr = new_declaration_expr(identifier, op, right) - !******** - ! new_declaration_expr() inlined - expr%kind = let_expr - - allocate(expr%right) - - expr%identifier = identifier - - expr%op = op - expr%right = right - - ! Pass the result value type up the tree for type checking in parent - expr%val = right%val - !******** + expr = new_declaration_expr(identifier, op, right) !print *, 'expr ident text = ', expr%identifier%text @@ -175,14 +161,13 @@ recursive module subroutine parse_expr_statement(parser, expr) !print *, "rewinding" parser%pos = pos0 !print *, 'pos0 = ', pos0 - call parser%parse_expr(expr) - !print *, "here" + expr = parser%parse_expr() return end if !print *, 'parsing assignment' op = parser%next() - call parser%parse_expr_statement(right) + right = parser%parse_expr_statement() !print *, "1a right index = ", right%right%id_index ! regular vs compound assignment exprs are denoted by the op. all of @@ -314,15 +299,14 @@ recursive module subroutine parse_expr_statement(parser, expr) end if - call parser%parse_expr(expr) + expr = parser%parse_expr() !semi = parser%match(semicolon_token) -end subroutine parse_expr_statement +end function parse_expr_statement !=============================================================================== -!recursive module function parse_expr(parser, parent_prec) result(expr) -recursive module subroutine parse_expr(parser, expr, parent_prec) +recursive module function parse_expr(parser, parent_prec) result(expr) ! In episode 3, Immo renamed this fn to "ParseBinaryExpression()", but ! I consider that confusing because the result could be either unary or @@ -332,8 +316,7 @@ recursive module subroutine parse_expr(parser, expr, parent_prec) integer, optional, intent(in) :: parent_prec - !type(syntax_node_t) :: expr - type(syntax_node_t), intent(out) :: expr + type(syntax_node_t) :: expr !******** @@ -354,7 +337,7 @@ recursive module subroutine parse_expr(parser, expr, parent_prec) if (prec /= 0 .and. prec >= parent_precl) then op = parser%next() - call parser%parse_expr(right, prec) + right = parser%parse_expr(prec) expr = new_unary_expr(op, right) rtype = right%val%type @@ -378,7 +361,7 @@ recursive module subroutine parse_expr(parser, expr, parent_prec) if (prec == 0 .or. prec <= parent_precl) exit op = parser%next() - call parser%parse_expr(right, prec) + right = parser%parse_expr(prec) expr = new_binary_expr(expr, op, right) ltype = expr%left %val%type @@ -442,10 +425,7 @@ recursive module subroutine parse_expr(parser, expr, parent_prec) end do - !print *, "ending parse_expr" - -!end function parse_expr -end subroutine parse_expr +end function parse_expr !=============================================================================== @@ -479,8 +459,8 @@ module function parse_primary_expr(parser) result(expr) ! These two lines are the difference between allowing statement ! "a = (b = 1)" or not. Note that "a = b = 1" is allowed either way - !call parser%parse_expr(expr) - call parser%parse_expr_statement(expr) + !expr = parser%parse_expr() + expr = parser%parse_expr_statement() right = parser%match(rparen_token) @@ -578,8 +558,6 @@ module function parse_primary_expr(parser) result(expr) end select - !print *, "ending parse_primary_expr" - end function parse_primary_expr !=============================================================================== diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 853b0c69..f54ffafc 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -51,7 +51,7 @@ module function parse_fn_call(parser) result(fn_call) parser%current_kind() /= eof_token) pos0 = parser%pos - call parser%parse_expr(arg) + arg = parser%parse_expr() call args%push(arg) !! TODO: we need a delete method for syntax_node_t (i.e. @@ -869,7 +869,7 @@ module function parse_struct_instance(parser) result(inst) identifier = parser%match(identifier_token) - print *, "parsing struct instance of identifier = ", identifier%text + !print *, "parsing struct instance of identifier = ", identifier%text !print *, "" !print *, "in parse_struct_instance():" @@ -914,9 +914,9 @@ module function parse_struct_instance(parser) result(inst) name = parser%match(identifier_token) equals = parser%match(equals_token) - call parser%parse_expr(mem) + mem = parser%parse_expr() - print *, "name%text = ", name%text + !print *, "name%text = ", name%text !call struct%vars%insert(struct%members(i)%name, val, & ! struct%num_vars, io, overwrite = .false.) @@ -957,7 +957,7 @@ module function parse_struct_instance(parser) result(inst) rbrace = parser%match(rbrace_token) - print *, "size = ", struct%num_vars + !print *, "size = ", struct%num_vars !print *, "size = ", mems%len_ if (mems%len_ /= struct%num_vars) then ! TODO: diag @@ -967,7 +967,7 @@ module function parse_struct_instance(parser) result(inst) ! TODO: check type of members match - print *, "ending parse_struct_instance()" + !print *, "ending parse_struct_instance()" end function parse_struct_instance diff --git a/src/types.f90 b/src/types.f90 index 2bc9e7c6..373cab17 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1395,7 +1395,7 @@ end function get_keyword_kind function new_declaration_expr(identifier, op, right) result(expr) ! TODO: IMO this fn is overly abstracted. It's only used once, so - ! just paste it there and delete the fn. That will make it easier to + ! just paste it their and delete the fn. That will make it easier to ! refactor and consolidate declaration_expr and assignment_expr parsing type(syntax_token_t), intent(in) :: identifier, op diff --git a/src/value.f90 b/src/value.f90 index 0039adcc..3a37278b 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -129,7 +129,7 @@ recursive subroutine value_copy(dst, src) integer :: i - if (debug > 1) print *, 'starting value_copy()' + if (debug > 3) print *, 'starting value_copy()' dst%type = src%type dst%sca = src%sca @@ -147,17 +147,11 @@ recursive subroutine value_copy(dst, src) if (allocated(src%struct)) then if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) - !dst%struct = src%struct - do i = 1, size(src%struct) - dst%struct(i) = src%struct(i) - end do - + dst%struct = src%struct else if (allocated(dst%struct)) then deallocate(dst%struct) end if - if (debug > 1) print *, 'ending value_copy()' - end subroutine value_copy !=============================================================================== From d9ea910a819ffe7844632cda41dc443864cc9698 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 26 Aug 2024 21:09:50 -0400 Subject: [PATCH 050/137] fuck yeah --- src/value.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/value.f90 b/src/value.f90 index 3a37278b..ea372ba5 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -147,7 +147,9 @@ recursive subroutine value_copy(dst, src) if (allocated(src%struct)) then if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) - dst%struct = src%struct + do i = 1, size(src%struct) + dst%struct(i) = src%struct(i) + end do else if (allocated(dst%struct)) then deallocate(dst%struct) end if From 3b1fc0c13521db6ac6dc03d0f53f57dd575ba576 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 26 Aug 2024 22:25:54 -0400 Subject: [PATCH 051/137] add tests for dot exprs in struct instantiators --- src/parse_fn.f90 | 3 ++- src/tests/test.f90 | 14 +++++++++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index f54ffafc..f2225f97 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -933,7 +933,8 @@ module function parse_struct_instance(parser) result(inst) if (io /= 0) then ! TODO: diag - write(*,*) err_prefix//"member does not exist in struct"//color_reset + write(*,*) err_prefix//"member """//name%text & + //""" does not exist in struct"//color_reset stop end if diff --git a/src/tests/test.f90 b/src/tests/test.f90 index fe3f0763..07053e1a 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2554,7 +2554,19 @@ subroutine unit_test_struct(npass, nfail) eval( 'struct D{y:i64, m:str, d:i32}' & ! 23 //'let glbl = D{y=i64(1883), m="Apr", d=7*2};' & //'fn x_year(): i64 {return glbl.y;}' & - //'x_year();', .false.) == '1883', & + //'x_year();', quiet) == '1883', & + eval( 'struct P{x:i32, y:i32,}' & ! 24 + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=5, y=p1.y};' & + //'p2.x;', quiet) == '5', & + eval( 'struct P{x:i32, y:i32,}' & ! 25 + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=5, y=p1.y};' & + //'p1.x;', quiet) == '6', & + eval( 'struct P{x:i32, y:i32,}' & ! 26 + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=5, y=p1.y};' & + //'p2.y;', quiet) == '13', & .false. & ! so I don't have to bother w/ trailing commas ] From 26a8daaca3da3944a04e3e057e045cdd8362140e Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 26 Aug 2024 22:30:51 -0400 Subject: [PATCH 052/137] one more test --- src/tests/test.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 07053e1a..910ce638 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2567,6 +2567,10 @@ subroutine unit_test_struct(npass, nfail) //'let p1 = P{x=6, y=13};' & //'let p2 = P{x=5, y=p1.y};' & //'p2.y;', quiet) == '13', & + eval( 'struct P{x:i32, y:i32,}' & ! 27 + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=5, y=p1.y};' & + //'p1.y;', quiet) == '13', & .false. & ! so I don't have to bother w/ trailing commas ] From 5b6a07135e5b8dee9536db8933f6b04cefb3e945 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 27 Aug 2024 20:29:45 -0400 Subject: [PATCH 053/137] fix bug for nested structs; add tests --- src/parse_expr.f90 | 38 ++++++++++++++++++++++++++++---------- src/parse_fn.f90 | 2 ++ src/tests/test.f90 | 36 ++++++++++++++++++++++++++++++++++++ src/types.f90 | 2 ++ 4 files changed, 68 insertions(+), 10 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 3f0f66dc..b2dca758 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -61,6 +61,8 @@ recursive module function parse_expr_statement(parser) result(expr) let = parser%next() identifier = parser%next() + !print *, 'let ident = ', identifier%text + op = parser%next() right = parser%parse_expr_statement() @@ -74,8 +76,6 @@ recursive module function parse_expr_statement(parser) result(expr) expr = new_declaration_expr(identifier, op, right) - !print *, 'expr ident text = ', expr%identifier%text - ! Increment the variable array index and save it in the expr node. ! TODO: make this a push_var fn? parse_for_statement uses it too parser%num_vars = parser%num_vars + 1 @@ -102,9 +102,9 @@ recursive module function parse_expr_statement(parser) result(expr) !! this should be unnecessary !!print *, "right type = ", kind_name(right%val%type) !if (right%val%type == struct_type) then - ! !print *, "struct_name = ", right%struct_name - ! !expr%struct_name = right%struct_name - ! !expr%val%struct_name = right%struct_name + ! print *, "struct_name = ", right%struct_name + ! expr%struct_name = right%struct_name + ! expr%val%struct_name = right%struct_name !end if return @@ -650,6 +650,7 @@ module function parse_name_expr(parser) result(expr) span, identifier%text)) end if + !print *, "tail parse_dot" call parser%parse_dot(expr) end function parse_name_expr @@ -672,6 +673,9 @@ module subroutine parse_dot(parser, expr) type(value_t) :: member + !integer :: idbg = 0 + !idbg = idbg + 1 + if (parser%current_kind() /= dot_token) then !! The function has to return something. Caller deallocates @@ -680,6 +684,9 @@ module subroutine parse_dot(parser, expr) end if + !print *, "" + !print *, "idbg = ", idbg + !print *, "parsing dot" dot = parser%match(dot_token) @@ -736,13 +743,24 @@ module subroutine parse_dot(parser, expr) expr%member%id_index = member_id !print *, "index = ", expr%member%id_index - ! Can we set the expr%val%type to the member's type here? Currently I have - ! to do a lot of checks for `if kind == dot_expr` in other places that seem - ! unnecessary - ! - ! Seems to work expr%val%type = member%type + !! TODO: val%type and val%struct_name at a minimum need to be copied, but it + !! might be cleaner to just copy the whole val + !expr%val = member + + !print *, "member%struct_name = ", member%struct_name + !print *, "member name = ", struct%members( member_id )%name + + expr%val%struct_name = member%struct_name + !expr%val%struct_name = struct%members(member_id)%name ! this is close, but we need the type not the name + + !! just testing a proof-of-concept + !if (idbg == 4) then + ! expr%val%struct_name = "P" + !end if + !expr%val%struct_name = member%type_name + ! TODO: I think this needs a recursive call to `parse_dot()` right here to ! handle things like `a.b.c`. There should probably be a parse_subscripts() ! call here too. For both, might need to differentiate between lvalues and diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index f2225f97..d553bcfe 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -794,6 +794,7 @@ module function parse_struct_declaration(parser) result(decl) val%array%rank = struct%members(i)%rank !print *, "rank = ", val%array%rank end if + val%struct_name = types%v(i)%s ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. @@ -943,6 +944,7 @@ module function parse_struct_instance(parser) result(inst) ! Members can be instantiated out of order inst%val%struct( member_id ) = mem%val + !inst%val%struct( member_id )%struct_name = mem%val%struct_name inst%members( member_id ) = mem call mems%push(mem) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 910ce638..5a8e3cdf 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2571,6 +2571,42 @@ subroutine unit_test_struct(npass, nfail) //'let p1 = P{x=6, y=13};' & //'let p2 = P{x=5, y=p1.y};' & //'p1.y;', quiet) == '13', & + eval('' & ! 28 + //'struct P{x:i32, y:i32,}' & + //'struct R{bl: P, tr: P}' & + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=9, y=17};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let po = r1.bl;' & + //'let yo = po.x;' & + , quiet) == '6', & + eval('' & ! 29 + //'struct P{x:i32, y:i32,}' & + //'struct R{bl: P, tr: P}' & + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=9, y=17};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let po = r1.bl;' & + //'let yo = po.y;' & + , quiet) == '13', & + eval('' & ! 30 + //'struct P{x:i32, y:i32,}' & + //'struct R{bl: P, tr: P}' & + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=9, y=17};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let po = r1.tr;' & + //'let yo = po.x;' & + , quiet) == '9', & + eval('' & ! 31 + //'struct P{x:i32, y:i32,}' & + //'struct R{bl: P, tr: P}' & + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=9, y=17};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let po = r1.tr;' & + //'let yo = po.y;' & + , quiet) == '17', & .false. & ! so I don't have to bother w/ trailing commas ] diff --git a/src/types.f90 b/src/types.f90 index 373cab17..7987e208 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1416,6 +1416,7 @@ function new_declaration_expr(identifier, op, right) result(expr) ! Pass the result value type up the tree for type checking in parent expr%val = right%val + !expr%struct_name = right%val%struct_name !expr%val%type = right%val%type !if (expr%val%type == array_type) then @@ -1490,6 +1491,7 @@ recursive subroutine ternary_search(node, key, id_index, iostat, val) end if val = node%val + !val%struct_name = node%val%struct_name id_index = node%id_index !print *, 'done ternary_search' From 9da834eac08f588c69e73566d056ab1bf278953a Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 27 Aug 2024 20:42:06 -0400 Subject: [PATCH 054/137] cleanup --- src/parse_expr.f90 | 90 +++------------------------------------------- src/parse_fn.f90 | 9 ++--- src/types.f90 | 2 -- 3 files changed, 7 insertions(+), 94 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index b2dca758..000ec480 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -99,14 +99,6 @@ recursive module function parse_expr_statement(parser) result(expr) span, identifier%text)) end if - !! this should be unnecessary - !!print *, "right type = ", kind_name(right%val%type) - !if (right%val%type == struct_type) then - ! print *, "struct_name = ", right%struct_name - ! expr%struct_name = right%struct_name - ! expr%val%struct_name = right%struct_name - !end if - return end if @@ -139,27 +131,18 @@ recursive module function parse_expr_statement(parser) result(expr) if (parser%peek_kind(0) == dot_token) then !print *, "dot token" - !call parser%vars%search(identifier%text, expr%id_index, io, var) - !expr%val = var call parser%vars%search(identifier%text, expr%id_index, io, expr%val) call parser%parse_dot(expr) if (.not. allocated(expr%member)) return - !allocate(expr%member) - !!member = expr%right - !!expr%member = member - !expr%member = expr%right ! swap because this will be re-used as RHS of whole expr - - !print *, "index = ", expr%member%id_index - end if if (.not. is_assignment_op(parser%current_kind())) then ! Rewind and do the default case (same as outside the assignment if ! block). Could use goto or probably refactor somehow - !print *, "rewinding" parser%pos = pos0 + !print *, "rewinding" !print *, 'pos0 = ', pos0 expr = parser%parse_expr() return @@ -244,22 +227,11 @@ recursive module function parse_expr_statement(parser) result(expr) ltype = expr%val%type rtype = expr%right%val%type - ! TODO: rename as *subtype instead of *arrtype larrtype = unknown_type rarrtype = unknown_type if (ltype == array_type) larrtype = expr%val%array%type if (rtype == array_type) rarrtype = expr%right%val%array%type - !if (allocated(expr%member)) ltype = expr%val%struct( member%id_index )%type - - !! Descend similarly for rarrtype if dot expr - !if (expr%right%kind == dot_expr) then - ! !rarrtype = expr%right%val%type - ! !rarrtype = expr%right%val%struct(expr%right%id_index)%type - ! !print *, "1 right index = ", expr%right%right%id_index - ! rtype = expr%right%val%struct(expr%right%right%id_index)%type - !end if - !print *, "larrtype = ", kind_name(larrtype) !print *, "rarrtype = ", kind_name(rarrtype) !print *, "ltype = ", kind_name(ltype) @@ -372,20 +344,6 @@ recursive module function parse_expr(parser, parent_prec) result(expr) if (ltype == array_type) larrtype = expr%left %val%array%type if (rtype == array_type) rarrtype = expr%right%val%array%type - !if (expr%left%kind == dot_expr) then - ! ! The index that I need is nested in an insane way - - ! !print *, "left index = ", expr%left%id_index - ! !print *, "left index = ", expr%left%right%id_index - ! ltype = expr%left%val%struct(expr%left%right%id_index)%type - !end if - - !if (expr%right%kind == dot_expr) then - ! !print *, "2 right index = ", expr%right%id_index - ! !rtype = expr%right%val%struct(expr%right%id_index)%type - ! rtype = expr%right%val%struct(expr%right%right%id_index)%type - !end if - !print *, 'larrtype = ', kind_name(larrtype) !print *, 'rarrtype = ', kind_name(rarrtype) !print *, 'ltype = ', kind_name(ltype) @@ -673,25 +631,13 @@ module subroutine parse_dot(parser, expr) type(value_t) :: member - !integer :: idbg = 0 - !idbg = idbg + 1 - - if (parser%current_kind() /= dot_token) then - - !! The function has to return something. Caller deallocates - !allocate( expr%lsubscripts(0)) - return - - end if - - !print *, "" - !print *, "idbg = ", idbg + if (parser%current_kind() /= dot_token) return !print *, "parsing dot" dot = parser%match(dot_token) - ! TODO: can this handle recursion? `a.b.c` + ! TODO: this can't handle recursion, e.g. `a.b.c` identifier = parser%match(identifier_token) @@ -705,8 +651,6 @@ module subroutine parse_dot(parser, expr) return end if - !print *, "struct name = ", expr%val%struct_name - ! For RHS dots, this will stick. For LHS dots, this will be shortly ! overwritten as assignment_expr in the caller expr%kind = dot_expr @@ -714,14 +658,9 @@ module subroutine parse_dot(parser, expr) ! Save dot info in member syntax node allocate(expr%member) - !parser%vars%search(identifier%text, id_index, io) - !dummy = parser%structs%search(parser%current_text(), dummy_id, io) - - ! Is there a better way than looking up every struct by name again? - !print *, "struct_name = """, expr%val%struct_name, """" - !struct = parser%structs%search(expr%val%struct_name, struct_id, io) + ! Is there a better way than looking up every struct by name again? call parser%structs%search(expr%val%struct_name, struct_id, io, struct) if (io /= 0) then @@ -730,7 +669,6 @@ module subroutine parse_dot(parser, expr) stop end if - !member = struct%vars%search(name%text, member_id, io) call struct%vars%search(identifier%text, member_id, io, member) if (io /= 0) then ! TODO: diag @@ -741,25 +679,7 @@ module subroutine parse_dot(parser, expr) !print *, "mem type = ", kind_name(member%type) expr%member%id_index = member_id - !print *, "index = ", expr%member%id_index - - expr%val%type = member%type - - !! TODO: val%type and val%struct_name at a minimum need to be copied, but it - !! might be cleaner to just copy the whole val - !expr%val = member - - !print *, "member%struct_name = ", member%struct_name - !print *, "member name = ", struct%members( member_id )%name - - expr%val%struct_name = member%struct_name - !expr%val%struct_name = struct%members(member_id)%name ! this is close, but we need the type not the name - - !! just testing a proof-of-concept - !if (idbg == 4) then - ! expr%val%struct_name = "P" - !end if - !expr%val%struct_name = member%type_name + expr%val = member ! TODO: I think this needs a recursive call to `parse_dot()` right here to ! handle things like `a.b.c`. There should probably be a parse_subscripts() diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index d553bcfe..558bb2d4 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -248,11 +248,6 @@ module function parse_fn_call(parser) result(fn_call) val_type = args%v(i)%val%type - !if (args%v(i)%kind == dot_expr) then - ! !print *, "dot_expr" - ! val_type = args%v(i)%val%struct( args%v(i)%right%id_index )%type - !end if - !print *, kind_name(val_type) !print *, kind_name(fn%params(i)%type) @@ -905,7 +900,8 @@ module function parse_struct_instance(parser) result(inst) ! TODO: each struct should get a different sub type (like array_type) for ! type checking, so you don't try to assign one type of struct to another - ! struct + ! struct. Should be able to use struct_name for this, although comparing + ! ints might be more efficient than comparing strings do while ( & parser%current_kind() /= rbrace_token .and. & @@ -944,7 +940,6 @@ module function parse_struct_instance(parser) result(inst) ! Members can be instantiated out of order inst%val%struct( member_id ) = mem%val - !inst%val%struct( member_id )%struct_name = mem%val%struct_name inst%members( member_id ) = mem call mems%push(mem) diff --git a/src/types.f90 b/src/types.f90 index 7987e208..373cab17 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1416,7 +1416,6 @@ function new_declaration_expr(identifier, op, right) result(expr) ! Pass the result value type up the tree for type checking in parent expr%val = right%val - !expr%struct_name = right%val%struct_name !expr%val%type = right%val%type !if (expr%val%type == array_type) then @@ -1491,7 +1490,6 @@ recursive subroutine ternary_search(node, key, id_index, iostat, val) end if val = node%val - !val%struct_name = node%val%struct_name id_index = node%id_index !print *, 'done ternary_search' From 4bdc25fe6688f9dc01be58f018a5e7d13f11d601 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 27 Aug 2024 21:59:11 -0400 Subject: [PATCH 055/137] more cleanup and comments --- src/core.f90 | 3 ++- src/eval.f90 | 5 +++-- src/parse_control.f90 | 10 +--------- src/parse_expr.f90 | 5 ++++- src/parse_fn.f90 | 15 ++++++++++++--- src/types.f90 | 9 --------- 6 files changed, 22 insertions(+), 25 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index c4b2f6e8..35db064c 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -31,6 +31,8 @@ module syntran__core_m ! - structs ! * mvp done: ! + struct fn return values + ! + nested structs + ! * works, but not nested dot exprs yet ! * tbd: ! + unary ops on dot exprs ! + tests @@ -43,7 +45,6 @@ module syntran__core_m ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names - ! + nested structs ! + structs of arrays ! * kinda works if you statically initialize the whole array in the ! struct and only refer to the whole array later. doesn't work if diff --git a/src/eval.f90 b/src/eval.f90 index 8614943f..608f3343 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -368,8 +368,6 @@ subroutine eval_name_expr(node, state, res) end if else - ! TODO: add another branch for dot member access expressions - !print *, "name expr without subscripts" !print *, "id_index = ", node%id_index !print *, "size(vals) = ", size(state%vars%vals) @@ -563,6 +561,9 @@ subroutine eval_fn_call(node, state, res) case ("println") + ! TODO: if struct, pass a struct_t as opt arg to to_str(), which + ! contains member names that can then be printed + do i = 1, size(node%args) call syntax_eval(node%args(i), state, arg) write(output_unit, '(a)', advance = 'no') arg%to_str() diff --git a/src/parse_control.f90 b/src/parse_control.f90 index 4bdf66c6..a65d2309 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -58,20 +58,12 @@ module function parse_return_statement(parser) result(statement) end if semi = parser%match(semicolon_token) - act_type = statement%right%val%type - !if (act_type == struct_type) then - ! print *, "return struct type" - !end if - !if (statement%right%kind == dot_expr) then - ! !print *, "return dot expr" - ! act_type = statement%right%val%struct( statement%right%right%id_index )%type - !end if - ! Check return type (unless we're at global level ifn == 1). That's half ! the point of return statements ! ! There should also be a check that every branch of a fn has a return ! statement, but that seems more difficult + act_type = statement%right%val%type types_match = & parser%fn_type == any_type .or. parser%fn_type == act_type diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 000ec480..60dc6512 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -131,7 +131,9 @@ recursive module function parse_expr_statement(parser) result(expr) if (parser%peek_kind(0) == dot_token) then !print *, "dot token" + ! Lookup the struct now because parse_dot() needs its data call parser%vars%search(identifier%text, expr%id_index, io, expr%val) + ! TODO: check io as in other search call below call parser%parse_dot(expr) if (.not. allocated(expr%member)) return @@ -168,7 +170,8 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'op = ', op%text ! Get the identifier's type and index from the dict and check that it - ! has been declared + ! has been declared, unless it is a struct which has already been looked + ! up above if (.not. allocated(expr%member)) then call parser%vars%search(identifier%text, expr%id_index, io, expr%val) if (io /= exit_success) then diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 558bb2d4..49ca26e0 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -505,6 +505,12 @@ module function parse_fn_declaration(parser) result(decl) !inst%val%struct( member_id ) = mem%val + ! TODO: test a fn with a 2nd-order struct arg (i.e. a struct + ! made up of other structs). Maybe more data needs to be copied + ! here, especially struct_name. Essentially every %type should + ! be bundled along with a %struct_name as in + ! parse_struct_declaration() + end do end if @@ -675,13 +681,16 @@ module function parse_struct_declaration(parser) result(decl) ! Structs use this syntax: ! - ! struct time + ! // declaration + ! struct Time ! { ! hh: i32, ! mm: i32, ! ss: f32, ! } - ! let t1 = time{hh = 9, mm = 20, ss = 0.030,}; + ! + ! // instance + ! let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; ! t1.hh = 10; ! ! A struct declaration is a lot like a fn declaration. Instead of a list of @@ -782,6 +791,7 @@ module function parse_struct_declaration(parser) result(decl) ! Create a value_t object to store the type val%type = struct%members(i)%type + val%struct_name = types%v(i)%s if (is_array%v(i)) then if (allocated(val%array)) deallocate(val%array) allocate(val%array) @@ -789,7 +799,6 @@ module function parse_struct_declaration(parser) result(decl) val%array%rank = struct%members(i)%rank !print *, "rank = ", val%array%rank end if - val%struct_name = types%v(i)%s ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. diff --git a/src/types.f90 b/src/types.f90 index 373cab17..7560e622 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1837,16 +1837,7 @@ function new_binary_expr(left, op, right) result(expr) ! get_binary_op_kind() will need to be applied for unary ops too ltype = left%val%type - !if (left%kind == dot_expr) then - ! !print *, "left index = ", left%id_index - ! !print *, "left index = ", left%right%id_index - ! ltype = left%val%struct(left%right%id_index)%type - !end if - rtype = right%val%type - !if (right%kind == dot_expr) then - ! rtype = right%val%struct(right%right%id_index)%type - !end if ! Pass the result value type up the tree for type checking in parent type_ = get_binary_op_kind(ltype, op%kind, rtype, & From ca197945eebeb6674e5a9840281a6ff753f53681 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 27 Aug 2024 22:42:52 -0400 Subject: [PATCH 056/137] add tests for structs of arrays --- src/eval.f90 | 5 +++++ src/tests/test.f90 | 41 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+) diff --git a/src/eval.f90 b/src/eval.f90 index 608f3343..aead82b1 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -563,6 +563,11 @@ subroutine eval_fn_call(node, state, res) ! TODO: if struct, pass a struct_t as opt arg to to_str(), which ! contains member names that can then be printed + ! + ! Actually it's a huge pain to pass structs dict from parser to evaler. + ! I tried for a bit but stashed it. I will probably need to do this + ! eventually anyway for interactive runs with structs. I can see why + ! rust requires #derive[debug] to allow printing a whole struct do i = 1, size(node%args) call syntax_eval(node%args(i), state, arg) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 5a8e3cdf..9d48e5d7 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2607,6 +2607,47 @@ subroutine unit_test_struct(npass, nfail) //'let po = r1.tr;' & //'let yo = po.y;' & , quiet) == '17', & + eval('' & ! 32 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'return v1.name;' & + , quiet) == 'myvec1', & + eval('' & ! 33 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'return v1.v;' & + , quiet) == '[6, 2, 5]', & + eval('' & ! 34 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'v1.v = [3, 1, 2];' & + //'return v1.v;' & + , quiet) == '[3, 1, 2]', & + eval('' & ! 35 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'let v2 = v1.v;' & + //'return v2;' & + , quiet) == '[6, 2, 5]', & + eval('' & ! 36 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'let v2 = v1.v;' & + //'return v2[0];' & + , quiet) == '6', & + eval('' & ! 37 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'let v2 = v1.v;' & + //'return v2[1];' & + , quiet) == '2', & + eval('' & ! 38 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'let v2 = [3, 1, 2];' & + //'v1.v = v2;' & + //'return v1.v;' & + , quiet) == '[3, 1, 2]', & .false. & ! so I don't have to bother w/ trailing commas ] From 0368df299ec5b330eff7321868bca3b7fcaf372c Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 29 Aug 2024 19:04:41 -0400 Subject: [PATCH 057/137] implement nested rhs dot exprs --- src/eval.f90 | 39 ++++++++++++++++++++++++++++++++++++++- src/parse_expr.f90 | 14 +++++++++++--- src/tests/test.f90 | 16 ++++++++++++++++ 3 files changed, 65 insertions(+), 4 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index aead82b1..70df5d87 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -391,13 +391,50 @@ subroutine eval_dot_expr(node, state, res) !******** + integer :: id, mem_kind + + type(syntax_node_t) :: mem + type(value_t) :: tmp + type(value_t) :: val !print *, "eval dot_expr" ! This won't work for struct literal member access. It only works for ! `identifier.member` - res = state%vars%vals(node%id_index)%struct( node%member%id_index ) + + !res = state%vars%vals(node%id_index)%struct( node%member%id_index ) + val = state%vars%vals(node%id_index) + id = node%member%id_index + res = val%struct(id) + + mem_kind = node%member%kind + + !print *, "res struct name = ", res%struct_name + !print *, "member kind = ", kind_name(node%member%kind) + !if (allocated(val%struct(id)%struct)) then + ! print *, "member 2[1] = ", val%struct(id)%struct(1)%to_str() + ! print *, "member 2[2] = ", val%struct(id)%struct(2)%to_str() + ! !print *, "member 2 = ", res%struct(1)%to_str() + !end if + + do while (mem_kind == dot_expr) + + ! It's highly suspicious that I got this right on the first try. Test + ! with deeper nesting + + ! TODO: LHS dot members need to be iterated similarly + + !mem = val%struct(id)% + mem = node%member + val = state%vars%vals( mem%id_index ) + id = mem%member%id_index + + res = val%struct(id) + + mem_kind = mem%member%kind + + end do !print *, "struct[", str(i), "] = ", res%struct(i)%to_str() !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 60dc6512..23a7b818 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -684,11 +684,19 @@ module subroutine parse_dot(parser, expr) expr%member%id_index = member_id expr%val = member - ! TODO: I think this needs a recursive call to `parse_dot()` right here to - ! handle things like `a.b.c`. There should probably be a parse_subscripts() - ! call here too. For both, might need to differentiate between lvalues and + ! I think this needs a recursive call to `parse_dot()` right here to handle + ! things like `a.b.c`. There should probably be a parse_subscripts() call + ! here too. For both, might need to differentiate between lvalues and ! rvalues, i.e. use separate parse_ldot(), parse_rdot(), ! parse_lsubscripts(), ... + if (parser%peek_kind(0) == dot_token) then + + !expr%member%val%type = struct_type + expr%member%val = member + + call parser%parse_dot(expr%member) + + end if end subroutine parse_dot diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 9d48e5d7..cbcb3475 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2648,6 +2648,22 @@ subroutine unit_test_struct(npass, nfail) //'v1.v = v2;' & //'return v1.v;' & , quiet) == '[3, 1, 2]', & + eval('' & ! 39 + //'struct P{x:i32, y:i32,}' & + //'struct R{bl: P, tr: P}' & + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=9, y=17};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let o = r1.bl.x;' & + , quiet) == '6', & + eval('' & ! 40 + //'struct P{x:i32, y:i32,}' & + //'struct R{bl: P, tr: P}' & + //'let p1 = P{x=6, y=13};' & + //'let p2 = P{x=9, y=17};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let o = r1.tr.y;' & + , quiet) == '17', & .false. & ! so I don't have to bother w/ trailing commas ] From 96ad59eb119dd9352a26be5b6415f60f93dcfaae Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 29 Aug 2024 19:11:00 -0400 Subject: [PATCH 058/137] broke intel by forgetting 'recursive' --- src/parse.f90 | 2 +- src/parse_expr.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parse.f90 b/src/parse.f90 index 2091cc74..5b23ad4e 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -217,7 +217,7 @@ module function parse_name_expr(parser) result(expr) type(syntax_node_t) :: expr end function parse_name_expr - module subroutine parse_dot(parser, expr) + recursive module subroutine parse_dot(parser, expr) class(parser_t) :: parser type(syntax_node_t), intent(inout) :: expr end subroutine parse_dot diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 23a7b818..14e7aaf5 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -618,7 +618,7 @@ end function parse_name_expr !=============================================================================== -module subroutine parse_dot(parser, expr) +recursive module subroutine parse_dot(parser, expr) class(parser_t) :: parser From 1b894153d06bcbea8739631699c0b0195a8a7e9b Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 29 Aug 2024 20:28:57 -0400 Subject: [PATCH 059/137] fix 3rd-order nested rhs dot exprs --- src/core.f90 | 2 +- src/eval.f90 | 79 ++++++++++++++++++++++++++++++++++------------ src/parse_expr.f90 | 6 ++-- src/value.f90 | 5 ++- 4 files changed, 68 insertions(+), 24 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 35db064c..39f5befc 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -32,7 +32,7 @@ module syntran__core_m ! * mvp done: ! + struct fn return values ! + nested structs - ! * works, but not nested dot exprs yet + ! * works, but not nested lhs dot exprs yet ! * tbd: ! + unary ops on dot exprs ! + tests diff --git a/src/eval.f90 b/src/eval.f90 index 70df5d87..d9e9ab03 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -393,9 +393,8 @@ subroutine eval_dot_expr(node, state, res) integer :: id, mem_kind - type(syntax_node_t) :: mem + type(syntax_node_t) :: mem, tmp_node - type(value_t) :: tmp type(value_t) :: val !print *, "eval dot_expr" @@ -403,11 +402,12 @@ subroutine eval_dot_expr(node, state, res) ! This won't work for struct literal member access. It only works for ! `identifier.member` - !res = state%vars%vals(node%id_index)%struct( node%member%id_index ) val = state%vars%vals(node%id_index) id = node%member%id_index - res = val%struct(id) + ! TODO: some of these operations are redundant now that i've fixed the loop + ! below + res = val%struct(id) mem_kind = node%member%kind !print *, "res struct name = ", res%struct_name @@ -418,23 +418,27 @@ subroutine eval_dot_expr(node, state, res) ! !print *, "member 2 = ", res%struct(1)%to_str() !end if + mem = node%member do while (mem_kind == dot_expr) - - ! It's highly suspicious that I got this right on the first try. Test - ! with deeper nesting + !print *, "loop" ! TODO: LHS dot members need to be iterated similarly - !mem = val%struct(id)% - mem = node%member - val = state%vars%vals( mem%id_index ) - id = mem%member%id_index + ! TODO: mem is the same at each iteration? sus + + !id = mem%member%id_index + id = mem%id_index res = val%struct(id) + val = res mem_kind = mem%member%kind + tmp_node = mem%member + mem = tmp_node end do + id = mem%id_index + res = val%struct(id) !print *, "struct[", str(i), "] = ", res%struct(i)%to_str() !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() @@ -1081,11 +1085,16 @@ subroutine eval_assignment_expr(node, state, res) !******** - integer :: rank_res + integer :: rank_res, id, mem_kind integer(kind = 8) :: i8, index_, len8 integer(kind = 8), allocatable :: lsubs(:), usubs(:), subs(:) + type(syntax_node_t) :: mem + type(value_t) :: array_val, tmp + !type(value_t), pointer :: val, ptmp + type(value_t), allocatable :: val, ptmp, vals(:) + !type(value_t) :: val !print *, "eval assignment_expr" !print *, "node identifier = ", node%identifier%text @@ -1095,25 +1104,55 @@ subroutine eval_assignment_expr(node, state, res) ! print *, "mem index = ", node%member%id_index !end if - !if (state%vars%vals(node%id_index)%type == struct_type) then if (allocated( node%member )) then !print *, "assign LHS dot member" call syntax_eval(node%right, state, res) - ! !call compound_assign(state%vars%vals(node%id_index), res, node%op) - ! !res = state%vars%vals(node%id_index) - ! !res = state%vars%vals(node%id_index)%struct( node%right%id_index ) + ! TODO: honestly probably just delete all this junk and start it again. + ! I started working on LHS nested dots when I realized I had bugs in my + ! RHS nested dot code + + !allocate(val, ptmp) + !val = state%vars%vals(node%id_index) + !call move_alloc(state%vars%vals(node%id_index), val) + call move_alloc(state%vars%vals(node%id_index)%struct, vals) + id = node%member%id_index + !ptmp = val%struct(id) + + !val = state%vars%vals(node%id_index) + !id = node%member%id_index + !ptmp = val%struct(id) + !mem_kind = node%member%kind + !do while (mem_kind == dot_expr) + ! mem = node%member + ! val = state%vars%vals( mem%id_index ) + ! id = mem%member%id_index + ! + ! ptmp = val%struct(id) + ! mem_kind = mem%member%kind + !end do + + !mem = node%member + !do while (allocated(mem%member)) + !end do - !state%vars%vals(node%id_index)%struct( node%member%id_index ) = res call compound_assign( & - state%vars%vals(node%id_index)%struct( node%member%id_index ), & + !state%vars%vals(node%id_index)%struct( node%member%id_index ), & + !val%struct(id), & + vals(id), & + !ptmp, & res, & node%op & ) + !state%vars%vals(node%id_index) = val + + !res = state%vars%vals(node%id_index)%struct( node%member%id_index ) + !res = val%struct(id) + res = vals(id) + !res = ptmp - !res = state%vars%vals(node%id_index) - res = state%vars%vals(node%id_index)%struct( node%member%id_index ) + call move_alloc(vals, state%vars%vals(node%id_index)%struct) else if (.not. allocated(node%lsubscripts)) then diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 14e7aaf5..ed143b51 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -685,8 +685,8 @@ recursive module subroutine parse_dot(parser, expr) expr%val = member ! I think this needs a recursive call to `parse_dot()` right here to handle - ! things like `a.b.c`. There should probably be a parse_subscripts() call - ! here too. For both, might need to differentiate between lvalues and + ! things like `a.b.c`. TODO: there should probably be a parse_subscripts() + ! call here too. For both, might need to differentiate between lvalues and ! rvalues, i.e. use separate parse_ldot(), parse_rdot(), ! parse_lsubscripts(), ... if (parser%peek_kind(0) == dot_token) then @@ -696,6 +696,8 @@ recursive module subroutine parse_dot(parser, expr) call parser%parse_dot(expr%member) + expr%val = expr%member%val + end if end subroutine parse_dot diff --git a/src/value.f90 b/src/value.f90 index ea372ba5..3e67711e 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -146,7 +146,10 @@ recursive subroutine value_copy(dst, src) end if if (allocated(src%struct)) then - if (.not. allocated(dst%struct)) allocate(dst%struct( size(src%struct) )) + ! TODO: some of the allocations above are wrong. make them like this + ! one which crashed on a 3rd-order Pyramid struct befored i fixed it + if (allocated(dst%struct)) deallocate(dst%struct) + allocate(dst%struct( size(src%struct) )) do i = 1, size(src%struct) dst%struct(i) = src%struct(i) end do From 91e3438e0ca49391b00076088569dcfde281871b Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 29 Aug 2024 20:35:03 -0400 Subject: [PATCH 060/137] add tests for 3rd-order nested rhs dot exprs --- src/tests/test.f90 | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index cbcb3475..6ee2dd21 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2664,6 +2664,39 @@ subroutine unit_test_struct(npass, nfail) //'let r1 = R{bl=p1, tr=p2};' & //'let o = r1.tr.y;' & , quiet) == '17', & + eval('' & ! 41 + //'struct P{x:i32, y:i32, z:i32}' & ! point + //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points + //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'let o = y1.ba.tr.x;' & + , quiet) == '9', & + eval('' & ! 42 + //'struct P{x:i32, y:i32, z:i32}' & ! point + //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points + //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'let o = y1.ba.bl.y;' & + , quiet) == '13', & + eval('' & ! 42 + //'struct P{x:i32, y:i32, z:i32}' & ! point + //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points + //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'let o = y1.p.z;' & + , quiet) == '5', & .false. & ! so I don't have to bother w/ trailing commas ] From 6bb2505561d3e45725416cbf8d613430f3c17b56 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 29 Aug 2024 20:57:25 -0400 Subject: [PATCH 061/137] refactor --- src/eval.f90 | 38 +++++++++++++++----------------------- 1 file changed, 15 insertions(+), 23 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index d9e9ab03..66b382d9 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -395,44 +395,36 @@ subroutine eval_dot_expr(node, state, res) type(syntax_node_t) :: mem, tmp_node - type(value_t) :: val + type(value_t) :: val, tmp_val !print *, "eval dot_expr" ! This won't work for struct literal member access. It only works for ! `identifier.member` + ! In nested expressions, like `a.b.c.d`, val begins as the top-most + ! (left-most, outer-most) value `a` val = state%vars%vals(node%id_index) - id = node%member%id_index - - ! TODO: some of these operations are redundant now that i've fixed the loop - ! below - res = val%struct(id) - mem_kind = node%member%kind - - !print *, "res struct name = ", res%struct_name - !print *, "member kind = ", kind_name(node%member%kind) - !if (allocated(val%struct(id)%struct)) then - ! print *, "member 2[1] = ", val%struct(id)%struct(1)%to_str() - ! print *, "member 2[2] = ", val%struct(id)%struct(2)%to_str() - ! !print *, "member 2 = ", res%struct(1)%to_str() - !end if - mem = node%member - do while (mem_kind == dot_expr) + do while (mem%kind == dot_expr) !print *, "loop" - ! TODO: LHS dot members need to be iterated similarly + ! For a 1st-order dot expr like `c.d` the loop never executes. For a + ! 2nd-order expr `b.c.d` it iterates once - ! TODO: mem is the same at each iteration? sus + ! TODO: LHS dot members need to be iterated similarly - !id = mem%member%id_index + ! `id` tracks whether each member is the 1st, 2nd, etc. member in the + ! struct array of its parent. A local variable isnt' really needed but + ! I think it helps readability id = mem%id_index - res = val%struct(id) - val = res + ! Descend the val from `a` to `b`, etc. A temporary value is needed + ! because copy assignment is a complex overridden routine + tmp_val = val%struct(id) + val = tmp_val - mem_kind = mem%member%kind + ! Descend the syntax node too tmp_node = mem%member mem = tmp_node From 08cac79b90e316dc02602bb4a30146cad1c2cbe1 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 30 Aug 2024 19:31:45 -0400 Subject: [PATCH 062/137] use recursion instead of iteration for rhs dot expr eval --- src/eval.f90 | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/src/eval.f90 b/src/eval.f90 index 66b382d9..7ad5fa79 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -402,6 +402,11 @@ subroutine eval_dot_expr(node, state, res) ! This won't work for struct literal member access. It only works for ! `identifier.member` + res = get_val(node, state%vars%vals(node%id_index)) + return + + ! TODO: delete + ! In nested expressions, like `a.b.c.d`, val begins as the top-most ! (left-most, outer-most) value `a` val = state%vars%vals(node%id_index) @@ -421,6 +426,17 @@ subroutine eval_dot_expr(node, state, res) ! Descend the val from `a` to `b`, etc. A temporary value is needed ! because copy assignment is a complex overridden routine + ! + ! I think LHS dot assignment will need to traverse the `a.b.c.d` tree + ! twice, or in a loop. First descend from a to d, and ascend back up + ! from d back to a to finally assign the outermost struct + ! + ! Actually, a better way to handle dot exprs on both sides is with + ! recursive getter and setter fn's. These would avoid issues with + ! copying and having to double walk the tree. Here, use a getter. In + ! LHS dot exprs, first use a getter, then do compound assignment, and + ! finally use a setter. This will act similarly to get_array_value_t() + ! and set_array_value_t() tmp_val = val%struct(id) val = tmp_val @@ -439,6 +455,35 @@ end subroutine eval_dot_expr !=============================================================================== +recursive function get_val(node, val) result(res) + + type(syntax_node_t), intent(in) :: node + type(value_t), intent(in) :: val + + !type(value_t), intent(inout) :: res + type(value_t) :: res + + !******** + !type(value_t) :: val, tmp_val + !type(syntax_node_t) :: mem, tmp_node + integer :: id + + id = node%member%id_index + + if (node%member%kind == dot_expr) then + ! Recurse + res = get_val(node%member, val%struct(id)) + return + end if + + ! Base case + res = val%struct(id) + !res = val%struct(node%member%id_index) + +end function get_val + +!=============================================================================== + subroutine eval_struct_instance(node, state, res) type(syntax_node_t), intent(in) :: node From b29c42f6c20174c7693291a194f5c49f46c59064 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 30 Aug 2024 19:49:32 -0400 Subject: [PATCH 063/137] cleanup, rename --- src/eval.f90 | 69 ++++++++++++---------------------------------------- 1 file changed, 15 insertions(+), 54 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 7ad5fa79..a3c61a31 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -398,87 +398,48 @@ subroutine eval_dot_expr(node, state, res) type(value_t) :: val, tmp_val !print *, "eval dot_expr" + !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() ! This won't work for struct literal member access. It only works for ! `identifier.member` res = get_val(node, state%vars%vals(node%id_index)) - return - - ! TODO: delete - - ! In nested expressions, like `a.b.c.d`, val begins as the top-most - ! (left-most, outer-most) value `a` - val = state%vars%vals(node%id_index) - mem = node%member - do while (mem%kind == dot_expr) - !print *, "loop" - - ! For a 1st-order dot expr like `c.d` the loop never executes. For a - ! 2nd-order expr `b.c.d` it iterates once - - ! TODO: LHS dot members need to be iterated similarly - - ! `id` tracks whether each member is the 1st, 2nd, etc. member in the - ! struct array of its parent. A local variable isnt' really needed but - ! I think it helps readability - id = mem%id_index - - ! Descend the val from `a` to `b`, etc. A temporary value is needed - ! because copy assignment is a complex overridden routine - ! - ! I think LHS dot assignment will need to traverse the `a.b.c.d` tree - ! twice, or in a loop. First descend from a to d, and ascend back up - ! from d back to a to finally assign the outermost struct - ! - ! Actually, a better way to handle dot exprs on both sides is with - ! recursive getter and setter fn's. These would avoid issues with - ! copying and having to double walk the tree. Here, use a getter. In - ! LHS dot exprs, first use a getter, then do compound assignment, and - ! finally use a setter. This will act similarly to get_array_value_t() - ! and set_array_value_t() - tmp_val = val%struct(id) - val = tmp_val - - ! Descend the syntax node too - tmp_node = mem%member - mem = tmp_node - - end do - id = mem%id_index - res = val%struct(id) - - !print *, "struct[", str(i), "] = ", res%struct(i)%to_str() - !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() end subroutine eval_dot_expr !=============================================================================== -recursive function get_val(node, val) result(res) +recursive function get_val(node, var) result(res) + + ! As is, maybe I should rename this to get_dot_val(), but I would like to + ! extend it to process subscripts too + + ! In nested expressions, like `a.b.c.d`, var begins as the top-most + ! (left-most, outer-most) value `a` type(syntax_node_t), intent(in) :: node - type(value_t), intent(in) :: val + type(value_t), intent(in) :: var !type(value_t), intent(inout) :: res type(value_t) :: res !******** - !type(value_t) :: val, tmp_val - !type(syntax_node_t) :: mem, tmp_node + integer :: id + ! `id` tracks whether each member is the 1st, 2nd, etc. member in the struct + ! array of its parent. A local variable isnt' really needed but I think it + ! helps readability id = node%member%id_index if (node%member%kind == dot_expr) then ! Recurse - res = get_val(node%member, val%struct(id)) + res = get_val(node%member, var%struct(id)) return end if ! Base case - res = val%struct(id) - !res = val%struct(node%member%id_index) + res = var%struct(id) end function get_val From 2c43af08e9f0240885b4bd2479e9fa786f854aaa Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 30 Aug 2024 19:55:54 -0400 Subject: [PATCH 064/137] cleanup 1st order lhs dot expr assignment --- src/eval.f90 | 52 +++++++--------------------------------------------- 1 file changed, 7 insertions(+), 45 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index a3c61a31..82b3c54c 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -1089,7 +1089,7 @@ subroutine eval_assignment_expr(node, state, res) type(syntax_node_t) :: mem - type(value_t) :: array_val, tmp + type(value_t) :: array_val, rhs, tmp !type(value_t), pointer :: val, ptmp type(value_t), allocatable :: val, ptmp, vals(:) !type(value_t) :: val @@ -1105,52 +1105,14 @@ subroutine eval_assignment_expr(node, state, res) if (allocated( node%member )) then !print *, "assign LHS dot member" - call syntax_eval(node%right, state, res) - - ! TODO: honestly probably just delete all this junk and start it again. - ! I started working on LHS nested dots when I realized I had bugs in my - ! RHS nested dot code + call syntax_eval(node%right, state, rhs) - !allocate(val, ptmp) - !val = state%vars%vals(node%id_index) - !call move_alloc(state%vars%vals(node%id_index), val) - call move_alloc(state%vars%vals(node%id_index)%struct, vals) id = node%member%id_index - !ptmp = val%struct(id) - - !val = state%vars%vals(node%id_index) - !id = node%member%id_index - !ptmp = val%struct(id) - !mem_kind = node%member%kind - !do while (mem_kind == dot_expr) - ! mem = node%member - ! val = state%vars%vals( mem%id_index ) - ! id = mem%member%id_index - ! - ! ptmp = val%struct(id) - ! mem_kind = mem%member%kind - !end do - - !mem = node%member - !do while (allocated(mem%member)) - !end do - - call compound_assign( & - !state%vars%vals(node%id_index)%struct( node%member%id_index ), & - !val%struct(id), & - vals(id), & - !ptmp, & - res, & - node%op & - ) - !state%vars%vals(node%id_index) = val - - !res = state%vars%vals(node%id_index)%struct( node%member%id_index ) - !res = val%struct(id) - res = vals(id) - !res = ptmp - - call move_alloc(vals, state%vars%vals(node%id_index)%struct) + res = state%vars%vals(node%id_index)%struct(id) ! get_val() + + call compound_assign(res, rhs, node%op) + + state%vars%vals(node%id_index)%struct(id) = res ! set_val() else if (.not. allocated(node%lsubscripts)) then From fcb031062737f3674e78bb7b2cbb90673924a107 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 30 Aug 2024 20:01:13 -0400 Subject: [PATCH 065/137] omfg. lhs nested dot exprs aren't so bad --- src/eval.f90 | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 82b3c54c..2a42a1dd 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -409,6 +409,34 @@ end subroutine eval_dot_expr !=============================================================================== +!call set_val(node, state%vars%vals(node%id_index), res) +recursive subroutine set_val(node, var, val) + + type(syntax_node_t), intent(in) :: node + type(value_t), intent(inout) :: var + type(value_t), intent(in) :: val + + !******** + + integer :: id + + id = node%member%id_index + + if (node%member%kind == dot_expr) then + ! Recurse + !res = get_val(node%member, var%struct(id)) + call set_val(node%member, var%struct(id), val) + return + end if + + ! Base case + !res = var%struct(id) + var%struct(id) = val + +end subroutine set_val + +!=============================================================================== + recursive function get_val(node, var) result(res) ! As is, maybe I should rename this to get_dot_val(), but I would like to @@ -1108,11 +1136,12 @@ subroutine eval_assignment_expr(node, state, res) call syntax_eval(node%right, state, rhs) id = node%member%id_index - res = state%vars%vals(node%id_index)%struct(id) ! get_val() + res = get_val(node, state%vars%vals(node%id_index)) call compound_assign(res, rhs, node%op) - state%vars%vals(node%id_index)%struct(id) = res ! set_val() + !state%vars%vals(node%id_index)%struct(id) = res ! set_val() + call set_val(node, state%vars%vals(node%id_index), res) else if (.not. allocated(node%lsubscripts)) then From 01855e6d4a5834f0707b2f937660fc70707ad946 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Fri, 30 Aug 2024 20:20:37 -0400 Subject: [PATCH 066/137] add tests for lhs nested dot exprs --- src/eval.f90 | 19 +++++++++++++------ src/tests/test.f90 | 38 +++++++++++++++++++++++++++++++++++++- 2 files changed, 50 insertions(+), 7 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 2a42a1dd..7c07a6f1 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -409,9 +409,10 @@ end subroutine eval_dot_expr !=============================================================================== -!call set_val(node, state%vars%vals(node%id_index), res) recursive subroutine set_val(node, var, val) + ! Assign var.mem = val, or recurse if mem is also a dot expr + type(syntax_node_t), intent(in) :: node type(value_t), intent(inout) :: var type(value_t), intent(in) :: val @@ -424,13 +425,11 @@ recursive subroutine set_val(node, var, val) if (node%member%kind == dot_expr) then ! Recurse - !res = get_val(node%member, var%struct(id)) call set_val(node%member, var%struct(id), val) return end if ! Base case - !res = var%struct(id) var%struct(id) = val end subroutine set_val @@ -1133,14 +1132,20 @@ subroutine eval_assignment_expr(node, state, res) if (allocated( node%member )) then !print *, "assign LHS dot member" + ! This is similar to what I do below with get_array_value_t() and + ! set_array_value_t(), but I've renamed some of the variables + + ! Evaluate the RHS call syntax_eval(node%right, state, rhs) + ! Get the initial value from the LHS, which could be nested like `a.b.c.d` id = node%member%id_index res = get_val(node, state%vars%vals(node%id_index)) + ! Do the assignment or += or whatever and set res call compound_assign(res, rhs, node%op) - !state%vars%vals(node%id_index)%struct(id) = res ! set_val() + ! Save it back into the LHS var call set_val(node, state%vars%vals(node%id_index), res) else if (.not. allocated(node%lsubscripts)) then @@ -1155,7 +1160,7 @@ subroutine eval_assignment_expr(node, state, res) !end if !end if - ! Assign return value + ! Eval the RHS !print *, 'eval and set res' call syntax_eval(node%right, state, res) @@ -1184,7 +1189,9 @@ subroutine eval_assignment_expr(node, state, res) !print *, 'LHS array subscript assignment' !print *, 'LHS type = ', kind_name(state%vars%vals(node%id_index)%array%type) ! not alloc for str - ! Assign return value from RHS + ! Eval the RHS. I should probably rename `res` to `rhs` here like I did + ! with get_val() for dot exprs above, because it's not really the result + ! yet in cases of compound assignment call syntax_eval(node%right, state, res) !print *, 'RHS = ', res%to_str() diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 6ee2dd21..36145a3e 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2686,7 +2686,7 @@ subroutine unit_test_struct(npass, nfail) //'let y1 = Y{ba=r1, p=p3};' & //'let o = y1.ba.bl.y;' & , quiet) == '13', & - eval('' & ! 42 + eval('' & ! 43 //'struct P{x:i32, y:i32, z:i32}' & ! point //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point @@ -2697,6 +2697,42 @@ subroutine unit_test_struct(npass, nfail) //'let y1 = Y{ba=r1, p=p3};' & //'let o = y1.p.z;' & , quiet) == '5', & + eval('' & ! 44 + //'struct P{x:i32, y:i32, z:i32}' & ! point + //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points + //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'y1.ba.tr.x = 10;' & + //'return y1.ba.tr.x;' & + , quiet) == '10', & + eval('' & ! 45 + //'struct P{x:i32, y:i32, z:i32}' & ! point + //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points + //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'y1.ba.bl.y += 1;' & + //'return y1.ba.bl.y;' & + , quiet) == '14', & + eval('' & ! 46 + //'struct P{x:i32, y:i32, z:i32}' & ! point + //'struct R{bl: P, tr: P}' & ! rectangle with bottom-left and top-right points + //'struct Y{ba: R, p: P}' & ! pyramid with base rect and a point + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'y1.p.z -= y1.ba.tr.x;' & + //'return y1.p.z;' & + , quiet) == '-4', & .false. & ! so I don't have to bother w/ trailing commas ] From 7ea35b772201b8936c16ddbc898952b095bb11a3 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 11:11:30 -0400 Subject: [PATCH 067/137] rhs dot expr subscripts --- src/core.f90 | 11 +++-- src/eval.f90 | 108 +++++++++++++++++++++++++++++++++++++++++++-- src/parse_expr.f90 | 8 ++++ 3 files changed, 117 insertions(+), 10 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 39f5befc..b4476599 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -32,8 +32,12 @@ module syntran__core_m ! * mvp done: ! + struct fn return values ! + nested structs - ! * works, but not nested lhs dot exprs yet ! * tbd: + ! + structs of arrays + ! * kinda works if you statically initialize the whole array in the + ! struct and only refer to the whole array later. doesn't work if + ! you try to subscript anything inside a struct + ! + arrays of structs ! + unary ops on dot exprs ! + tests ! > moar @@ -45,11 +49,6 @@ module syntran__core_m ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names - ! + structs of arrays - ! * kinda works if you statically initialize the whole array in the - ! struct and only refer to the whole array later. doesn't work if - ! you try to subscript anything inside a struct - ! + arrays of structs ! - triage notes from AOC. many things are already fixed ! - jumping control flow: ! * fn return statement done diff --git a/src/eval.f90 b/src/eval.f90 index 7c07a6f1..c179b3b7 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -387,6 +387,7 @@ subroutine eval_dot_expr(node, state, res) type(state_t), intent(inout) :: state + ! TODO: can res be just out? There's one other routine in here that does this type(value_t), intent(inout) :: res !******** @@ -403,7 +404,7 @@ subroutine eval_dot_expr(node, state, res) ! This won't work for struct literal member access. It only works for ! `identifier.member` - res = get_val(node, state%vars%vals(node%id_index)) + res = get_val(node, state%vars%vals(node%id_index), state) end subroutine eval_dot_expr @@ -436,7 +437,7 @@ end subroutine set_val !=============================================================================== -recursive function get_val(node, var) result(res) +recursive function get_val(node, var, state) result(res) ! As is, maybe I should rename this to get_dot_val(), but I would like to ! extend it to process subscripts too @@ -446,6 +447,7 @@ recursive function get_val(node, var) result(res) type(syntax_node_t), intent(in) :: node type(value_t), intent(in) :: var + type(state_t), intent(inout) :: state !type(value_t), intent(inout) :: res type(value_t) :: res @@ -453,6 +455,7 @@ recursive function get_val(node, var) result(res) !******** integer :: id + integer(kind = 8) :: i8 ! `id` tracks whether each member is the 1st, 2nd, etc. member in the struct ! array of its parent. A local variable isnt' really needed but I think it @@ -461,11 +464,50 @@ recursive function get_val(node, var) result(res) if (node%member%kind == dot_expr) then ! Recurse - res = get_val(node%member, var%struct(id)) + res = get_val(node%member, var%struct(id), state) return end if ! Base case + + ! TODO: maybe invert if to never nest? Is this ordered correctly in the + ! recursion wrt parsing? + if (allocated(node%member%lsubscripts)) then + !if (allocated(node%lsubscripts)) then + !print *, "lsubscripts allocated" + + if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then + !print *, "slice sub" + ! TODO: not implemented, throw error + else + !print *, "scalar_sub" + + !i8 = subscript_eval(node, state) + !array_val = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + !call compound_assign(array_val, res, node%op) + !call set_array_value_t( & + ! state%vars%vals(node%id_index)%array, i8, array_val) + !res = array_val + + !! beware this print only works for literals. in general we need to + !! eval via sub_eval() + !print *, "lsub 1 = ", node%member%lsubscripts(1)%val%to_str() + + !i8 = subscript_eval(node%member, state) + !i8 = sub_eval(node%member, state) + !i8 = sub_eval(node%member, var%struct(id)%array, state) + i8 = sub_eval(node%member, var%struct(id), state) + + !array_val = ... + !res = get_array_value_t(node%member%array, i8) + res = get_array_value_t(var%struct(id)%array, i8) + + return + + end if + + end if + res = var%struct(id) end function get_val @@ -1140,7 +1182,7 @@ subroutine eval_assignment_expr(node, state, res) ! Get the initial value from the LHS, which could be nested like `a.b.c.d` id = node%member%id_index - res = get_val(node, state%vars%vals(node%id_index)) + res = get_val(node, state%vars%vals(node%id_index), state) ! Do the assignment or += or whatever and set res call compound_assign(res, rhs, node%op) @@ -2119,6 +2161,64 @@ end function subscript_i32_eval !=============================================================================== +! TODO: DRY +function sub_eval(node, var, state) result(index_) + + ! Evaluate subscript indices and convert a multi-rank subscript to a rank-1 + ! subscript index_ + + type(syntax_node_t) :: node + type(value_t) :: var + type(state_t), intent(inout) :: state + + integer(kind = 8) :: index_ + + !****** + + integer :: i + integer(kind = 8) :: prod + type(value_t) :: subscript + + !print *, 'starting sub_eval()' + + !! TODO + !! str scalar with single char subscript + !if (state%vars%vals(node%id_index)%type == str_type) then + ! call syntax_eval(node%lsubscripts(1), state, subscript) + ! index_ = subscript%to_i64() + ! return + !end if + + !if (state%vars%vals(node%id_index)%type /= array_type) then + ! ! internal_error? + !end if + + prod = 1 + index_ = 0 + !do i = 1, state%vars%vals(node%id_index)%array%rank + !do i = 1, node%array%rank + do i = 1, var%array%rank + !print *, 'i = ', i + + call syntax_eval(node%lsubscripts(i), state, subscript) + + ! TODO: bound checking? by default or enabled with cmd line flag? + ! + ! I think the only way to do it without killing perf is by having bound + ! checking turned off in release, and setting a compiler macro + ! definition to enable it only in debug + + index_ = index_ + prod * subscript%to_i64() + !prod = prod * state%vars%vals(node%id_index)%array%size(i) + !prod = prod * node%array%size(i) + prod = prod * var%array%size(i) + + end do + +end function sub_eval + +!=============================================================================== + function subscript_eval(node, state) result(index_) ! Evaluate subscript indices and convert a multi-rank subscript to a rank-1 diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index ed143b51..151b6aa5 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -566,6 +566,8 @@ module function parse_name_expr(parser) result(expr) span0 = parser%current_pos() call parser%parse_subscripts(expr) + ! TODO: can any of this coda be moved inside of parse_subscripts()? Are + ! there differences between lval and rval subscripts? span1 = parser%current_pos() - 1 if (size(expr%lsubscripts) <= 0) then deallocate(expr%lsubscripts) @@ -684,6 +686,12 @@ recursive module subroutine parse_dot(parser, expr) expr%member%id_index = member_id expr%val = member + ! I think this is the right place to parse subscripts. Or should it be after + ! the recursive parse_dot()? + call parser%parse_subscripts(expr%member) + !call parser%parse_subscripts(expr) + if (size(expr%member%lsubscripts) <= 0) deallocate(expr%member%lsubscripts) + ! I think this needs a recursive call to `parse_dot()` right here to handle ! things like `a.b.c`. TODO: there should probably be a parse_subscripts() ! call here too. For both, might need to differentiate between lvalues and From 9122de0243e18f84f9e80b0e037fb19010449e6c Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 11:59:58 -0400 Subject: [PATCH 068/137] add tests. refactor --- src/core.f90 | 6 ++--- src/eval.f90 | 63 +++++++++++++++++++-------------------------- src/parse_array.f90 | 3 +-- src/parse_expr.f90 | 23 +++++++---------- src/tests/test.f90 | 58 +++++++++++++++++++++++++++++++++++++---- 5 files changed, 93 insertions(+), 60 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index b4476599..2d2c67d1 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -34,9 +34,9 @@ module syntran__core_m ! + nested structs ! * tbd: ! + structs of arrays - ! * kinda works if you statically initialize the whole array in the - ! struct and only refer to the whole array later. doesn't work if - ! you try to subscript anything inside a struct + ! * wip + ! * lhs subs tbd + ! * rhs subs done ! + arrays of structs ! + unary ops on dot exprs ! + tests diff --git a/src/eval.f90 b/src/eval.f90 index c179b3b7..b1d12861 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -387,8 +387,7 @@ subroutine eval_dot_expr(node, state, res) type(state_t), intent(inout) :: state - ! TODO: can res be just out? There's one other routine in here that does this - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** @@ -439,8 +438,8 @@ end subroutine set_val recursive function get_val(node, var, state) result(res) - ! As is, maybe I should rename this to get_dot_val(), but I would like to - ! extend it to process subscripts too + ! TODO: should res be an out arg for consistency? Similar question for + ! get_array_value_t() ! In nested expressions, like `a.b.c.d`, var begins as the top-most ! (left-most, outer-most) value `a` @@ -449,7 +448,6 @@ recursive function get_val(node, var, state) result(res) type(value_t), intent(in) :: var type(state_t), intent(inout) :: state - !type(value_t), intent(inout) :: res type(value_t) :: res !******** @@ -470,45 +468,36 @@ recursive function get_val(node, var, state) result(res) ! Base case - ! TODO: maybe invert if to never nest? Is this ordered correctly in the - ! recursion wrt parsing? - if (allocated(node%member%lsubscripts)) then - !if (allocated(node%lsubscripts)) then - !print *, "lsubscripts allocated" - - if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then - !print *, "slice sub" - ! TODO: not implemented, throw error - else - !print *, "scalar_sub" + if (.not. allocated(node%member%lsubscripts)) then + res = var%struct(id) + return + end if - !i8 = subscript_eval(node, state) - !array_val = get_array_value_t(state%vars%vals(node%id_index)%array, i8) - !call compound_assign(array_val, res, node%op) - !call set_array_value_t( & - ! state%vars%vals(node%id_index)%array, i8, array_val) - !res = array_val + ! TODO: is this ordered correctly in the + ! recursion wrt parsing? + !print *, "lsubscripts allocated" - !! beware this print only works for literals. in general we need to - !! eval via sub_eval() - !print *, "lsub 1 = ", node%member%lsubscripts(1)%val%to_str() + if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then + !print *, "slice sub" - !i8 = subscript_eval(node%member, state) - !i8 = sub_eval(node%member, state) - !i8 = sub_eval(node%member, var%struct(id)%array, state) - i8 = sub_eval(node%member, var%struct(id), state) + ! TODO: not implemented, throw error. Add code to catch in parser first + write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset + call internal_error() + end if - !array_val = ... - !res = get_array_value_t(node%member%array, i8) - res = get_array_value_t(var%struct(id)%array, i8) + !print *, "scalar_sub" - return + !! beware this print only works for literals. in general we need to + !! eval via sub_eval() + !print *, "lsub 1 = ", node%member%lsubscripts(1)%val%to_str() - end if + ! TODO: i don't think this works for subs nested in between multiple + ! dot exprs. Still need to recurse - end if + i8 = sub_eval(node%member, var%struct(id), state) + res = get_array_value_t(var%struct(id)%array, i8) - res = var%struct(id) + !return end function get_val @@ -520,7 +509,7 @@ subroutine eval_struct_instance(node, state, res) type(state_t), intent(inout) :: state - type(value_t), intent(inout) :: res + type(value_t), intent(out) :: res !******** diff --git a/src/parse_array.f90 b/src/parse_array.f90 index d6632939..1524b1f9 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -449,8 +449,7 @@ module subroutine parse_subscripts(parser, expr) if (parser%current_kind() /= lbracket_token) then - !! The function has to return something. Caller deallocates - allocate( expr%lsubscripts(0)) + !allocate( expr%lsubscripts(0)) return end if diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 151b6aa5..acc0f700 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -125,7 +125,7 @@ recursive module function parse_expr_statement(parser) result(expr) span0 = parser%current_pos() call parser%parse_subscripts(expr) - if (size(expr%lsubscripts) <= 0) deallocate(expr%lsubscripts) + !if (size(expr%lsubscripts) <= 0) deallocate(expr%lsubscripts) span1 = parser%current_pos() - 1 if (parser%peek_kind(0) == dot_token) then @@ -186,13 +186,15 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'allocated(expr%val%array) = ', allocated(expr%val%array) - if (size(expr%lsubscripts) > 0) then + !if (size(expr%lsubscripts) > 0) then + if (allocated(expr%lsubscripts)) then if (expr%val%type == str_type) then !print *, 'str type' ! TODO: check rank == 1 else if (expr%val%type /= array_type) then span = new_span(span0, span1 - span0 + 1) + print *, "err_scalar_subscript 2" call parser%diagnostics%push( & err_scalar_subscript(parser%context(), & span, identifier%text)) @@ -569,8 +571,9 @@ module function parse_name_expr(parser) result(expr) ! TODO: can any of this coda be moved inside of parse_subscripts()? Are ! there differences between lval and rval subscripts? span1 = parser%current_pos() - 1 - if (size(expr%lsubscripts) <= 0) then - deallocate(expr%lsubscripts) + !if (size(expr%lsubscripts) <= 0) then + if (.not. allocated(expr%lsubscripts)) then + !deallocate(expr%lsubscripts) else if (expr%val%type == array_type) then !print *, 'sub kind = ', kind_name(expr%lsubscripts(1)%sub_kind) @@ -608,6 +611,7 @@ module function parse_name_expr(parser) result(expr) end if else span = new_span(span0, span1 - span0 + 1) + print *, "err_scalar_subscript 1" call parser%diagnostics%push( & err_scalar_subscript(parser%context(), & span, identifier%text)) @@ -689,21 +693,14 @@ recursive module subroutine parse_dot(parser, expr) ! I think this is the right place to parse subscripts. Or should it be after ! the recursive parse_dot()? call parser%parse_subscripts(expr%member) - !call parser%parse_subscripts(expr) - if (size(expr%member%lsubscripts) <= 0) deallocate(expr%member%lsubscripts) + !if (size(expr%member%lsubscripts) <= 0) deallocate(expr%member%lsubscripts) ! I think this needs a recursive call to `parse_dot()` right here to handle - ! things like `a.b.c`. TODO: there should probably be a parse_subscripts() - ! call here too. For both, might need to differentiate between lvalues and - ! rvalues, i.e. use separate parse_ldot(), parse_rdot(), - ! parse_lsubscripts(), ... + ! things like `a.b.c` if (parser%peek_kind(0) == dot_token) then - !expr%member%val%type = struct_type expr%member%val = member - call parser%parse_dot(expr%member) - expr%val = expr%member%val end if diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 36145a3e..3e35c857 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2450,8 +2450,6 @@ end subroutine unit_test_return subroutine unit_test_struct(npass, nfail) - ! More advanced tests on longer scripts - implicit none integer, intent(inout) :: npass, nfail @@ -2465,8 +2463,6 @@ subroutine unit_test_struct(npass, nfail) write(*,*) 'Unit testing '//label//' ...' - ! TODO: more struct tests - tests = & [ & eval( 'struct D{y:i64, m:str, d:i32}' & ! 1 @@ -2738,7 +2734,7 @@ subroutine unit_test_struct(npass, nfail) ! Trim dummy false element tests = tests(1: size(tests) - 1) - !print *, "number of struct tests = ", size(tests) + !print *, "number of "//label//" tests = ", size(tests) call unit_test_coda(tests, label, npass, nfail) @@ -2746,6 +2742,57 @@ end subroutine unit_test_struct !=============================================================================== +subroutine unit_test_struct_arr(npass, nfail) + + implicit none + + integer, intent(inout) :: npass, nfail + + !******** + + character(len = *), parameter :: label = 'structs/arrays' + + logical, parameter :: quiet = .true. + logical, allocatable :: tests(:) + + write(*,*) 'Unit testing '//label//' ...' + + tests = & + [ & + eval('' & ! 1 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'return v1.v[0];' & + , quiet) == '6', & + eval('' & ! 2 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'return v1.v[1];' & + , quiet) == '2', & + eval('' & ! 3 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'return v1.v[1] + 1;' & + , quiet) == '3', & + eval('' & ! 3 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'v1.v = [3, 1, 2];' & + //'return v1.v[0] + v1.v[1];' & + , quiet) == '4', & + .false. & ! so I don't have to bother w/ trailing commas + ] + + ! Trim dummy false element + tests = tests(1: size(tests) - 1) + !print *, "number of "//label//" tests = ", size(tests) + + call unit_test_coda(tests, label, npass, nfail) + +end subroutine unit_test_struct_arr + +!=============================================================================== + subroutine unit_test_array_bool(npass, nfail) ! More advanced tests on longer scripts @@ -2965,6 +3012,7 @@ subroutine unit_tests(iostat) call unit_test_lhs_slc_1 (npass, nfail) call unit_test_return (npass, nfail) call unit_test_struct (npass, nfail) + call unit_test_struct_arr (npass, nfail) ! TODO: add tests that mock interpreting one line at a time (as opposed to ! whole files) From 177515d9c84a5ebc3c2efa440b9d9ec92eb3e3de Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 12:13:03 -0400 Subject: [PATCH 069/137] add higher order struct array tests --- src/parse_expr.f90 | 6 +----- src/tests/test.f90 | 29 +++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index acc0f700..e052dea7 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -125,7 +125,6 @@ recursive module function parse_expr_statement(parser) result(expr) span0 = parser%current_pos() call parser%parse_subscripts(expr) - !if (size(expr%lsubscripts) <= 0) deallocate(expr%lsubscripts) span1 = parser%current_pos() - 1 if (parser%peek_kind(0) == dot_token) then @@ -186,7 +185,6 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'allocated(expr%val%array) = ', allocated(expr%val%array) - !if (size(expr%lsubscripts) > 0) then if (allocated(expr%lsubscripts)) then if (expr%val%type == str_type) then @@ -571,9 +569,8 @@ module function parse_name_expr(parser) result(expr) ! TODO: can any of this coda be moved inside of parse_subscripts()? Are ! there differences between lval and rval subscripts? span1 = parser%current_pos() - 1 - !if (size(expr%lsubscripts) <= 0) then if (.not. allocated(expr%lsubscripts)) then - !deallocate(expr%lsubscripts) + ! do nothing else if (expr%val%type == array_type) then !print *, 'sub kind = ', kind_name(expr%lsubscripts(1)%sub_kind) @@ -693,7 +690,6 @@ recursive module subroutine parse_dot(parser, expr) ! I think this is the right place to parse subscripts. Or should it be after ! the recursive parse_dot()? call parser%parse_subscripts(expr%member) - !if (size(expr%member%lsubscripts) <= 0) deallocate(expr%member%lsubscripts) ! I think this needs a recursive call to `parse_dot()` right here to handle ! things like `a.b.c` diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 3e35c857..999c569b 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2780,6 +2780,35 @@ subroutine unit_test_struct_arr(npass, nfail) //'v1.v = [3, 1, 2];' & //'return v1.v[0] + v1.v[1];' & , quiet) == '4', & + eval('' & ! 4 + //'struct V{v:[i32;:], name:str,}' & + //'let v1 = V{v=[6,2,5], name="myvec1"};' & + //'let x = v1.v[1] + [3, 2, 1];' & + , quiet) == '[5, 4, 3]', & + eval('' & ! 5 + //'struct V{v:[i32;:], name:str,}' & ! vector + //'struct L{s:V, e:V}' & ! line with start and end vectors + //'let v1 = V{v=[3,2,1], name="myvec1"};' & + //'let v2 = V{v=[6,2,5], name="myvec2"};' & + //'let l1 = L{s=v1, e=v2};' & + //'return l1.s.v[0];' & + , quiet) == '3', & + eval('' & ! 5 + //'struct V{v:[i32;:], name:str,}' & ! vector + //'struct L{s:V, e:V}' & ! line with start and end vectors + //'let v1 = V{v=[3,2,1], name="myvec1"};' & + //'let v2 = V{v=[6,2,5], name="myvec2"};' & + //'let l1 = L{s=v1, e=v2};' & + //'return l1.e.v[1];' & + , quiet) == '2', & + eval('' & ! 6 + //'struct V{v:[i32;:], name:str,}' & ! vector + //'struct L{s:V, e:V}' & ! line with start and end vectors + //'let v1 = V{v=[3,2,1], name="myvec1"};' & + //'let v2 = V{v=[6,2,5], name="myvec2"};' & + //'let l1 = L{s=v1, e=v2};' & + //'return l1.e.name;' & + , quiet) == 'myvec2', & .false. & ! so I don't have to bother w/ trailing commas ] From 51920560b1e4957dab4dfd38406ab65340826f64 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 13:28:48 -0400 Subject: [PATCH 070/137] add dot string subscripts, planning to revert --- src/eval.f90 | 34 ++++++++++++++++++++++++++++------ src/tests/test.f90 | 26 +++++++++++++++++++++----- 2 files changed, 49 insertions(+), 11 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index b1d12861..e4913f72 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -495,6 +495,27 @@ recursive function get_val(node, var, state) result(res) ! dot exprs. Still need to recurse i8 = sub_eval(node%member, var%struct(id), state) + + ! TODO: keep str dot subscripts here, but that's not a priority yet. I want + ! to do lhs dot subs and arrays of structs first + + !if () then + !if (var%type == str_type) then + if (var%struct(id)%type == str_type) then + + ! TODO: this feels like a dirty hack. Can it be refactored inside of + ! get_array_value_t? + + !res%type = state%vars%vals(node%id_index)%type + res%type = str_type + + !res%sca%str%s = state%vars%vals(node%id_index)%sca%str%s(i8+1: i8+1) + !res%sca%str%s = var%sca%str%s(i8+1: i8+1) + res%sca%str%s = var%struct(id)%sca%str%s(i8+1: i8+1) + + return + + end if res = get_array_value_t(var%struct(id)%array, i8) !return @@ -2170,13 +2191,14 @@ function sub_eval(node, var, state) result(index_) !print *, 'starting sub_eval()' - !! TODO - !! str scalar with single char subscript + ! str scalar with single char subscript + if (var%type == str_type) then !if (state%vars%vals(node%id_index)%type == str_type) then - ! call syntax_eval(node%lsubscripts(1), state, subscript) - ! index_ = subscript%to_i64() - ! return - !end if + print *, "str type" + call syntax_eval(node%lsubscripts(1), state, subscript) + index_ = subscript%to_i64() + return + end if !if (state%vars%vals(node%id_index)%type /= array_type) then ! ! internal_error? diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 999c569b..15a73b68 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2774,18 +2774,18 @@ subroutine unit_test_struct_arr(npass, nfail) //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'return v1.v[1] + 1;' & , quiet) == '3', & - eval('' & ! 3 + eval('' & ! 4 //'struct V{v:[i32;:], name:str,}' & //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'v1.v = [3, 1, 2];' & //'return v1.v[0] + v1.v[1];' & , quiet) == '4', & - eval('' & ! 4 + eval('' & ! 5 //'struct V{v:[i32;:], name:str,}' & //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'let x = v1.v[1] + [3, 2, 1];' & , quiet) == '[5, 4, 3]', & - eval('' & ! 5 + eval('' & ! 6 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2793,7 +2793,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.s.v[0];' & , quiet) == '3', & - eval('' & ! 5 + eval('' & ! 7 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2801,7 +2801,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.e.v[1];' & , quiet) == '2', & - eval('' & ! 6 + eval('' & ! 8 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2809,6 +2809,22 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.e.name;' & , quiet) == 'myvec2', & + eval('' & ! 9 + //'struct V{v:[i32;:], name:str,}' & ! vector + //'struct L{s:V, e:V}' & ! line with start and end vectors + //'let v1 = V{v=[3,2,1], name="myvec1"};' & + //'let v2 = V{v=[6,2,5], name="myvec2"};' & + //'let l1 = L{s=v1, e=v2};' & + //'return l1.e.name[0];' & + , quiet) == 'm', & + eval('' & ! 10 + //'struct V{v:[i32;:], name:str,}' & ! vector + //'struct L{s:V, e:V}' & ! line with start and end vectors + //'let v1 = V{v=[3,2,1], name="myvec1"};' & + //'let v2 = V{v=[6,2,5], name="myvec2"};' & + //'let l1 = L{s=v1, e=v2};' & + //'return l1.e.name[0];' & + , quiet) == 'm', & .false. & ! so I don't have to bother w/ trailing commas ] From 08b529ccfba4a659d1e551c24ccc617608cfa32d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 13:29:01 -0400 Subject: [PATCH 071/137] Revert "add dot string subscripts, planning to revert" This reverts commit 51920560b1e4957dab4dfd38406ab65340826f64. --- src/eval.f90 | 34 ++++++---------------------------- src/tests/test.f90 | 26 +++++--------------------- 2 files changed, 11 insertions(+), 49 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index e4913f72..b1d12861 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -495,27 +495,6 @@ recursive function get_val(node, var, state) result(res) ! dot exprs. Still need to recurse i8 = sub_eval(node%member, var%struct(id), state) - - ! TODO: keep str dot subscripts here, but that's not a priority yet. I want - ! to do lhs dot subs and arrays of structs first - - !if () then - !if (var%type == str_type) then - if (var%struct(id)%type == str_type) then - - ! TODO: this feels like a dirty hack. Can it be refactored inside of - ! get_array_value_t? - - !res%type = state%vars%vals(node%id_index)%type - res%type = str_type - - !res%sca%str%s = state%vars%vals(node%id_index)%sca%str%s(i8+1: i8+1) - !res%sca%str%s = var%sca%str%s(i8+1: i8+1) - res%sca%str%s = var%struct(id)%sca%str%s(i8+1: i8+1) - - return - - end if res = get_array_value_t(var%struct(id)%array, i8) !return @@ -2191,14 +2170,13 @@ function sub_eval(node, var, state) result(index_) !print *, 'starting sub_eval()' - ! str scalar with single char subscript - if (var%type == str_type) then + !! TODO + !! str scalar with single char subscript !if (state%vars%vals(node%id_index)%type == str_type) then - print *, "str type" - call syntax_eval(node%lsubscripts(1), state, subscript) - index_ = subscript%to_i64() - return - end if + ! call syntax_eval(node%lsubscripts(1), state, subscript) + ! index_ = subscript%to_i64() + ! return + !end if !if (state%vars%vals(node%id_index)%type /= array_type) then ! ! internal_error? diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 15a73b68..999c569b 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2774,18 +2774,18 @@ subroutine unit_test_struct_arr(npass, nfail) //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'return v1.v[1] + 1;' & , quiet) == '3', & - eval('' & ! 4 + eval('' & ! 3 //'struct V{v:[i32;:], name:str,}' & //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'v1.v = [3, 1, 2];' & //'return v1.v[0] + v1.v[1];' & , quiet) == '4', & - eval('' & ! 5 + eval('' & ! 4 //'struct V{v:[i32;:], name:str,}' & //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'let x = v1.v[1] + [3, 2, 1];' & , quiet) == '[5, 4, 3]', & - eval('' & ! 6 + eval('' & ! 5 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2793,7 +2793,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.s.v[0];' & , quiet) == '3', & - eval('' & ! 7 + eval('' & ! 5 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2801,7 +2801,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.e.v[1];' & , quiet) == '2', & - eval('' & ! 8 + eval('' & ! 6 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2809,22 +2809,6 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.e.name;' & , quiet) == 'myvec2', & - eval('' & ! 9 - //'struct V{v:[i32;:], name:str,}' & ! vector - //'struct L{s:V, e:V}' & ! line with start and end vectors - //'let v1 = V{v=[3,2,1], name="myvec1"};' & - //'let v2 = V{v=[6,2,5], name="myvec2"};' & - //'let l1 = L{s=v1, e=v2};' & - //'return l1.e.name[0];' & - , quiet) == 'm', & - eval('' & ! 10 - //'struct V{v:[i32;:], name:str,}' & ! vector - //'struct L{s:V, e:V}' & ! line with start and end vectors - //'let v1 = V{v=[3,2,1], name="myvec1"};' & - //'let v2 = V{v=[6,2,5], name="myvec2"};' & - //'let l1 = L{s=v1, e=v2};' & - //'return l1.e.name[0];' & - , quiet) == 'm', & .false. & ! so I don't have to bother w/ trailing commas ] From c2fa40ccb6978afae52cb340ea331d3915dcf032 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 17:13:16 -0400 Subject: [PATCH 072/137] wip, arrays of structs --- src/errors.f90 | 2 +- src/eval.f90 | 174 +++++++++++++++++++++++++++++++-------------- src/parse_expr.f90 | 2 + src/syntran.f90 | 2 + src/tests/test.f90 | 10 +-- src/value.f90 | 5 ++ 6 files changed, 136 insertions(+), 59 deletions(-) diff --git a/src/errors.f90 b/src/errors.f90 index 3cfa6148..feb73d89 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -693,7 +693,7 @@ function err_eval_len_array(type_name) result(err) character(len = :), allocatable :: err err = err_int_prefix & - //'array cannot be evaluated for type `' & + //'len array cannot be evaluated for type `' & //type_name//'`'//color_reset end function err_eval_len_array diff --git a/src/eval.f90 b/src/eval.f90 index b1d12861..d082cb04 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -253,7 +253,7 @@ subroutine eval_name_expr(node, state, res) !******** - integer :: rank_res, idim_, idim_res + integer :: rank_res, idim_, idim_res, type integer(kind = 8) :: il, iu, i8, index_ integer(kind = 8), allocatable :: lsubs(:), usubs(:), subs(:) @@ -311,11 +311,23 @@ subroutine eval_name_expr(node, state, res) if (all(node%lsubscripts%sub_kind == scalar_sub)) then - ! This could probably be lumped in with the range_sub case now - ! that I have it fully generalized - i8 = subscript_eval(node, state) - !print *, 'i8 = ', i8 - res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + !print *, "rval scalar sub" + + type = state%vars%vals(node%id_index)%array%type + !print *, "type = ", kind_name(type) + + if (type == struct_type) then + res = get_val(node, state%vars%vals(node%id_index), state) + else + + ! This could probably be lumped in with the range_sub case now + ! that I have it fully generalized + ! + ! TODO: try to unify with get_val() branch above + i8 = subscript_eval(node, state) + res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + + end if else @@ -351,7 +363,7 @@ subroutine eval_name_expr(node, state, res) res%array%len_ = product(res%array%size) !print *, 'res len = ', res%array%len_ - call allocate_array(res%array, res%array%len_) + call allocate_array(res, res%array%len_) ! Iterate through all subscripts in range and copy to result ! array @@ -455,6 +467,26 @@ recursive function get_val(node, var, state) result(res) integer :: id integer(kind = 8) :: i8 + if (allocated(node%lsubscripts)) then + + !print *, "rval scalar sub" + !print *, "lsubscripts allocated" + i8 = subscript_eval(node, state) + !print *, 'i8 = ', i8 + + !res = get_val(node, var%struct(i8), state) + !res = var%struct(i8)%struct + res = var%struct(i8+1) + res%type = struct_type + !res%struct_name = var%struct_name + res%struct_name = var%struct(i8+1)%struct_name ! TODO: empty + + ! TODO: recurse somehow + + return + + end if + ! `id` tracks whether each member is the 1st, 2nd, etc. member in the struct ! array of its parent. A local variable isnt' really needed but I think it ! helps readability @@ -1556,17 +1588,18 @@ subroutine eval_array_expr(node, state, res) else if (node%val%array%kind == unif_array) then - array%rank = size( node%size ) - !print *, "rank = ", array%rank - allocate(array%size( array%rank )) + allocate(res%array) + res%array%rank = size( node%size ) + !print *, "rank = ", res%array%rank + allocate(res%array%size( res%array%rank )) - do i = 1, array%rank + do i = 1, res%array%rank !print *, "i = ", i call syntax_eval(node%size(i), state, len_) !print *, "len_%type = ", kind_name(len_%type) !print *, "len_ = ", len_%to_i64() - array%size(i) = len_%to_i64() - !print *, 'size['//str(i)//'] = ', array%size(i) + res%array%size(i) = len_%to_i64() + !print *, 'size['//str(i)//'] = ', res%array%size(i) end do ! Uniform-value impl arrays (every element has the same value at @@ -1578,30 +1611,49 @@ subroutine eval_array_expr(node, state, res) ! Allocate in one shot without growing - array%type = node%val%array%type - array%len_ = product(array%size) - !print *, 'array%len_ = ', array%len_ + res%array%type = node%val%array%type + res%array%len_ = product(res%array%size) + !print *, 'res%array%len_ = ', res%array%len_ - call allocate_array(array, array%len_) - select case (array%type) + call allocate_array(res, res%array%len_) + select case (res%array%type) case (i32_type) - array%i32 = lbound_%sca%i32 + res%array%i32 = lbound_%sca%i32 + case (i64_type) - array%i64 = lbound_%sca%i64 + res%array%i64 = lbound_%sca%i64 + case (f32_type) - array%f32 = lbound_%sca%f32 + res%array%f32 = lbound_%sca%f32 + case (bool_type) - array%bool = lbound_%sca%bool + res%array%bool = lbound_%sca%bool + case (str_type) - array%str = lbound_%sca%str + res%array%str = lbound_%sca%str + + case (struct_type) + !res%array%str = lbound_%sca%str + !res%struct(:) = lbound_ + !res%struct(:)%struct = lbound_ + + print *, "lbound_ size = ", size(lbound_%struct) + + !res%struct(:)%struct = lbound_%struct + do i8 = 1, res%array%len_ + !allocate(res%struct(i8)%struct) + !res%struct(i8)%struct = lbound_ + res%struct(i8)%struct = lbound_%struct + end do + case default - write(*,*) err_eval_len_array(kind_name(array%type)) + write(*,*) err_eval_len_array(kind_name(res%array%type)) call internal_error() end select - allocate(res%array) res%type = array_type - res%array = array + !allocate(res%array) + !res%array = array else if (node%val%array%kind == bound_array) then !print *, 'impl_array' @@ -1621,47 +1673,47 @@ subroutine eval_array_expr(node, state, res) !array = new_array(node%val%array%type) - array%type = node%val%array%type + allocate(res%array) + res%array%type = node%val%array%type if (any(i64_type == [lbound_%type, ubound_%type])) then call promote_i32_i64(lbound_) call promote_i32_i64(ubound_) end if - if (.not. any(array%type == [i32_type, i64_type])) then + if (.not. any(res%array%type == [i32_type, i64_type])) then write(*,*) err_int_prefix//'unit step array type eval not implemented'//color_reset call internal_error() end if - if (array%type == i32_type) then - array%len_ = ubound_%sca%i32 - lbound_%sca%i32 - else !if (array%type == i64_type) then - array%len_ = ubound_%sca%i64 - lbound_%sca%i64 + if (res%array%type == i32_type) then + res%array%len_ = ubound_%sca%i32 - lbound_%sca%i32 + else !if (res%array%type == i64_type) then + res%array%len_ = ubound_%sca%i64 - lbound_%sca%i64 end if - call allocate_array(array, array%len_) + call allocate_array(res, res%array%len_) !print *, 'bounds in [', lbound_%str(), ': ', ubound_%str(), ']' !print *, 'node%val%array%type = ', node%val%array%type - if (array%type == i32_type) then + if (res%array%type == i32_type) then do i = lbound_%sca%i32, ubound_%sca%i32 - 1 - array%i32(i - lbound_%sca%i32 + 1) = i + res%array%i32(i - lbound_%sca%i32 + 1) = i end do - else !if (array%type == i64_type) then + else !if (res%array%type == i64_type) then do i8 = lbound_%sca%i64, ubound_%sca%i64 - 1 - array%i64(i8 - lbound_%sca%i64 + 1) = i8 + res%array%i64(i8 - lbound_%sca%i64 + 1) = i8 end do end if - array%rank = 1 - allocate(array%size( array%rank )) - array%size = array%len_ - - allocate(res%array) + res%array%rank = 1 + allocate(res%array%size( res%array%rank )) + res%array%size = res%array%len_ res%type = array_type - res%array = array + !allocate(res%array) + !res%array = array else if (node%val%array%kind == size_array) then @@ -1912,27 +1964,40 @@ end subroutine promote_i32_i64 !=============================================================================== -subroutine allocate_array(array, cap) +!subroutine allocate_array(array, cap) +subroutine allocate_array(val, cap) - type(array_t), intent(inout) :: array + !type(array_t), intent(inout) :: array + type(value_t), intent(inout) :: val integer(kind = 8), intent(in) :: cap - array%cap = cap + val%array%cap = cap - select case (array%type) + select case (val%array%type) case (i32_type) - allocate(array%i32( cap )) + allocate(val%array%i32( cap )) + case (i64_type) - allocate(array%i64( cap )) + allocate(val%array%i64( cap )) + case (f32_type) - allocate(array%f32( cap )) + allocate(val%array%f32( cap )) + case (bool_type) - allocate(array%bool( cap )) + allocate(val%array%bool( cap )) + case (str_type) - allocate(array%str( cap )) + allocate(val%array%str( cap )) + + case (struct_type) + !allocate(val%array%struct( cap )) + !print *, "val%array of structs" + allocate(val%struct( cap )) + !call internal_error() + case default write(*,*) err_int_prefix//'cannot allocate array of type `' & - //kind_name(array%type)//'`'//color_reset + //kind_name(val%array%type)//'`'//color_reset call internal_error() end select @@ -2367,6 +2432,9 @@ function get_array_value_t(array, i) result(val) case (str_type) val%sca%str = array%str(i + 1) + case default + print *, "bad type in get_array_value_t" + end select end function get_array_value_t diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index e052dea7..b1b6a055 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -614,6 +614,8 @@ module function parse_name_expr(parser) result(expr) span, identifier%text)) end if + !print *, "expr%val%type = ", kind_name(expr%val%type) + !print *, "tail parse_dot" call parser%parse_dot(expr) diff --git a/src/syntran.f90 b/src/syntran.f90 index 4b24d394..8ccd5c0b 100644 --- a/src/syntran.f90 +++ b/src/syntran.f90 @@ -350,6 +350,8 @@ function syntran_eval(str_, quiet, src_file, chdir_) result(res) src_filel = '' if (present(src_file)) src_filel = src_file + !print * , "src_filel = """, src_filel, """" + chdirl = .false. if (present(chdir_)) then chdirl = .true. diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 999c569b..7b9f6356 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2774,18 +2774,18 @@ subroutine unit_test_struct_arr(npass, nfail) //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'return v1.v[1] + 1;' & , quiet) == '3', & - eval('' & ! 3 + eval('' & ! 4 //'struct V{v:[i32;:], name:str,}' & //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'v1.v = [3, 1, 2];' & //'return v1.v[0] + v1.v[1];' & , quiet) == '4', & - eval('' & ! 4 + eval('' & ! 5 //'struct V{v:[i32;:], name:str,}' & //'let v1 = V{v=[6,2,5], name="myvec1"};' & //'let x = v1.v[1] + [3, 2, 1];' & , quiet) == '[5, 4, 3]', & - eval('' & ! 5 + eval('' & ! 6 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2793,7 +2793,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.s.v[0];' & , quiet) == '3', & - eval('' & ! 5 + eval('' & ! 7 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & @@ -2801,7 +2801,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.e.v[1];' & , quiet) == '2', & - eval('' & ! 6 + eval('' & ! 8 //'struct V{v:[i32;:], name:str,}' & ! vector //'struct L{s:V, e:V}' & ! line with start and end vectors //'let v1 = V{v=[3,2,1], name="myvec1"};' & diff --git a/src/value.f90 b/src/value.f90 index 3e67711e..e2f2fccc 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -60,6 +60,9 @@ module syntran__value_m type(string_t ), allocatable :: str(:) + !type(value_t), allocatable :: struct(:) + !type(value_t), pointer :: struct(:) + ! TODO: file arrays integer :: rank @@ -484,6 +487,8 @@ recursive function value_to_str(val) result(ans) !type(string_vector_t) :: str_vec type(char_vector_t) :: str_vec + !print *, "val type = ", kind_name(val%type) + select case (val%type) case (struct_type) From 9898e6c2eedbe3ef9f392270400e4a25c90e62fa Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 17:44:46 -0400 Subject: [PATCH 073/137] add str conversion for arrays of structs --- src/eval.f90 | 17 +++++++++++++---- src/value.f90 | 52 ++++++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 60 insertions(+), 9 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index d082cb04..65fb841b 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -469,19 +469,23 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts)) then + ! TODO: throw error for anything but scalar_sub + !print *, "rval scalar sub" !print *, "lsubscripts allocated" i8 = subscript_eval(node, state) !print *, 'i8 = ', i8 + ! TODO: recurse somehow + + !res = get_val(node%member, var%struct(i8+1), state) !res = get_val(node, var%struct(i8), state) !res = var%struct(i8)%struct res = var%struct(i8+1) - res%type = struct_type - !res%struct_name = var%struct_name - res%struct_name = var%struct(i8+1)%struct_name ! TODO: empty - ! TODO: recurse somehow + res%type = struct_type + res%struct_name = var%struct_name + !res%struct_name = var%struct(i8+1)%struct_name return @@ -1644,8 +1648,13 @@ subroutine eval_array_expr(node, state, res) !allocate(res%struct(i8)%struct) !res%struct(i8)%struct = lbound_ res%struct(i8)%struct = lbound_%struct + !res%struct(i8)%struct_name = lbound_%struct_name end do + ! Arrays are homogeneous, so every element shares one struct_name + ! for efficiency + res%struct_name = lbound_%struct_name + case default write(*,*) err_eval_len_array(kind_name(res%array%type)) call internal_error() diff --git a/src/value.f90 b/src/value.f90 index e2f2fccc..f2a9f955 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -482,7 +482,7 @@ recursive function value_to_str(val) result(ans) !character(len = 16) :: buf16 integer :: j - integer(kind = 8) :: i8, prod, n + integer(kind = 8) :: i8, j8, prod, n, nj !type(string_vector_t) :: str_vec type(char_vector_t) :: str_vec @@ -504,11 +504,15 @@ recursive function value_to_str(val) result(ans) !call str_vec%push( val%struct(i8)%struct_name//" = " ) call str_vec%push( trimw(val%struct(i8)%to_str()) ) + + !do j8 = 1, size(val%struct(i8)%struct) + ! call str_vec%push( trimw(val%struct(i8)%struct(j8)%to_str()) ) + !end do + if (i8 < n) call str_vec%push(", ") end do call str_vec%push("}") - !ans = str_vec%v( 1: str_vec%len_ ) ans = str_vec%trim() case (array_type) @@ -646,10 +650,48 @@ recursive function value_to_str(val) result(ans) end do + else if (val%array%type == struct_type) then + + call str_vec%push("array<"//val%struct_name//"> ") + + n = size(val%struct) + do i8 = 1, n + + !! TODO: can we just recurse instead of nesting a loop? + !call str_vec%push( val%struct(i8)%to_str() ) + + ! It would be nice to label each member with its name + + !call str_vec%push( val%struct(i8)%struct_name//" = " ) + + !call str_vec%push( trimw(val%struct(i8)%to_str()) ) + + call str_vec%push("{") + nj = size(val%struct(i8)%struct) + do j8 = 1, nj + call str_vec%push( trimw(val%struct(i8)%struct(j8)%to_str()) ) + if (j8 < nj) call str_vec%push(", ") + end do + + if (i8 < n) call str_vec%push("}, ") + + end do + call str_vec%push("}") + !ans = str_vec%trim() + else - write(*,*) 'Error: array ans conversion not implemented' & - //' for this type' - call internal_error() + + ! Do *not* print anything in this function, as recursive IO will + ! cause a hang + + !call str_vec%push(err_prefix//"array str conversion not" & + ! //" implemented for this type") + call str_vec%push(err_prefix//""//color_reset) + + !write(*,*) 'Error: array ans conversion not implemented' & + ! //' for this type' + !call internal_error() + end if if (val%array%rank > 1) call str_vec%push(line_feed) From 18bb0852b11187c62228eca90f3c8cce581eddab Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 20:19:43 -0400 Subject: [PATCH 074/137] pass types for arrays of structs and subscripting the verbose logging here will break github actions if pushed separately --- src/parse.f90 | 3 +- src/parse_array.f90 | 70 ++++++++++++++++++++++++++++++++---- src/parse_expr.f90 | 88 +++++++++++++++++++-------------------------- 3 files changed, 102 insertions(+), 59 deletions(-) diff --git a/src/parse.f90 b/src/parse.f90 index 5b23ad4e..e2d3b2bc 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -147,9 +147,10 @@ module function parse_size(parser) result(size) type(syntax_node_vector_t) :: size end function parse_size - module subroutine parse_subscripts(parser, expr) + module subroutine parse_subscripts(parser, expr, set_types) class(parser_t) :: parser type(syntax_node_t), intent(inout) :: expr + logical, intent(in), optional :: set_types end subroutine parse_subscripts end interface diff --git a/src/parse_array.f90 b/src/parse_array.f90 index 1524b1f9..f2b5a8b9 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -125,6 +125,7 @@ module function parse_array_expr(parser) result(expr) expr%kind = array_expr expr%val%type = array_type + expr%val%struct_name = lbound_%val%struct_name expr%val%array%type = lbound_%val%type expr%val%array%kind = unif_array @@ -429,16 +430,21 @@ end function parse_array_expr !=============================================================================== -module subroutine parse_subscripts(parser, expr) +module subroutine parse_subscripts(parser, expr, set_types) ! Parse array subscripts, if present + ! + ! TODO: get rid of set_types now that it's never present class(parser_t) :: parser type(syntax_node_t), intent(inout) :: expr + logical, intent(in), optional :: set_types + logical :: set_typesl + !******** - integer :: pos0, span0 + integer :: pos0, span0, span1, expect_rank type(syntax_node_t) :: lsubscript, usubscript type(syntax_node_vector_t) :: lsubscripts_vec, usubscripts_vec @@ -447,12 +453,10 @@ module subroutine parse_subscripts(parser, expr) type(text_span_t) :: span - if (parser%current_kind() /= lbracket_token) then + if (parser%current_kind() /= lbracket_token) return - !allocate( expr%lsubscripts(0)) - return - - end if + set_typesl = .true. + if (present(set_types)) set_typesl = set_types !print *, 'parsing subscripts' @@ -524,6 +528,58 @@ module subroutine parse_subscripts(parser, expr) call syntax_nodes_copy(expr%usubscripts, & usubscripts_vec%v( 1: usubscripts_vec%len_ )) + ! Do some type juggling which the caller used to do + if (.not. set_typesl) return + + ! TODO: can any of this coda be moved inside of parse_subscripts()? Are + ! there differences between lval and rval subscripts? + span1 = parser%current_pos() - 1 + if (.not. allocated(expr%lsubscripts)) then + ! do nothing + else if (expr%val%type == array_type) then + + !print *, 'sub kind = ', kind_name(expr%lsubscripts(1)%sub_kind) + + if (all(expr%lsubscripts%sub_kind == scalar_sub)) then + ! this is not necessarily true for strings + expr%val%type = expr%val%array%type + expr%val%struct_name = expr%val%struct_name + end if + + ! TODO: allow rank+1 for str arrays + if (expr%val%array%rank /= size(expr%lsubscripts)) then + span = new_span(span0, span1 - span0 + 1) + call parser%diagnostics%push( & + err_bad_sub_count(parser%context(), span, & + expr%identifier%text, & + expr%val%array%rank, size(expr%lsubscripts))) + end if + + ! A slice operation can change the result rank + + !print *, 'rank in = ', expr%val%array%rank + expr%val%array%rank = count(expr%lsubscripts%sub_kind /= scalar_sub) + !print *, 'rank out = ', expr%val%array%rank + + else if (expr%val%type == str_type) then + !print *, 'string type' + + expect_rank = 1 + if (size(expr%lsubscripts) /= expect_rank) then + span = new_span(span0, span1 - span0 + 1) + call parser%diagnostics%push( & + err_bad_sub_count(parser%context(), span, & + expr%identifier%text, & + expect_rank, size(expr%lsubscripts))) + end if + else + span = new_span(span0, span1 - span0 + 1) + print *, "err_scalar_subscript 1" + call parser%diagnostics%push( & + err_scalar_subscript(parser%context(), & + span, expr%identifier%text)) + end if + end subroutine parse_subscripts !=============================================================================== diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index b1b6a055..24cfecb2 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -61,7 +61,7 @@ recursive module function parse_expr_statement(parser) result(expr) let = parser%next() identifier = parser%next() - !print *, 'let ident = ', identifier%text + print *, 'let ident = ', identifier%text op = parser%next() @@ -76,6 +76,11 @@ recursive module function parse_expr_statement(parser) result(expr) expr = new_declaration_expr(identifier, op, right) + print *, "right type = ", kind_name(right%val%type) + print *, "expr type = ", kind_name(expr %val%type) + print *, "right struct = ", right%val%struct_name + print *, "expr struct = ", expr %val%struct_name + ! Increment the variable array index and save it in the expr node. ! TODO: make this a push_var fn? parse_for_statement uses it too parser%num_vars = parser%num_vars + 1 @@ -116,6 +121,15 @@ recursive module function parse_expr_statement(parser) result(expr) identifier = parser%match(identifier_token) + ! TODO: DRY + call parser%vars%search(identifier%text, expr%id_index, io, expr%val) + !if (io /= exit_success) then + ! span = new_span(identifier%pos, len(identifier%text)) + ! call parser%diagnostics%push( & + ! err_undeclare_var(parser%context(), & + ! span, identifier%text)) + !end if + !print *, "ident = ", identifier%text ! Parse array subscript indices if present @@ -123,6 +137,7 @@ recursive module function parse_expr_statement(parser) result(expr) ! Subscript can appear in assignment expr but not let expr, because let ! must initialize the whole array. Similarly for dot member access span0 = parser%current_pos() + !call parser%parse_subscripts(expr, set_types = .false.) call parser%parse_subscripts(expr) span1 = parser%current_pos() - 1 @@ -132,7 +147,12 @@ recursive module function parse_expr_statement(parser) result(expr) ! Lookup the struct now because parse_dot() needs its data call parser%vars%search(identifier%text, expr%id_index, io, expr%val) - ! TODO: check io as in other search call below + if (io /= exit_success) then + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push( & + err_undeclare_var(parser%context(), & + span, identifier%text)) + end if call parser%parse_dot(expr) if (.not. allocated(expr%member)) return @@ -185,6 +205,10 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'allocated(expr%val%array) = ', allocated(expr%val%array) + ! TODO: can this be deleted now that it's copied inside of + ! parse_subscripts()? Maybe I'll need a separate set type fn if it's + ! important, so it can be called separately here instead of at the same + ! time as parse_subscripts() if (allocated(expr%lsubscripts)) then if (expr%val%type == str_type) then @@ -531,7 +555,7 @@ module function parse_name_expr(parser) result(expr) !******** - integer :: io, id_index, span0, span1, expect_rank + integer :: io, id_index, span0, span1 type(syntax_token_t) :: identifier type(text_span_t) :: span @@ -566,54 +590,6 @@ module function parse_name_expr(parser) result(expr) span0 = parser%current_pos() call parser%parse_subscripts(expr) - ! TODO: can any of this coda be moved inside of parse_subscripts()? Are - ! there differences between lval and rval subscripts? - span1 = parser%current_pos() - 1 - if (.not. allocated(expr%lsubscripts)) then - ! do nothing - else if (expr%val%type == array_type) then - - !print *, 'sub kind = ', kind_name(expr%lsubscripts(1)%sub_kind) - - if (all(expr%lsubscripts%sub_kind == scalar_sub)) then - ! this is not necessarily true for strings - expr%val%type = expr%val%array%type - end if - - ! TODO: allow rank+1 for str arrays - if (expr%val%array%rank /= size(expr%lsubscripts)) then - span = new_span(span0, span1 - span0 + 1) - call parser%diagnostics%push( & - err_bad_sub_count(parser%context(), span, & - identifier%text, & - expr%val%array%rank, size(expr%lsubscripts))) - end if - - ! A slice operation can change the result rank - - !print *, 'rank in = ', expr%val%array%rank - expr%val%array%rank = count(expr%lsubscripts%sub_kind /= scalar_sub) - !print *, 'rank out = ', expr%val%array%rank - - else if (expr%val%type == str_type) then - !print *, 'string type' - - expect_rank = 1 - if (size(expr%lsubscripts) /= expect_rank) then - span = new_span(span0, span1 - span0 + 1) - call parser%diagnostics%push( & - err_bad_sub_count(parser%context(), span, & - identifier%text, & - expect_rank, size(expr%lsubscripts))) - end if - else - span = new_span(span0, span1 - span0 + 1) - print *, "err_scalar_subscript 1" - call parser%diagnostics%push( & - err_scalar_subscript(parser%context(), & - span, identifier%text)) - end if - !print *, "expr%val%type = ", kind_name(expr%val%type) !print *, "tail parse_dot" @@ -691,7 +667,17 @@ recursive module subroutine parse_dot(parser, expr) ! I think this is the right place to parse subscripts. Or should it be after ! the recursive parse_dot()? + !call parser%parse_subscripts(expr%member, set_types = .false.) + expr%member%val = member call parser%parse_subscripts(expr%member) + if (allocated(expr%member%lsubscripts)) then + expr%val = expr%member%val ! important + + ! TODO: these don't seem to do anything important + expr%val%type = expr%member%val%type + expr%val%struct_name = expr%member%val%struct_name + + end if ! I think this needs a recursive call to `parse_dot()` right here to handle ! things like `a.b.c` From 55bbade7b36c4d456c5a34c98f75792c4782371f Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 20:20:46 -0400 Subject: [PATCH 075/137] cleanup logging --- src/parse_array.f90 | 2 +- src/parse_expr.f90 | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parse_array.f90 b/src/parse_array.f90 index f2b5a8b9..5a2f7606 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -574,7 +574,7 @@ module subroutine parse_subscripts(parser, expr, set_types) end if else span = new_span(span0, span1 - span0 + 1) - print *, "err_scalar_subscript 1" + !print *, "err_scalar_subscript 1" call parser%diagnostics%push( & err_scalar_subscript(parser%context(), & span, expr%identifier%text)) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 24cfecb2..214f8044 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -61,7 +61,7 @@ recursive module function parse_expr_statement(parser) result(expr) let = parser%next() identifier = parser%next() - print *, 'let ident = ', identifier%text + !print *, 'let ident = ', identifier%text op = parser%next() @@ -76,10 +76,10 @@ recursive module function parse_expr_statement(parser) result(expr) expr = new_declaration_expr(identifier, op, right) - print *, "right type = ", kind_name(right%val%type) - print *, "expr type = ", kind_name(expr %val%type) - print *, "right struct = ", right%val%struct_name - print *, "expr struct = ", expr %val%struct_name + !print *, "right type = ", kind_name(right%val%type) + !print *, "expr type = ", kind_name(expr %val%type) + !print *, "right struct = ", right%val%struct_name + !print *, "expr struct = ", expr %val%struct_name ! Increment the variable array index and save it in the expr node. ! TODO: make this a push_var fn? parse_for_statement uses it too @@ -216,7 +216,7 @@ recursive module function parse_expr_statement(parser) result(expr) ! TODO: check rank == 1 else if (expr%val%type /= array_type) then span = new_span(span0, span1 - span0 + 1) - print *, "err_scalar_subscript 2" + !print *, "err_scalar_subscript 2" call parser%diagnostics%push( & err_scalar_subscript(parser%context(), & span, identifier%text)) From 37c05d9cfe08b60b28c52bffe9ac7285c6f49277 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 31 Aug 2024 23:02:55 -0400 Subject: [PATCH 076/137] add tests; refactor --- src/eval.f90 | 9 +---- src/parse.f90 | 3 +- src/parse_array.f90 | 19 ++-------- src/parse_expr.f90 | 90 +++++++++------------------------------------ src/tests/test.f90 | 14 +++++++ 5 files changed, 37 insertions(+), 98 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 65fb841b..5d8f305f 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -1637,18 +1637,11 @@ subroutine eval_array_expr(node, state, res) res%array%str = lbound_%sca%str case (struct_type) - !res%array%str = lbound_%sca%str - !res%struct(:) = lbound_ - !res%struct(:)%struct = lbound_ - print *, "lbound_ size = ", size(lbound_%struct) + !print *, "lbound_ size = ", size(lbound_%struct) - !res%struct(:)%struct = lbound_%struct do i8 = 1, res%array%len_ - !allocate(res%struct(i8)%struct) - !res%struct(i8)%struct = lbound_ res%struct(i8)%struct = lbound_%struct - !res%struct(i8)%struct_name = lbound_%struct_name end do ! Arrays are homogeneous, so every element shares one struct_name diff --git a/src/parse.f90 b/src/parse.f90 index e2d3b2bc..5b23ad4e 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -147,10 +147,9 @@ module function parse_size(parser) result(size) type(syntax_node_vector_t) :: size end function parse_size - module subroutine parse_subscripts(parser, expr, set_types) + module subroutine parse_subscripts(parser, expr) class(parser_t) :: parser type(syntax_node_t), intent(inout) :: expr - logical, intent(in), optional :: set_types end subroutine parse_subscripts end interface diff --git a/src/parse_array.f90 b/src/parse_array.f90 index 5a2f7606..65ea07b8 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -430,18 +430,13 @@ end function parse_array_expr !=============================================================================== -module subroutine parse_subscripts(parser, expr, set_types) +module subroutine parse_subscripts(parser, expr) ! Parse array subscripts, if present - ! - ! TODO: get rid of set_types now that it's never present class(parser_t) :: parser type(syntax_node_t), intent(inout) :: expr - logical, intent(in), optional :: set_types - logical :: set_typesl - !******** integer :: pos0, span0, span1, expect_rank @@ -455,9 +450,6 @@ module subroutine parse_subscripts(parser, expr, set_types) if (parser%current_kind() /= lbracket_token) return - set_typesl = .true. - if (present(set_types)) set_typesl = set_types - !print *, 'parsing subscripts' lsubscripts_vec = new_syntax_node_vector() ! lower-bounds @@ -529,21 +521,15 @@ module subroutine parse_subscripts(parser, expr, set_types) usubscripts_vec%v( 1: usubscripts_vec%len_ )) ! Do some type juggling which the caller used to do - if (.not. set_typesl) return - ! TODO: can any of this coda be moved inside of parse_subscripts()? Are - ! there differences between lval and rval subscripts? span1 = parser%current_pos() - 1 - if (.not. allocated(expr%lsubscripts)) then - ! do nothing - else if (expr%val%type == array_type) then + if (expr%val%type == array_type) then !print *, 'sub kind = ', kind_name(expr%lsubscripts(1)%sub_kind) if (all(expr%lsubscripts%sub_kind == scalar_sub)) then ! this is not necessarily true for strings expr%val%type = expr%val%array%type - expr%val%struct_name = expr%val%struct_name end if ! TODO: allow rank+1 for str arrays @@ -572,6 +558,7 @@ module subroutine parse_subscripts(parser, expr, set_types) expr%identifier%text, & expect_rank, size(expr%lsubscripts))) end if + else span = new_span(span0, span1 - span0 + 1) !print *, "err_scalar_subscript 1" diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 214f8044..f64069f4 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -23,15 +23,15 @@ recursive module function parse_expr_statement(parser) result(expr) !******** - integer :: io, ltype, rtype, pos0, span0, span1, lrank, rrank, larrtype, & - rarrtype, id_index + integer :: io, ltype, rtype, pos0, lrank, rrank, larrtype, & + rarrtype, id_index, search_io type(syntax_node_t) :: right, member type(syntax_token_t) :: let, identifier, op type(text_span_t) :: span - type(value_t) :: var + type(value_t) :: var, val_sub !print *, 'starting parse_expr_statement()' @@ -121,14 +121,10 @@ recursive module function parse_expr_statement(parser) result(expr) identifier = parser%match(identifier_token) - ! TODO: DRY - call parser%vars%search(identifier%text, expr%id_index, io, expr%val) - !if (io /= exit_success) then - ! span = new_span(identifier%pos, len(identifier%text)) - ! call parser%diagnostics%push( & - ! err_undeclare_var(parser%context(), & - ! span, identifier%text)) - !end if + ! this makes `identifier` a redundant copy, although a convenient + ! shorthand. we need expr%identifier for error handling inside + ! parse_subscripts() + expr%identifier = identifier; !print *, "ident = ", identifier%text @@ -136,18 +132,16 @@ recursive module function parse_expr_statement(parser) result(expr) ! Subscript can appear in assignment expr but not let expr, because let ! must initialize the whole array. Similarly for dot member access - span0 = parser%current_pos() - !call parser%parse_subscripts(expr, set_types = .false.) - call parser%parse_subscripts(expr) - span1 = parser%current_pos() - 1 + ! Delay the error-handling on search_io because we might end up rewinding + call parser%vars%search(identifier%text, expr%id_index, search_io, expr%val) + call parser%parse_subscripts(expr) + val_sub = expr%val ! backup for later if (parser%peek_kind(0) == dot_token) then !print *, "dot token" - ! Lookup the struct now because parse_dot() needs its data - call parser%vars%search(identifier%text, expr%id_index, io, expr%val) - if (io /= exit_success) then + if (search_io /= exit_success) then span = new_span(identifier%pos, len(identifier%text)) call parser%diagnostics%push( & err_undeclare_var(parser%context(), & @@ -192,8 +186,8 @@ recursive module function parse_expr_statement(parser) result(expr) ! has been declared, unless it is a struct which has already been looked ! up above if (.not. allocated(expr%member)) then - call parser%vars%search(identifier%text, expr%id_index, io, expr%val) - if (io /= exit_success) then + !call parser%vars%search(identifier%text, expr%id_index, io, expr%val) + if (search_io /= exit_success) then span = new_span(identifier%pos, len(identifier%text)) call parser%diagnostics%push( & err_undeclare_var(parser%context(), & @@ -205,50 +199,8 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'allocated(expr%val%array) = ', allocated(expr%val%array) - ! TODO: can this be deleted now that it's copied inside of - ! parse_subscripts()? Maybe I'll need a separate set type fn if it's - ! important, so it can be called separately here instead of at the same - ! time as parse_subscripts() if (allocated(expr%lsubscripts)) then - - if (expr%val%type == str_type) then - !print *, 'str type' - ! TODO: check rank == 1 - else if (expr%val%type /= array_type) then - span = new_span(span0, span1 - span0 + 1) - !print *, "err_scalar_subscript 2" - call parser%diagnostics%push( & - err_scalar_subscript(parser%context(), & - span, identifier%text)) - return - - end if - - !print *, 'type = ', expr%val%type - - if (expr%val%type /= str_type) then - - if (all(expr%lsubscripts%sub_kind == scalar_sub)) then - ! this is not necessarily true for strings - expr%val%type = expr%val%array%type - end if - - !print *, 'rank = ', expr%val%array%rank - !print *, 'subs = ', size(expr%lsubscripts) - - if (expr%val%array%rank /= size(expr%lsubscripts)) then - span = new_span(span0, span1 - span0 + 1) - call parser%diagnostics%push( & - err_bad_sub_count(parser%context(), span, identifier%text, & - expr%val%array%rank, size(expr%lsubscripts))) - end if - - !print *, 'rank in = ', expr%val%array%rank - expr%val%array%rank = count(expr%lsubscripts%sub_kind /= scalar_sub) - !print *, 'rank out = ', expr%val%array%rank - - end if - + expr%val = val_sub end if ltype = expr%val%type @@ -667,17 +619,11 @@ recursive module subroutine parse_dot(parser, expr) ! I think this is the right place to parse subscripts. Or should it be after ! the recursive parse_dot()? - !call parser%parse_subscripts(expr%member, set_types = .false.) expr%member%val = member call parser%parse_subscripts(expr%member) - if (allocated(expr%member%lsubscripts)) then - expr%val = expr%member%val ! important - - ! TODO: these don't seem to do anything important - expr%val%type = expr%member%val%type - expr%val%struct_name = expr%member%val%struct_name - - end if + !if (allocated(expr%member%lsubscripts)) then + ! expr%val = expr%member%val + !end if ! I think this needs a recursive call to `parse_dot()` right here to handle ! things like `a.b.c` diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 7b9f6356..27562501 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2809,6 +2809,20 @@ subroutine unit_test_struct_arr(npass, nfail) //'let l1 = L{s=v1, e=v2};' & //'return l1.e.name;' & , quiet) == 'myvec2', & + eval('' & ! 9 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let ps = [p1; 2];' & + //'let po = ps[0];' & + //'return po.x;' & + , quiet) == '6', & + eval('' & ! 10 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let ps = [p1; 2];' & + //'let po = ps[1];' & + //'return po.y;' & + , quiet) == '13', & .false. & ! so I don't have to bother w/ trailing commas ] From 33352cb18e9177263349869411e0b3a3a9cc72e8 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 10:16:23 -0400 Subject: [PATCH 077/137] add dotted subscript exprs like `a[0].b` --- src/eval.f90 | 23 +++++++++++++++++++++-- src/tests/test.f90 | 14 +++++++++++++- 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 5d8f305f..dd8b746f 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -452,6 +452,8 @@ recursive function get_val(node, var, state) result(res) ! TODO: should res be an out arg for consistency? Similar question for ! get_array_value_t() + ! + ! Should I rename this eval_*() for consistency? ! In nested expressions, like `a.b.c.d`, var begins as the top-most ! (left-most, outer-most) value `a` @@ -469,14 +471,31 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts)) then - ! TODO: throw error for anything but scalar_sub + ! TODO: throw error for anything but scalar_sub for now !print *, "rval scalar sub" !print *, "lsubscripts allocated" i8 = subscript_eval(node, state) !print *, 'i8 = ', i8 - ! TODO: recurse somehow + !! this indicates recursion may be needed + !print *, "allocated(member) = ", allocated(node%member) + + if (allocated(node%member)) then + + id = node%member%id_index + + ! TODO: recursion could still be required. Unfortunately, if an + ! identifier has a subscript *and* a dot, then so does its node. I + ! think this might require a bunch of if() logic like this instead + ! of any possibility of clean recursion + + !res = get_val(node%member, var%struct(i8+1), state) + !res = var%struct(id) + res = var%struct(i8+1)%struct(id) + + return + end if !res = get_val(node%member, var%struct(i8+1), state) !res = get_val(node, var%struct(i8), state) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 27562501..47784339 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2819,10 +2819,22 @@ subroutine unit_test_struct_arr(npass, nfail) eval('' & ! 10 //'struct P{x:i32, y:i32,}' & ! point //'let p1 = P{x=6, y=13,};' & - //'let ps = [p1; 2];' & + //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 //'let po = ps[1];' & //'return po.y;' & , quiet) == '13', & + eval('' & ! 10 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 + //'return ps[0].x;' & + , quiet) == '6', & + eval('' & ! 10 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 + //'return ps[1].y;' & + , quiet) == '13', & .false. & ! so I don't have to bother w/ trailing commas ] From aae15685782bf1b64d6b7c265a518663680e35e6 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 11:00:30 -0400 Subject: [PATCH 078/137] explicit arrays of structs --- src/core.f90 | 6 ++-- src/eval.f90 | 69 +++++++++++++++++++++++++-------------------- src/parse_array.f90 | 9 ++++-- src/tests/test.f90 | 23 +++++++++++++++ 4 files changed, 72 insertions(+), 35 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 2d2c67d1..d1bb3186 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -33,11 +33,11 @@ module syntran__core_m ! + struct fn return values ! + nested structs ! * tbd: - ! + structs of arrays + ! + structs of arrays (and arrays of structs) ! * wip - ! * lhs subs tbd + ! * lhs subs tbd. want to finish rhs recursion first, then lhs will + ! be a very similar structure but with setters instead of getters ! * rhs subs done - ! + arrays of structs ! + unary ops on dot exprs ! + tests ! > moar diff --git a/src/eval.f90 b/src/eval.f90 index dd8b746f..3906e447 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -497,14 +497,10 @@ recursive function get_val(node, var, state) result(res) return end if - !res = get_val(node%member, var%struct(i8+1), state) - !res = get_val(node, var%struct(i8), state) - !res = var%struct(i8)%struct res = var%struct(i8+1) res%type = struct_type res%struct_name = var%struct_name - !res%struct_name = var%struct(i8+1)%struct_name return @@ -527,9 +523,6 @@ recursive function get_val(node, var, state) result(res) res = var%struct(id) return end if - - ! TODO: is this ordered correctly in the - ! recursion wrt parsing? !print *, "lsubscripts allocated" if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then @@ -539,21 +532,11 @@ recursive function get_val(node, var, state) result(res) write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset call internal_error() end if - !print *, "scalar_sub" - !! beware this print only works for literals. in general we need to - !! eval via sub_eval() - !print *, "lsub 1 = ", node%member%lsubscripts(1)%val%to_str() - - ! TODO: i don't think this works for subs nested in between multiple - ! dot exprs. Still need to recurse - i8 = sub_eval(node%member, var%struct(id), state) res = get_array_value_t(var%struct(id)%array, i8) - !return - end function get_val !=============================================================================== @@ -1777,23 +1760,50 @@ subroutine eval_array_expr(node, state, res) ! TODO: allow empty arrays? Sub type of empty array? Empty arrays ! can currently be created like [0: -1]; - array = new_array(node%val%array%type, size(node%elems)) + + allocate(res%array) + res%array%type = node%val%array%type + !array = new_array(node%val%array%type, size(node%elems)) + !call allocate_array(res, res%array%len_) + call allocate_array(res, size(node%elems, kind = 8)) + + ! TODO: dry + res%array%len_ = 0 + !res%array%cap + !res%array%type = do i = 1, size(node%elems) call syntax_eval(node%elems(i), state, elem) !print *, 'elem['//str(i)//'] = ', elem%str() - call array%push(elem) + + if (res%array%type == struct_type) then + res%struct(i) = elem + else + call res%array%push(elem) + end if + end do - array%rank = 1 - allocate(array%size( array%rank )) - array%size = array%len_ + if (res%array%type == struct_type) then + res%array%len_ = size(node%elems) + end if + + res%array%rank = 1 + allocate(res%array%size( res%array%rank )) + res%array%size = res%array%len_ - !print *, 'copying array' - allocate(res%array) res%type = array_type - res%array = array - !print *, 'done' + + !res%struct_name = lbound_%struct_name + !res%struct_name = node%elems(1)%struct_name + res%struct_name = node%val%struct_name + + !print *, "struct_name = ", res%struct_name + + !!print *, 'copying array' + !allocate(res%array) + !res%array = array + !!print *, 'done' else write(*,*) err_int_prefix//'unexpected array kind'//color_reset @@ -1985,13 +1995,15 @@ end subroutine promote_i32_i64 !=============================================================================== -!subroutine allocate_array(array, cap) subroutine allocate_array(val, cap) !type(array_t), intent(inout) :: array type(value_t), intent(inout) :: val integer(kind = 8), intent(in) :: cap + !! always done in caller + !if (.not. allocated(val%array)) allocate(val%array) + val%array%cap = cap select case (val%array%type) @@ -2011,10 +2023,7 @@ subroutine allocate_array(val, cap) allocate(val%array%str( cap )) case (struct_type) - !allocate(val%array%struct( cap )) - !print *, "val%array of structs" allocate(val%struct( cap )) - !call internal_error() case default write(*,*) err_int_prefix//'cannot allocate array of type `' & diff --git a/src/parse_array.f90 b/src/parse_array.f90 index 65ea07b8..cdf61b1c 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -124,7 +124,7 @@ module function parse_array_expr(parser) result(expr) expr%kind = array_expr - expr%val%type = array_type + expr%val%type = array_type expr%val%struct_name = lbound_%val%struct_name expr%val%array%type = lbound_%val%type @@ -410,9 +410,14 @@ module function parse_array_expr(parser) result(expr) expr%kind = array_expr !expr%val%type = lbound_%val%type - expr%val%type = array_type + expr%val%type = array_type + expr%val%struct_name = lbound_%val%struct_name + + !print *, "expr struct_name = ", expr%val%struct_name expr%val%array%type = lbound_%val%type + expr%val%array%type = lbound_%val%type + expr%val%array%kind = expl_array expr%val%array%rank = 1 expr%val%array%len_ = elems%len_ diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 47784339..cc20041e 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2729,6 +2729,9 @@ subroutine unit_test_struct(npass, nfail) //'y1.p.z -= y1.ba.tr.x;' & //'return y1.p.z;' & , quiet) == '-4', & + eval( 'struct P{x:i32, y:i32,}' & ! 47 + //'let p1 = P{x=6, y=13};' & ! might be premature to test struct to str conversion + //'p1;', quiet) == 'P{6, 13}', & .false. & ! so I don't have to bother w/ trailing commas ] @@ -2835,6 +2838,26 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 //'return ps[1].y;' & , quiet) == '13', & + eval('' & ! 11 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 + //'return ps[0];' & ! might be premature to test struct to str conversion + , quiet) == 'P{6, 13}', & + eval('' & ! 12 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let p2 = P{x=4, y=15,};' & + //'let ps = [p1, p2];' & + //'return ps[0].x;' & + , quiet) == '6', & + eval('' & ! 12 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let p2 = P{x=4, y=15,};' & + //'let ps = [p1, p2];' & + //'return ps[1].y;' & + , quiet) == '15', & .false. & ! so I don't have to bother w/ trailing commas ] From 653acc36cc1720634e4af80eeb5e1995856c4827 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 11:12:08 -0400 Subject: [PATCH 079/137] cleanup struct str conversion --- src/parse_fn.f90 | 5 +++++ src/value.f90 | 35 +++++++++++++++-------------------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 49ca26e0..f9e58b0f 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -918,6 +918,11 @@ module function parse_struct_instance(parser) result(inst) pos0 = parser%pos + ! TODO: allow "anonymous" members where the name (and type) is implied + ! by the order? This is the way that structs are printed, so unless I + ! change print str conversion is might be nice to allow print output to + ! be pasted back into syntran source code. Could be dangerous tho + name = parser%match(identifier_token) equals = parser%match(equals_token) mem = parser%parse_expr() diff --git a/src/value.f90 b/src/value.f90 index f2a9f955..c4fb736f 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -505,10 +505,6 @@ recursive function value_to_str(val) result(ans) call str_vec%push( trimw(val%struct(i8)%to_str()) ) - !do j8 = 1, size(val%struct(i8)%struct) - ! call str_vec%push( trimw(val%struct(i8)%struct(j8)%to_str()) ) - !end do - if (i8 < n) call str_vec%push(", ") end do @@ -539,6 +535,10 @@ recursive function value_to_str(val) result(ans) ! strings str_vec = new_char_vector() + !if (val%array%type == struct_type) then + ! call str_vec%push(val%struct_name) + !end if + call str_vec%push('[') if (val%array%rank > 1) call str_vec%push(line_feed) @@ -651,29 +651,24 @@ recursive function value_to_str(val) result(ans) end do else if (val%array%type == struct_type) then - - call str_vec%push("array<"//val%struct_name//"> ") n = size(val%struct) do i8 = 1, n - !! TODO: can we just recurse instead of nesting a loop? - !call str_vec%push( val%struct(i8)%to_str() ) + ! Just recurse instead of nesting a loop + call str_vec%push( val%struct(i8)%to_str() ) ! It would be nice to label each member with its name - !call str_vec%push( val%struct(i8)%struct_name//" = " ) - - !call str_vec%push( trimw(val%struct(i8)%to_str()) ) - - call str_vec%push("{") - nj = size(val%struct(i8)%struct) - do j8 = 1, nj - call str_vec%push( trimw(val%struct(i8)%struct(j8)%to_str()) ) - if (j8 < nj) call str_vec%push(", ") - end do - - if (i8 < n) call str_vec%push("}, ") + !call str_vec%push("{") + !nj = size(val%struct(i8)%struct) + !do j8 = 1, nj + ! call str_vec%push( trimw(val%struct(i8)%struct(j8)%to_str()) ) + ! if (j8 < nj) call str_vec%push(", ") + !end do + !if (i8 < n) call str_vec%push("}, ") + + if (i8 < n) call str_vec%push(", ") end do call str_vec%push("}") From f1a53026e308bc51368230538c0c0ce746f619a1 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 11:24:48 -0400 Subject: [PATCH 080/137] unify get_val() and get_array_value_t(). move tests --- src/eval.f90 | 31 +++++++++++++---------- src/tests/test.f90 | 62 +++++++++++++++++++++++++++++++++++++++------- src/value.f90 | 3 +-- 3 files changed, 72 insertions(+), 24 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 3906e447..07c4b4eb 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -316,18 +316,18 @@ subroutine eval_name_expr(node, state, res) type = state%vars%vals(node%id_index)%array%type !print *, "type = ", kind_name(type) - if (type == struct_type) then + !if (type == struct_type) then res = get_val(node, state%vars%vals(node%id_index), state) - else + !else - ! This could probably be lumped in with the range_sub case now - ! that I have it fully generalized - ! - ! TODO: try to unify with get_val() branch above - i8 = subscript_eval(node, state) - res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + ! ! This could probably be lumped in with the range_sub case now + ! ! that I have it fully generalized + ! ! + ! ! TODO: try to unify with get_val() branch above + ! i8 = subscript_eval(node, state) + ! res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) - end if + !end if else @@ -497,10 +497,15 @@ recursive function get_val(node, var, state) result(res) return end if - res = var%struct(i8+1) - - res%type = struct_type - res%struct_name = var%struct_name + !if (type == struct_type) then + if (var%array%type == struct_type) then + res = var%struct(i8+1) + res%type = struct_type + res%struct_name = var%struct_name + else + !res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + res = get_array_value_t(var%array, i8) + end if return diff --git a/src/tests/test.f90 b/src/tests/test.f90 index cc20041e..5e7daef8 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2729,9 +2729,6 @@ subroutine unit_test_struct(npass, nfail) //'y1.p.z -= y1.ba.tr.x;' & //'return y1.p.z;' & , quiet) == '-4', & - eval( 'struct P{x:i32, y:i32,}' & ! 47 - //'let p1 = P{x=6, y=13};' & ! might be premature to test struct to str conversion - //'p1;', quiet) == 'P{6, 13}', & .false. & ! so I don't have to bother w/ trailing commas ] @@ -2838,12 +2835,6 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 //'return ps[1].y;' & , quiet) == '13', & - eval('' & ! 11 - //'struct P{x:i32, y:i32,}' & ! point - //'let p1 = P{x=6, y=13,};' & - //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 - //'return ps[0];' & ! might be premature to test struct to str conversion - , quiet) == 'P{6, 13}', & eval('' & ! 12 //'struct P{x:i32, y:i32,}' & ! point //'let p1 = P{x=6, y=13,};' & @@ -2871,6 +2862,58 @@ end subroutine unit_test_struct_arr !=============================================================================== +subroutine unit_test_struct_str(npass, nfail) + + implicit none + + integer, intent(inout) :: npass, nfail + + !******** + + character(len = *), parameter :: label = 'struct str formatting' + + logical, parameter :: quiet = .true. + logical, allocatable :: tests(:) + + write(*,*) 'Unit testing '//label//' ...' + + ! This is a separate test from other struct stuff because struct to string + ! conversion is subject to change, especially if I figure out how to label + ! each member with its name + ! + ! TODO: update documentation to reflect any changes here + + tests = & + [ & + eval( 'struct P{x:i32, y:i32,}' & ! 1 + //'let p1 = P{x=6, y=13};' & + //'p1;', quiet) == 'P{6, 13}', & + eval('' & ! 2 + //'struct P{x:i32, y:i32,}' & ! point + //'let p1 = P{x=6, y=13,};' & + //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 + //'return ps[0];' & + , quiet) == 'P{6, 13}', & + eval('' & ! 3 + //'struct P{x:i32, y:i32,}' & + //'let p1 = P{x=6, y=13,};' & + //'let p2 = P{x=4, y=15,};' & + //'let ps = [p1, p2];' & + //'return ps;' & + , quiet) == '[P{6, 13}, P{4, 15}]', & + .false. & ! so I don't have to bother w/ trailing commas + ] + + ! Trim dummy false element + tests = tests(1: size(tests) - 1) + !print *, "number of "//label//" tests = ", size(tests) + + call unit_test_coda(tests, label, npass, nfail) + +end subroutine unit_test_struct_str + +!=============================================================================== + subroutine unit_test_array_bool(npass, nfail) ! More advanced tests on longer scripts @@ -3091,6 +3134,7 @@ subroutine unit_tests(iostat) call unit_test_return (npass, nfail) call unit_test_struct (npass, nfail) call unit_test_struct_arr (npass, nfail) + call unit_test_struct_str (npass, nfail) ! TODO: add tests that mock interpreting one line at a time (as opposed to ! whole files) diff --git a/src/value.f90 b/src/value.f90 index c4fb736f..4fb82101 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -671,8 +671,7 @@ recursive function value_to_str(val) result(ans) if (i8 < n) call str_vec%push(", ") end do - call str_vec%push("}") - !ans = str_vec%trim() + !call str_vec%push("}") else From 01241828e97869dda90a99eb30a46f1c5354156f Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 11:27:11 -0400 Subject: [PATCH 081/137] rename get_array_value_t -> get_array_val, also setter --- src/eval.f90 | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 07c4b4eb..5eab1bfc 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -325,7 +325,7 @@ subroutine eval_name_expr(node, state, res) ! ! ! ! TODO: try to unify with get_val() branch above ! i8 = subscript_eval(node, state) - ! res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + ! res = get_array_val(state%vars%vals(node%id_index)%array, i8) !end if @@ -372,8 +372,8 @@ subroutine eval_name_expr(node, state, res) !print *, 'subs = ', int(subs, 4) index_ = subscript_i32_eval(subs, state%vars%vals(node%id_index)%array) - call set_array_value_t(res%array, i8, & - get_array_value_t(state%vars%vals(node%id_index)%array, index_)) + call set_array_val(res%array, i8, & + get_array_val(state%vars%vals(node%id_index)%array, index_)) call get_next_subscript(lsubs, usubs, subs) end do @@ -451,7 +451,7 @@ end subroutine set_val recursive function get_val(node, var, state) result(res) ! TODO: should res be an out arg for consistency? Similar question for - ! get_array_value_t() + ! get_array_val() ! ! Should I rename this eval_*() for consistency? @@ -503,8 +503,8 @@ recursive function get_val(node, var, state) result(res) res%type = struct_type res%struct_name = var%struct_name else - !res = get_array_value_t(state%vars%vals(node%id_index)%array, i8) - res = get_array_value_t(var%array, i8) + !res = get_array_val(state%vars%vals(node%id_index)%array, i8) + res = get_array_val(var%array, i8) end if return @@ -540,7 +540,7 @@ recursive function get_val(node, var, state) result(res) !print *, "scalar_sub" i8 = sub_eval(node%member, var%struct(id), state) - res = get_array_value_t(var%struct(id)%array, i8) + res = get_array_val(var%struct(id)%array, i8) end function get_val @@ -1134,7 +1134,7 @@ subroutine eval_for_statement(node, state, res) ! over it. Parser guarantees that this is an array ! ! Unlike step_array, itr%type does not need to be set here because - ! it is set in array_at() (via get_array_value_t()) + ! it is set in array_at() (via get_array_val()) for_kind = array_expr call syntax_eval(node%array, state, tmp) @@ -1206,8 +1206,8 @@ subroutine eval_assignment_expr(node, state, res) if (allocated( node%member )) then !print *, "assign LHS dot member" - ! This is similar to what I do below with get_array_value_t() and - ! set_array_value_t(), but I've renamed some of the variables + ! This is similar to what I do below with get_array_val() and + ! set_array_val(), but I've renamed some of the variables ! Evaluate the RHS call syntax_eval(node%right, state, rhs) @@ -1285,9 +1285,9 @@ subroutine eval_assignment_expr(node, state, res) !print *, 'LHS array = ', state%vars%vals(node%id_index)%array%i32 i8 = subscript_eval(node, state) - array_val = get_array_value_t(state%vars%vals(node%id_index)%array, i8) + array_val = get_array_val(state%vars%vals(node%id_index)%array, i8) call compound_assign(array_val, res, node%op) - call set_array_value_t( & + call set_array_val( & state%vars%vals(node%id_index)%array, i8, array_val) res = array_val @@ -1316,17 +1316,17 @@ subroutine eval_assignment_expr(node, state, res) ! tmp -> lhs_val or something if (res%type == array_type) then - array_val = get_array_value_t(res%array, i8) + array_val = get_array_val(res%array, i8) end if index_ = subscript_i32_eval(subs, state%vars%vals(node%id_index)%array) - tmp = get_array_value_t(state%vars%vals(node%id_index)%array, index_) + tmp = get_array_val(state%vars%vals(node%id_index)%array, index_) call compound_assign(tmp, array_val, node%op) - call set_array_value_t(state%vars%vals(node%id_index)%array, index_, tmp) + call set_array_val(state%vars%vals(node%id_index)%array, index_, tmp) !! move conditions out of loop for perf? !if (res%type == array_type) then - ! call set_array_value_t(res%array, i8, tmp) + ! call set_array_val(res%array, i8, tmp) !else ! ! this makes the res return value a scalar. Maybe @@ -2428,7 +2428,7 @@ subroutine array_at(val, kind_, i, lbound_, step, ubound_, len_, array, & case (array_expr) ! Non-primary array expr - val = get_array_value_t(array, i - 1) + val = get_array_val(array, i - 1) case default write(*,*) err_int_prefix//'for loop not implemented for this array kind'//color_reset @@ -2439,7 +2439,7 @@ end subroutine array_at !=============================================================================== -function get_array_value_t(array, i) result(val) +function get_array_val(array, i) result(val) type(array_t), intent(in) :: array @@ -2447,7 +2447,7 @@ function get_array_value_t(array, i) result(val) type(value_t) :: val - !print *, 'starting get_array_value_t()' + !print *, 'starting get_array_val()' !print *, 'array%type = ', kind_name(array%type) val%type = array%type @@ -2468,15 +2468,15 @@ function get_array_value_t(array, i) result(val) val%sca%str = array%str(i + 1) case default - print *, "bad type in get_array_value_t" + print *, "bad type in get_array_val" end select -end function get_array_value_t +end function get_array_val !=============================================================================== -subroutine set_array_value_t(array, i, val) +subroutine set_array_val(array, i, val) type(array_t), intent(inout) :: array @@ -2484,7 +2484,7 @@ subroutine set_array_value_t(array, i, val) type(value_t), intent(in) :: val - !print *, 'starting set_array_value_t()' + !print *, 'starting set_array_val()' !print *, 'array%type = ', kind_name(array%type) !print *, 'val%type = ', kind_name(val%type) @@ -2507,7 +2507,7 @@ subroutine set_array_value_t(array, i, val) end select -end subroutine set_array_value_t +end subroutine set_array_val !=============================================================================== From 2b333d3e8675848c2875c10f240a3f9a09220a78 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 11:46:49 -0400 Subject: [PATCH 082/137] chained dot exprs for arrays of structs --- src/eval.f90 | 40 ++++++++---------------------------- src/tests/test.f90 | 51 ++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 56 insertions(+), 35 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 5eab1bfc..ec6f6261 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -310,25 +310,7 @@ subroutine eval_name_expr(node, state, res) !print *, 'rank = ', node%val%array%rank if (all(node%lsubscripts%sub_kind == scalar_sub)) then - - !print *, "rval scalar sub" - - type = state%vars%vals(node%id_index)%array%type - !print *, "type = ", kind_name(type) - - !if (type == struct_type) then - res = get_val(node, state%vars%vals(node%id_index), state) - !else - - ! ! This could probably be lumped in with the range_sub case now - ! ! that I have it fully generalized - ! ! - ! ! TODO: try to unify with get_val() branch above - ! i8 = subscript_eval(node, state) - ! res = get_array_val(state%vars%vals(node%id_index)%array, i8) - - !end if - + res = get_val(node, state%vars%vals(node%id_index), state) else call get_subscript_range(node, state, lsubs, usubs, rank_res) @@ -472,38 +454,34 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts)) then ! TODO: throw error for anything but scalar_sub for now - - !print *, "rval scalar sub" - !print *, "lsubscripts allocated" i8 = subscript_eval(node, state) !print *, 'i8 = ', i8 - !! this indicates recursion may be needed - !print *, "allocated(member) = ", allocated(node%member) - if (allocated(node%member)) then id = node%member%id_index - ! TODO: recursion could still be required. Unfortunately, if an + ! Recursion could still be required. Unfortunately, if an ! identifier has a subscript *and* a dot, then so does its node. I ! think this might require a bunch of if() logic like this instead ! of any possibility of clean recursion - !res = get_val(node%member, var%struct(i8+1), state) - !res = var%struct(id) - res = var%struct(i8+1)%struct(id) + if (node%member%kind == dot_expr) then + ! Recurse + res = get_val(node%member, var%struct(i8+1)%struct(id), state) + return + end if + res = var%struct(i8+1)%struct(id) return + end if - !if (type == struct_type) then if (var%array%type == struct_type) then res = var%struct(i8+1) res%type = struct_type res%struct_name = var%struct_name else - !res = get_array_val(state%vars%vals(node%id_index)%array, i8) res = get_array_val(var%array, i8) end if diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 5e7daef8..1acc0171 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2729,6 +2729,18 @@ subroutine unit_test_struct(npass, nfail) //'y1.p.z -= y1.ba.tr.x;' & //'return y1.p.z;' & , quiet) == '-4', & + eval('' & ! 47 + //'struct P{z:i32, x:i32, y:i32}' & ! point with members in weird order + //'struct R{bl: P, tr: P}' & + //'struct Y{ba: R, p: P}' & + //'let p1 = P{x=6, y=13, z=0};' & + //'let p2 = P{x=9, y=17, z=0};' & + //'let p3 = P{x=7, y=15, z=5};' & + //'let r1 = R{bl=p1, tr=p2};' & + //'let y1 = Y{ba=r1, p=p3};' & + //'y1.p.z -= y1.ba.tr.x;' & + //'return y1.p.z;' & + , quiet) == '-4', & .false. & ! so I don't have to bother w/ trailing commas ] @@ -2823,32 +2835,63 @@ subroutine unit_test_struct_arr(npass, nfail) //'let po = ps[1];' & //'return po.y;' & , quiet) == '13', & - eval('' & ! 10 + eval('' & ! 11 //'struct P{x:i32, y:i32,}' & ! point //'let p1 = P{x=6, y=13,};' & //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 //'return ps[0].x;' & , quiet) == '6', & - eval('' & ! 10 + eval('' & ! 12 //'struct P{x:i32, y:i32,}' & ! point //'let p1 = P{x=6, y=13,};' & //'let ps = [p1; 2];' & ! ps is an array of 2 copies of p1 //'return ps[1].y;' & , quiet) == '13', & - eval('' & ! 12 + eval('' & ! 13 //'struct P{x:i32, y:i32,}' & ! point //'let p1 = P{x=6, y=13,};' & //'let p2 = P{x=4, y=15,};' & //'let ps = [p1, p2];' & //'return ps[0].x;' & , quiet) == '6', & - eval('' & ! 12 + eval('' & ! 14 //'struct P{x:i32, y:i32,}' & ! point //'let p1 = P{x=6, y=13,};' & //'let p2 = P{x=4, y=15,};' & //'let ps = [p1, p2];' & //'return ps[1].y;' & , quiet) == '15', & + eval('' & ! 15 + //'struct P{y:i32, x:i32,}' & ! point in weird order + //'let p1 = P{x=6, y=13,};' & + //'let p2 = P{x=4, y=15,};' & + //'let ps = [p1, p2];' & + //'return ps[1].y;' & + , quiet) == '15', & + eval('' & ! 16 + //'struct P{x:i32, y:i32,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{x= 6, y=13,};' & + //'let p2 = P{x= 4, y=15,};' & + //'let p3 = P{x=16, y=18,};' & + //'let p4 = P{x=14, y=20,};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'return ls[0].e.x;' & + , quiet) == '4', & + eval('' & ! 17 + //'struct P{x:i32, y:i32,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{x= 6, y=13,};' & + //'let p2 = P{x= 4, y=15,};' & + //'let p3 = P{x=16, y=18,};' & + //'let p4 = P{x=14, y=20,};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'return ls[1].s.y;' & + , quiet) == '18', & .false. & ! so I don't have to bother w/ trailing commas ] From 2fdf4ade3cc0814592ba28976d8dfa8e84f6ab8f Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 13:14:03 -0400 Subject: [PATCH 083/137] chained dot sub exprs like `a[0].b[0]` --- src/eval.f90 | 24 ++++++++++++++++++++++-- src/tests/test.f90 | 36 ++++++++++++++++++++++++++++++++++++ src/types.f90 | 5 ----- 3 files changed, 58 insertions(+), 7 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index ec6f6261..d59dd985 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -432,6 +432,12 @@ end subroutine set_val recursive function get_val(node, var, state) result(res) + ! TODO: this is a mess because %member and %lsubscripts are children of the + ! same syntax node. If I nest %lsubscripts inside of an %elem child or + ! something, can this be implemented more cleanly with recursion? It will + ! require lots of changes for (non-struct) arrays elsewhere but it could be + ! worth it + ! ! TODO: should res be an out arg for consistency? Similar question for ! get_array_val() ! @@ -449,7 +455,7 @@ recursive function get_val(node, var, state) result(res) !******** integer :: id - integer(kind = 8) :: i8 + integer(kind = 8) :: i8, j8 if (allocated(node%lsubscripts)) then @@ -472,7 +478,21 @@ recursive function get_val(node, var, state) result(res) return end if - res = var%struct(i8+1)%struct(id) + if (.not. allocated(node%member%lsubscripts)) then + res = var%struct(i8+1)%struct(id) + return + end if + + ! Arrays chained by a dot: `a[0].b[0]` + ! + ! TODO: ban non-scalar subscripts like below + + !print *, "array dot chain" + + !i8 = sub_eval(node%member, var%struct(id), state) + !res = get_array_val(var%struct(id)%array, i8) + j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) + res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) return end if diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 1acc0171..34c12103 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2762,6 +2762,9 @@ subroutine unit_test_struct_arr(npass, nfail) !******** + ! This tests both structs of arrays and arrays of structs. There are + ! limited structs of arrays covered in unit_test_struct(), but more complex + ! cases are covered here character(len = *), parameter :: label = 'structs/arrays' logical, parameter :: quiet = .true. @@ -2892,6 +2895,39 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ls = [l1, l2];' & //'return ls[1].s.y;' & , quiet) == '18', & + eval('' & ! 18 + //'struct P{v:[i32;:], s:str,}' & ! point + //'let p1 = P{v=[6, 13], s="pt1"};' & + //'let p2 = P{v=[4, 15], s="pt2"};' & + //'let ps = [p1, p2];' & + //'return ps[0].v[1];' & + , quiet) == '13', & + eval('' & ! 19 + //'struct P{v:[i32;:], s:str,}' & ! point + //'let p1 = P{v=[6, 13], s="pt1"};' & + //'let p2 = P{v=[4, 15], s="pt2"};' & + //'let ps = [p1, p2];' & + //'return ps[1].v[0];' & + , quiet) == '4', & + eval('' & ! 20 + //'struct P{v:[i32;:], s:str,}' & ! point + //'let p1 = P{v=[6, 13], s="pt1"};' & + //'let p2 = P{v=[4, 15], s="pt2"};' & + //'let ps = [p1, p2];' & + //'return ps[1].s;' & + , quiet) == 'pt2', & + eval('' & ! 17 + //'struct P{v:[i32;:], s:str,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{v=[ 6, 13], s="pt1"};' & + //'let p2 = P{v=[ 4, 15], s="pt2"};' & + //'let p3 = P{v=[16, 18], s="pt3"};' & + //'let p4 = P{v=[14, 20], s="pt4"};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'return ls[1].s.v[1];' & + , quiet) == '18', & .false. & ! so I don't have to bother w/ trailing commas ] diff --git a/src/types.f90 b/src/types.f90 index 7560e622..b7befcc0 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -61,11 +61,6 @@ module syntran__types_m ! Reference to the function definition, i.e. the syntax node containing ! the function parameters and body - ! - ! TODO: my experience has taught me that Fortran pointers are extremely - ! dangerous (see memory leaks due to now removed value_t -> array_t - ! pointer). Can we avoid having a pointer here and make it allocatable - ! instead? !type(syntax_node_t), pointer :: node => null() type(syntax_node_t), allocatable :: node From 904fa03c681940bc5d0df6f7e826aae644ebc867 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 13:35:34 -0400 Subject: [PATCH 084/137] comments, cleanup --- src/eval.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index d59dd985..5c449dc2 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -445,6 +445,9 @@ recursive function get_val(node, var, state) result(res) ! In nested expressions, like `a.b.c.d`, var begins as the top-most ! (left-most, outer-most) value `a` + ! + ! Now realize that the node var expression could be any permutation like + ! `a.b[1].c[2].d`. That is what this routine abstracts type(syntax_node_t), intent(in) :: node type(value_t), intent(in) :: var @@ -460,6 +463,9 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts)) then ! TODO: throw error for anything but scalar_sub for now + ! + ! I might want a separate variable for `i8+1` but it's going to invite + ! mixups i8 = subscript_eval(node, state) !print *, 'i8 = ', i8 @@ -482,15 +488,11 @@ recursive function get_val(node, var, state) result(res) res = var%struct(i8+1)%struct(id) return end if + !print *, "array dot chain" ! Arrays chained by a dot: `a[0].b[0]` ! ! TODO: ban non-scalar subscripts like below - - !print *, "array dot chain" - - !i8 = sub_eval(node%member, var%struct(id), state) - !res = get_array_val(var%struct(id)%array, i8) j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) return From 28f7e8c5f2ff6c7aac547f205f47b9e4287ae937 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 14:44:09 -0400 Subject: [PATCH 085/137] refactor conditional nesting --- src/eval.f90 | 65 +++++++++++++++++++++++----------------------------- 1 file changed, 29 insertions(+), 36 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 5c449dc2..6a3bcef3 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -460,53 +460,46 @@ recursive function get_val(node, var, state) result(res) integer :: id integer(kind = 8) :: i8, j8 - if (allocated(node%lsubscripts)) then + if (allocated(node%lsubscripts) .and. allocated(node%member)) then - ! TODO: throw error for anything but scalar_sub for now - ! - ! I might want a separate variable for `i8+1` but it's going to invite - ! mixups i8 = subscript_eval(node, state) - !print *, 'i8 = ', i8 - - if (allocated(node%member)) then - - id = node%member%id_index - - ! Recursion could still be required. Unfortunately, if an - ! identifier has a subscript *and* a dot, then so does its node. I - ! think this might require a bunch of if() logic like this instead - ! of any possibility of clean recursion - - if (node%member%kind == dot_expr) then - ! Recurse - res = get_val(node%member, var%struct(i8+1)%struct(id), state) - return - end if + id = node%member%id_index - if (.not. allocated(node%member%lsubscripts)) then - res = var%struct(i8+1)%struct(id) - return - end if - !print *, "array dot chain" + ! Recursion could still be required. Unfortunately, if an + ! identifier has a subscript *and* a dot, then so does its node. I + ! think this might require a bunch of if() logic like this instead + ! of any possibility of clean recursion - ! Arrays chained by a dot: `a[0].b[0]` - ! - ! TODO: ban non-scalar subscripts like below - j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) - res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) + if (node%member%kind == dot_expr) then + ! Recurse + res = get_val(node%member, var%struct(i8+1)%struct(id), state) return + end if + if (.not. allocated(node%member%lsubscripts)) then + res = var%struct(i8+1)%struct(id) + return end if + !print *, "array dot chain" - if (var%array%type == struct_type) then - res = var%struct(i8+1) - res%type = struct_type - res%struct_name = var%struct_name - else + ! Arrays chained by a dot: `a[0].b[0]` + ! + ! TODO: ban non-scalar subscripts like below + j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) + res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) + return + + else if (allocated(node%lsubscripts)) then + + i8 = subscript_eval(node, state) + if (var%array%type /= struct_type) then res = get_array_val(var%array, i8) + return end if + res = var%struct(i8+1) + res%type = struct_type + res%struct_name = var%struct_name return end if From 0225f8537073dec42f6ecb20ef22ee90343ffaba Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 16:09:03 -0400 Subject: [PATCH 086/137] update setter for lhs. add a couple tests --- src/eval.f90 | 106 ++++++++++++++++++++++++++++++++++++++++----- src/parse_expr.f90 | 7 +-- src/tests/test.f90 | 16 +++++++ 3 files changed, 116 insertions(+), 13 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 6a3bcef3..fd5a6057 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -403,23 +403,114 @@ end subroutine eval_dot_expr !=============================================================================== -recursive subroutine set_val(node, var, val) +recursive subroutine set_val(node, var, state, val) ! Assign var.mem = val, or recurse if mem is also a dot expr type(syntax_node_t), intent(in) :: node type(value_t), intent(inout) :: var + type(state_t), intent(inout) :: state type(value_t), intent(in) :: val !******** integer :: id + integer(kind = 8) :: i8, j8 + + if (allocated(node%lsubscripts) .and. allocated(node%member)) then + + i8 = subscript_eval(node, state) + id = node%member%id_index + + ! Recursion could still be required. Unfortunately, if an + ! identifier has a subscript *and* a dot, then so does its node. I + ! think this might require a bunch of if() logic like this instead + ! of any possibility of clean recursion + + if (node%member%kind == dot_expr) then + ! Recurse + !res = get_val(node%member, var%struct(i8+1)%struct(id), state) + call set_val(node%member, var%struct(i8+1)%struct(id), state, val) + return + end if + + if (.not. allocated(node%member%lsubscripts)) then + !res = var%struct(i8+1)%struct(id) + var%struct(i8+1)%struct(id) = val + return + end if + !print *, "array dot chain" + + ! Arrays chained by a dot: `a[0].b[0]` + ! + ! TODO: ban non-scalar subscripts like below + j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) + !res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) + call set_array_val(var%struct(i8+1)%struct(id)%array, j8, val) + return + + else if (allocated(node%lsubscripts)) then + + i8 = subscript_eval(node, state) + if (var%array%type /= struct_type) then + !res = get_array_val(var%array, i8) + call set_array_val(var%array, i8, val) + return + end if + + !res = var%struct(i8+1) + !res%type = struct_type + !res%struct_name = var%struct_name + var%struct(i8+1) = val + !res%type = struct_type ! TODO? + !res%struct_name = var%struct_name + return + + end if + + ! `id` tracks whether each member is the 1st, 2nd, etc. member in the struct + ! array of its parent. A local variable isnt' really needed but I think it + ! helps readability + id = node%member%id_index + + if (node%member%kind == dot_expr) then + ! Recurse + call set_val(node%member, var%struct(id), state, val) + return + end if + + ! Base case + + if (.not. allocated(node%member%lsubscripts)) then + !res = var%struct(id) + var%struct(id) = val + return + end if + !print *, "lsubscripts allocated" + + if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then + !print *, "slice sub" + + ! TODO: not implemented, throw error. Add code to catch in parser first + write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset + call internal_error() + end if + !print *, "scalar_sub" + + i8 = sub_eval(node%member, var%struct(id), state) + !res = get_array_val(var%struct(id)%array, i8) + call set_array_val(var%struct(id)%array, i8, val) + + !******************** + return + ! TODO + !******************** id = node%member%id_index if (node%member%kind == dot_expr) then ! Recurse - call set_val(node%member, var%struct(id), val) + call set_val(node%member, var%struct(id), state, val) return end if @@ -432,12 +523,6 @@ end subroutine set_val recursive function get_val(node, var, state) result(res) - ! TODO: this is a mess because %member and %lsubscripts are children of the - ! same syntax node. If I nest %lsubscripts inside of an %elem child or - ! something, can this be implemented more cleanly with recursion? It will - ! require lots of changes for (non-struct) arrays elsewhere but it could be - ! worth it - ! ! TODO: should res be an out arg for consistency? Similar question for ! get_array_val() ! @@ -447,7 +532,8 @@ recursive function get_val(node, var, state) result(res) ! (left-most, outer-most) value `a` ! ! Now realize that the node var expression could be any permutation like - ! `a.b[1].c[2].d`. That is what this routine abstracts + ! `a.b[1].c[2].d`, with the tail value `d` being either a primitive type, + ! array, or another struct. That is what this routine abstracts type(syntax_node_t), intent(in) :: node type(value_t), intent(in) :: var @@ -1213,7 +1299,7 @@ subroutine eval_assignment_expr(node, state, res) call compound_assign(res, rhs, node%op) ! Save it back into the LHS var - call set_val(node, state%vars%vals(node%id_index), res) + call set_val(node, state%vars%vals(node%id_index), state, res) else if (.not. allocated(node%lsubscripts)) then diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index f64069f4..4c6cae2f 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -150,6 +150,7 @@ recursive module function parse_expr_statement(parser) result(expr) call parser%parse_dot(expr) if (.not. allocated(expr%member)) return + val_sub = expr%val end if @@ -621,9 +622,9 @@ recursive module subroutine parse_dot(parser, expr) ! the recursive parse_dot()? expr%member%val = member call parser%parse_subscripts(expr%member) - !if (allocated(expr%member%lsubscripts)) then - ! expr%val = expr%member%val - !end if + if (allocated(expr%member%lsubscripts)) then + expr%val = expr%member%val + end if ! I think this needs a recursive call to `parse_dot()` right here to handle ! things like `a.b.c` diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 34c12103..81209d6f 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2928,6 +2928,22 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ls = [l1, l2];' & //'return ls[1].s.v[1];' & , quiet) == '18', & + eval('' & ! 18 + //'struct P{v:[i32;:], s:str,}' & ! point + //'let p1 = P{v=[6, 13], s="pt1"};' & + //'let p2 = P{v=[4, 15], s="pt2"};' & + //'let ps = [p1, p2];' & + //'ps[1].v[0] = 3;' & + //'return ps[1].v[0];' & + , quiet) == '3', & + eval('' & ! 19 + //'struct P{v:[i32;:], s:str,}' & ! point + //'let p1 = P{v=[6, 13], s="pt1"};' & + //'let p2 = P{v=[4, 15], s="pt2"};' & + //'let ps = [p1, p2];' & + //'ps[1].v[0] -= 1;' & + //'return ps[1].v[0];' & + , quiet) == '3', & .false. & ! so I don't have to bother w/ trailing commas ] From 5de982f47ee96dd09eeca0ec6abe754f9edebbd2 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 16:18:15 -0400 Subject: [PATCH 087/137] add more tests --- src/core.f90 | 10 +++----- src/tests/test.f90 | 63 +++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 62 insertions(+), 11 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index d1bb3186..13f3c1f8 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -32,15 +32,11 @@ module syntran__core_m ! * mvp done: ! + struct fn return values ! + nested structs - ! * tbd: ! + structs of arrays (and arrays of structs) - ! * wip - ! * lhs subs tbd. want to finish rhs recursion first, then lhs will - ! be a very similar structure but with setters instead of getters - ! * rhs subs done + ! * string indexing tbd. should be do-able + ! * slice indexing tbd (more difficult) + ! * tbd: ! + unary ops on dot exprs - ! + tests - ! > moar ! + remove unused things like mems/members copies in various ! types/routines ! > currently using members for fn param declarations diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 81209d6f..841e0108 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2916,7 +2916,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ps = [p1, p2];' & //'return ps[1].s;' & , quiet) == 'pt2', & - eval('' & ! 17 + eval('' & ! 21 //'struct P{v:[i32;:], s:str,}' & ! point //'struct L{s:P, e:P}' & ! line //'let p1 = P{v=[ 6, 13], s="pt1"};' & @@ -2928,15 +2928,15 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ls = [l1, l2];' & //'return ls[1].s.v[1];' & , quiet) == '18', & - eval('' & ! 18 + eval('' & ! 22 //'struct P{v:[i32;:], s:str,}' & ! point //'let p1 = P{v=[6, 13], s="pt1"};' & //'let p2 = P{v=[4, 15], s="pt2"};' & //'let ps = [p1, p2];' & - //'ps[1].v[0] = 3;' & + //'ps[1].v[0] = 3;' & ! dot/subscript expr on lhs //'return ps[1].v[0];' & , quiet) == '3', & - eval('' & ! 19 + eval('' & ! 23 //'struct P{v:[i32;:], s:str,}' & ! point //'let p1 = P{v=[6, 13], s="pt1"};' & //'let p2 = P{v=[4, 15], s="pt2"};' & @@ -2944,9 +2944,64 @@ subroutine unit_test_struct_arr(npass, nfail) //'ps[1].v[0] -= 1;' & //'return ps[1].v[0];' & , quiet) == '3', & + eval('' & ! 24 + //'struct P{v:[i32;:], s:str,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{v=[ 6, 13], s="pt1"};' & + //'let p2 = P{v=[ 4, 15], s="pt2"};' & + //'let p3 = P{v=[16, 18], s="pt3"};' & + //'let p4 = P{v=[14, 20], s="pt4"};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'ls[1].s.v[1] = 19;' & + //'return ls[1].s.v[1];' & + , quiet) == '19', & + eval('' & ! 25 + //'struct P{v:[i32;:], s:str,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{v=[ 6, 13], s="pt1"};' & + //'let p2 = P{v=[ 4, 15], s="pt2"};' & + //'let p3 = P{v=[16, 18], s="pt3"};' & + //'let p4 = P{v=[14, 20], s="pt4"};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'ls[1].s.v[1] += 1;' & + //'return ls[1].s.v[1];' & + , quiet) == '19', & + eval('' & ! 26 + //'struct P{x:i32, y:i32,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{x= 6, y=13,};' & + //'let p2 = P{x= 4, y=15,};' & + //'let p3 = P{x=16, y=18,};' & + //'let p4 = P{x=14, y=20,};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'ls[1].s.y = 21;' & + //'return ls[1].s.y;' & + , quiet) == '21', & + eval('' & ! 27 + //'struct P{x:i32, y:i32,}' & ! point + //'struct L{s:P, e:P}' & ! line + //'let p1 = P{x= 6, y=13,};' & + //'let p2 = P{x= 4, y=15,};' & + //'let p3 = P{x=16, y=18,};' & + //'let p4 = P{x=14, y=20,};' & + //'let l1 = L{s = p1, e = p2};' & + //'let l2 = L{s = p3, e = p4};' & + //'let ls = [l1, l2];' & + //'ls[1].s.y += p1.x / 2;' & + //'return ls[1].s.y;' & + , quiet) == '21', & .false. & ! so I don't have to bother w/ trailing commas ] + ! I developed LHS dot exprs almost all at once, so I might have missed some + ! cases. For RHS dot exprs I did it piece-by-piece and added tests as I went + ! Trim dummy false element tests = tests(1: size(tests) - 1) !print *, "number of "//label//" tests = ", size(tests) From 647d0240086da9a58019b40c6ec1d85b01261e8a Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 16:48:34 -0400 Subject: [PATCH 088/137] fix bug for nested array of structs of array --- src/eval.f90 | 28 +++++++++++++++++++++++++--- src/parse_expr.f90 | 4 +++- src/tests/test.f90 | 18 ++++++++++++++++++ 3 files changed, 46 insertions(+), 4 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index fd5a6057..492aa565 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -534,6 +534,8 @@ recursive function get_val(node, var, state) result(res) ! Now realize that the node var expression could be any permutation like ! `a.b[1].c[2].d`, with the tail value `d` being either a primitive type, ! array, or another struct. That is what this routine abstracts + ! + ! FIXME: if you change something in the getter, change it in the setter too type(syntax_node_t), intent(in) :: node type(value_t), intent(in) :: var @@ -548,7 +550,9 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts) .and. allocated(node%member)) then - i8 = subscript_eval(node, state) + !i8 = subscript_eval(node, state) + i8 = sub_eval(node, var, state) + !print *, "i8 = ", i8 id = node%member%id_index ! Recursion could still be required. Unfortunately, if an @@ -572,13 +576,18 @@ recursive function get_val(node, var, state) result(res) ! ! TODO: ban non-scalar subscripts like below j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) + !print *, "get_array_val 1" res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) return else if (allocated(node%lsubscripts)) then - i8 = subscript_eval(node, state) + ! TODO: prefer sub_eval() + !i8 = subscript_eval(node, state) + i8 = sub_eval(node, var, state) + if (var%array%type /= struct_type) then + !print *, "get_array_val 2" res = get_array_val(var%array, i8) return end if @@ -618,8 +627,21 @@ recursive function get_val(node, var, state) result(res) end if !print *, "scalar_sub" + !i8 = sub_eval(node%member, var%struct(id), state) + !!print *, "get_array_val 3" + !res = get_array_val(var%struct(id)%array, i8) + + !i8 = subscript_eval(node%member, state) i8 = sub_eval(node%member, var%struct(id), state) - res = get_array_val(var%struct(id)%array, i8) + if (var%struct(id)%array%type /= struct_type) then + !print *, "get_array_val 3" + res = get_array_val(var%struct(id)%array, i8) + return + end if + + res = var%struct(id)%struct(i8+1) + res%type = struct_type + res%struct_name = var%struct(id)%struct_name end function get_val diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 4c6cae2f..39fde6d5 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -630,7 +630,9 @@ recursive module subroutine parse_dot(parser, expr) ! things like `a.b.c` if (parser%peek_kind(0) == dot_token) then - expr%member%val = member + !expr%member%val = member + expr%member%val = expr%val + call parser%parse_dot(expr%member) expr%val = expr%member%val diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 841e0108..e2122092 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2996,6 +2996,24 @@ subroutine unit_test_struct_arr(npass, nfail) //'ls[1].s.y += p1.x / 2;' & //'return ls[1].s.y;' & , quiet) == '21', & + eval('' & ! 28 + //'struct P{v:[i32; :], s:str,}' & ! point + //'struct G{x:[P ; :], s:str,}' & ! polyGon of points + //'let p0 = P{v=[6, 13], s="pta"};' & + //'let p1 = P{v=[4, 15], s="ptb"};' & + //'let p2 = P{v=[3, 17], s="ptc"};' & + //'let g0 = G{x=[p0, p1, p2], s="tri"};' & + //'return g0.x[0].v[0];' & + , quiet) == '6', & + eval('' & ! 29 + //'struct P{v:[i32; :], s:str,}' & ! point + //'struct G{x:[P ; :], s:str,}' & ! polyGon of points + //'let p0 = P{v=[6, 13], s="pta"};' & + //'let p1 = P{v=[4, 15], s="ptb"};' & + //'let p2 = P{v=[3, 17], s="ptc"};' & + //'let g0 = G{x=[p0, p1, p2], s="tri"};' & + //'return g0.x[2].v[1];' & + , quiet) == '17', & .false. & ! so I don't have to bother w/ trailing commas ] From 3cf7599ce69f3b802404f9d796a6bdcc5e9c0374 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 19:40:02 -0400 Subject: [PATCH 089/137] fix setter like last commit --- src/eval.f90 | 35 ++++++++++------------------------- src/tests/test.f90 | 30 ++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 25 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 492aa565..12c69ec0 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -419,7 +419,7 @@ recursive subroutine set_val(node, var, state, val) if (allocated(node%lsubscripts) .and. allocated(node%member)) then - i8 = subscript_eval(node, state) + i8 = sub_eval(node, var, state) id = node%member%id_index ! Recursion could still be required. Unfortunately, if an @@ -451,7 +451,7 @@ recursive subroutine set_val(node, var, state, val) else if (allocated(node%lsubscripts)) then - i8 = subscript_eval(node, state) + i8 = sub_eval(node, var, state) if (var%array%type /= struct_type) then !res = get_array_val(var%array, i8) call set_array_val(var%array, i8, val) @@ -498,24 +498,15 @@ recursive subroutine set_val(node, var, state, val) !print *, "scalar_sub" i8 = sub_eval(node%member, var%struct(id), state) - !res = get_array_val(var%struct(id)%array, i8) - call set_array_val(var%struct(id)%array, i8, val) - - !******************** - return - ! TODO - !******************** - - id = node%member%id_index - - if (node%member%kind == dot_expr) then - ! Recurse - call set_val(node%member, var%struct(id), state, val) + if (var%struct(id)%array%type /= struct_type) then + call set_array_val(var%struct(id)%array, i8, val) return end if - ! Base case - var%struct(id) = val + !res = var%struct(id)%struct(i8+1) + var%struct(id)%struct(i8+1) = val + !res%type = struct_type + !res%struct_name = var%struct(id)%struct_name end subroutine set_val @@ -550,7 +541,6 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts) .and. allocated(node%member)) then - !i8 = subscript_eval(node, state) i8 = sub_eval(node, var, state) !print *, "i8 = ", i8 id = node%member%id_index @@ -582,8 +572,8 @@ recursive function get_val(node, var, state) result(res) else if (allocated(node%lsubscripts)) then - ! TODO: prefer sub_eval() - !i8 = subscript_eval(node, state) + ! Prefer sub_eval() over subscript_eval() because it doesn't make any + ! assumptions about var's relation to node i8 = sub_eval(node, var, state) if (var%array%type /= struct_type) then @@ -627,11 +617,6 @@ recursive function get_val(node, var, state) result(res) end if !print *, "scalar_sub" - !i8 = sub_eval(node%member, var%struct(id), state) - !!print *, "get_array_val 3" - !res = get_array_val(var%struct(id)%array, i8) - - !i8 = subscript_eval(node%member, state) i8 = sub_eval(node%member, var%struct(id), state) if (var%struct(id)%array%type /= struct_type) then !print *, "get_array_val 3" diff --git a/src/tests/test.f90 b/src/tests/test.f90 index e2122092..1b8313d9 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3014,6 +3014,36 @@ subroutine unit_test_struct_arr(npass, nfail) //'let g0 = G{x=[p0, p1, p2], s="tri"};' & //'return g0.x[2].v[1];' & , quiet) == '17', & + eval('' & ! 30 + //'struct P{v:[i32; :], s:str,}' & ! point + //'struct G{x:[P ; :], s:str,}' & ! polyGon of points + //'let p0 = P{v=[6, 13], s="pta"};' & + //'let p1 = P{v=[4, 15], s="ptb"};' & + //'let p2 = P{v=[3, 17], s="ptc"};' & + //'let g0 = G{x=[p0, p1, p2], s="tri"};' & + //'g0.x[0].v[0] = 7;' & + //'return g0.x[0].v[0];' & + , quiet) == '7', & + eval('' & ! 31 + //'struct P{v:[i32; :], s:str,}' & ! point + //'struct G{x:[P ; :], s:str,}' & ! polyGon of points + //'let p0 = P{v=[6, 13], s="pta"};' & + //'let p1 = P{v=[4, 15], s="ptb"};' & + //'let p2 = P{v=[3, 17], s="ptc"};' & + //'let g0 = G{x=[p0, p1, p2], s="tri"};' & + //'g0.x[2].v[1] += 1;' & + //'return g0.x[2].v[1];' & + , quiet) == '18', & + eval('' & ! 31 + //'struct P{v:[i32; :], s:str,}' & ! point + //'struct G{x:[P ; :], s:str,}' & ! polyGon of points + //'let p0 = P{v=[6, 13], s="pta"};' & + //'let p1 = P{v=[4, 15], s="ptb"};' & + //'let p2 = P{v=[3, 17], s="ptc"};' & + //'let g0 = G{x=[p0, p1, p2], s="tri"};' & + //'g0.x[2].v = [2, 19];' & + //'return g0.x[2].v;' & + , quiet) == '[2, 19]', & .false. & ! so I don't have to bother w/ trailing commas ] From c7bf69ded2244c575fa8b4954309642a98482c5e Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 20:14:51 -0400 Subject: [PATCH 090/137] add order-5 tests with various arrays interleaved --- src/eval.f90 | 9 --- src/tests/test.f90 | 191 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 190 insertions(+), 10 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 12c69ec0..bfcc2630 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -429,13 +429,11 @@ recursive subroutine set_val(node, var, state, val) if (node%member%kind == dot_expr) then ! Recurse - !res = get_val(node%member, var%struct(i8+1)%struct(id), state) call set_val(node%member, var%struct(i8+1)%struct(id), state, val) return end if if (.not. allocated(node%member%lsubscripts)) then - !res = var%struct(i8+1)%struct(id) var%struct(i8+1)%struct(id) = val return end if @@ -445,7 +443,6 @@ recursive subroutine set_val(node, var, state, val) ! ! TODO: ban non-scalar subscripts like below j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) - !res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) call set_array_val(var%struct(i8+1)%struct(id)%array, j8, val) return @@ -453,14 +450,10 @@ recursive subroutine set_val(node, var, state, val) i8 = sub_eval(node, var, state) if (var%array%type /= struct_type) then - !res = get_array_val(var%array, i8) call set_array_val(var%array, i8, val) return end if - !res = var%struct(i8+1) - !res%type = struct_type - !res%struct_name = var%struct_name var%struct(i8+1) = val !res%type = struct_type ! TODO? !res%struct_name = var%struct_name @@ -482,7 +475,6 @@ recursive subroutine set_val(node, var, state, val) ! Base case if (.not. allocated(node%member%lsubscripts)) then - !res = var%struct(id) var%struct(id) = val return end if @@ -503,7 +495,6 @@ recursive subroutine set_val(node, var, state, val) return end if - !res = var%struct(id)%struct(i8+1) var%struct(id)%struct(i8+1) = val !res%type = struct_type !res%struct_name = var%struct(id)%struct_name diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 1b8313d9..b768d14b 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3034,7 +3034,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'g0.x[2].v[1] += 1;' & //'return g0.x[2].v[1];' & , quiet) == '18', & - eval('' & ! 31 + eval('' & ! ?? //'struct P{v:[i32; :], s:str,}' & ! point //'struct G{x:[P ; :], s:str,}' & ! polyGon of points //'let p0 = P{v=[6, 13], s="pta"};' & @@ -3044,6 +3044,195 @@ subroutine unit_test_struct_arr(npass, nfail) //'g0.x[2].v = [2, 19];' & //'return g0.x[2].v;' & , quiet) == '[2, 19]', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'return e.e.d.c.b.a;' & + , quiet) == '42', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: [B;:]}' & ! middle array + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = [b]};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'return e.e.d.c[0].b.a;' & + , quiet) == '42', & + eval('' & ! ?? + //'struct A{a: [i32;:]}' & ! inner-most array + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'let a = A{a = [42]};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'return e.e.d.c.b.a[0];' & + , quiet) == '42', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct, outer-most array + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = [E{e = d}];' & + //'return e[0].e.d.c.b.a;' & + , quiet) == '42', & + eval('' & ! ?? + //'struct A{a: [i32;:]}' & + //'struct B{b: [A;:]}' & + //'struct C{c: [B;:]}' & + //'struct D{d: [C;:]}' & + //'struct E{e: [D;:]}' & ! order-5 struct, all arrays + //'let a = A{a = [42]};' & + //'let b = B{b = [a]};' & + //'let c = C{c = [b]};' & + //'let d = D{d = [c]};' & + //'let e = [E{e = [d]}];' & + //'return e[0].e[0].d[0].c[0].b[0].a[0];' & + , quiet) == '42', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: [A;:]}' & + //'struct C{c: B}' & + //'struct D{d: [C;:]}' & + //'struct E{e: D}' & ! order-5 struct, alternating arrays + //'let a = A{a = 1337};' & + //'let b = B{b = [a]};' & + //'let c = C{c = b};' & + //'let d = D{d = [c]};' & + //'let e = [E{e = d}];' & + //'return e[0].e.d[0].c.b[0].a;' & + , quiet) == '1337', & + eval('' & ! ?? + //'struct A{a: [i32;:]}' & + //'struct B{b: A}' & + //'struct C{c: [B;:]}' & + //'struct D{d: C}' & + //'struct E{e: [D;:]}' & ! order-5 struct, alternating arrays the other way + //'let a = A{a = [42]};' & + //'let b = B{b = a};' & + //'let c = C{c = [b]};' & + //'let d = D{d = c};' & + //'let e = E{e = [d]};' & + //'return e.e[0].d.c[0].b.a[0];' & + , quiet) == '42', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'e.e.d.c.b.a = 69;' & + //'return e.e.d.c.b.a;' & + , quiet) == '69', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: [B;:]}' & ! middle array + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = [b]};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'e.e.d.c[0].b.a = 69;' & + //'return e.e.d.c[0].b.a;' & + , quiet) == '69', & + eval('' & ! ?? + //'struct A{a: [i32;:]}' & ! inner-most array + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'let a = A{a = [42]};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'e.e.d.c.b.a[0] = 69;' & + //'return e.e.d.c.b.a[0];' & + , quiet) == '69', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct, outer-most array + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = [E{e = d}];' & + //'e[0].e.d.c.b.a = 69;' & + //'return e[0].e.d.c.b.a;' & + , quiet) == '69', & + eval('' & ! ?? + //'struct A{a: [i32;:]}' & + //'struct B{b: [A;:]}' & + //'struct C{c: [B;:]}' & + //'struct D{d: [C;:]}' & + //'struct E{e: [D;:]}' & ! order-5 struct, all arrays + //'let a = A{a = [42]};' & + //'let b = B{b = [a]};' & + //'let c = C{c = [b]};' & + //'let d = D{d = [c]};' & + //'let e = [E{e = [d]}];' & + //'e[0].e[0].d[0].c[0].b[0].a[0] = 69;' & + //'return e[0].e[0].d[0].c[0].b[0].a[0];' & + , quiet) == '69', & + eval('' & ! ?? + //'struct A{a: i32}' & + //'struct B{b: [A;:]}' & + //'struct C{c: B}' & + //'struct D{d: [C;:]}' & + //'struct E{e: D}' & ! order-5 struct, alternating arrays + //'let a = A{a = 1337};' & + //'let b = B{b = [a]};' & + //'let c = C{c = b};' & + //'let d = D{d = [c]};' & + //'let e = [E{e = d}];' & + //'e[0].e.d[0].c.b[0].a = 420;' & + //'return e[0].e.d[0].c.b[0].a;' & + , quiet) == '420', & + eval('' & ! ?? + //'struct A{a: [i32;:]}' & + //'struct B{b: A}' & + //'struct C{c: [B;:]}' & + //'struct D{d: C}' & + //'struct E{e: [D;:]}' & ! order-5 struct, alternating arrays the other way + //'let a = A{a = [42]};' & + //'let b = B{b = a};' & + //'let c = C{c = [b]};' & + //'let d = D{d = c};' & + //'let e = E{e = [d]};' & + //'e.e[0].d.c[0].b.a[0] += 27;' & + //'return e.e[0].d.c[0].b.a[0];' & + , quiet) == '69', & .false. & ! so I don't have to bother w/ trailing commas ] From 264af3f86f891ff3767d44e94a830d1185d39e24 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 1 Sep 2024 22:50:59 -0400 Subject: [PATCH 091/137] add a struct diagnostic. so it begins --- src/core.f90 | 6 +++++- src/errors.f90 | 16 ++++++++++++++++ src/parse_expr.f90 | 10 +++++----- src/parse_fn.f90 | 18 ++++++++++++++++++ src/tests/test.f90 | 30 +++++++++++++++--------------- 5 files changed, 59 insertions(+), 21 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 13f3c1f8..9eba038b 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -34,14 +34,18 @@ module syntran__core_m ! + nested structs ! + structs of arrays (and arrays of structs) ! * string indexing tbd. should be do-able + ! + was done in a reverted commit before i re-focused on struct/array combos ! * slice indexing tbd (more difficult) - ! * tbd: ! + unary ops on dot exprs + ! * i had broken and fixed binary ops at some point, but i think i + ! changed things later which automatically fixed unary ops? + ! * tbd: ! + remove unused things like mems/members copies in various ! types/routines ! > currently using members for fn param declarations ! + struct type checking ! > check dot member types in instantiation + ! * done for primitives, still need to compare struct subtypes ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names diff --git a/src/errors.f90 b/src/errors.f90 index feb73d89..44faf1ae 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -626,6 +626,22 @@ end function err_het_array !=============================================================================== +function err_bad_member_type(context, span, mem_name, struct_name, act_type, exp_type) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: mem_name, struct_name, exp_type, act_type + err = err_prefix & + //'member `'//mem_name//'` in struct `'//struct_name//'` has the wrong type. ' & + //'Member requires type `'//exp_type//'` but was given `'//act_type//'`' & + //underline(context, span) & + //" bad member type"//color_reset + +end function err_bad_member_type + +!=============================================================================== + function err_inc_404(context, span, filename) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 39fde6d5..b5a5ecba 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -136,7 +136,7 @@ recursive module function parse_expr_statement(parser) result(expr) ! Delay the error-handling on search_io because we might end up rewinding call parser%vars%search(identifier%text, expr%id_index, search_io, expr%val) call parser%parse_subscripts(expr) - val_sub = expr%val ! backup for later + !val_sub = expr%val ! backup for later if (parser%peek_kind(0) == dot_token) then !print *, "dot token" @@ -150,7 +150,7 @@ recursive module function parse_expr_statement(parser) result(expr) call parser%parse_dot(expr) if (.not. allocated(expr%member)) return - val_sub = expr%val + !val_sub = expr%val end if @@ -200,9 +200,9 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, 'allocated(expr%val%array) = ', allocated(expr%val%array) - if (allocated(expr%lsubscripts)) then - expr%val = val_sub - end if + !if (allocated(expr%lsubscripts)) then + ! expr%val = val_sub + !end if ltype = expr%val%type rtype = expr%right%val%type diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index f9e58b0f..086b5f6f 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -868,6 +868,8 @@ module function parse_struct_instance(parser) result(inst) type(syntax_token_t) :: identifier, name, equals, comma, lbrace, rbrace, dummy + type(text_span_t) :: span + type(value_t) :: member !print *, "starting parse_struct_instance()" @@ -949,6 +951,22 @@ module function parse_struct_instance(parser) result(inst) stop end if + !! TODO: if both are struct_type, use struct_name in condition instead + !! of int enum + !print *, "member type = ", kind_name(member%type) + !print *, "mem type = ", kind_name(mem%val%type) + if (member%type /= mem%val%type) then + !span = new_span(name%pos, parser%current_pos() - name%pos + 1) ! `mem = expr` + span = new_span(equals%pos+1, parser%current_pos() - equals%pos - 1) ! just `expr` + call parser%diagnostics%push(err_bad_member_type( & + parser%context(), & + span, & + name%text, & + identifier%text, & + kind_name(mem%val%type), & + kind_name(member%type))) + end if + ! TODO: add a size check here too !print *, "mem type = ", kind_name(mem%val%type) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index b768d14b..b66db918 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3034,7 +3034,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'g0.x[2].v[1] += 1;' & //'return g0.x[2].v[1];' & , quiet) == '18', & - eval('' & ! ?? + eval('' & ! 32 //'struct P{v:[i32; :], s:str,}' & ! point //'struct G{x:[P ; :], s:str,}' & ! polyGon of points //'let p0 = P{v=[6, 13], s="pta"};' & @@ -3044,7 +3044,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'g0.x[2].v = [2, 19];' & //'return g0.x[2].v;' & , quiet) == '[2, 19]', & - eval('' & ! ?? + eval('' & ! 33 //'struct A{a: i32}' & //'struct B{b: A}' & //'struct C{c: B}' & @@ -3057,7 +3057,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = E{e = d};' & //'return e.e.d.c.b.a;' & , quiet) == '42', & - eval('' & ! ?? + eval('' & ! 34 //'struct A{a: i32}' & //'struct B{b: A}' & //'struct C{c: [B;:]}' & ! middle array @@ -3070,7 +3070,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = E{e = d};' & //'return e.e.d.c[0].b.a;' & , quiet) == '42', & - eval('' & ! ?? + eval('' & ! 35 //'struct A{a: [i32;:]}' & ! inner-most array //'struct B{b: A}' & //'struct C{c: B}' & @@ -3083,7 +3083,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = E{e = d};' & //'return e.e.d.c.b.a[0];' & , quiet) == '42', & - eval('' & ! ?? + eval('' & ! 36 //'struct A{a: i32}' & //'struct B{b: A}' & //'struct C{c: B}' & @@ -3096,7 +3096,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = [E{e = d}];' & //'return e[0].e.d.c.b.a;' & , quiet) == '42', & - eval('' & ! ?? + eval('' & ! 37 //'struct A{a: [i32;:]}' & //'struct B{b: [A;:]}' & //'struct C{c: [B;:]}' & @@ -3109,7 +3109,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = [E{e = [d]}];' & //'return e[0].e[0].d[0].c[0].b[0].a[0];' & , quiet) == '42', & - eval('' & ! ?? + eval('' & ! 38 //'struct A{a: i32}' & //'struct B{b: [A;:]}' & //'struct C{c: B}' & @@ -3122,7 +3122,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = [E{e = d}];' & //'return e[0].e.d[0].c.b[0].a;' & , quiet) == '1337', & - eval('' & ! ?? + eval('' & ! 39 //'struct A{a: [i32;:]}' & //'struct B{b: A}' & //'struct C{c: [B;:]}' & @@ -3135,7 +3135,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = E{e = [d]};' & //'return e.e[0].d.c[0].b.a[0];' & , quiet) == '42', & - eval('' & ! ?? + eval('' & ! 40 //'struct A{a: i32}' & //'struct B{b: A}' & //'struct C{c: B}' & @@ -3149,7 +3149,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'e.e.d.c.b.a = 69;' & //'return e.e.d.c.b.a;' & , quiet) == '69', & - eval('' & ! ?? + eval('' & ! 41 //'struct A{a: i32}' & //'struct B{b: A}' & //'struct C{c: [B;:]}' & ! middle array @@ -3163,7 +3163,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'e.e.d.c[0].b.a = 69;' & //'return e.e.d.c[0].b.a;' & , quiet) == '69', & - eval('' & ! ?? + eval('' & ! 42 //'struct A{a: [i32;:]}' & ! inner-most array //'struct B{b: A}' & //'struct C{c: B}' & @@ -3177,7 +3177,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'e.e.d.c.b.a[0] = 69;' & //'return e.e.d.c.b.a[0];' & , quiet) == '69', & - eval('' & ! ?? + eval('' & ! 43 //'struct A{a: i32}' & //'struct B{b: A}' & //'struct C{c: B}' & @@ -3191,7 +3191,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'e[0].e.d.c.b.a = 69;' & //'return e[0].e.d.c.b.a;' & , quiet) == '69', & - eval('' & ! ?? + eval('' & ! 44 //'struct A{a: [i32;:]}' & //'struct B{b: [A;:]}' & //'struct C{c: [B;:]}' & @@ -3205,7 +3205,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'e[0].e[0].d[0].c[0].b[0].a[0] = 69;' & //'return e[0].e[0].d[0].c[0].b[0].a[0];' & , quiet) == '69', & - eval('' & ! ?? + eval('' & ! 45 //'struct A{a: i32}' & //'struct B{b: [A;:]}' & //'struct C{c: B}' & @@ -3219,7 +3219,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'e[0].e.d[0].c.b[0].a = 420;' & //'return e[0].e.d[0].c.b[0].a;' & , quiet) == '420', & - eval('' & ! ?? + eval('' & ! 46 //'struct A{a: [i32;:]}' & //'struct B{b: A}' & //'struct C{c: [B;:]}' & From 1c95f71725e8ca0b0eefb29656ef921e2efc37b7 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 2 Sep 2024 10:46:59 -0400 Subject: [PATCH 092/137] add more struct type checking diagnostics --- src/errors.f90 | 28 ++++++++++++++++++++++++++++ src/parse_fn.f90 | 31 ++++++++++++++++++++++++++++--- 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/src/errors.f90 b/src/errors.f90 index 44faf1ae..21b3542a 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -183,6 +183,34 @@ end function err_redeclare_fn !=============================================================================== +function err_redeclare_struct(context, span, struct) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: struct + err = err_prefix & + //'struct `'//struct//'` has already been declared' & + //underline(context, span)//" struct already declared"//color_reset + +end function err_redeclare_struct + +!=============================================================================== + +function err_redeclare_primitive(context, span, struct) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: struct + err = err_prefix & + //'struct name `'//struct//'` is reserved for a primitive type' & + //underline(context, span)//" cannot redeclare primitives"//color_reset + +end function err_redeclare_primitive + +!=============================================================================== + function err_undeclare_var(context, span, var) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 086b5f6f..85861926 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -675,6 +675,17 @@ module function parse_struct_declaration(parser) result(decl) identifier = parser%match(identifier_token) !print *, "parsing struct ", identifier%text + itype = lookup_type(identifier%text, parser%structs, dummy_struct) + !print *, "itype = ", itype, kind_name(itype) + if (itype /= unknown_type .and. itype /= struct_type) then + ! Redeclared structs are caught below + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push(err_redeclare_primitive( & + parser%context(), & + span, & + identifier%text)) + end if + pos1 = parser%current_pos() lbrace = parser%match(lbrace_token) @@ -833,7 +844,16 @@ module function parse_struct_declaration(parser) result(decl) decl%id_index = parser%num_structs !print *, "inserting identifier ", identifier%text, " into parser structs" - call parser%structs%insert(identifier%text, struct, decl%id_index) + call parser%structs%insert( & + identifier%text, struct, decl%id_index, io, overwrite = .false.) + !print *, "io = ", io + if (io /= 0) then + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push(err_redeclare_struct( & + parser%context(), & + span, & + identifier%text)) + end if !print *, "parser structs root = ", parser%structs%dict%root%split_char !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char @@ -858,7 +878,7 @@ module function parse_struct_instance(parser) result(inst) !******** - integer :: io, pos0, struct_id, member_id + integer :: io, pos0, pos1, struct_id, member_id !type(struct_t), save :: struct type(struct_t) :: struct @@ -927,6 +947,7 @@ module function parse_struct_instance(parser) result(inst) name = parser%match(identifier_token) equals = parser%match(equals_token) + pos1 = parser%current_pos() mem = parser%parse_expr() !print *, "name%text = ", name%text @@ -953,11 +974,15 @@ module function parse_struct_instance(parser) result(inst) !! TODO: if both are struct_type, use struct_name in condition instead !! of int enum + !! + !! TODO: check array sub type. Might be time for a do_types_match() fn. + !! Is numeric casting allowed? + !print *, "member type = ", kind_name(member%type) !print *, "mem type = ", kind_name(mem%val%type) if (member%type /= mem%val%type) then !span = new_span(name%pos, parser%current_pos() - name%pos + 1) ! `mem = expr` - span = new_span(equals%pos+1, parser%current_pos() - equals%pos - 1) ! just `expr` + span = new_span(pos1, parser%current_pos() - pos1) ! just `expr` call parser%diagnostics%push(err_bad_member_type( & parser%context(), & span, & From a17411349f63345d3c4eeb5b9e7dce98367c3a05 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 2 Sep 2024 11:14:58 -0400 Subject: [PATCH 093/137] more diags --- src/errors.f90 | 29 +++++++++++++++++++++++++++ src/parse_fn.f90 | 52 +++++++++++++++++++----------------------------- 2 files changed, 49 insertions(+), 32 deletions(-) diff --git a/src/errors.f90 b/src/errors.f90 index 21b3542a..dfa69c16 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -169,6 +169,20 @@ end function err_redeclare_var !=============================================================================== +function err_redeclare_mem(context, span, var) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: var + err = err_prefix & + //'member `'//var//'` has already been declared in this struct' & + //underline(context, span)//" member already declared"//color_reset + +end function err_redeclare_mem + +!=============================================================================== + function err_redeclare_fn(context, span, fn) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span @@ -654,6 +668,21 @@ end function err_het_array !=============================================================================== +function err_bad_member_name(context, span, mem_name, struct_name) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: mem_name, struct_name + err = err_prefix & + //'member `'//mem_name//'` in struct `'//struct_name//'` does not exist' & + //underline(context, span) & + //" bad member name"//color_reset + +end function err_bad_member_name + +!=============================================================================== + function err_bad_member_type(context, span, mem_name, struct_name, act_type, exp_type) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 85861926..734b7094 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -31,9 +31,13 @@ module function parse_fn_call(parser) result(fn_call) logical :: types_match type(fn_t) :: fn + + type(integer_vector_t) :: ranks, pos_args + type(syntax_node_t) :: arg type(syntax_node_vector_t) :: args type(syntax_token_t) :: identifier, comma, lparen, rparen, dummy + type(text_span_t) :: span if (debug > 1) print *, 'parse_fn_call' @@ -44,6 +48,7 @@ module function parse_fn_call(parser) result(fn_call) !print *, 'identifier = ', identifier%text args = new_syntax_node_vector() + pos_args = new_integer_vector() lparen = parser%match(lparen_token) do while ( & @@ -51,23 +56,10 @@ module function parse_fn_call(parser) result(fn_call) parser%current_kind() /= eof_token) pos0 = parser%pos + call pos_args%push(parser%current_pos()) arg = parser%parse_expr() call args%push(arg) - !! TODO: we need a delete method for syntax_node_t (i.e. - !! arg). There was a bug here where the fact that the - !! subscripts for the 1st fn arg were allocated, leaked into - !! the 2nd arg because of this loop. For example: - !! - !! let result = my_fn_call(str1[beg:end], str2); - !! - !! We should delete the whole thing just to be safe, to - !! prevent anything else from leaking. - - !if (allocated(arg%lsubscripts)) then - ! deallocate(arg%lsubscripts) - !end if - if (parser%current_kind() /= rparen_token) then comma = parser%match(comma_token) end if @@ -76,6 +68,7 @@ module function parse_fn_call(parser) result(fn_call) if (parser%pos == pos0) dummy = parser%next() end do + call pos_args%push(parser%current_pos() + 1) rparen = parser%match(rparen_token) @@ -288,8 +281,7 @@ module function parse_fn_call(parser) result(fn_call) if (.not. types_match) then - ! TODO: get span of individual arg, not whole arg list - span = new_span(lparen%pos, rparen%pos - lparen%pos + 1) + span = new_span(pos_args%v(i), pos_args%v(i+1) - pos_args%v(i) - 1) call parser%diagnostics%push( & err_bad_arg_type(parser%context(), & span, identifier%text, i, fn%params(i)%name, & @@ -667,7 +659,6 @@ module function parse_struct_declaration(parser) result(decl) type(value_t) :: val - !! TODO? !call parser%vars%push_scope() struct_kw = parser%match(struct_keyword) @@ -817,8 +808,6 @@ module function parse_struct_declaration(parser) result(decl) ! type, just like `parser%vars`. Just add one inside of the `struct_t` ! type. - ! TODO: check for duplicate member names - !print *, "insert var type ", kind_name(val%type) !print *, "insert var name = ", struct%members(i)%name !call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) @@ -828,12 +817,11 @@ module function parse_struct_declaration(parser) result(decl) struct%num_vars, io, overwrite = .false.) !print *, 'io = ', io if (io /= exit_success) then - ! TODO: diag - write(*,*) err_prefix//"re-declared struct member"//color_reset - !span = new_span(identifier%pos, len(identifier%text)) - !call parser%diagnostics%push( & - ! err_redeclare_var(parser%context(), & - ! span, identifier%text)) + span = new_span(pos_mems%v(i), pos_mems%v(i+1) - pos_mems%v(i)) + call parser%diagnostics%push(err_redeclare_mem( & + parser%context(), & + span, & + struct%members(i)%name)) end if end do @@ -960,16 +948,16 @@ module function parse_struct_instance(parser) result(inst) !print *, "char mid = ", struct%vars%dicts(1)%root%mid%split_char call struct%vars%search(name%text, member_id, io, member) - - !member = parser%structs(struct_id)%vars%search(name%text, member_id, io) !print *, "member io = ", io !print *, "member id = ", member_id - if (io /= 0) then - ! TODO: diag - write(*,*) err_prefix//"member """//name%text & - //""" does not exist in struct"//color_reset - stop + span = new_span(name%pos, len(name%text)) + call parser%diagnostics%push(err_bad_member_name( & + parser%context(), & + span, & + name%text, & + identifier%text)) + !return end if !! TODO: if both are struct_type, use struct_name in condition instead From a2124338d5be08e93ed1980b9581f8642b2ef9b7 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 2 Sep 2024 12:19:42 -0400 Subject: [PATCH 094/137] add diags for unset and reset members --- src/errors.f90 | 31 ++++++++++++++++ src/parse_fn.f90 | 96 +++++++++++++++++++++++++++++++++++------------- 2 files changed, 101 insertions(+), 26 deletions(-) diff --git a/src/errors.f90 b/src/errors.f90 index dfa69c16..e43098ac 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -668,6 +668,37 @@ end function err_het_array !=============================================================================== +function err_unset_member(context, span, mem_name, struct_name) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: mem_name, struct_name + err = err_prefix & + //'not all members in struct `'//struct_name//'` are initialized. ' & + //'Member `'//mem_name//'` is uninitialized' & + //underline(context, span) & + //" uninitialized member(s)"//color_reset + +end function err_unset_member + +!=============================================================================== + +function err_reset_member(context, span, mem_name, struct_name) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: mem_name, struct_name + err = err_prefix & + //'member `'//mem_name//'` is already initialized in struct `'//struct_name//'`' & + //underline(context, span) & + //" duplicate member"//color_reset + +end function err_reset_member + +!=============================================================================== + function err_bad_member_name(context, span, mem_name, struct_name) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 734b7094..5bf671dd 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -363,7 +363,7 @@ module function parse_fn_declaration(parser) result(decl) type( string_vector_t) :: names, types type(logical_vector_t) :: is_array - type(integer_vector_t) :: ranks + type(integer_vector_t) :: ranks, pos_args type(struct_t) :: struct @@ -401,6 +401,7 @@ module function parse_fn_declaration(parser) result(decl) types = new_string_vector() is_array = new_logical_vector() ranks = new_integer_vector() + pos_args = new_integer_vector() ! technically params not args ! Array params use this syntax: ! @@ -422,6 +423,7 @@ module function parse_fn_declaration(parser) result(decl) parser%current_kind() /= eof_token) pos0 = parser%current_pos() + call pos_args%push(pos0) !print *, 'matching name' name = parser%match(identifier_token) @@ -446,6 +448,7 @@ module function parse_fn_declaration(parser) result(decl) if (parser%current_pos() == pos0) dummy = parser%next() end do + call pos_args%push(parser%current_pos() + 1) !print *, 'matching rparen' rparen = parser%match(rparen_token) @@ -464,16 +467,9 @@ module function parse_fn_declaration(parser) result(decl) itype = lookup_type(types%v(i)%s, parser%structs, struct) !print *, "itype = ", itype if (itype == unknown_type) then - - ! TODO: make an array of pos's for each param to underline - ! individual param, not whole param list. Struct parser does this - ! slightly better - - span = new_span(pos1, pos2 - pos1 + 1) + span = new_span(pos_args%v(i), pos_args%v(i+1) - pos_args%v(i) - 1) call parser%diagnostics%push(err_bad_type( & parser%context(), span, types%v(i)%s)) - !parser%contexts%v(name%unit_), span, types%v(i)%s)) - end if if (itype == struct_type) then @@ -764,13 +760,9 @@ module function parse_struct_declaration(parser) result(decl) ! TODO: consume dummy_struct for nested structs itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) if (itype == unknown_type) then - - !span = new_span(pos1, pos2 - pos1 - 1) - !span = new_span(lbrace%pos, rbrace%pos - lbrace%pos + 1) span = new_span(pos_mems%v(i), pos_mems%v(i+1) - pos_mems%v(i)) call parser%diagnostics%push(err_bad_type( & parser%context(), span, types%v(i)%s)) - end if if (is_array%v(i)) then @@ -866,7 +858,12 @@ module function parse_struct_instance(parser) result(inst) !******** - integer :: io, pos0, pos1, struct_id, member_id + character(len = :), allocatable :: unset_name + + integer :: io, pos0, pos1, struct_id, member_id, id1(1) + + logical :: is_ok + logical, allocatable :: member_set(:) !type(struct_t), save :: struct type(struct_t) :: struct @@ -908,6 +905,11 @@ module function parse_struct_instance(parser) result(inst) allocate(inst%val%struct( struct%num_vars )) allocate(inst%members ( struct%num_vars )) + !allocate(member_set ( struct%num_vars )) + !member_set = .false. + member_set = spread(.false., 1, struct%num_vars) + !print *, "member_set = ", member_set + !if (allocated(inst%struct)) deallocate(inst%struct) !allocate(inst%struct) !inst%struct = struct @@ -950,7 +952,8 @@ module function parse_struct_instance(parser) result(inst) call struct%vars%search(name%text, member_id, io, member) !print *, "member io = ", io !print *, "member id = ", member_id - if (io /= 0) then + is_ok = io == 0 + if (.not. is_ok) then span = new_span(name%pos, len(name%text)) call parser%diagnostics%push(err_bad_member_name( & parser%context(), & @@ -968,6 +971,7 @@ module function parse_struct_instance(parser) result(inst) !print *, "member type = ", kind_name(member%type) !print *, "mem type = ", kind_name(mem%val%type) + if (is_ok) then if (member%type /= mem%val%type) then !span = new_span(name%pos, parser%current_pos() - name%pos + 1) ! `mem = expr` span = new_span(pos1, parser%current_pos() - pos1) ! just `expr` @@ -979,13 +983,32 @@ module function parse_struct_instance(parser) result(inst) kind_name(mem%val%type), & kind_name(member%type))) end if - - ! TODO: add a size check here too + end if !print *, "mem type = ", kind_name(mem%val%type) - ! Members can be instantiated out of order - inst%val%struct( member_id ) = mem%val - inst%members( member_id ) = mem + ! member_id may be out-of-bounds. Probably want to parse the rest of + ! the tokens in this loop but not try any indexing by member_id if not + ! ok + + if (is_ok) then + + if (member_set(member_id)) then + !span = new_span(identifier%pos, len(identifier%text)) + !span = new_span(pos1, parser%current_pos() - pos1) + span = new_span(name%pos, len(name%text)) + call parser%diagnostics%push(err_reset_member( & + parser%context(), & + span, & + name%text, & + identifier%text)) + end if + + ! Members can be instantiated out of order. Insert by id, not loop iterator + inst%val%struct( member_id ) = mem%val + inst%members( member_id ) = mem + member_set(member_id) = .true. + + end if call mems%push(mem) @@ -1000,16 +1023,37 @@ module function parse_struct_instance(parser) result(inst) rbrace = parser%match(rbrace_token) + ! Use a boolean array to check if all members are set. You could have the + ! correct number but with duplicates and other members missing + !print *, "member_set = ", member_set + if (.not. all(member_set)) then + + ! There could be more than 1 unset member but we only log diag for the + ! 1st one + id1 = findlocl1(member_set, .false.) + !print *, "id1 = ", id1 + !print *, "name = ", struct%members(id1(1))%name + unset_name = struct%members(id1(1))%name + + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push(err_unset_member( & + parser%context(), & + span, & + unset_name, & + identifier%text)) + end if + !print *, "size = ", struct%num_vars !print *, "size = ", mems%len_ - if (mems%len_ /= struct%num_vars) then - ! TODO: diag - write(*,*) err_prefix//"struct instance does not have the right number of members"//color_reset - stop + if (mems%len_ < struct%num_vars) then + ! I think this is unreachable given the other checks + write(*,*) err_prefix//"struct instance does not have enough members"//color_reset + call internal_error() + !else if (mems%len_ > struct%num_vars) then + ! write(*,*) err_prefix//"struct instance has too many members"//color_reset + ! call internal_error() end if - ! TODO: check type of members match - !print *, "ending parse_struct_instance()" end function parse_struct_instance From 7eebcb2f8bddc4c4ea9360e4ff2f361612ea19fb Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 2 Sep 2024 14:42:23 -0400 Subject: [PATCH 095/137] check struct and array subtypes for struct instances --- src/parse_fn.f90 | 109 +++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 91 insertions(+), 18 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 5bf671dd..30821b4d 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -9,6 +9,13 @@ ! subroutine` when pasting them into a submodule. gfortran doesn't care but ! intel fortran will refuse to compile otherwise + integer, parameter :: & + TYPE_RANK_MISMATCH = 4, & + TYPE_ARRAY_MISMATCH = 3, & + TYPE_STRUCT_MISMATCH = 2, & + TYPE_MISMATCH = 1, & + TYPE_MATCH = 0 + !=============================================================================== contains @@ -858,14 +865,13 @@ module function parse_struct_instance(parser) result(inst) !******** - character(len = :), allocatable :: unset_name + character(len = :), allocatable :: unset_name, exp_type, act_type integer :: io, pos0, pos1, struct_id, member_id, id1(1) logical :: is_ok logical, allocatable :: member_set(:) - !type(struct_t), save :: struct type(struct_t) :: struct type(syntax_node_t) :: mem @@ -905,10 +911,7 @@ module function parse_struct_instance(parser) result(inst) allocate(inst%val%struct( struct%num_vars )) allocate(inst%members ( struct%num_vars )) - !allocate(member_set ( struct%num_vars )) - !member_set = .false. member_set = spread(.false., 1, struct%num_vars) - !print *, "member_set = ", member_set !if (allocated(inst%struct)) deallocate(inst%struct) !allocate(inst%struct) @@ -963,16 +966,15 @@ module function parse_struct_instance(parser) result(inst) !return end if - !! TODO: if both are struct_type, use struct_name in condition instead - !! of int enum - !! - !! TODO: check array sub type. Might be time for a do_types_match() fn. - !! Is numeric casting allowed? - !print *, "member type = ", kind_name(member%type) !print *, "mem type = ", kind_name(mem%val%type) if (is_ok) then - if (member%type /= mem%val%type) then + + if (do_types_match(member, mem%val) /= TYPE_MATCH) then + + exp_type = type_str(member) + act_type = type_str(mem%val) + !span = new_span(name%pos, parser%current_pos() - name%pos + 1) ! `mem = expr` span = new_span(pos1, parser%current_pos() - pos1) ! just `expr` call parser%diagnostics%push(err_bad_member_type( & @@ -980,8 +982,9 @@ module function parse_struct_instance(parser) result(inst) span, & name%text, & identifier%text, & - kind_name(mem%val%type), & - kind_name(member%type))) + act_type, & + exp_type)) + end if end if !print *, "mem type = ", kind_name(mem%val%type) @@ -993,8 +996,6 @@ module function parse_struct_instance(parser) result(inst) if (is_ok) then if (member_set(member_id)) then - !span = new_span(identifier%pos, len(identifier%text)) - !span = new_span(pos1, parser%current_pos() - pos1) span = new_span(name%pos, len(name%text)) call parser%diagnostics%push(err_reset_member( & parser%context(), & @@ -1031,9 +1032,9 @@ module function parse_struct_instance(parser) result(inst) ! There could be more than 1 unset member but we only log diag for the ! 1st one id1 = findlocl1(member_set, .false.) - !print *, "id1 = ", id1 - !print *, "name = ", struct%members(id1(1))%name unset_name = struct%members(id1(1))%name + !print *, "id1 = ", id1 + !print *, "name = ", unset_name span = new_span(identifier%pos, len(identifier%text)) call parser%diagnostics%push(err_unset_member( & @@ -1060,6 +1061,78 @@ end function parse_struct_instance !=============================================================================== +function type_str(a) result(str_) + type(value_t), intent(in) :: a + character(len = :), allocatable :: str_ + + if (a%type == struct_type) then + str_ = a%struct_name + else if (a%type == array_type) then + ! TODO: syntran style? Maybe `[i32; :]` instead of `array`. I + ! think the fn call type checker already has a precedent for this + str_ = "array<"//kind_name(a%array%type)//">" + else + str_ = kind_name(a%type) + end if + +end function type_str + +!=============================================================================== + +integer function do_types_match(a, b) result(io) + + ! Check if the type of value a matches value b + ! + ! Numeric casting, e.g. i32 to f32, is not allowed. Maybe we could add a + ! flag if some callers need to allow casting + ! + ! TODO: maybe this fn and type_str() should be moved to types.f90 or + ! somewhere else + + type(value_t), intent(in) :: a, b + + !**************** + + ! TODO: use this for fn calls too + + io = TYPE_MATCH + + if (.not. (a%type == any_type .or. a%type == b%type)) then + ! Top-level type mismatch (e.g. f32 vs str) + io = TYPE_MISMATCH + return + end if + + if (a%type == struct_type) then + if (a%struct_name /= b%struct_name) then + ! Both are structs but different kinds of structs + io = TYPE_STRUCT_MISMATCH + return + end if + end if + + if (a%type == array_type) then + + if (.not. (a%array%type == any_type .or. a%array%type == b%array%type)) then + ! Both arrays but with different types of elements + io = TYPE_ARRAY_MISMATCH + return + end if + + if (.not. (a%array%rank == 0 .or. a%array%rank == b%array%rank)) then + ! Both arrays but with different ranks (e.g. vector vs matrix) + io = TYPE_RANK_MISMATCH + return + end if + + ! TODO: for arrays of structs, check struct sub type + + end if + +end function do_types_match + +!=============================================================================== + module subroutine parse_type(parser, type_text, rank) ! TODO: encapsulate out-args in struct if adding any more From 0154d01c53451e559ba119de74746f2c37eea150 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 2 Sep 2024 17:13:06 -0400 Subject: [PATCH 096/137] dry up fn arg type checking --- src/core.f90 | 1 + src/errors.f90 | 4 +- src/parse_fn.f90 | 170 +++++++++++++++++++++++------------------------ src/types.f90 | 2 +- 4 files changed, 86 insertions(+), 91 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 9eba038b..78b4c43e 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -40,6 +40,7 @@ module syntran__core_m ! * i had broken and fixed binary ops at some point, but i think i ! changed things later which automatically fixed unary ops? ! * tbd: + ! + remove unused vars per cmake warnings ! + remove unused things like mems/members copies in various ! types/routines ! > currently using members for fn param declarations diff --git a/src/errors.f90 b/src/errors.f90 index e43098ac..9ab05aea 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -464,8 +464,8 @@ function err_bad_arg_type(context, span, fn, iarg, param, expect, actual) & err = err_prefix & //'function `'//fn//'` parameter '//str(iarg)//' `'//param & - //'` requires value of '//expect//' but was given a value of ' & - //actual & + //'` requires type `'//expect//'` but was given `' & + //actual//'`' & //underline(context, span)//" wrong argument type"//color_reset end function err_bad_arg_type diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 30821b4d..ffc878f0 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -30,12 +30,10 @@ module function parse_fn_call(parser) result(fn_call) !******** - character(len = :), allocatable :: param_type, arg_type + character(len = :), allocatable :: param_type, arg_type, exp_type, act_type integer :: i, io, id_index, param_rank, arg_rank, ptype, atype, pos0, & - type_, val_type - - logical :: types_match + type_ type(fn_t) :: fn @@ -47,6 +45,8 @@ module function parse_fn_call(parser) result(fn_call) type(text_span_t) :: span + type(value_t) :: param_val + if (debug > 1) print *, 'parse_fn_call' ! Function call expression @@ -244,12 +244,9 @@ module function parse_fn_call(parser) result(fn_call) end if - do i = 1, args%len_ - - val_type = args%v(i)%val%type + allocate(param_val%array) - !print *, kind_name(val_type) - !print *, kind_name(fn%params(i)%type) + do i = 1, args%len_ ! For variadic fns, check the argument type against the type ! of the last required parameter. This may need to change, @@ -259,88 +256,51 @@ module function parse_fn_call(parser) result(fn_call) ! TODO: re-test min/max arg count/type checking - !! We want println() to just print an empty line - !if (fn%variadic_min == 0) exit + ! Construct a param val just for type checking. I think this is the + ! only way to do it for intrinsic fns, which don't actually have a val + ! anywhere if (i <= size(fn%params)) then ptype = fn%params(i)%type - else - ptype = fn%variadic_type - end if - - !j = i - !if (fn%variadic_min > 0) j = fn%variadic_min - !ptype = fn%params(j)%type - - types_match = & - ptype == any_type .or. ptype == val_type - - !! make a fn for use here and for array `atype` below? this - !! could be more easily extended if i add fn's with something - !! generic like `int_type` or `num_type` - !types_match = .false. - !select case (ptype) - !case (any_type) - ! types_match = .true. - !case default - ! types_match = ptype == val_type - !end select - if (.not. types_match) then + param_val%type = fn%params(i)%type + param_val%array%type = fn%params(i)%array_type + param_val%array%rank = fn%params(i)%rank + ! TODO: struct_name - span = new_span(pos_args%v(i), pos_args%v(i+1) - pos_args%v(i) - 1) - call parser%diagnostics%push( & - err_bad_arg_type(parser%context(), & - span, identifier%text, i, fn%params(i)%name, & - kind_name(ptype), & - kind_name(val_type))) - return - - end if - - ! TODO: fns w/ variadic array params are not implemented - if (fn%variadic_min >= 0 .and. i > size(fn%params)) cycle - - if (ptype == array_type) then - atype = fn%params(i)%array_type - types_match = & - atype == any_type .or. & - atype == args%v(i)%val%array%type - end if - - if (.not. types_match) then - - span = new_span(lparen%pos, rparen%pos - lparen%pos + 1) - param_type = kind_name( atype) - arg_type = kind_name(args%v(i)%val%array%type) + else + ptype = fn%variadic_type - call parser%diagnostics%push( & - err_bad_array_arg_type(parser%context(), & - span, identifier%text, i, fn%params(i)%name, & - param_type, arg_type)) - return + param_val%type = fn%variadic_type + param_val%array%type = unknown_type + param_val%array%rank = 0 + param_val%struct_name = "" end if - if (ptype == array_type) then - param_rank = fn%params(i)%rank - arg_rank = args%v(i)%val%array%rank - - if (param_rank >= 0 .and. param_rank /= arg_rank) then + if (types_match(param_val, args%v(i)%val) /= TYPE_MATCH) then - span = new_span(lparen%pos, & - rparen%pos - lparen%pos + 1) + exp_type = type_name(param_val) + act_type = type_name(args%v(i)%val) - call parser%diagnostics%push( & - err_bad_arg_rank(parser%context(), & - span, identifier%text, i, fn%params(i)%name, & - param_rank, arg_rank)) - return + ! This used to call a different diagnostic fn depending on whether + ! it was a top-level type mismatch, array mismatch, or rank + ! mismatch. types_match() returns an enum so we could make it that + ! way again if there's a need. Currently err_bad_arg_rank() is + ! unused - end if + !span = new_span(pos1, parser%current_pos() - pos1) + span = new_span(pos_args%v(i), pos_args%v(i+1) - pos_args%v(i) - 1) + call parser%diagnostics%push(err_bad_arg_type( & + parser%context(), & + span, & + identifier%text, & + i, & + fn%params(i)%name, & + exp_type, & + act_type)) end if - end do fn_call%id_index = id_index @@ -970,10 +930,10 @@ module function parse_struct_instance(parser) result(inst) !print *, "mem type = ", kind_name(mem%val%type) if (is_ok) then - if (do_types_match(member, mem%val) /= TYPE_MATCH) then + if (types_match(member, mem%val) /= TYPE_MATCH) then - exp_type = type_str(member) - act_type = type_str(mem%val) + exp_type = type_name(member) + act_type = type_name(mem%val) !span = new_span(name%pos, parser%current_pos() - name%pos + 1) ! `mem = expr` span = new_span(pos1, parser%current_pos() - pos1) ! just `expr` @@ -1061,25 +1021,61 @@ end function parse_struct_instance !=============================================================================== -function type_str(a) result(str_) +function type_name(a) result(str_) + ! c.f. lookup_type() which is mostly the inverse of this type(value_t), intent(in) :: a character(len = :), allocatable :: str_ if (a%type == struct_type) then str_ = a%struct_name else if (a%type == array_type) then + ! TODO: syntran style? Maybe `[i32; :]` instead of `array`. I ! think the fn call type checker already has a precedent for this - str_ = "array<"//kind_name(a%array%type)//">" + + !str_ = "array<"//type_name_primitive(a%array%type)//">" + !str_ = "["//type_name_primitive(a%array%type)//"; :]" + + ! Repeat ":, " appropriately + str_ = "["//type_name_primitive(a%array%type)//"; " + str_ = str_//repeat(":, ", a%array%rank - 1) + str_ = str_//":]" + else - str_ = kind_name(a%type) + str_ = type_name_primitive(a%type) end if -end function type_str +end function type_name + +!=============================================================================== + +function type_name_primitive(itype) result(str_) + ! c.f. lookup_type() which is mostly the inverse of this + integer, intent(in) :: itype + character(len = :), allocatable :: str_ + + select case (itype) + case (i32_type) + str_ = "i32" + case (i64_type) + str_ = "i64" + case (f32_type) + str_ = "f32" + case (str_type) + str_ = "str" + case (bool_type) + str_ = "bool" + case (any_type) + str_ = "any" + case default + str_ = "unknown" + end select + +end function type_name_primitive !=============================================================================== -integer function do_types_match(a, b) result(io) +integer function types_match(a, b) result(io) ! Check if the type of value a matches value b ! @@ -1093,8 +1089,6 @@ integer function do_types_match(a, b) result(io) !**************** - ! TODO: use this for fn calls too - io = TYPE_MATCH if (.not. (a%type == any_type .or. a%type == b%type)) then @@ -1129,7 +1123,7 @@ integer function do_types_match(a, b) result(io) end if -end function do_types_match +end function types_match !=============================================================================== diff --git a/src/types.f90 b/src/types.f90 index b7befcc0..2c49b887 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -43,7 +43,7 @@ module syntran__types_m type fn_t ! Function signature: input and output types - ! Return type + ! Return type. TODO: add struct_name and check it integer :: type, array_type, rank ! Arguments/parameters. Technically, "arguments" in most languages are From d7160259685f193315e060b71b32666771525a39 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 2 Sep 2024 17:31:54 -0400 Subject: [PATCH 097/137] check struct type; fix tests :pray: --- src/parse_fn.f90 | 19 +++++++++++++------ src/types.f90 | 1 + 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index ffc878f0..58cf16bc 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -264,9 +264,9 @@ module function parse_fn_call(parser) result(fn_call) ptype = fn%params(i)%type param_val%type = fn%params(i)%type - param_val%array%type = fn%params(i)%array_type - param_val%array%rank = fn%params(i)%rank - ! TODO: struct_name + param_val%array%type = fn%params(i)%array_type + param_val%array%rank = fn%params(i)%rank + param_val%struct_name = fn%params(i)%struct_name else ptype = fn%variadic_type @@ -295,7 +295,7 @@ module function parse_fn_call(parser) result(fn_call) parser%context(), & span, & identifier%text, & - i, & + i - 1, & ! 0-based index in err msg fn%params(i)%name, & exp_type, & act_type)) @@ -480,6 +480,12 @@ module function parse_fn_declaration(parser) result(decl) !print *, "(scalar)" end if + ! TODO: i think this will fail for an array of structs + if (itype == struct_type) then + fn%params(i)%struct_name = val%struct_name + print *, "struct_name = ", val%struct_name + end if + ! Declare the parameter variable parser%num_vars = parser%num_vars + 1 @@ -536,6 +542,7 @@ module function parse_fn_declaration(parser) result(decl) else fn%type = itype end if + ! TODO: struct_name for fn return type end if !print *, 'fn%type = ', fn%type @@ -1038,7 +1045,7 @@ function type_name(a) result(str_) ! Repeat ":, " appropriately str_ = "["//type_name_primitive(a%array%type)//"; " - str_ = str_//repeat(":, ", a%array%rank - 1) + str_ = str_//repeat(":, ", max(a%array%rank - 1, 0)) str_ = str_//":]" else @@ -1113,7 +1120,7 @@ integer function types_match(a, b) result(io) return end if - if (.not. (a%array%rank == 0 .or. a%array%rank == b%array%rank)) then + if (.not. (a%array%rank < 0 .or. a%array%rank == b%array%rank)) then ! Both arrays but with different ranks (e.g. vector vs matrix) io = TYPE_RANK_MISMATCH return diff --git a/src/types.f90 b/src/types.f90 index 2c49b887..cdb6a298 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -29,6 +29,7 @@ module syntran__types_m integer :: type character(len = :), allocatable :: name + character(len = :), allocatable :: struct_name integer :: array_type, rank From c9c9d3426f5913af4b3df96e526dd36178a550aa Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 3 Sep 2024 20:10:18 -0400 Subject: [PATCH 098/137] check assignment and fn arg array of struct types --- src/parse_expr.f90 | 17 +++++-- src/parse_fn.f90 | 117 +----------------------------------------- src/types.f90 | 123 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 139 insertions(+), 118 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index b5a5ecba..cbb3a90c 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -23,6 +23,8 @@ recursive module function parse_expr_statement(parser) result(expr) !******** + logical :: is_op_allowed + integer :: io, ltype, rtype, pos0, lrank, rrank, larrtype, & rarrtype, id_index, search_io @@ -217,9 +219,16 @@ recursive module function parse_expr_statement(parser) result(expr) !print *, "ltype = ", kind_name(ltype) !print *, "rtype = ", kind_name(rtype) + is_op_allowed = is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype) + if (ltype == struct_type .and. is_op_allowed) then + if (expr%val%struct_name /= expr%right%val%struct_name) then + is_op_allowed = .false. + end if + end if + ! This check could be moved inside of is_binary_op_allowed, but we would ! need to pass parser to it to push diagnostics - if (.not. is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype)) then + if (.not. is_op_allowed) then !print *, 'bin not allowed in parse_expr_statement' @@ -227,8 +236,10 @@ recursive module function parse_expr_statement(parser) result(expr) call parser%diagnostics%push( & err_binary_types(parser%context(), & span, op%text, & - kind_name(ltype), & - kind_name(rtype))) + type_name(expr%val), & + type_name(expr%right%val))) + !kind_name(ltype), & + !kind_name(rtype))) end if diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 58cf16bc..3610cdfa 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -9,13 +9,6 @@ ! subroutine` when pasting them into a submodule. gfortran doesn't care but ! intel fortran will refuse to compile otherwise - integer, parameter :: & - TYPE_RANK_MISMATCH = 4, & - TYPE_ARRAY_MISMATCH = 3, & - TYPE_STRUCT_MISMATCH = 2, & - TYPE_MISMATCH = 1, & - TYPE_MATCH = 0 - !=============================================================================== contains @@ -267,6 +260,7 @@ module function parse_fn_call(parser) result(fn_call) param_val%array%type = fn%params(i)%array_type param_val%array%rank = fn%params(i)%rank param_val%struct_name = fn%params(i)%struct_name + !param_val%array%struct_name = fn%params(i)%array_struct_name else ptype = fn%variadic_type @@ -480,10 +474,9 @@ module function parse_fn_declaration(parser) result(decl) !print *, "(scalar)" end if - ! TODO: i think this will fail for an array of structs if (itype == struct_type) then fn%params(i)%struct_name = val%struct_name - print *, "struct_name = ", val%struct_name + !print *, "struct_name = ", val%struct_name end if ! Declare the parameter variable @@ -1028,112 +1021,6 @@ end function parse_struct_instance !=============================================================================== -function type_name(a) result(str_) - ! c.f. lookup_type() which is mostly the inverse of this - type(value_t), intent(in) :: a - character(len = :), allocatable :: str_ - - if (a%type == struct_type) then - str_ = a%struct_name - else if (a%type == array_type) then - - ! TODO: syntran style? Maybe `[i32; :]` instead of `array`. I - ! think the fn call type checker already has a precedent for this - - !str_ = "array<"//type_name_primitive(a%array%type)//">" - !str_ = "["//type_name_primitive(a%array%type)//"; :]" - - ! Repeat ":, " appropriately - str_ = "["//type_name_primitive(a%array%type)//"; " - str_ = str_//repeat(":, ", max(a%array%rank - 1, 0)) - str_ = str_//":]" - - else - str_ = type_name_primitive(a%type) - end if - -end function type_name - -!=============================================================================== - -function type_name_primitive(itype) result(str_) - ! c.f. lookup_type() which is mostly the inverse of this - integer, intent(in) :: itype - character(len = :), allocatable :: str_ - - select case (itype) - case (i32_type) - str_ = "i32" - case (i64_type) - str_ = "i64" - case (f32_type) - str_ = "f32" - case (str_type) - str_ = "str" - case (bool_type) - str_ = "bool" - case (any_type) - str_ = "any" - case default - str_ = "unknown" - end select - -end function type_name_primitive - -!=============================================================================== - -integer function types_match(a, b) result(io) - - ! Check if the type of value a matches value b - ! - ! Numeric casting, e.g. i32 to f32, is not allowed. Maybe we could add a - ! flag if some callers need to allow casting - ! - ! TODO: maybe this fn and type_str() should be moved to types.f90 or - ! somewhere else - - type(value_t), intent(in) :: a, b - - !**************** - - io = TYPE_MATCH - - if (.not. (a%type == any_type .or. a%type == b%type)) then - ! Top-level type mismatch (e.g. f32 vs str) - io = TYPE_MISMATCH - return - end if - - if (a%type == struct_type) then - if (a%struct_name /= b%struct_name) then - ! Both are structs but different kinds of structs - io = TYPE_STRUCT_MISMATCH - return - end if - end if - - if (a%type == array_type) then - - if (.not. (a%array%type == any_type .or. a%array%type == b%array%type)) then - ! Both arrays but with different types of elements - io = TYPE_ARRAY_MISMATCH - return - end if - - if (.not. (a%array%rank < 0 .or. a%array%rank == b%array%rank)) then - ! Both arrays but with different ranks (e.g. vector vs matrix) - io = TYPE_RANK_MISMATCH - return - end if - - ! TODO: for arrays of structs, check struct sub type - - end if - -end function types_match - -!=============================================================================== - module subroutine parse_type(parser, type_text, rank) ! TODO: encapsulate out-args in struct if adding any more diff --git a/src/types.f90 b/src/types.f90 index cdb6a298..4b52f705 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -10,6 +10,14 @@ module syntran__types_m implicit none + integer, parameter :: & + TYPE_ARRAY_STRUCT_MISMATCH = 5, & + TYPE_RANK_MISMATCH = 4, & + TYPE_ARRAY_MISMATCH = 3, & + TYPE_STRUCT_MISMATCH = 2, & + TYPE_MISMATCH = 1, & + TYPE_MATCH = 0 + !******** type member_t @@ -30,6 +38,7 @@ module syntran__types_m integer :: type character(len = :), allocatable :: name character(len = :), allocatable :: struct_name + !character(len = :), allocatable :: array_struct_name integer :: array_type, rank @@ -1510,6 +1519,10 @@ logical function is_binary_op_allowed(left, op, right, left_arr, right_arr) & !allowed = .true. !return + ! TODO: pass struct_name into this somehow and check it. Maybe just pass a + ! val instead of ints? Maybe just special-case check assignment ops in + ! caller for structs + allowed = .false. if (left == unknown_type .or. right == unknown_type) then @@ -2708,6 +2721,116 @@ end subroutine struct_search !=============================================================================== +function type_name(a) result(str_) + ! c.f. lookup_type() which is mostly the inverse of this + type(value_t), intent(in) :: a + character(len = :), allocatable :: str_, array_name + + if (a%type == struct_type) then + str_ = a%struct_name + else if (a%type == array_type) then + + if (a%array%type == struct_type) then + array_name = a%struct_name + else + array_name = type_name_primitive(a%array%type) + end if + + str_ = "["//array_name//"; " + + ! Repeat ":, " appropriately + str_ = str_//repeat(":, ", max(a%array%rank - 1, 0)) + str_ = str_//":]" + + else + str_ = type_name_primitive(a%type) + end if + +end function type_name + +!=============================================================================== + +function type_name_primitive(itype) result(str_) + ! c.f. lookup_type() which is mostly the inverse of this + integer, intent(in) :: itype + character(len = :), allocatable :: str_ + + select case (itype) + case (i32_type) + str_ = "i32" + case (i64_type) + str_ = "i64" + case (f32_type) + str_ = "f32" + case (str_type) + str_ = "str" + case (bool_type) + str_ = "bool" + case (any_type) + str_ = "any" + case default + str_ = "unknown" + end select + +end function type_name_primitive + +!=============================================================================== + +integer function types_match(a, b) result(io) + + ! Check if the type of value a matches value b + ! + ! Numeric casting, e.g. i32 to f32, is not allowed. Maybe we could add a + ! flag if some callers need to allow casting + + type(value_t), intent(in) :: a, b + + !**************** + + io = TYPE_MATCH + + if (.not. (a%type == any_type .or. a%type == b%type)) then + ! Top-level type mismatch (e.g. f32 vs str) + io = TYPE_MISMATCH + return + end if + + if (a%type == struct_type) then + if (a%struct_name /= b%struct_name) then + ! Both are structs but different kinds of structs + io = TYPE_STRUCT_MISMATCH + return + end if + end if + + if (a%type == array_type) then + + if (.not. (a%array%type == any_type .or. a%array%type == b%array%type)) then + ! Both arrays but with different types of elements + io = TYPE_ARRAY_MISMATCH + return + end if + + if (.not. (a%array%rank < 0 .or. a%array%rank == b%array%rank)) then + ! Both arrays but with different ranks (e.g. vector vs matrix) + io = TYPE_RANK_MISMATCH + return + end if + + if (a%array%type == struct_type) then + if (a%struct_name /= b%struct_name) then + ! Both are arrays of structs but different kinds of structs + io = TYPE_ARRAY_STRUCT_MISMATCH + return + end if + end if + + end if + +end function types_match + +!=============================================================================== + end module syntran__types_m !=============================================================================== From e1606c14aa81afa01ef0c3d1c429ee6e992c9904 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 3 Sep 2024 20:36:17 -0400 Subject: [PATCH 099/137] cleanup --- samples/struct.syntran | 72 +++++++++++++++--------------------------- src/consts.f90 | 2 +- src/core.f90 | 2 +- src/parse_control.f90 | 2 ++ src/parse_expr.f90 | 19 +++-------- src/parse_fn.f90 | 18 +---------- src/types.f90 | 18 ----------- 7 files changed, 36 insertions(+), 97 deletions(-) diff --git a/samples/struct.syntran b/samples/struct.syntran index da97c77e..e3b1da10 100644 --- a/samples/struct.syntran +++ b/samples/struct.syntran @@ -6,71 +6,51 @@ struct Time ss: f32, // trailing comma is optional } -//let t1 = Time(hh = 9, mm = 20, ss = 0.030,); let t1 = Time{hh = 9, mm = 20, ss = 0.030,}; -//let t1num = Time{hh = 9, mm = 20}; -//let t1htns = Time{hh = 9, mm = 20, sshtns = 0.030,}; - -//let taoeu = Timeaoeu{hh = 9, mm = 20, ss = 0.030,}; - -//println("t1.hh = ", t1.hh); - -//t1.hh = 10; println("t1.hh = ", t1.hh); -//let t3 = t1; -//println("t1 = ", t1); let t2 = Time{hh = 13, mm = 37, ss = 0.069,}; -//fn print_time(t: Time) -//{ -// // TODO -// println("h = ", t.hh); -// println("m = ", t.mm); -// println("s = ", t.ss); -// return; -//} +fn print_time(t: Time) +{ + // You can also do `println("t = ", t);` if you're ok with the default + // formatting + println("h = ", t.hh); + println("m = ", t.mm); + println("s = ", t.ss); + println(); + return; +} struct Date { d: i32, - //m: stri, // err: bad type m: str, y: i64 } -let d1 = Date{y = i64(1900) + 12, m = "Apr", d = 14}; - -//let d1 = Date{y = i64(1912), m = "Apr", d = 14}; -//d1.d = 1969; - -println("d1.y = ", d1.y); -println("d1.m = ", d1.m); -println("d1.d = ", d1.d); +fn print_date(d: Date) +{ + println("y = ", d.y); + println("m = ", d.m); + println("d = ", d.d); + println(); + return; +} -println("t1.hh = ", t1.hh); -println("t1.mm = ", t1.mm); -println("t1.ss = ", t1.ss); +let d1 = Date{y = i64(1900) + 12, m = "Apr", d = 14}; +println("d1 ="); +print_date(d1); -println("t2.hh = ", t2.hh); -println("t2.mm = ", t2.mm); -println("t2.ss = ", t2.ss); +println("t1 ="); +print_time(t1); t2 = t1; -println("t2.hh = ", t2.hh); -println("t2.mm = ", t2.mm); -println("t2.ss = ", t2.ss); +t2.hh = 11; +println("t2 = ", t2); d1 = Date{y = i64(1900) + 45, m = "Ma" + "y", d = 5*4}; d1.m = "June"; -println("d1.y = ", d1.y); -println("d1.m = ", d1.m); -println("d1.d = ", d1.d); - -// TODO: date is cast as time by member indices! -t2 = d1; -println("t2.hh = ", t2.hh); -println("t2.mm = ", t2.mm); -println("t2.ss = ", t2.ss); +println("d1 = ", d1); return 0; diff --git a/src/consts.f90 b/src/consts.f90 index 29aff2f5..eaf34d84 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -16,7 +16,7 @@ module syntran__consts_m ! Token and syntax node kinds enum. Is there a better way to do this that ! allows re-ordering enums? Currently it would break kind_name() integer, parameter :: & - dot_expr = 98, & ! TODO: rename to rhs_dot_expr + dot_expr = 98, & struct_type = 97, & struct_instance_expr = 96, & struct_declaration = 95, & diff --git a/src/core.f90 b/src/core.f90 index 78b4c43e..3aaae3eb 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -50,7 +50,6 @@ module syntran__core_m ! > check mismatches of assigning one struct to another, or passing a ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names - ! - triage notes from AOC. many things are already fixed ! - jumping control flow: ! * fn return statement done ! * c continue (fortran cycle), c break (fortran loop exit) @@ -83,6 +82,7 @@ module syntran__core_m ! - cmd args ! * args would be useful for logo sample, e.g. image size and some ! control color options + ! * related: environment variables ! - check assignment to void type? guard against things like ! `let x = println();` ! * did i allow this to stop cascading errors? i think i used diff --git a/src/parse_control.f90 b/src/parse_control.f90 index a65d2309..c319327c 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -63,6 +63,8 @@ module function parse_return_statement(parser) result(statement) ! ! There should also be a check that every branch of a fn has a return ! statement, but that seems more difficult + ! + ! TODO: use types_match() and then pass type_name() to err_bad_ret*() act_type = statement%right%val%type types_match = & parser%fn_type == any_type .or. parser%fn_type == act_type diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index cbb3a90c..acd54def 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -33,7 +33,7 @@ recursive module function parse_expr_statement(parser) result(expr) type(text_span_t) :: span - type(value_t) :: var, val_sub + type(value_t) :: var !print *, 'starting parse_expr_statement()' @@ -138,7 +138,6 @@ recursive module function parse_expr_statement(parser) result(expr) ! Delay the error-handling on search_io because we might end up rewinding call parser%vars%search(identifier%text, expr%id_index, search_io, expr%val) call parser%parse_subscripts(expr) - !val_sub = expr%val ! backup for later if (parser%peek_kind(0) == dot_token) then !print *, "dot token" @@ -152,7 +151,6 @@ recursive module function parse_expr_statement(parser) result(expr) call parser%parse_dot(expr) if (.not. allocated(expr%member)) return - !val_sub = expr%val end if @@ -189,7 +187,6 @@ recursive module function parse_expr_statement(parser) result(expr) ! has been declared, unless it is a struct which has already been looked ! up above if (.not. allocated(expr%member)) then - !call parser%vars%search(identifier%text, expr%id_index, io, expr%val) if (search_io /= exit_success) then span = new_span(identifier%pos, len(identifier%text)) call parser%diagnostics%push( & @@ -199,13 +196,8 @@ recursive module function parse_expr_statement(parser) result(expr) end if !print *, 'type = ', kind_name(expr%val%type) - !print *, 'allocated(expr%val%array) = ', allocated(expr%val%array) - !if (allocated(expr%lsubscripts)) then - ! expr%val = val_sub - !end if - ltype = expr%val%type rtype = expr%right%val%type @@ -222,6 +214,10 @@ recursive module function parse_expr_statement(parser) result(expr) is_op_allowed = is_binary_op_allowed(ltype, op%kind, rtype, larrtype, rarrtype) if (ltype == struct_type .and. is_op_allowed) then if (expr%val%struct_name /= expr%right%val%struct_name) then + ! TODO: this is a one-off check for assignment of one struct to + ! another. It should really be inside of is_binary_op_allowed(), + ! but I should change is_binary_op_allowed() to take 2 value_t + ! args, instead of a bunch of int args as-is is_op_allowed = .false. end if end if @@ -229,18 +225,13 @@ recursive module function parse_expr_statement(parser) result(expr) ! This check could be moved inside of is_binary_op_allowed, but we would ! need to pass parser to it to push diagnostics if (.not. is_op_allowed) then - !print *, 'bin not allowed in parse_expr_statement' - span = new_span(op%pos, len(op%text)) call parser%diagnostics%push( & err_binary_types(parser%context(), & span, op%text, & type_name(expr%val), & type_name(expr%right%val))) - !kind_name(ltype), & - !kind_name(rtype))) - end if if (ltype == array_type .and. rtype == array_type) then diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 3610cdfa..240d8c73 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -25,8 +25,7 @@ module function parse_fn_call(parser) result(fn_call) character(len = :), allocatable :: param_type, arg_type, exp_type, act_type - integer :: i, io, id_index, param_rank, arg_rank, ptype, atype, pos0, & - type_ + integer :: i, io, id_index, param_rank, arg_rank, pos0, type_ type(fn_t) :: fn @@ -238,7 +237,6 @@ module function parse_fn_call(parser) result(fn_call) end if allocate(param_val%array) - do i = 1, args%len_ ! For variadic fns, check the argument type against the type @@ -252,24 +250,16 @@ module function parse_fn_call(parser) result(fn_call) ! Construct a param val just for type checking. I think this is the ! only way to do it for intrinsic fns, which don't actually have a val ! anywhere - if (i <= size(fn%params)) then - ptype = fn%params(i)%type - param_val%type = fn%params(i)%type param_val%array%type = fn%params(i)%array_type param_val%array%rank = fn%params(i)%rank param_val%struct_name = fn%params(i)%struct_name - !param_val%array%struct_name = fn%params(i)%array_struct_name - else - ptype = fn%variadic_type - param_val%type = fn%variadic_type param_val%array%type = unknown_type param_val%array%rank = 0 param_val%struct_name = "" - end if if (types_match(param_val, args%v(i)%val) /= TYPE_MATCH) then @@ -283,7 +273,6 @@ module function parse_fn_call(parser) result(fn_call) ! way again if there's a need. Currently err_bad_arg_rank() is ! unused - !span = new_span(pos1, parser%current_pos() - pos1) span = new_span(pos_args%v(i), pos_args%v(i+1) - pos_args%v(i) - 1) call parser%diagnostics%push(err_bad_arg_type( & parser%context(), & @@ -882,11 +871,6 @@ module function parse_struct_instance(parser) result(inst) !print *, "struct name = ", inst%struct_name - ! TODO: each struct should get a different sub type (like array_type) for - ! type checking, so you don't try to assign one type of struct to another - ! struct. Should be able to use struct_name for this, although comparing - ! ints might be more efficient than comparing strings - do while ( & parser%current_kind() /= rbrace_token .and. & parser%current_kind() /= eof_token) diff --git a/src/types.f90 b/src/types.f90 index 4b52f705..bf9b5420 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -38,7 +38,6 @@ module syntran__types_m integer :: type character(len = :), allocatable :: name character(len = :), allocatable :: struct_name - !character(len = :), allocatable :: array_struct_name integer :: array_type, rank @@ -1519,10 +1518,6 @@ logical function is_binary_op_allowed(left, op, right, left_arr, right_arr) & !allowed = .true. !return - ! TODO: pass struct_name into this somehow and check it. Maybe just pass a - ! val instead of ints? Maybe just special-case check assignment ops in - ! caller for structs - allowed = .false. if (left == unknown_type .or. right == unknown_type) then @@ -1603,19 +1598,6 @@ logical function is_binary_op_allowed(left, op, right, left_arr, right_arr) & (is_int_type(left_arr) .and. is_int_type(right)) .or. & (left_arr == right) .or. (left == right) - !! TODO: just combine this with condition above - !else if (left == struct_type) then - ! allowed = & - ! (is_int_type(left_arr) .and. is_int_type(right)) .or. & - ! (left_arr == right) .or. (left == right) - - !else if (right == struct_type) then - ! ! I'm not sure about this one. It's needed at least for things - ! ! like `x = t1.m` but I think it's too broad and general - ! allowed = & - ! (is_int_type(left) .and. is_int_type(right_arr)) .or. & - ! (left == right_arr) .or. (left == right) - else allowed = & (is_int_type(left) .and. is_int_type(right)) .or. & From 46eb09f9f9980c5d7399feb358717e4bf9a67037 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 3 Sep 2024 20:56:16 -0400 Subject: [PATCH 100/137] ban struct/array slicing --- src/errors.f90 | 31 +++++++++++++++++++++++++++++++ src/parse_array.f90 | 6 ++++++ src/parse_expr.f90 | 14 +++++++++++++- 3 files changed, 50 insertions(+), 1 deletion(-) diff --git a/src/errors.f90 b/src/errors.f90 index 9ab05aea..c19841fb 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -83,6 +83,37 @@ end function err_unterminated_str !=============================================================================== +function err_array_struct_slice(context, span, array) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: array + + err = err_prefix & + //'slices are not implemented for arrays of structs, on array `' & + //array//'`' & + //underline(context, span) & + //" slice subscript not implemented"//color_reset + +end function err_array_struct_slice + +!=============================================================================== + +function err_struct_array_slice(context, span) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + err = err_prefix//'slices are not implemented for structs of arrays. ' & + //'Only scalar subscripts can be used here' & + //underline(context, span) & + //' slice subscript not implemented'//color_reset + +end function err_struct_array_slice + +!=============================================================================== + function err_non_int_subscript(context, span, subscript) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_array.f90 b/src/parse_array.f90 index cdf61b1c..91bdb654 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -535,6 +535,12 @@ module subroutine parse_subscripts(parser, expr) if (all(expr%lsubscripts%sub_kind == scalar_sub)) then ! this is not necessarily true for strings expr%val%type = expr%val%array%type + else if (expr%val%array%type == struct_type) then + span = new_span(span0, span1 - span0 + 1) + call parser%diagnostics%push(err_array_struct_slice( & + parser%context(), & + span, & + expr%identifier%text)) end if ! TODO: allow rank+1 for str arrays diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index acd54def..84aecc1c 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -562,12 +562,14 @@ recursive module subroutine parse_dot(parser, expr) !******** - integer :: io, struct_id, member_id + integer :: io, struct_id, member_id, pos0, pos1 type(struct_t) :: struct type(syntax_token_t) :: dot, identifier + type(text_span_t) :: span + type(value_t) :: member if (parser%current_kind() /= dot_token) return @@ -623,9 +625,19 @@ recursive module subroutine parse_dot(parser, expr) ! I think this is the right place to parse subscripts. Or should it be after ! the recursive parse_dot()? expr%member%val = member + pos0 = parser%current_pos() call parser%parse_subscripts(expr%member) + pos1 = parser%current_pos() if (allocated(expr%member%lsubscripts)) then expr%val = expr%member%val + + if (.not. all(expr%member%lsubscripts%sub_kind == scalar_sub)) then + span = new_span(pos0, pos1 - pos0) + call parser%diagnostics%push(err_struct_array_slice( & + parser%context(), & + span)) + end if + end if ! I think this needs a recursive call to `parse_dot()` right here to handle From 51832e458c9732d2b371ffdf85f9a85a31f2ef43 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 5 Sep 2024 19:11:31 -0400 Subject: [PATCH 101/137] cleanup --- samples/array-fns.syntran | 33 +++------------------------------ src/eval.f90 | 12 ++---------- src/value.f90 | 3 ++- 3 files changed, 7 insertions(+), 41 deletions(-) diff --git a/samples/array-fns.syntran b/samples/array-fns.syntran index 3bc96f2c..016c1c16 100644 --- a/samples/array-fns.syntran +++ b/samples/array-fns.syntran @@ -1,7 +1,4 @@ -let chain = true; -//chain = false; - fn mul_mat_vec(mat: [f32; :,:], vec: [f32; :]): [f32; :] { // Matrix-vector multiplication. Return mat * vec @@ -72,14 +69,7 @@ println(mul_mat_vec(rotx, vec)); // Apply 180 degree x rotation -if chain - println(mul_mat_vec(mul_mat(rotx, rotx), vec)); -else -{ - let rotxx = mul_mat(rotx, rotx); - println(mul_mat_vec(rotxx, vec)); -} - +println(mul_mat_vec(mul_mat(rotx, rotx), vec)); println(mul_mat_vec(mul_mat(rotx, rotx), vec)); // [1.0, -2.0, -3.0] @@ -89,31 +79,14 @@ println(mul_mat_vec(mul_mat(rotx, rotx), vec)); // to applying a 180 degree z rotation println("calling 1"); -// TODO: this is broken. It should work as a chain of fn calls (without temp -//// var rotxx) but there's a syntran bug, maybe re deep copy of value_t -//// -if chain - println(mul_mat_vec(mul_mat(mul_mat(mul_mat(rotx, rotx), roty), roty), vec)); -else -{ - let rotxx = mul_mat(rotx, rotx); - let rotxxy = mul_mat(rotxx, roty); - println(mul_mat_vec(mul_mat(rotxxy, roty), vec)); -} +println(mul_mat_vec(mul_mat(mul_mat(mul_mat(rotx, rotx), roty), roty), vec)); println("done 1"); // [-1.0, -2.0, 3.0] println("calling 2"); -if chain - println(mul_mat(mul_mat(mul_mat(rotx, rotx), roty), roty)); -else -{ - let rotxx = mul_mat(rotx, rotx); - let rotxxy = mul_mat(rotxx, roty); - println(mul_mat(rotxxy, roty)); -} +println(mul_mat(mul_mat(mul_mat(rotx, rotx), roty), roty)); println("done 2"); // [ diff --git a/src/eval.f90 b/src/eval.f90 index bfcc2630..c0c2f930 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -440,8 +440,6 @@ recursive subroutine set_val(node, var, state, val) !print *, "array dot chain" ! Arrays chained by a dot: `a[0].b[0]` - ! - ! TODO: ban non-scalar subscripts like below j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) call set_array_val(var%struct(i8+1)%struct(id)%array, j8, val) return @@ -481,9 +479,7 @@ recursive subroutine set_val(node, var, state, val) !print *, "lsubscripts allocated" if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then - !print *, "slice sub" - - ! TODO: not implemented, throw error. Add code to catch in parser first + ! Already caught in parser write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset call internal_error() end if @@ -506,7 +502,7 @@ end subroutine set_val recursive function get_val(node, var, state) result(res) ! TODO: should res be an out arg for consistency? Similar question for - ! get_array_val() + ! get_array_val(). Yes: https://github.com/JeffIrwin/syntran/pull/12 ! ! Should I rename this eval_*() for consistency? @@ -633,8 +629,6 @@ subroutine eval_struct_instance(node, state, res) !******** - !type(value_t) :: tmp - integer :: i !print *, 'eval struct_instance_expr' @@ -654,8 +648,6 @@ subroutine eval_struct_instance(node, state, res) do i = 1, size(node%members) call syntax_eval(node%members(i), state, res%struct(i)) - !call syntax_eval(node%members(i), state, tmp) - !res%struct(i) = tmp !print *, "mem[", str(i), "] = ", res%struct(i)%to_str() !res = node%val%struct( node%right%id_index ) diff --git a/src/value.f90 b/src/value.f90 index 4fb82101..1803cb04 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -150,7 +150,8 @@ recursive subroutine value_copy(dst, src) if (allocated(src%struct)) then ! TODO: some of the allocations above are wrong. make them like this - ! one which crashed on a 3rd-order Pyramid struct befored i fixed it + ! one which crashed on a 3rd-order Pyramid struct befored i fixed it. + ! there are similar potential issues in fn_copy() if (allocated(dst%struct)) deallocate(dst%struct) allocate(dst%struct( size(src%struct) )) do i = 1, size(src%struct) From c6bd6ab9283fdac7e3b61498815f4dccd8c1ceca Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 5 Sep 2024 20:49:25 -0400 Subject: [PATCH 102/137] stuff --- Dockerfile.ubuntu | 28 ++++++++++++++-------------- src/core.f90 | 1 + 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/Dockerfile.ubuntu b/Dockerfile.ubuntu index 975a71be..c2297165 100644 --- a/Dockerfile.ubuntu +++ b/Dockerfile.ubuntu @@ -7,8 +7,8 @@ RUN apt-get update -y RUN apt-get install -y vim ## syntran crashes almost immediately with gfortran 13 -ARG GFORT_VERS="12" -#ARG GFORT_VERS="13" +#ARG GFORT_VERS="12" +ARG GFORT_VERS="13" #RUN apt-get install -y gfortran RUN apt-get install -y gfortran-${GFORT_VERS} @@ -33,15 +33,15 @@ RUN fpm --version RUN yes | fpm clean RUN fpm build --compiler gfortran-${GFORT_VERS} -RUN fpm test test --compiler gfortran-${GFORT_VERS} -#RUN fpm test long --compiler gfortran-${GFORT_VERS} - -#ARG PROFILE release -ARG PROFILE debug - -#RUN fpm build --compiler gfortran-${GFORT_VERS} --profile "$PROFILE" --link-flag "-static-libgcc -static-libgfortran -static-libquadmath" - -RUN fpm build --compiler gfortran-${GFORT_VERS} --profile "$PROFILE" --link-flag "-static-libgcc -static-libgfortran -Wl,-Bstatic -lquadmath -Wl,-Bdynamic" - -RUN find ./build -wholename "*app/syntran" | xargs ls -ltrh - +#RUN fpm test test --compiler gfortran-${GFORT_VERS} +##RUN fpm test long --compiler gfortran-${GFORT_VERS} +# +##ARG PROFILE release +#ARG PROFILE debug +# +##RUN fpm build --compiler gfortran-${GFORT_VERS} --profile "$PROFILE" --link-flag "-static-libgcc -static-libgfortran -static-libquadmath" +# +#RUN fpm build --compiler gfortran-${GFORT_VERS} --profile "$PROFILE" --link-flag "-static-libgcc -static-libgfortran -Wl,-Bstatic -lquadmath -Wl,-Bdynamic" +# +#RUN find ./build -wholename "*app/syntran" | xargs ls -ltrh +# diff --git a/src/core.f90 b/src/core.f90 index 3aaae3eb..84236df0 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -218,6 +218,7 @@ module syntran__core_m !=============================================================================== function declare_intrinsic_fns() result(fns) + ! TODO: this should be a subroutine to help with gfortran-13 type(fns_t) :: fns From 9422b06a4b73908df98c73a00db8bb80e75e5c9a Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 5 Sep 2024 20:49:54 -0400 Subject: [PATCH 103/137] update version to 0.0.48 --- src/core.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core.f90 b/src/core.f90 index 84236df0..aaebc8cf 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -25,7 +25,7 @@ module syntran__core_m integer, parameter :: & syntran_major = 0, & syntran_minor = 0, & - syntran_patch = 47 + syntran_patch = 48 ! TODO: ! - structs From 4c43b689bed0d311dda50c5a53a9cbb2855ee0f6 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Thu, 5 Sep 2024 20:54:22 -0400 Subject: [PATCH 104/137] Revert "update version to 0.0.48" This reverts commit 9422b06a4b73908df98c73a00db8bb80e75e5c9a. --- src/core.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core.f90 b/src/core.f90 index aaebc8cf..84236df0 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -25,7 +25,7 @@ module syntran__core_m integer, parameter :: & syntran_major = 0, & syntran_minor = 0, & - syntran_patch = 48 + syntran_patch = 47 ! TODO: ! - structs From 6e9e1023cee365f9dbdab05de74e11917235c148 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 12:01:37 -0400 Subject: [PATCH 105/137] add build date to version output --- src/app.f90 | 3 ++- src/compiler.F90 | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/app.f90 b/src/app.f90 index 1d225253..7e9d9976 100644 --- a/src/app.f90 +++ b/src/app.f90 @@ -177,8 +177,9 @@ function parse_args() result(args) write(*,*) fg_bright_magenta//lang_name//' '//version//color_reset write(*,*) fg_bright_magenta//url//color_reset if (args%version) then - ! TODO: add build date, maybe git hash + ! TODO: add git hash. Need to auto-generate/sed some source write(*,*) "fortran compiler = "//fort_compiler//" "//str(fort_vers) + write(*,*) "build date = "//build_date end if write(*,*) end if diff --git a/src/compiler.F90 b/src/compiler.F90 index ed8c6f98..ce5a0649 100644 --- a/src/compiler.F90 +++ b/src/compiler.F90 @@ -35,6 +35,8 @@ module syntran__compiler_m #endif + character(len = *), parameter :: build_date = __DATE__ + end module syntran__compiler_m !=============================================================================== From 2630ced9cdb664cc1010ba1c3038031b585b2818 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 13:17:05 -0400 Subject: [PATCH 106/137] fix array of structs bug and wicked state bug --- src/eval.f90 | 59 ++++++++++++++++++++++++++++++++++++++++--------- src/syntran.f90 | 1 + 2 files changed, 49 insertions(+), 11 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index c0c2f930..a2025367 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -403,15 +403,18 @@ end subroutine eval_dot_expr !=============================================================================== -recursive subroutine set_val(node, var, state, val) +recursive subroutine set_val(node, var, state, val, index_) ! Assign var.mem = val, or recurse if mem is also a dot expr type(syntax_node_t), intent(in) :: node type(value_t), intent(inout) :: var type(state_t), intent(inout) :: state + type(value_t), intent(in) :: val + integer(kind = 8), optional, intent(in) :: index_ + !******** integer :: id @@ -419,7 +422,11 @@ recursive subroutine set_val(node, var, state, val) if (allocated(node%lsubscripts) .and. allocated(node%member)) then - i8 = sub_eval(node, var, state) + if (present(index_)) then + i8 = index_ + else + i8 = sub_eval(node, var, state) + end if id = node%member%id_index ! Recursion could still be required. Unfortunately, if an @@ -446,12 +453,17 @@ recursive subroutine set_val(node, var, state, val) else if (allocated(node%lsubscripts)) then - i8 = sub_eval(node, var, state) + if (present(index_)) then + i8 = index_ + else + i8 = sub_eval(node, var, state) + end if if (var%array%type /= struct_type) then call set_array_val(var%array, i8, val) return end if + !print *, "set subscript val" var%struct(i8+1) = val !res%type = struct_type ! TODO? !res%struct_name = var%struct_name @@ -485,7 +497,11 @@ recursive subroutine set_val(node, var, state, val) end if !print *, "scalar_sub" - i8 = sub_eval(node%member, var%struct(id), state) + if (present(index_)) then + i8 = index_ + else + i8 = sub_eval(node%member, var%struct(id), state) + end if if (var%struct(id)%array%type /= struct_type) then call set_array_val(var%struct(id)%array, i8, val) return @@ -499,7 +515,7 @@ end subroutine set_val !=============================================================================== -recursive function get_val(node, var, state) result(res) +recursive function get_val(node, var, state, index_) result(res) ! TODO: should res be an out arg for consistency? Similar question for ! get_array_val(). Yes: https://github.com/JeffIrwin/syntran/pull/12 @@ -519,6 +535,8 @@ recursive function get_val(node, var, state) result(res) type(value_t), intent(in) :: var type(state_t), intent(inout) :: state + integer(kind = 8), optional, intent(in) :: index_ + type(value_t) :: res !******** @@ -528,7 +546,12 @@ recursive function get_val(node, var, state) result(res) if (allocated(node%lsubscripts) .and. allocated(node%member)) then - i8 = sub_eval(node, var, state) + if (present(index_)) then + i8 = index_ + else + i8 = sub_eval(node, var, state) + end if + !print *, "i8 = ", i8 id = node%member%id_index @@ -561,7 +584,11 @@ recursive function get_val(node, var, state) result(res) ! Prefer sub_eval() over subscript_eval() because it doesn't make any ! assumptions about var's relation to node - i8 = sub_eval(node, var, state) + if (present(index_)) then + i8 = index_ + else + i8 = sub_eval(node, var, state) + end if if (var%array%type /= struct_type) then !print *, "get_array_val 2" @@ -604,7 +631,11 @@ recursive function get_val(node, var, state) result(res) end if !print *, "scalar_sub" - i8 = sub_eval(node%member, var%struct(id), state) + if (present(index_)) then + i8 = index_ + else + i8 = sub_eval(node%member, var%struct(id), state) + end if if (var%struct(id)%array%type /= struct_type) then !print *, "get_array_val 3" res = get_array_val(var%struct(id)%array, i8) @@ -1353,11 +1384,15 @@ subroutine eval_assignment_expr(node, state, res) ! state%vars%vals(node%id_index)%array%type !print *, 'LHS array = ', state%vars%vals(node%id_index)%array%i32 + !print *, "get_array_val a" + + ! It is important to only eval the subscript once, in case it is an + ! expression which changes the state! For example, `array[(index += 1)];` i8 = subscript_eval(node, state) - array_val = get_array_val(state%vars%vals(node%id_index)%array, i8) + array_val = get_val(node, state%vars%vals(node%id_index), state, index_ = i8) + !res = get_val(node, state%vars%vals(node%id_index), state) call compound_assign(array_val, res, node%op) - call set_array_val( & - state%vars%vals(node%id_index)%array, i8, array_val) + call set_val(node, state%vars%vals(node%id_index), state, array_val, index_ = i8) res = array_val else @@ -2372,6 +2407,7 @@ function sub_eval(node, var, state) result(index_) prod = prod * var%array%size(i) end do + !print *, "index_ = ", index_ end function sub_eval @@ -2537,6 +2573,7 @@ function get_array_val(array, i) result(val) val%sca%str = array%str(i + 1) case default + ! TODO: internal error print *, "bad type in get_array_val" end select diff --git a/src/syntran.f90 b/src/syntran.f90 index 8ccd5c0b..31ce9923 100644 --- a/src/syntran.f90 +++ b/src/syntran.f90 @@ -70,6 +70,7 @@ function syntran_interpret(str_, quiet, startup_file) result(res_str) sv = new_string_view(str_//line_feed) src_file = '' end if + !print *, "src_file = ", src_file call init_state(state) state%quiet = .false. From 1175799765f1119b90ab6e00bb6002a312e17b61 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 13:55:52 -0400 Subject: [PATCH 107/137] add test for array of structs bug from 2630ced9 --- src/eval.f90 | 9 +++++++-- src/tests/test.f90 | 18 ++++++++++++++++++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index a2025367..656ce0d2 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -1388,6 +1388,11 @@ subroutine eval_assignment_expr(node, state, res) ! It is important to only eval the subscript once, in case it is an ! expression which changes the state! For example, `array[(index += 1)];` + ! + ! TODO: check for other get_val/set_val calls which should use the + ! index opt arg. Maybe I should ban expression statements as + ! indices, but src/tests/test-src/fns/test-19.syntran at least will + ! need updated i8 = subscript_eval(node, state) array_val = get_val(node, state%vars%vals(node%id_index), state, index_ = i8) !res = get_val(node, state%vars%vals(node%id_index), state) @@ -2573,8 +2578,8 @@ function get_array_val(array, i) result(val) val%sca%str = array%str(i + 1) case default - ! TODO: internal error - print *, "bad type in get_array_val" + write(*,*) err_int_prefix//"bad type in get_array_val"//color_reset + call internal_error() end select diff --git a/src/tests/test.f90 b/src/tests/test.f90 index b66db918..67d427e1 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3233,6 +3233,24 @@ subroutine unit_test_struct_arr(npass, nfail) //'e.e[0].d.c[0].b.a[0] += 27;' & //'return e.e[0].d.c[0].b.a[0];' & , quiet) == '69', & + eval('' & ! 47 + //'struct P{v:[i32; :],}' & ! point + //'let p0 = P{v=[6, 13]};' & + //'let p1 = P{v=[4, 15]};' & + //'let p2 = P{v=[3, 17]};' & + //'let ps = [p0, p1];' & + //'ps[0] = p2;' & + //'return ps[1].v;' & + , quiet) == '[4, 15]', & + eval('' & ! 48 + //'struct P{v:[i32; :],}' & ! point + //'let p0 = P{v=[6, 13]};' & + //'let p1 = P{v=[4, 15]};' & + //'let p2 = P{v=[3, 17]};' & + //'let ps = [p0, p1];' & + //'ps[0] = p2;' & + //'return ps[0].v;' & + , quiet) == '[3, 17]', & .false. & ! so I don't have to bother w/ trailing commas ] From e35d5457f95a929526a108cb7d5c0f2e53d2bb07 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 14:07:35 -0400 Subject: [PATCH 108/137] add another pre-emptive one-time subscript eval --- src/eval.f90 | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 656ce0d2..5276b498 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -310,7 +310,8 @@ subroutine eval_name_expr(node, state, res) !print *, 'rank = ', node%val%array%rank if (all(node%lsubscripts%sub_kind == scalar_sub)) then - res = get_val(node, state%vars%vals(node%id_index), state) + i8 = subscript_eval(node, state) + res = get_val(node, state%vars%vals(node%id_index), state, index_ = i8) else call get_subscript_range(node, state, lsubs, usubs, rank_res) @@ -624,8 +625,6 @@ recursive function get_val(node, var, state, index_) result(res) if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then !print *, "slice sub" - - ! TODO: not implemented, throw error. Add code to catch in parser first write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset call internal_error() end if @@ -1387,15 +1386,11 @@ subroutine eval_assignment_expr(node, state, res) !print *, "get_array_val a" ! It is important to only eval the subscript once, in case it is an - ! expression which changes the state! For example, `array[(index += 1)];` - ! - ! TODO: check for other get_val/set_val calls which should use the - ! index opt arg. Maybe I should ban expression statements as - ! indices, but src/tests/test-src/fns/test-19.syntran at least will - ! need updated + ! expression which changes the state! For example, `array[(index += + ! 1)];`. Maybe I should ban expression statements as indices, but + ! src/tests/test-src/fns/test-19.syntran at least will need updated i8 = subscript_eval(node, state) array_val = get_val(node, state%vars%vals(node%id_index), state, index_ = i8) - !res = get_val(node, state%vars%vals(node%id_index), state) call compound_assign(array_val, res, node%op) call set_val(node, state%vars%vals(node%id_index), state, array_val, index_ = i8) res = array_val From 7cc6692cbcfd300125a7f02808fb91c87ff76169 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 14:34:48 -0400 Subject: [PATCH 109/137] prefer out-args for intel perf; catch errors --- src/eval.f90 | 103 +++++++++++++++++++++++++++++---------------------- 1 file changed, 59 insertions(+), 44 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 5276b498..a843383b 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -55,13 +55,6 @@ recursive subroutine syntax_eval(node, state, res) !print *, 'starting syntax_eval()' - ! if_statement and while_statement may return an uninitialized type - ! otherwise if their conditions are false - ! - ! TODO: setting here should be unnecessary now that type is initialized - ! inside the value_t declaration - res%type = unknown_type - if (node%is_empty) then !print *, 'returning' return @@ -257,7 +250,7 @@ subroutine eval_name_expr(node, state, res) integer(kind = 8) :: il, iu, i8, index_ integer(kind = 8), allocatable :: lsubs(:), usubs(:), subs(:) - type(value_t) :: right + type(value_t) :: right, tmp !print *, "starting eval_name_expr()" !print *, 'searching identifier ', node%identifier%text @@ -311,7 +304,7 @@ subroutine eval_name_expr(node, state, res) if (all(node%lsubscripts%sub_kind == scalar_sub)) then i8 = subscript_eval(node, state) - res = get_val(node, state%vars%vals(node%id_index), state, index_ = i8) + call get_val(node, state%vars%vals(node%id_index), state, res, index_ = i8) else call get_subscript_range(node, state, lsubs, usubs, rank_res) @@ -355,9 +348,8 @@ subroutine eval_name_expr(node, state, res) !print *, 'subs = ', int(subs, 4) index_ = subscript_i32_eval(subs, state%vars%vals(node%id_index)%array) - call set_array_val(res%array, i8, & - get_array_val(state%vars%vals(node%id_index)%array, index_)) - + call get_array_val(state%vars%vals(node%id_index)%array, index_, tmp) + call set_array_val(res%array, i8, tmp) call get_next_subscript(lsubs, usubs, subs) end do end if @@ -398,7 +390,7 @@ subroutine eval_dot_expr(node, state, res) ! This won't work for struct literal member access. It only works for ! `identifier.member` - res = get_val(node, state%vars%vals(node%id_index), state) + call get_val(node, state%vars%vals(node%id_index), state, res) end subroutine eval_dot_expr @@ -464,10 +456,7 @@ recursive subroutine set_val(node, var, state, val, index_) return end if - !print *, "set subscript val" var%struct(i8+1) = val - !res%type = struct_type ! TODO? - !res%struct_name = var%struct_name return end if @@ -516,12 +505,7 @@ end subroutine set_val !=============================================================================== -recursive function get_val(node, var, state, index_) result(res) - - ! TODO: should res be an out arg for consistency? Similar question for - ! get_array_val(). Yes: https://github.com/JeffIrwin/syntran/pull/12 - ! - ! Should I rename this eval_*() for consistency? +recursive subroutine get_val(node, var, state, res, index_) ! In nested expressions, like `a.b.c.d`, var begins as the top-most ! (left-most, outer-most) value `a` @@ -531,6 +515,8 @@ recursive function get_val(node, var, state, index_) result(res) ! array, or another struct. That is what this routine abstracts ! ! FIXME: if you change something in the getter, change it in the setter too + ! + ! Should I rename this eval_*() for consistency? type(syntax_node_t), intent(in) :: node type(value_t), intent(in) :: var @@ -538,7 +524,7 @@ recursive function get_val(node, var, state, index_) result(res) integer(kind = 8), optional, intent(in) :: index_ - type(value_t) :: res + type(value_t), intent(out) :: res !******** @@ -550,6 +536,13 @@ recursive function get_val(node, var, state, index_) result(res) if (present(index_)) then i8 = index_ else + + if (.not. all(node%lsubscripts%sub_kind == scalar_sub)) then + !print *, "slice sub" + write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset + call internal_error() + end if + i8 = sub_eval(node, var, state) end if @@ -563,7 +556,7 @@ recursive function get_val(node, var, state, index_) result(res) if (node%member%kind == dot_expr) then ! Recurse - res = get_val(node%member, var%struct(i8+1)%struct(id), state) + call get_val(node%member, var%struct(i8+1)%struct(id), state, res) return end if @@ -573,12 +566,16 @@ recursive function get_val(node, var, state, index_) result(res) end if !print *, "array dot chain" + if (.not. all(node%member%lsubscripts%sub_kind == scalar_sub)) then + !print *, "slice sub" + write(*,*) err_rt_prefix//"struct array slices are not implemented"//color_reset + call internal_error() + end if + ! Arrays chained by a dot: `a[0].b[0]` - ! - ! TODO: ban non-scalar subscripts like below j8 = sub_eval(node%member, var%struct(i8+1)%struct(id), state) !print *, "get_array_val 1" - res = get_array_val(var%struct(i8+1)%struct(id)%array, j8) + call get_array_val(var%struct(i8+1)%struct(id)%array, j8, res) return else if (allocated(node%lsubscripts)) then @@ -593,7 +590,7 @@ recursive function get_val(node, var, state, index_) result(res) if (var%array%type /= struct_type) then !print *, "get_array_val 2" - res = get_array_val(var%array, i8) + call get_array_val(var%array, i8, res) return end if @@ -611,7 +608,7 @@ recursive function get_val(node, var, state, index_) result(res) if (node%member%kind == dot_expr) then ! Recurse - res = get_val(node%member, var%struct(id), state) + call get_val(node%member, var%struct(id), state, res) return end if @@ -637,7 +634,7 @@ recursive function get_val(node, var, state, index_) result(res) end if if (var%struct(id)%array%type /= struct_type) then !print *, "get_array_val 3" - res = get_array_val(var%struct(id)%array, i8) + call get_array_val(var%struct(id)%array, i8, res) return end if @@ -645,7 +642,7 @@ recursive function get_val(node, var, state, index_) result(res) res%type = struct_type res%struct_name = var%struct(id)%struct_name -end function get_val +end subroutine get_val !=============================================================================== @@ -705,6 +702,8 @@ subroutine eval_fn_call(node, state, res) logical :: returned0 + type(char_vector_t) :: str_ + type(value_t) :: arg, arg1, arg2, tmp !print *, 'eval fn_call_expr' @@ -820,11 +819,12 @@ subroutine eval_fn_call(node, state, res) case ("str") - res%sca%str%s = '' + str_ = new_char_vector() do i = 1, size(node%args) call syntax_eval(node%args(i), state, arg) - res%sca%str%s = res%sca%str%s // arg%to_str() ! TODO: use char_vector_t + call str_%push(arg%to_str()) end do + res%sca%str%s = str_%trim() state%returned = .true. case ("len") @@ -836,19 +836,34 @@ subroutine eval_fn_call(node, state, res) case ("parse_i32") call syntax_eval(node%args(1), state, arg) - read(arg%sca%str%s, *) res%sca%i32 ! TODO: catch iostat + read(arg%sca%str%s, *, iostat = io) res%sca%i32 + if (io /= 0) then + write(*,*) err_rt_prefix//" cannot parse_i32() for argument `"// & + arg%sca%str%s//"`"//color_reset + call internal_error() + end if state%returned = .true. case ("parse_i64") call syntax_eval(node%args(1), state, arg) - read(arg%sca%str%s, *) res%sca%i64 ! TODO: catch iostat + read(arg%sca%str%s, *, iostat = io) res%sca%i64 + if (io /= 0) then + write(*,*) err_rt_prefix//" cannot parse_i64() for argument `"// & + arg%sca%str%s//"`"//color_reset + call internal_error() + end if state%returned = .true. case ("parse_f32") call syntax_eval(node%args(1), state, arg) - read(arg%sca%str%s, *) res%sca%f32 ! TODO: catch iostat + read(arg%sca%str%s, *, iostat = io) res%sca%f32 + if (io /= 0) then + write(*,*) err_rt_prefix//" cannot parse_f32() for argument `"// & + arg%sca%str%s//"`"//color_reset + call internal_error() + end if state%returned = .true. case ("0i32_sca") @@ -1313,7 +1328,7 @@ subroutine eval_assignment_expr(node, state, res) ! Get the initial value from the LHS, which could be nested like `a.b.c.d` id = node%member%id_index - res = get_val(node, state%vars%vals(node%id_index), state) + call get_val(node, state%vars%vals(node%id_index), state, res) ! Do the assignment or += or whatever and set res call compound_assign(res, rhs, node%op) @@ -1390,7 +1405,7 @@ subroutine eval_assignment_expr(node, state, res) ! 1)];`. Maybe I should ban expression statements as indices, but ! src/tests/test-src/fns/test-19.syntran at least will need updated i8 = subscript_eval(node, state) - array_val = get_val(node, state%vars%vals(node%id_index), state, index_ = i8) + call get_val(node, state%vars%vals(node%id_index), state, array_val, index_ = i8) call compound_assign(array_val, res, node%op) call set_val(node, state%vars%vals(node%id_index), state, array_val, index_ = i8) res = array_val @@ -1420,11 +1435,11 @@ subroutine eval_assignment_expr(node, state, res) ! tmp -> lhs_val or something if (res%type == array_type) then - array_val = get_array_val(res%array, i8) + call get_array_val(res%array, i8, array_val) end if index_ = subscript_i32_eval(subs, state%vars%vals(node%id_index)%array) - tmp = get_array_val(state%vars%vals(node%id_index)%array, index_) + call get_array_val(state%vars%vals(node%id_index)%array, index_, tmp) call compound_assign(tmp, array_val, node%op) call set_array_val(state%vars%vals(node%id_index)%array, index_, tmp) @@ -2533,7 +2548,7 @@ subroutine array_at(val, kind_, i, lbound_, step, ubound_, len_, array, & case (array_expr) ! Non-primary array expr - val = get_array_val(array, i - 1) + call get_array_val(array, i - 1, val) case default write(*,*) err_int_prefix//'for loop not implemented for this array kind'//color_reset @@ -2544,13 +2559,13 @@ end subroutine array_at !=============================================================================== -function get_array_val(array, i) result(val) +subroutine get_array_val(array, i, val) type(array_t), intent(in) :: array integer(kind = 8), intent(in) :: i - type(value_t) :: val + type(value_t), intent(out) :: val !print *, 'starting get_array_val()' !print *, 'array%type = ', kind_name(array%type) @@ -2578,7 +2593,7 @@ function get_array_val(array, i) result(val) end select -end function get_array_val +end subroutine get_array_val !=============================================================================== From 475bceaed7226923041da2c57e33564dcbcfb2fe Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 14:45:16 -0400 Subject: [PATCH 110/137] run lipo on mac bin to get info --- .github/workflows/main.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 28b49d99..44f5605f 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -391,6 +391,7 @@ ./syntran -c 'sum([0: 101]);' \n otool -L ./syntran \n + lipo -info ./syntran \n " }, ] From 72f635985397303c7a581624f1cbd7bd05b173b7 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 15:23:41 -0400 Subject: [PATCH 111/137] check fn return structure sub type --- .github/workflows/main.yml | 7 ++- src/core.f90 | 4 +- src/eval.f90 | 18 ++------ src/parse.f90 | 6 ++- src/parse_control.f90 | 94 +++++++++++++++++++++----------------- src/parse_fn.f90 | 15 ++++-- src/types.f90 | 3 +- 7 files changed, 81 insertions(+), 66 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 44f5605f..6ce33993 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -376,7 +376,7 @@ " set -exu \n - # Test this to run syntran without homebrew gcc lib paths + # Test this to run syntran without homebrew gcc lib paths \n brew remove gcc@12 \n curl -LO \"https://github.com/JeffIrwin/syntran/releases/latest/download/syntran-macos.zip\" \n @@ -390,7 +390,12 @@ ./syntran -c '4 + 5 * [6: 10];' \n ./syntran -c 'sum([0: 101]);' \n + # otool shows the dependent dylibs (like `ldd` on linux) \n otool -L ./syntran \n + + # lipo shows which architecture this bin was built for + # (e.g. arm64 (apple silly con) or x86_64 (intel)). as + # of september 2024, github action runners are arm64 \n lipo -info ./syntran \n " }, diff --git a/src/core.f90 b/src/core.f90 index 2091fbc2..0e0c3ad4 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -772,7 +772,9 @@ function syntax_parse(str, vars, fns, src_file, allow_continue) result(tree) ! The global scope can return any type. This is initialized here and not ! inside new_parser() in case you have half of a function body inside an ! include file (!) - parser%fn_type = any_type + parser%fn_type%type = any_type + allocate(parser%fn_type%array) + !parser%fn_type = any_type ! Do nothing for blank lines (or comments) if (parser%current_kind() == eof_token) then diff --git a/src/eval.f90 b/src/eval.f90 index a843383b..be6ba0ae 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -1887,14 +1887,8 @@ subroutine eval_array_expr(node, state, res) allocate(res%array) res%array%type = node%val%array%type - !array = new_array(node%val%array%type, size(node%elems)) - !call allocate_array(res, res%array%len_) call allocate_array(res, size(node%elems, kind = 8)) - - ! TODO: dry res%array%len_ = 0 - !res%array%cap - !res%array%type = do i = 1, size(node%elems) call syntax_eval(node%elems(i), state, elem) @@ -2121,7 +2115,6 @@ end subroutine promote_i32_i64 subroutine allocate_array(val, cap) - !type(array_t), intent(inout) :: array type(value_t), intent(inout) :: val integer(kind = 8), intent(in) :: cap @@ -2369,11 +2362,12 @@ end function subscript_i32_eval !=============================================================================== -! TODO: DRY function sub_eval(node, var, state) result(index_) ! Evaluate subscript indices and convert a multi-rank subscript to a rank-1 ! subscript index_ + ! + ! Can this be dried up with subscript_eval()? type(syntax_node_t) :: node type(value_t) :: var @@ -2389,7 +2383,7 @@ function sub_eval(node, var, state) result(index_) !print *, 'starting sub_eval()' - !! TODO + !! TODO: i think member string indexing is broken without this !! str scalar with single char subscript !if (state%vars%vals(node%id_index)%type == str_type) then ! call syntax_eval(node%lsubscripts(1), state, subscript) @@ -2403,8 +2397,6 @@ function sub_eval(node, var, state) result(index_) prod = 1 index_ = 0 - !do i = 1, state%vars%vals(node%id_index)%array%rank - !do i = 1, node%array%rank do i = 1, var%array%rank !print *, 'i = ', i @@ -2417,9 +2409,7 @@ function sub_eval(node, var, state) result(index_) ! definition to enable it only in debug index_ = index_ + prod * subscript%to_i64() - !prod = prod * state%vars%vals(node%id_index)%array%size(i) - !prod = prod * node%array%size(i) - prod = prod * var%array%size(i) + prod = prod * var%array%size(i) end do !print *, "index_ = ", index_ diff --git a/src/parse.f90 b/src/parse.f90 index 5b23ad4e..a4752412 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -52,7 +52,8 @@ module syntran__parse_m ! to walk back up the syntax tree to do return type checking ! ! This won't work with nested fns but we don't allow that anyway - integer :: fn_type, fn_rank, fn_array_type + type(value_t) :: fn_type + !integer :: fn_type, fn_rank, fn_array_type character(len = :), allocatable :: fn_name logical :: returned @@ -119,7 +120,8 @@ module subroutine parse_type(parser, type_text, rank) integer, intent(out) :: rank end subroutine parse_type - ! TODO: move struct stuff to another translation unit + ! TODO: move struct stuff to another translation unit? parse_fn.f90 is a + ! very manageable ~1100 lines rn, so not much benefit to splitting module function parse_struct_declaration(parser) result(decl) class(parser_t) :: parser type(syntax_node_t) :: decl diff --git a/src/parse_control.f90 b/src/parse_control.f90 index c319327c..606b8f96 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -25,7 +25,7 @@ module function parse_return_statement(parser) result(statement) integer :: right_beg, right_end, exp_type, act_type, exp_rank, act_rank - logical :: types_match + !logical :: types_match type(syntax_token_t) :: return_token, semi type(text_span_t) :: span @@ -63,54 +63,64 @@ module function parse_return_statement(parser) result(statement) ! ! There should also be a check that every branch of a fn has a return ! statement, but that seems more difficult - ! - ! TODO: use types_match() and then pass type_name() to err_bad_ret*() - act_type = statement%right%val%type - types_match = & - parser%fn_type == any_type .or. parser%fn_type == act_type - if (.not. types_match) then + if (types_match(parser%fn_type, statement%right%val) /= TYPE_MATCH) then span = new_span(right_beg, right_end - right_beg + 1) call parser%diagnostics%push( & err_bad_ret_type(parser%context(), & span, parser%fn_name, & - kind_name(parser%fn_type), & - kind_name(act_type))) - - return - end if - - ! Check array type and rank if needed - if (parser%fn_type == array_type) then - exp_type = parser%fn_array_type - act_type = statement%right%val%array%type - types_match = exp_type == any_type .or. exp_type == act_type + type_name(parser%fn_type), & + type_name(statement%right%val))) end if - if (.not. types_match) then - span = new_span(right_beg, right_end - right_beg + 1) - call parser%diagnostics%push( & - err_bad_array_ret_type(parser%context(), & - span, parser%fn_name, & - kind_name(exp_type), kind_name(act_type))) - - return - end if - - if (parser%fn_type == array_type) then - exp_rank = parser%fn_rank - act_rank = statement%right%val%array%rank - - if (exp_rank >= 0 .and. exp_rank /= act_rank) then - span = new_span(right_beg, right_end - right_beg + 1) - call parser%diagnostics%push( & - err_bad_ret_rank(parser%context(), & - span, parser%fn_name, & - exp_rank, act_rank)) - - return - end if - end if + ! TODO: test and delete + +! act_type = statement%right%val%type +! types_match = & +! parser%fn_type == any_type .or. parser%fn_type == act_type +! +! if (.not. types_match) then +! span = new_span(right_beg, right_end - right_beg + 1) +! call parser%diagnostics%push( & +! err_bad_ret_type(parser%context(), & +! span, parser%fn_name, & +! kind_name(parser%fn_type), & +! kind_name(act_type))) +! +! return +! end if +! +! ! Check array type and rank if needed +! if (parser%fn_type == array_type) then +! exp_type = parser%fn_array_type +! act_type = statement%right%val%array%type +! types_match = exp_type == any_type .or. exp_type == act_type +! end if +! +! if (.not. types_match) then +! span = new_span(right_beg, right_end - right_beg + 1) +! call parser%diagnostics%push( & +! err_bad_array_ret_type(parser%context(), & +! span, parser%fn_name, & +! kind_name(exp_type), kind_name(act_type))) +! +! return +! end if +! +! if (parser%fn_type == array_type) then +! exp_rank = parser%fn_rank +! act_rank = statement%right%val%array%rank +! +! if (exp_rank >= 0 .and. exp_rank /= act_rank) then +! span = new_span(right_beg, right_end - right_beg + 1) +! call parser%diagnostics%push( & +! err_bad_ret_rank(parser%context(), & +! span, parser%fn_name, & +! exp_rank, act_rank)) +! +! return +! end if +! end if end function parse_return_statement diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 240d8c73..a50ab2e4 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -524,17 +524,21 @@ module function parse_fn_declaration(parser) result(decl) else fn%type = itype end if - ! TODO: struct_name for fn return type + fn%struct_name = type_text end if !print *, 'fn%type = ', fn%type ! Copy for later return type checking while parsing body parser%fn_name = identifier%text - parser%fn_type = fn%type + !parser%fn_type = fn%type + parser%fn_type%type = fn%type + parser%fn_type%struct_name = fn%struct_name if (rank >= 0) then - parser%fn_rank = fn%rank - parser%fn_array_type = fn%array_type + !parser%fn_rank = fn%rank + !parser%fn_array_type = fn%array_type + parser%fn_type%array%rank = fn%rank + parser%fn_type%array%type = fn%array_type end if body = parser%parse_statement() @@ -547,7 +551,8 @@ module function parse_fn_declaration(parser) result(decl) end if ! Reset to allow the global scope to return anything - parser%fn_type = any_type + parser%fn_type%type = any_type + !parser%fn_type = any_type ! Insert fn into parser%fns diff --git a/src/types.f90 b/src/types.f90 index bf9b5420..73c6c378 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -52,8 +52,9 @@ module syntran__types_m type fn_t ! Function signature: input and output types - ! Return type. TODO: add struct_name and check it + ! Return type integer :: type, array_type, rank + character(len = :), allocatable :: struct_name ! Arguments/parameters. Technically, "arguments" in most languages are ! what Fortran calls "actual arguments" and "parameters" are Fortran From c6a0145699c1d65a5f3d205b49e98df8ab86d289 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 22:43:56 -0400 Subject: [PATCH 112/137] cleanup --- src/parse_control.f90 | 56 ++----------------------------------------- src/parse_expr.f90 | 16 ++++++------- src/types.f90 | 3 ++- 3 files changed, 11 insertions(+), 64 deletions(-) diff --git a/src/parse_control.f90 b/src/parse_control.f90 index 606b8f96..3a6a6813 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -25,8 +25,6 @@ module function parse_return_statement(parser) result(statement) integer :: right_beg, right_end, exp_type, act_type, exp_rank, act_rank - !logical :: types_match - type(syntax_token_t) :: return_token, semi type(text_span_t) :: span @@ -58,12 +56,11 @@ module function parse_return_statement(parser) result(statement) end if semi = parser%match(semicolon_token) - ! Check return type (unless we're at global level ifn == 1). That's half - ! the point of return statements + ! Check return type (unless we're at global level ifn == 1, in which case + ! %fn_type is any_type). That's half the point of return statements ! ! There should also be a check that every branch of a fn has a return ! statement, but that seems more difficult - if (types_match(parser%fn_type, statement%right%val) /= TYPE_MATCH) then span = new_span(right_beg, right_end - right_beg + 1) call parser%diagnostics%push( & @@ -73,55 +70,6 @@ module function parse_return_statement(parser) result(statement) type_name(statement%right%val))) end if - ! TODO: test and delete - -! act_type = statement%right%val%type -! types_match = & -! parser%fn_type == any_type .or. parser%fn_type == act_type -! -! if (.not. types_match) then -! span = new_span(right_beg, right_end - right_beg + 1) -! call parser%diagnostics%push( & -! err_bad_ret_type(parser%context(), & -! span, parser%fn_name, & -! kind_name(parser%fn_type), & -! kind_name(act_type))) -! -! return -! end if -! -! ! Check array type and rank if needed -! if (parser%fn_type == array_type) then -! exp_type = parser%fn_array_type -! act_type = statement%right%val%array%type -! types_match = exp_type == any_type .or. exp_type == act_type -! end if -! -! if (.not. types_match) then -! span = new_span(right_beg, right_end - right_beg + 1) -! call parser%diagnostics%push( & -! err_bad_array_ret_type(parser%context(), & -! span, parser%fn_name, & -! kind_name(exp_type), kind_name(act_type))) -! -! return -! end if -! -! if (parser%fn_type == array_type) then -! exp_rank = parser%fn_rank -! act_rank = statement%right%val%array%rank -! -! if (exp_rank >= 0 .and. exp_rank /= act_rank) then -! span = new_span(right_beg, right_end - right_beg + 1) -! call parser%diagnostics%push( & -! err_bad_ret_rank(parser%context(), & -! span, parser%fn_name, & -! exp_rank, act_rank)) -! -! return -! end if -! end if - end function parse_return_statement !=============================================================================== diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 84aecc1c..1e07cd42 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -448,12 +448,12 @@ module function parse_primary_expr(parser) result(expr) ! syntran to use a different token for struct instantiators, ! e.g. `.{`, but I prefer this solution. - ! TODO: is the exists() method needed? Search will probably - ! work and simplify the code. I was experimenting while - ! debugging memory issue, but exists might not be necessary. On - ! the other hand, it might be more optimal to check existence - ! w/o copying an output val (which could containt big nested dict - ! types) + ! The exists() method is not strictly needed. Search could work + ! and simplify the code. I was experimenting while debugging + ! memory issue, but exists is not necessary. On the other hand, + ! it might be more optimal to check existence w/o copying an + ! output val (which could containt big nested dict types) + !print *, "text = ", parser%current_text() !dummy = parser%structs%search(parser%current_text(), dummy_id, io) exists = parser%structs%exists(parser%current_text(), dummy_id, io) @@ -578,15 +578,13 @@ recursive module subroutine parse_dot(parser, expr) dot = parser%match(dot_token) - ! TODO: this can't handle recursion, e.g. `a.b.c` - identifier = parser%match(identifier_token) !print *, "dot identifier = ", identifier%text !print *, "type = ", kind_name(expr%val%type) if (expr%val%type /= struct_type) then - ! TODO: diag. Skip if unknown_type? Probably already threw a diag in caller + ! TODO: need to catch in parser write(*,*) err_prefix//"variable in dot expr is not a struct"//color_reset !print *, "type = ", kind_name(expr%val%type) return diff --git a/src/types.f90 b/src/types.f90 index 73c6c378..b9ceb97d 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -2761,7 +2761,8 @@ end function type_name_primitive integer function types_match(a, b) result(io) - ! Check if the type of value a matches value b + ! Check if the type of value `a` matches value `b`. Arguments are not + ! transitive! If `a` is of value any_type, enforcement is less strict. ! ! Numeric casting, e.g. i32 to f32, is not allowed. Maybe we could add a ! flag if some callers need to allow casting From 14e9b88a22b425bc4f316d5ec40ed88852f66f49 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 22:59:10 -0400 Subject: [PATCH 113/137] fix type bug for fns returning structs *lights cigarette* --- src/core.f90 | 70 +++++++++++++++++++++++++----------------------- src/parse_fn.f90 | 48 ++++++++++++++++++--------------- src/types.f90 | 9 ++++--- 3 files changed, 67 insertions(+), 60 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 0e0c3ad4..1255617b 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -239,7 +239,7 @@ function declare_intrinsic_fns() result(fns) !******** ! TODO: polymorphic in f32, f64, etc. - exp_fn%type = f32_type + exp_fn%type%type = f32_type allocate(exp_fn%params(1)) exp_fn%params(1)%type = f32_type exp_fn%params(1)%name = "x" @@ -264,7 +264,7 @@ function declare_intrinsic_fns() result(fns) ! TODO: min_f64_fn, max_f64_fn - min_i32_fn%type = i32_type + min_i32_fn%type%type = i32_type allocate(min_i32_fn%params(2)) min_i32_fn%params(1)%type = i32_type @@ -282,7 +282,7 @@ function declare_intrinsic_fns() result(fns) !******** - min_i64_fn%type = i64_type + min_i64_fn%type%type = i64_type allocate(min_i64_fn%params(2)) min_i64_fn%params(1)%type = i64_type @@ -298,7 +298,7 @@ function declare_intrinsic_fns() result(fns) !******** - min_f32_fn%type = f32_type + min_f32_fn%type%type = f32_type allocate(min_f32_fn%params(2)) min_f32_fn%params(1)%type = f32_type @@ -314,7 +314,7 @@ function declare_intrinsic_fns() result(fns) !******** - max_i32_fn%type = i32_type + max_i32_fn%type%type = i32_type allocate(max_i32_fn%params(2)) max_i32_fn%params(1)%type = i32_type @@ -332,7 +332,7 @@ function declare_intrinsic_fns() result(fns) !******** - max_i64_fn%type = i64_type + max_i64_fn%type%type = i64_type allocate(max_i64_fn%params(2)) max_i64_fn%params(1)%type = i64_type @@ -348,7 +348,7 @@ function declare_intrinsic_fns() result(fns) !******** - max_f32_fn%type = f32_type + max_f32_fn%type%type = f32_type allocate(max_f32_fn%params(2)) max_f32_fn%params(1)%type = f32_type @@ -366,7 +366,7 @@ function declare_intrinsic_fns() result(fns) ! TODO: update docs to use println() instead of old holyc implicit prints - println_fn%type = void_type ! TODO? + println_fn%type%type = void_type ! TODO? allocate(println_fn%params(0)) @@ -377,7 +377,7 @@ function declare_intrinsic_fns() result(fns) !******** - str_fn%type = str_type + str_fn%type%type = str_type allocate(str_fn%params(0)) @@ -388,7 +388,7 @@ function declare_intrinsic_fns() result(fns) !******** - len_fn%type = i64_type + len_fn%type%type = i64_type allocate(len_fn%params(1)) len_fn%params(1)%type = str_type len_fn%params(1)%name = "str" @@ -402,7 +402,7 @@ function declare_intrinsic_fns() result(fns) ! Should this accept any type? f32 can be converted implicitly so there ! shouldn't be a need for other types - parse_i32_fn%type = i32_type + parse_i32_fn%type%type = i32_type allocate(parse_i32_fn%params(1)) parse_i32_fn%params(1)%type = str_type parse_i32_fn%params(1)%name = "str" @@ -411,7 +411,7 @@ function declare_intrinsic_fns() result(fns) !******** - parse_i64_fn%type = i64_type + parse_i64_fn%type%type = i64_type allocate(parse_i64_fn%params(1)) parse_i64_fn%params(1)%type = str_type parse_i64_fn%params(1)%name = "str" @@ -420,7 +420,7 @@ function declare_intrinsic_fns() result(fns) !******** - parse_f32_fn%type = f32_type + parse_f32_fn%type%type = f32_type allocate(parse_f32_fn%params(1)) parse_f32_fn%params(1)%type = str_type parse_f32_fn%params(1)%name = "str" @@ -429,7 +429,7 @@ function declare_intrinsic_fns() result(fns) !******** - i32_sca_fn%type = i32_type + i32_sca_fn%type%type = i32_type allocate(i32_sca_fn%params(1)) i32_sca_fn%params(1)%type = any_type @@ -440,9 +440,10 @@ function declare_intrinsic_fns() result(fns) !******** - i32_arr_fn%type = array_type - i32_arr_fn%array_type = i32_type - i32_arr_fn%rank = -1 + i32_arr_fn%type%type = array_type + allocate(i32_arr_fn%type%array) + i32_arr_fn%type%array%type = i32_type + i32_arr_fn%type%array%rank = -1 allocate(i32_arr_fn%params(1)) @@ -456,7 +457,7 @@ function declare_intrinsic_fns() result(fns) ! TODO: to f32 casting - i64_sca_fn%type = i64_type + i64_sca_fn%type%type = i64_type allocate(i64_sca_fn%params(1)) i64_sca_fn%params(1)%type = any_type @@ -467,9 +468,10 @@ function declare_intrinsic_fns() result(fns) !******** - i64_arr_fn%type = array_type - i64_arr_fn%array_type = i64_type - i64_arr_fn%rank = -1 + i64_arr_fn%type%type = array_type + allocate(i64_arr_fn%type%array) + i64_arr_fn%type%array%type = i64_type + i64_arr_fn%type%array%rank = -1 allocate(i64_arr_fn%params(1)) @@ -481,7 +483,7 @@ function declare_intrinsic_fns() result(fns) !******** - open_fn%type = file_type + open_fn%type%type = file_type allocate(open_fn%params(1)) open_fn%params(1)%type = str_type open_fn%params(1)%name = "filename" @@ -490,7 +492,7 @@ function declare_intrinsic_fns() result(fns) !******** - readln_fn%type = str_type + readln_fn%type%type = str_type allocate(readln_fn%params(1)) readln_fn%params(1)%type = file_type readln_fn%params(1)%name = "file_handle" @@ -499,7 +501,7 @@ function declare_intrinsic_fns() result(fns) !******** - writeln_fn%type = void_type + writeln_fn%type%type = void_type allocate(writeln_fn%params(1)) writeln_fn%params(1)%type = file_type writeln_fn%params(1)%name = "file_handle" @@ -512,7 +514,7 @@ function declare_intrinsic_fns() result(fns) !******** - eof_fn%type = bool_type + eof_fn%type%type = bool_type allocate(eof_fn%params(1)) eof_fn%params(1)%type = file_type eof_fn%params(1)%name = "file_handle" @@ -521,7 +523,7 @@ function declare_intrinsic_fns() result(fns) !******** - close_fn%type = void_type + close_fn%type%type = void_type allocate(close_fn%params(1)) close_fn%params(1)%type = file_type close_fn%params(1)%name = "file_handle" @@ -530,7 +532,7 @@ function declare_intrinsic_fns() result(fns) !******** - exit_fn%type = void_type + exit_fn%type%type = void_type allocate(exit_fn%params(1)) exit_fn%params(1)%type = i32_type exit_fn%params(1)%name = "exit_status" @@ -539,7 +541,7 @@ function declare_intrinsic_fns() result(fns) !******** - size_fn%type = i64_type + size_fn%type%type = i64_type allocate(size_fn%params(2)) size_fn%params(1)%type = array_type @@ -560,7 +562,7 @@ function declare_intrinsic_fns() result(fns) !******** - count_fn%type = i64_type + count_fn%type%type = i64_type allocate(count_fn%params(1)) count_fn%params(1)%type = array_type @@ -578,7 +580,7 @@ function declare_intrinsic_fns() result(fns) !******** - sum_i32_fn%type = i32_type + sum_i32_fn%type%type = i32_type allocate(sum_i32_fn%params(1)) sum_i32_fn%params(1)%type = array_type @@ -598,7 +600,7 @@ function declare_intrinsic_fns() result(fns) !******** - sum_i64_fn%type = i64_type + sum_i64_fn%type%type = i64_type allocate(sum_i64_fn%params(1)) sum_i64_fn%params(1)%type = array_type @@ -612,7 +614,7 @@ function declare_intrinsic_fns() result(fns) !******** - sum_f32_fn%type = f32_type + sum_f32_fn%type%type = f32_type allocate(sum_f32_fn%params(1)) sum_f32_fn%params(1)%type = array_type @@ -626,7 +628,7 @@ function declare_intrinsic_fns() result(fns) !******** - all_fn%type = bool_type + all_fn%type%type = bool_type allocate(all_fn%params(1)) all_fn%params(1)%type = array_type @@ -644,7 +646,7 @@ function declare_intrinsic_fns() result(fns) !******** - any_fn%type = bool_type + any_fn%type%type = bool_type allocate(any_fn%params(1)) any_fn%params(1)%type = array_type diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index a50ab2e4..bd517de3 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -180,15 +180,16 @@ module function parse_fn_call(parser) result(fn_call) end if - fn_call%val%type = fn%type - if (fn%type == array_type) then - if (.not. allocated(fn_call%val%array)) allocate(fn_call%val%array) - fn_call%val%array%type = fn%array_type + fn_call%val = fn%type + !fn_call%val%type = fn%type + !if (fn%type == array_type) then + ! if (.not. allocated(fn_call%val%array)) allocate(fn_call%val%array) + ! fn_call%val%array%type = fn%array_type - ! i32_arr_fn returns same rank as arg (not -1) - if (fn%rank > 0) fn_call%val%array%rank = fn%rank + ! ! i32_arr_fn returns same rank as arg (not -1) + ! if (fn%rank > 0) fn_call%val%array%rank = fn%rank - end if + !end if ! Intrinsic fns don't have a syntax node: they are implemented ! in Fortran, not syntran @@ -498,7 +499,7 @@ module function parse_fn_declaration(parser) result(decl) ! https://stackoverflow.com/questions/35018919/whats-the-origin-of-in-rust-function-definition-return-types ! - fn%type = void_type + fn%type%type = void_type rank = 0 if (parser%current_kind() == colon_token) then @@ -518,28 +519,31 @@ module function parse_fn_declaration(parser) result(decl) end if if (rank >= 0) then - fn%type = array_type - fn%rank = rank - fn%array_type = itype + fn%type%type = array_type + allocate(fn%type%array) + fn%type%array%rank = rank + fn%type%array%type = itype else - fn%type = itype + fn%type%type = itype end if - fn%struct_name = type_text + !fn%struct_name = type_text + fn%type%struct_name = type_text end if !print *, 'fn%type = ', fn%type ! Copy for later return type checking while parsing body parser%fn_name = identifier%text - !parser%fn_type = fn%type - parser%fn_type%type = fn%type - parser%fn_type%struct_name = fn%struct_name - if (rank >= 0) then - !parser%fn_rank = fn%rank - !parser%fn_array_type = fn%array_type - parser%fn_type%array%rank = fn%rank - parser%fn_type%array%type = fn%array_type - end if + parser%fn_type = fn%type + !!parser%fn_type = fn%type + !parser%fn_type%type = fn%type + !parser%fn_type%struct_name = fn%struct_name + !if (rank >= 0) then + ! !parser%fn_rank = fn%rank + ! !parser%fn_array_type = fn%array_type + ! parser%fn_type%array%rank = fn%rank + ! parser%fn_type%array%type = fn%array_type + !end if body = parser%parse_statement() diff --git a/src/types.f90 b/src/types.f90 index b9ceb97d..d0d17ef7 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -53,8 +53,9 @@ module syntran__types_m ! Function signature: input and output types ! Return type - integer :: type, array_type, rank - character(len = :), allocatable :: struct_name + type(value_t) :: type + !integer :: type, array_type, rank + !character(len = :), allocatable :: struct_name ! Arguments/parameters. Technically, "arguments" in most languages are ! what Fortran calls "actual arguments" and "parameters" are Fortran @@ -454,8 +455,8 @@ recursive subroutine fn_copy(dst, src) !print *, 'starting fn_copy()' dst%type = src%type - dst%array_type = src%array_type - dst%rank = src%rank + !dst%array_type = src%array_type + !dst%rank = src%rank dst%variadic_min = src%variadic_min dst%variadic_type = src%variadic_type From 7769ea3a002a72dd81b734c9bf17b16bfd3e9440 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 23:10:29 -0400 Subject: [PATCH 114/137] add test for bug from 14e9b88a --- src/tests/test.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 67d427e1..b18fae1e 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2741,6 +2741,12 @@ subroutine unit_test_struct(npass, nfail) //'y1.p.z -= y1.ba.tr.x;' & //'return y1.p.z;' & , quiet) == '-4', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 48 + //'fn get_d(): D {return D{y=2024, m="Sep", d=21};}' & + //'let d0 = get_d();' & + //'return d0.m;' & + , quiet) == 'Sep', & .false. & ! so I don't have to bother w/ trailing commas ] From b949090d9066e986fc0f607fe385745391e40928 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sat, 7 Sep 2024 23:28:02 -0400 Subject: [PATCH 115/137] add diagnostic for dots on things that aren't structs --- src/consts.f90 | 2 +- src/errors.f90 | 16 ++++++++++++++++ src/parse_expr.f90 | 12 +++++++++--- 3 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/consts.f90 b/src/consts.f90 index eaf34d84..84fd080c 100644 --- a/src/consts.f90 +++ b/src/consts.f90 @@ -339,7 +339,7 @@ function kind_name(kind) "size_array ", & ! 90 "return_keyword ", & ! 91 "return_statement ", & ! 92 - "comma_token ", & ! 93 + "dot_token ", & ! 93 "struct_keyword ", & ! 94 "struct_declaration ", & ! 95 "struct_instance_expr", & ! 96 diff --git a/src/errors.f90 b/src/errors.f90 index c19841fb..76d62f11 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -730,6 +730,22 @@ end function err_reset_member !=============================================================================== +function err_non_struct_dot(context, span, ident) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + character(len = *), intent(in) :: ident + err = err_prefix & + //'dot member access cannot be performed on non-struct variable `' & + //ident//'`' & + //underline(context, span) & + //" dot on a non-struct"//color_reset + +end function err_non_struct_dot + +!=============================================================================== + function err_bad_member_name(context, span, mem_name, struct_name) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index 1e07cd42..90213222 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -575,6 +575,7 @@ recursive module subroutine parse_dot(parser, expr) if (parser%current_kind() /= dot_token) return !print *, "parsing dot" + !print *, "expr type = ", type_name(expr%val) dot = parser%match(dot_token) @@ -584,9 +585,14 @@ recursive module subroutine parse_dot(parser, expr) !print *, "type = ", kind_name(expr%val%type) if (expr%val%type /= struct_type) then - ! TODO: need to catch in parser - write(*,*) err_prefix//"variable in dot expr is not a struct"//color_reset - !print *, "type = ", kind_name(expr%val%type) + ! Does expr%identifier always exist to create a span? May need to just + ! underline dot itself, e.g. for struct_array[0].member + span = new_span(expr%identifier%pos, dot%pos - expr%identifier%pos + 1) + !span = new_span(expr%identifier%pos, len(expr%identifier%text)) + call parser%diagnostics%push(err_non_struct_dot( & + parser%context(), & + span, & + expr%identifier%text)) return end if From 606b7688ae44c6187151dece6fc02c0de28897ff Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 10:41:57 -0400 Subject: [PATCH 116/137] add tests for fns returning arrays of structs --- src/compiler.F90 | 6 +++--- src/parse_expr.f90 | 11 +++++++---- src/tests/test.f90 | 20 ++++++++++++++++++++ 3 files changed, 30 insertions(+), 7 deletions(-) diff --git a/src/compiler.F90 b/src/compiler.F90 index 1aefadbc..f7a3f937 100644 --- a/src/compiler.F90 +++ b/src/compiler.F90 @@ -22,17 +22,17 @@ module syntran__compiler_m #elif defined(__INTEL_COMPILER) - ! Could be ifx or ifort + ! Could be either ifx or ifort character(len = *), parameter :: fort_compiler = "intel" integer, parameter :: fort_vers(*) = [__INTEL_COMPILER] #else +#error Neither __GFORTRAN__ nor __INTEL__ are defined. Please use a supported compiler and compile with pre-processing `-cpp` (gfortran) or `-fpp` (intel) + character(len = *), parameter :: fort_compiler = "unknown" integer, parameter :: fort_vers(*) = [] -#error Neither __GFORTRAN__ nor __INTEL__ are defined. Please use a supported compiler and compile with pre-processing `-cpp` (gfortran) or `-fpp` (intel) - #endif ! dev commit is replaced with the git hash by gen-header.sh diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index bf7e28ef..a8c5b5de 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -608,14 +608,17 @@ recursive module subroutine parse_dot(parser, expr) ! Is there a better way than looking up every struct by name again? call parser%structs%search(expr%val%struct_name, struct_id, io, struct) if (io /= 0) then - ! TODO: diag - write(*,*) err_prefix//"unreachable struct lookup failure"//color_reset - stop + ! Type is already confirmed as struct_type above, so I'm fairly sure + ! this is unreachable + write(*,*) err_int_prefix//"unreachable struct lookup failure"//color_reset + call internal_error() end if call struct%vars%search(identifier%text, member_id, io, member) if (io /= 0) then - ! TODO: diag + + ! TODO: diag + write(*,*) err_prefix//"struct dot member does not exist"//color_reset stop end if diff --git a/src/tests/test.f90 b/src/tests/test.f90 index b18fae1e..01bd02ba 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3257,6 +3257,26 @@ subroutine unit_test_struct_arr(npass, nfail) //'ps[0] = p2;' & //'return ps[0].v;' & , quiet) == '[3, 17]', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 48 + //'fn get_ds(): [D;:] {'& + //' let d0 = D{y=2024, m="Sep", d=21};' & + //' let d1 = D{y=1990, m="Aug", d=2};' & + //' return [d0, d1];' & + //'}' & + //'let ds = get_ds();' & + //'return ds[1].m;' & + , quiet) == 'Aug', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 48 + //'fn get_ds(): [D;:] {'& + //' let d0 = D{y=2024, m="Sep", d=21};' & + //' let d1 = D{y=1990, m="Aug", d=2};' & + //' return [d0, d1];' & + //'}' & + //'let ds = get_ds();' & + //'return ds[0].d;' & + , quiet) == '21', & .false. & ! so I don't have to bother w/ trailing commas ] From 5fe5439252eb7d1a92db52e2ff7cf72cc4a3b188 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 10:59:04 -0400 Subject: [PATCH 117/137] add diagnostic for bad member names in dot exprs --- src/errors.f90 | 29 ++++++++++++++++++++++++++--- src/parse_expr.f90 | 31 ++++++++++++++++++------------- src/parse_fn.f90 | 2 +- 3 files changed, 45 insertions(+), 17 deletions(-) diff --git a/src/errors.f90 b/src/errors.f90 index 76d62f11..16b8149d 100644 --- a/src/errors.f90 +++ b/src/errors.f90 @@ -746,14 +746,18 @@ end function err_non_struct_dot !=============================================================================== -function err_bad_member_name(context, span, mem_name, struct_name) result(err) +function err_bad_member_name(context, span, mem_name, struct_var_name, struct_name) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span character(len = :), allocatable :: err - character(len = *), intent(in) :: mem_name, struct_name + ! This msg yells about both the variable name `struct_var_name` and its + ! "class" `struct_name`. Its useful for dot expressions `var.mem` + + character(len = *), intent(in) :: mem_name, struct_var_name, struct_name err = err_prefix & - //'member `'//mem_name//'` in struct `'//struct_name//'` does not exist' & + //'member `'//mem_name//'` does not exist in struct `'//struct_var_name//'`' & + //' of type `'//struct_name//'`' & //underline(context, span) & //" bad member name"//color_reset @@ -761,6 +765,25 @@ end function err_bad_member_name !=============================================================================== +function err_bad_member_name_short(context, span, mem_name, struct_name) result(err) + type(text_context_t) :: context + type(text_span_t), intent(in) :: span + character(len = :), allocatable :: err + + ! This msg yells only about the "class" `struct_name`. Its useful for + ! struct instantiations as in `return Class{mem = val};` where there may not + ! be a variable identifier like in the longer fn above + + character(len = *), intent(in) :: mem_name, struct_name + err = err_prefix & + //'member `'//mem_name//'` does not exist in struct `'//struct_name//'`' & + //underline(context, span) & + //" bad member name"//color_reset + +end function err_bad_member_name_short + +!=============================================================================== + function err_bad_member_type(context, span, mem_name, struct_name, act_type, exp_type) result(err) type(text_context_t) :: context type(text_span_t), intent(in) :: span diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index a8c5b5de..f235e120 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -585,14 +585,16 @@ recursive module subroutine parse_dot(parser, expr) !print *, "type = ", kind_name(expr%val%type) if (expr%val%type /= struct_type) then - ! Does expr%identifier always exist to create a span? May need to just - ! underline dot itself, e.g. for struct_array[0].member - span = new_span(expr%identifier%pos, dot%pos - expr%identifier%pos + 1) - !span = new_span(expr%identifier%pos, len(expr%identifier%text)) - call parser%diagnostics%push(err_non_struct_dot( & - parser%context(), & - span, & - expr%identifier%text)) + ! Don't cascade errors for undeclared vars + if (expr%val%type /= unknown_type) then + ! Does expr%identifier always exist to create a span? May need to just + ! underline dot itself, e.g. for struct_array[0].member + span = new_span(expr%identifier%pos, dot%pos - expr%identifier%pos + 1) + call parser%diagnostics%push(err_non_struct_dot( & + parser%context(), & + span, & + expr%identifier%text)) + end if return end if @@ -616,11 +618,14 @@ recursive module subroutine parse_dot(parser, expr) call struct%vars%search(identifier%text, member_id, io, member) if (io /= 0) then - - ! TODO: diag - - write(*,*) err_prefix//"struct dot member does not exist"//color_reset - stop + span = new_span(identifier%pos, len(identifier%text)) + call parser%diagnostics%push(err_bad_member_name( & + parser%context(), & + span, & + identifier%text, & + expr%identifier%text, & + expr%val%struct_name)) + return end if !print *, "member id = ", member_id !print *, "mem type = ", kind_name(member%type) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index bd517de3..ed8a88be 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -911,7 +911,7 @@ module function parse_struct_instance(parser) result(inst) is_ok = io == 0 if (.not. is_ok) then span = new_span(name%pos, len(name%text)) - call parser%diagnostics%push(err_bad_member_name( & + call parser%diagnostics%push(err_bad_member_name_short( & parser%context(), & span, & name%text, & From 012f1404276034c52ab1c95fc6072e1c94b69106 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 11:33:45 -0400 Subject: [PATCH 118/137] add test for fn of high-order struct; stop cascades --- src/parse_control.f90 | 2 ++ src/parse_expr.f90 | 16 +++++++++------- src/parse_fn.f90 | 9 +++++---- src/tests/test.f90 | 18 ++++++++++++++++-- 4 files changed, 32 insertions(+), 13 deletions(-) diff --git a/src/parse_control.f90 b/src/parse_control.f90 index 3a6a6813..ccbe8f66 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -62,6 +62,7 @@ module function parse_return_statement(parser) result(statement) ! There should also be a check that every branch of a fn has a return ! statement, but that seems more difficult if (types_match(parser%fn_type, statement%right%val) /= TYPE_MATCH) then + if (statement%right%val%type /= unknown_type) then ! don't cascade span = new_span(right_beg, right_end - right_beg + 1) call parser%diagnostics%push( & err_bad_ret_type(parser%context(), & @@ -69,6 +70,7 @@ module function parse_return_statement(parser) result(statement) type_name(parser%fn_type), & type_name(statement%right%val))) end if + end if end function parse_return_statement diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index f235e120..efedee5b 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -150,7 +150,10 @@ recursive module function parse_expr_statement(parser) result(expr) end if call parser%parse_dot(expr) - if (.not. allocated(expr%member)) return + if (.not. allocated(expr%member)) then + !print *, "RETURNING ******" + return + end if end if @@ -158,7 +161,7 @@ recursive module function parse_expr_statement(parser) result(expr) ! Rewind and do the default case (same as outside the assignment if ! block). Could use goto or probably refactor somehow parser%pos = pos0 - !print *, "rewinding" + !print *, "rewinding ********" !print *, 'pos0 = ', pos0 expr = parser%parse_expr() return @@ -588,7 +591,8 @@ recursive module subroutine parse_dot(parser, expr) ! Don't cascade errors for undeclared vars if (expr%val%type /= unknown_type) then ! Does expr%identifier always exist to create a span? May need to just - ! underline dot itself, e.g. for struct_array[0].member + ! underline dot itself. I've tested this with arrays of structs + ! `struct_array[0].member` and nested dot exprs `a.b.c.z` span = new_span(expr%identifier%pos, dot%pos - expr%identifier%pos + 1) call parser%diagnostics%push(err_non_struct_dot( & parser%context(), & @@ -625,6 +629,7 @@ recursive module subroutine parse_dot(parser, expr) identifier%text, & expr%identifier%text, & expr%val%struct_name)) + expr%val%type = unknown_type ! this prevents cascades later return end if !print *, "member id = ", member_id @@ -654,13 +659,10 @@ recursive module subroutine parse_dot(parser, expr) ! I think this needs a recursive call to `parse_dot()` right here to handle ! things like `a.b.c` if (parser%peek_kind(0) == dot_token) then - - !expr%member%val = member expr%member%val = expr%val - + expr%member%identifier = identifier ! set for diags in recursed parse_dot() call parser%parse_dot(expr%member) expr%val = expr%member%val - end if end subroutine parse_dot diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index ed8a88be..530a1580 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -369,6 +369,7 @@ module function parse_fn_declaration(parser) result(decl) ! // do something with a[i,j] ! } + ! Parse fn parameters (arguments) do while ( & parser%current_kind() /= rparen_token .and. & parser%current_kind() /= eof_token) @@ -444,10 +445,10 @@ module function parse_fn_declaration(parser) result(decl) !inst%val%struct( member_id ) = mem%val - ! TODO: test a fn with a 2nd-order struct arg (i.e. a struct - ! made up of other structs). Maybe more data needs to be copied - ! here, especially struct_name. Essentially every %type should - ! be bundled along with a %struct_name as in + ! Test a fn with a 2nd-order struct arg (i.e. a struct made up + ! of other structs). Maybe more data needs to be copied here, + ! especially struct_name. Essentially every %type should be + ! bundled along with a %struct_name as in ! parse_struct_declaration() end do diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 01bd02ba..833b036d 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3258,7 +3258,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'return ps[0].v;' & , quiet) == '[3, 17]', & eval('' & - //'struct D{y:i32, m:str, d:i32}' & ! 48 + //'struct D{y:i32, m:str, d:i32}' & ! 49 //'fn get_ds(): [D;:] {'& //' let d0 = D{y=2024, m="Sep", d=21};' & //' let d1 = D{y=1990, m="Aug", d=2};' & @@ -3268,7 +3268,7 @@ subroutine unit_test_struct_arr(npass, nfail) //'return ds[1].m;' & , quiet) == 'Aug', & eval('' & - //'struct D{y:i32, m:str, d:i32}' & ! 48 + //'struct D{y:i32, m:str, d:i32}' & ! 50 //'fn get_ds(): [D;:] {'& //' let d0 = D{y=2024, m="Sep", d=21};' & //' let d1 = D{y=1990, m="Aug", d=2};' & @@ -3277,6 +3277,20 @@ subroutine unit_test_struct_arr(npass, nfail) //'let ds = get_ds();' & //'return ds[0].d;' & , quiet) == '21', & + eval('' & ! 51 + //'struct A{a: i32}' & + //'struct B{b: A}' & + //'struct C{c: B}' & + //'struct D{d: C}' & + //'struct E{e: D}' & ! order-5 struct + //'fn extract_a(x: E): i32 { return x.e.d.c.b.a; }' & + //'let a = A{a = 42};' & + //'let b = B{b = a};' & + //'let c = C{c = b};' & + //'let d = D{d = c};' & + //'let e = E{e = d};' & + //'return extract_a(e);' & + , quiet = .false.) == '42', & .false. & ! so I don't have to bother w/ trailing commas ] From 4bd6746c0e6c66c4f4577c823d164ecc18362f6c Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 11:48:42 -0400 Subject: [PATCH 119/137] remove unnecessary syntax node vector from parse_struct_instance() --- src/parse_fn.f90 | 33 ++++++++++++++++++++++----------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 530a1580..7bdbda0e 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -445,11 +445,25 @@ module function parse_fn_declaration(parser) result(decl) !inst%val%struct( member_id ) = mem%val - ! Test a fn with a 2nd-order struct arg (i.e. a struct made up + ! ~~Test a fn with a 2nd-order struct arg (i.e. a struct made up ! of other structs). Maybe more data needs to be copied here, ! especially struct_name. Essentially every %type should be ! bundled along with a %struct_name as in - ! parse_struct_declaration() + ! parse_struct_declaration()~~ + ! + ! Unit test added in 012f1404. This code works, but I think it + ! could be significantly simplified by following my new mantra: + ! "a type is a value!" Roughly a dozen lines here could be + ! replaced by a single value_t copy to handle the parameter + ! types. The return type has already accomplished this + ! simplification by assigning `parser%fn_type = fn%type` below. + ! Parameters could probably be simplified similarly, but it will + ! take a little refactoring. member_t contains an int `type` + ! and param_t also contains an int `type` and associated array + ! type enums, etc. Both member_t and param_t should be changed + ! to simply wrap a `value_t` to contain the type meta-data. + ! Perhaps member_t and/or param_t could be entirely eliminated + ! if they become only a wrapper for the value_t. end do @@ -723,7 +737,6 @@ module function parse_struct_declaration(parser) result(decl) struct%members(i)%name = names%v(i)%s - ! TODO: consume dummy_struct for nested structs itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) if (itype == unknown_type) then span = new_span(pos_mems%v(i), pos_mems%v(i+1) - pos_mems%v(i)) @@ -826,7 +839,7 @@ module function parse_struct_instance(parser) result(inst) character(len = :), allocatable :: unset_name, exp_type, act_type - integer :: io, pos0, pos1, struct_id, member_id, id1(1) + integer :: io, pos0, pos1, struct_id, member_id, id1(1), num_mems logical :: is_ok logical, allocatable :: member_set(:) @@ -834,7 +847,6 @@ module function parse_struct_instance(parser) result(inst) type(struct_t) :: struct type(syntax_node_t) :: mem - type(syntax_node_vector_t) :: mems type(syntax_token_t) :: identifier, name, equals, comma, lbrace, rbrace, dummy @@ -857,8 +869,7 @@ module function parse_struct_instance(parser) result(inst) call parser%structs%search(identifier%text, struct_id, io, struct) !print *, "struct io = ", io - ! TODO: do we need `mems`? Or just inst%members - mems = new_syntax_node_vector() + num_mems = 0 lbrace = parser%match(lbrace_token) @@ -965,7 +976,7 @@ module function parse_struct_instance(parser) result(inst) end if - call mems%push(mem) + num_mems = num_mems + 1 if (parser%current_kind() /= rbrace_token) then comma = parser%match(comma_token) @@ -999,12 +1010,12 @@ module function parse_struct_instance(parser) result(inst) end if !print *, "size = ", struct%num_vars - !print *, "size = ", mems%len_ - if (mems%len_ < struct%num_vars) then + !print *, "size = ", num_mems + if (num_mems < struct%num_vars) then ! I think this is unreachable given the other checks write(*,*) err_prefix//"struct instance does not have enough members"//color_reset call internal_error() - !else if (mems%len_ > struct%num_vars) then + !else if (num_mems > struct%num_vars) then ! write(*,*) err_prefix//"struct instance has too many members"//color_reset ! call internal_error() end if From 2722730b92b7ba71635f3a1d2c7a06ec8380ed55 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 11:58:31 -0400 Subject: [PATCH 120/137] comments --- src/parse_fn.f90 | 1 - src/tests/test.f90 | 2 +- src/types.f90 | 4 +--- 3 files changed, 2 insertions(+), 5 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 7bdbda0e..40a4daef 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -934,7 +934,6 @@ module function parse_struct_instance(parser) result(inst) !print *, "member type = ", kind_name(member%type) !print *, "mem type = ", kind_name(mem%val%type) if (is_ok) then - if (types_match(member, mem%val) /= TYPE_MATCH) then exp_type = type_name(member) diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 833b036d..e5f21a73 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3326,7 +3326,7 @@ subroutine unit_test_struct_str(npass, nfail) ! conversion is subject to change, especially if I figure out how to label ! each member with its name ! - ! TODO: update documentation to reflect any changes here + ! TODO: update documentation to reflect any struct-to-str changes here tests = & [ & diff --git a/src/types.f90 b/src/types.f90 index d0d17ef7..492e6ebc 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -52,10 +52,8 @@ module syntran__types_m type fn_t ! Function signature: input and output types - ! Return type + ! Return type. "A type is a value!" type(value_t) :: type - !integer :: type, array_type, rank - !character(len = :), allocatable :: struct_name ! Arguments/parameters. Technically, "arguments" in most languages are ! what Fortran calls "actual arguments" and "parameters" are Fortran From ba14778da99e9a179c7089c256e9eee14a97d12a Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 12:15:22 -0400 Subject: [PATCH 121/137] remove most of member_t. this feels risky --- src/parse_fn.f90 | 100 +++++++++++++++++++++++------------------------ src/types.f90 | 13 +++--- 2 files changed, 55 insertions(+), 58 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 40a4daef..de4ad6d8 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -435,37 +435,37 @@ module function parse_fn_declaration(parser) result(decl) !print *, "allocated = ", allocated(struct%vars%vals) val%struct_name = types%v(i)%s - allocate(val%struct( struct%num_vars )) - !allocate(val%members( struct%num_vars )) - !val = struct - do j = 1, struct%num_vars - !val%struct(j) = struct%members(j)%val - val%struct(j)%type = struct%members(j)%type - !val%struct(j) = struct%vars%vals(j) - - !inst%val%struct( member_id ) = mem%val - - ! ~~Test a fn with a 2nd-order struct arg (i.e. a struct made up - ! of other structs). Maybe more data needs to be copied here, - ! especially struct_name. Essentially every %type should be - ! bundled along with a %struct_name as in - ! parse_struct_declaration()~~ - ! - ! Unit test added in 012f1404. This code works, but I think it - ! could be significantly simplified by following my new mantra: - ! "a type is a value!" Roughly a dozen lines here could be - ! replaced by a single value_t copy to handle the parameter - ! types. The return type has already accomplished this - ! simplification by assigning `parser%fn_type = fn%type` below. - ! Parameters could probably be simplified similarly, but it will - ! take a little refactoring. member_t contains an int `type` - ! and param_t also contains an int `type` and associated array - ! type enums, etc. Both member_t and param_t should be changed - ! to simply wrap a `value_t` to contain the type meta-data. - ! Perhaps member_t and/or param_t could be entirely eliminated - ! if they become only a wrapper for the value_t. - - end do + !allocate(val%struct( struct%num_vars )) + !!allocate(val%members( struct%num_vars )) + !!val = struct + !do j = 1, struct%num_vars + ! !val%struct(j) = struct%members(j)%val + ! val%struct(j)%type = struct%members(j)%type + ! !val%struct(j) = struct%vars%vals(j) + + ! !inst%val%struct( member_id ) = mem%val + + ! ! ~~Test a fn with a 2nd-order struct arg (i.e. a struct made up + ! ! of other structs). Maybe more data needs to be copied here, + ! ! especially struct_name. Essentially every %type should be + ! ! bundled along with a %struct_name as in + ! ! parse_struct_declaration()~~ + ! ! + ! ! Unit test added in 012f1404. This code works, but I think it + ! ! could be significantly simplified by following my new mantra: + ! ! "a type is a value!" Roughly a dozen lines here could be + ! ! replaced by a single value_t copy to handle the parameter + ! ! types. The return type has already accomplished this + ! ! simplification by assigning `parser%fn_type = fn%type` below. + ! ! Parameters could probably be simplified similarly, but it will + ! ! take a little refactoring. member_t contains an int `type` + ! ! and param_t also contains an int `type` and associated array + ! ! type enums, etc. Both member_t and param_t should be changed + ! ! to simply wrap a `value_t` to contain the type meta-data. + ! ! Perhaps member_t and/or param_t could be entirely eliminated + ! ! if they become only a wrapper for the value_t. + + !end do end if @@ -621,6 +621,9 @@ module function parse_struct_declaration(parser) result(decl) integer :: itype, i, io, pos0, pos1, pos2, rank + ! TODO: this is the only use of member_t. Maybe eliminate it + type(member_t), allocatable :: members(:) + !type(struct_t), save :: struct type(struct_t) :: struct, dummy_struct @@ -725,8 +728,8 @@ module function parse_struct_declaration(parser) result(decl) ! Now that we have the number of members, save them struct%num_vars = 0 - if (allocated(struct%members)) deallocate(struct%members) - allocate(struct%members( names%len_ )) + allocate(members( names%len_ )) + allocate(struct%member_names%v( names%len_ )) !allocate(decl %params( names%len_ )) ! if this is needed, we need a new !! name. "members" already means the member statements of a block statement @@ -735,7 +738,8 @@ module function parse_struct_declaration(parser) result(decl) do i = 1, names%len_ !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s - struct%members(i)%name = names%v(i)%s + members(i)%name = names%v(i)%s + struct%member_names%v(i)%s = names%v(i)%s itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) if (itype == unknown_type) then @@ -745,12 +749,12 @@ module function parse_struct_declaration(parser) result(decl) end if if (is_array%v(i)) then - struct%members(i)%type = array_type - struct%members(i)%array_type = itype - struct%members(i)%rank = ranks%v(i) - !print *, "rank = ", struct%members(i)%rank + members(i)%type = array_type + members(i)%array_type = itype + members(i)%rank = ranks%v(i) + !print *, "rank = ", members(i)%rank else - struct%members(i)%type = itype + members(i)%type = itype !print *, "(scalar)" end if @@ -763,13 +767,13 @@ module function parse_struct_declaration(parser) result(decl) !decl%params(i) = parser%num_vars ! Create a value_t object to store the type - val%type = struct%members(i)%type + val%type = members(i)%type val%struct_name = types%v(i)%s if (is_array%v(i)) then if (allocated(val%array)) deallocate(val%array) allocate(val%array) - val%array%type = struct%members(i)%array_type - val%array%rank = struct%members(i)%rank + val%array%type = members(i)%array_type + val%array%rank = members(i)%rank !print *, "rank = ", val%array%rank end if @@ -779,12 +783,7 @@ module function parse_struct_declaration(parser) result(decl) ! type, just like `parser%vars`. Just add one inside of the `struct_t` ! type. - !print *, "insert var type ", kind_name(val%type) - !print *, "insert var name = ", struct%members(i)%name - !call parser%vars%insert(struct%members(i)%name, val, parser%num_vars) - !call struct%vars%insert(struct%members(i)%name, val, struct%num_vars) - - call struct%vars%insert(struct%members(i)%name, val, & + call struct%vars%insert(members(i)%name, val, & struct%num_vars, io, overwrite = .false.) !print *, 'io = ', io if (io /= exit_success) then @@ -792,7 +791,7 @@ module function parse_struct_declaration(parser) result(decl) call parser%diagnostics%push(err_redeclare_mem( & parser%context(), & span, & - struct%members(i)%name)) + members(i)%name)) end if end do @@ -996,7 +995,8 @@ module function parse_struct_instance(parser) result(inst) ! There could be more than 1 unset member but we only log diag for the ! 1st one id1 = findlocl1(member_set, .false.) - unset_name = struct%members(id1(1))%name + !unset_name = struct%members(id1(1))%name + unset_name = struct%member_names%v(id1(1))%s !print *, "id1 = ", id1 !print *, "name = ", unset_name diff --git a/src/types.f90 b/src/types.f90 index 492e6ebc..0c26f564 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -271,13 +271,10 @@ module syntran__types_m !******** type struct_t - ! Structure declaration. Will this be different than a struct instance? + ! User-defined structure, aka derived type - !! TODO: do we need members inside struct_t? Or only a local var inside - !! parse_struct_instance? I think all the same info is also contained - !! in struct%vars - !type(param_t), allocatable :: params(:) - type(member_t), allocatable :: members(:) + !type(member_t), allocatable :: members(:) + type(string_vector_t) :: member_names type(vars_t) :: vars ! can't compile w/o allocatable if vars_t is defined below !type(vars_t), allocatable :: vars @@ -2419,7 +2416,7 @@ recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) val = node%val !val%vars = node%val%vars id_index = node%id_index - val%members = node%val%members + !val%members = node%val%members !print *, 'done struct_ternary_search' !print *, '' @@ -2517,7 +2514,7 @@ recursive subroutine struct_ternary_insert(node, key, val, id_index, iostat, ove node%val = val !node%val%vars = val%vars node%id_index = id_index - node%val%members = val%members + !node%val%members = val%members !print *, 'done inserting' !print *, '' From f1e5c721084d7fb43aa990e68c8fbbf2cfc70df2 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 12:48:27 -0400 Subject: [PATCH 122/137] a type is a value! refactor fn param type handling --- src/core.f90 | 113 +++++++++++++++++++++++++---------------------- src/parse_fn.f90 | 92 +++++++++++++++----------------------- src/types.f90 | 8 ++-- 3 files changed, 99 insertions(+), 114 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 1255617b..694df510 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -241,7 +241,7 @@ function declare_intrinsic_fns() result(fns) ! TODO: polymorphic in f32, f64, etc. exp_fn%type%type = f32_type allocate(exp_fn%params(1)) - exp_fn%params(1)%type = f32_type + exp_fn%params(1)%type%type = f32_type exp_fn%params(1)%name = "x" ! Insert the fn into the dict. These are global intrinsic fns, so there's no @@ -267,10 +267,10 @@ function declare_intrinsic_fns() result(fns) min_i32_fn%type%type = i32_type allocate(min_i32_fn%params(2)) - min_i32_fn%params(1)%type = i32_type + min_i32_fn%params(1)%type%type = i32_type min_i32_fn%params(1)%name = "a0" - min_i32_fn%params(2)%type = i32_type + min_i32_fn%params(2)%type%type = i32_type min_i32_fn%params(2)%name = "a1" min_i32_fn%variadic_min = 0 @@ -285,10 +285,10 @@ function declare_intrinsic_fns() result(fns) min_i64_fn%type%type = i64_type allocate(min_i64_fn%params(2)) - min_i64_fn%params(1)%type = i64_type + min_i64_fn%params(1)%type%type = i64_type min_i64_fn%params(1)%name = "a0" - min_i64_fn%params(2)%type = i64_type + min_i64_fn%params(2)%type%type = i64_type min_i64_fn%params(2)%name = "a1" min_i64_fn%variadic_min = 0 @@ -301,10 +301,10 @@ function declare_intrinsic_fns() result(fns) min_f32_fn%type%type = f32_type allocate(min_f32_fn%params(2)) - min_f32_fn%params(1)%type = f32_type + min_f32_fn%params(1)%type%type = f32_type min_f32_fn%params(1)%name = "a0" - min_f32_fn%params(2)%type = f32_type + min_f32_fn%params(2)%type%type = f32_type min_f32_fn%params(2)%name = "a1" min_f32_fn%variadic_min = 0 @@ -317,10 +317,10 @@ function declare_intrinsic_fns() result(fns) max_i32_fn%type%type = i32_type allocate(max_i32_fn%params(2)) - max_i32_fn%params(1)%type = i32_type + max_i32_fn%params(1)%type%type = i32_type max_i32_fn%params(1)%name = "a0" - max_i32_fn%params(2)%type = i32_type + max_i32_fn%params(2)%type%type = i32_type max_i32_fn%params(2)%name = "a1" max_i32_fn%variadic_min = 0 @@ -335,10 +335,10 @@ function declare_intrinsic_fns() result(fns) max_i64_fn%type%type = i64_type allocate(max_i64_fn%params(2)) - max_i64_fn%params(1)%type = i64_type + max_i64_fn%params(1)%type%type = i64_type max_i64_fn%params(1)%name = "a0" - max_i64_fn%params(2)%type = i64_type + max_i64_fn%params(2)%type%type = i64_type max_i64_fn%params(2)%name = "a1" max_i64_fn%variadic_min = 0 @@ -351,10 +351,10 @@ function declare_intrinsic_fns() result(fns) max_f32_fn%type%type = f32_type allocate(max_f32_fn%params(2)) - max_f32_fn%params(1)%type = f32_type + max_f32_fn%params(1)%type%type = f32_type max_f32_fn%params(1)%name = "a0" - max_f32_fn%params(2)%type = f32_type + max_f32_fn%params(2)%type%type = f32_type max_f32_fn%params(2)%name = "a1" max_f32_fn%variadic_min = 0 @@ -390,7 +390,7 @@ function declare_intrinsic_fns() result(fns) len_fn%type%type = i64_type allocate(len_fn%params(1)) - len_fn%params(1)%type = str_type + len_fn%params(1)%type%type = str_type len_fn%params(1)%name = "str" call fns%insert("len", len_fn, id_index) @@ -404,7 +404,7 @@ function declare_intrinsic_fns() result(fns) parse_i32_fn%type%type = i32_type allocate(parse_i32_fn%params(1)) - parse_i32_fn%params(1)%type = str_type + parse_i32_fn%params(1)%type%type = str_type parse_i32_fn%params(1)%name = "str" call fns%insert("parse_i32", parse_i32_fn, id_index) @@ -413,7 +413,7 @@ function declare_intrinsic_fns() result(fns) parse_i64_fn%type%type = i64_type allocate(parse_i64_fn%params(1)) - parse_i64_fn%params(1)%type = str_type + parse_i64_fn%params(1)%type%type = str_type parse_i64_fn%params(1)%name = "str" call fns%insert("parse_i64", parse_i64_fn, id_index) @@ -422,7 +422,7 @@ function declare_intrinsic_fns() result(fns) parse_f32_fn%type%type = f32_type allocate(parse_f32_fn%params(1)) - parse_f32_fn%params(1)%type = str_type + parse_f32_fn%params(1)%type%type = str_type parse_f32_fn%params(1)%name = "str" call fns%insert("parse_f32", parse_f32_fn, id_index) @@ -432,7 +432,7 @@ function declare_intrinsic_fns() result(fns) i32_sca_fn%type%type = i32_type allocate(i32_sca_fn%params(1)) - i32_sca_fn%params(1)%type = any_type + i32_sca_fn%params(1)%type%type = any_type i32_sca_fn%params(1)%name = "a" @@ -447,7 +447,7 @@ function declare_intrinsic_fns() result(fns) allocate(i32_arr_fn%params(1)) - i32_arr_fn%params(1)%type = any_type + i32_arr_fn%params(1)%type%type = any_type i32_arr_fn%params(1)%name = "a" @@ -460,7 +460,7 @@ function declare_intrinsic_fns() result(fns) i64_sca_fn%type%type = i64_type allocate(i64_sca_fn%params(1)) - i64_sca_fn%params(1)%type = any_type + i64_sca_fn%params(1)%type%type = any_type i64_sca_fn%params(1)%name = "a" @@ -475,7 +475,7 @@ function declare_intrinsic_fns() result(fns) allocate(i64_arr_fn%params(1)) - i64_arr_fn%params(1)%type = any_type + i64_arr_fn%params(1)%type%type = any_type i64_arr_fn%params(1)%name = "a" @@ -485,7 +485,7 @@ function declare_intrinsic_fns() result(fns) open_fn%type%type = file_type allocate(open_fn%params(1)) - open_fn%params(1)%type = str_type + open_fn%params(1)%type%type = str_type open_fn%params(1)%name = "filename" call fns%insert("open", open_fn, id_index) @@ -494,7 +494,7 @@ function declare_intrinsic_fns() result(fns) readln_fn%type%type = str_type allocate(readln_fn%params(1)) - readln_fn%params(1)%type = file_type + readln_fn%params(1)%type%type = file_type readln_fn%params(1)%name = "file_handle" call fns%insert("readln", readln_fn, id_index) @@ -503,7 +503,7 @@ function declare_intrinsic_fns() result(fns) writeln_fn%type%type = void_type allocate(writeln_fn%params(1)) - writeln_fn%params(1)%type = file_type + writeln_fn%params(1)%type%type = file_type writeln_fn%params(1)%name = "file_handle" writeln_fn%variadic_min = 0 @@ -516,7 +516,7 @@ function declare_intrinsic_fns() result(fns) eof_fn%type%type = bool_type allocate(eof_fn%params(1)) - eof_fn%params(1)%type = file_type + eof_fn%params(1)%type%type = file_type eof_fn%params(1)%name = "file_handle" call fns%insert("eof", eof_fn, id_index) @@ -525,7 +525,7 @@ function declare_intrinsic_fns() result(fns) close_fn%type%type = void_type allocate(close_fn%params(1)) - close_fn%params(1)%type = file_type + close_fn%params(1)%type%type = file_type close_fn%params(1)%name = "file_handle" call fns%insert("close", close_fn, id_index) @@ -534,7 +534,7 @@ function declare_intrinsic_fns() result(fns) exit_fn%type%type = void_type allocate(exit_fn%params(1)) - exit_fn%params(1)%type = i32_type + exit_fn%params(1)%type%type = i32_type exit_fn%params(1)%name = "exit_status" call fns%insert("exit", exit_fn, id_index) @@ -544,14 +544,15 @@ function declare_intrinsic_fns() result(fns) size_fn%type%type = i64_type allocate(size_fn%params(2)) - size_fn%params(1)%type = array_type + size_fn%params(1)%type%type = array_type - size_fn%params(1)%array_type = any_type - size_fn%params(1)%rank = -1 ! negative means any rank + allocate(size_fn%params(1)%type%array) + size_fn%params(1)%type%array%type = any_type + size_fn%params(1)%type%array%rank = -1 ! negative means any rank size_fn%params(1)%name = "array" - size_fn%params(2)%type = i32_type + size_fn%params(2)%type%type = i32_type size_fn%params(2)%name = "dim" call fns%insert("size", size_fn, id_index) @@ -565,15 +566,16 @@ function declare_intrinsic_fns() result(fns) count_fn%type%type = i64_type allocate(count_fn%params(1)) - count_fn%params(1)%type = array_type + count_fn%params(1)%type%type = array_type - count_fn%params(1)%array_type = bool_type - count_fn%params(1)%rank = -1 ! negative means any rank + allocate(count_fn%params(1)%type%array) + count_fn%params(1)%type%array%type = bool_type + count_fn%params(1)%type%array%rank = -1 ! negative means any rank count_fn%params(1)%name = "mask" !! TODO: add dim arg to count() like Fortran - !count_fn%params(2)%type = i32_type + !count_fn%params(2)%type%type = i32_type !count_fn%params(2)%name = "dim" call fns%insert("count", count_fn, id_index) @@ -583,17 +585,18 @@ function declare_intrinsic_fns() result(fns) sum_i32_fn%type%type = i32_type allocate(sum_i32_fn%params(1)) - sum_i32_fn%params(1)%type = array_type + sum_i32_fn%params(1)%type%type = array_type - sum_i32_fn%params(1)%array_type = i32_type - sum_i32_fn%params(1)%rank = -1 ! negative means any rank + allocate(sum_i32_fn%params(1)%type%array) + sum_i32_fn%params(1)%type%array%type = i32_type + sum_i32_fn%params(1)%type%array%rank = -1 ! negative means any rank sum_i32_fn%params(1)%name = "array" !! TODO: add mask and dim args to sum() like Fortran. Maybe overload !! several distinct internal fn's like 0min_i32 vs 0min_i64? The return !! value is still the same so maybe there's an easier way - !sum_i32_fn%params(2)%type = i32_type + !sum_i32_fn%params(2)%type%type = i32_type !sum_i32_fn%params(2)%name = "dim" call fns%insert("0sum_i32", sum_i32_fn, id_index) @@ -603,10 +606,11 @@ function declare_intrinsic_fns() result(fns) sum_i64_fn%type%type = i64_type allocate(sum_i64_fn%params(1)) - sum_i64_fn%params(1)%type = array_type + sum_i64_fn%params(1)%type%type = array_type - sum_i64_fn%params(1)%array_type = i64_type - sum_i64_fn%params(1)%rank = -1 ! negative means any rank + allocate(sum_i64_fn%params(1)%type%array) + sum_i64_fn%params(1)%type%array%type = i64_type + sum_i64_fn%params(1)%type%array%rank = -1 ! negative means any rank sum_i64_fn%params(1)%name = "array" @@ -617,10 +621,11 @@ function declare_intrinsic_fns() result(fns) sum_f32_fn%type%type = f32_type allocate(sum_f32_fn%params(1)) - sum_f32_fn%params(1)%type = array_type + sum_f32_fn%params(1)%type%type = array_type - sum_f32_fn%params(1)%array_type = f32_type - sum_f32_fn%params(1)%rank = -1 ! negative means any rank + allocate(sum_f32_fn%params(1)%type%array) + sum_f32_fn%params(1)%type%array%type = f32_type + sum_f32_fn%params(1)%type%array%rank = -1 ! negative means any rank sum_f32_fn%params(1)%name = "array" @@ -631,15 +636,16 @@ function declare_intrinsic_fns() result(fns) all_fn%type%type = bool_type allocate(all_fn%params(1)) - all_fn%params(1)%type = array_type + all_fn%params(1)%type%type = array_type - all_fn%params(1)%array_type = bool_type - all_fn%params(1)%rank = -1 ! negative means any rank + allocate(all_fn%params(1)%type%array) + all_fn%params(1)%type%array%type = bool_type + all_fn%params(1)%type%array%rank = -1 ! negative means any rank all_fn%params(1)%name = "mask" !! TODO: add dim arg to all() like Fortran - !all_fn%params(2)%type = i32_type + !all_fn%params(2)%type%type = i32_type !all_fn%params(2)%name = "dim" call fns%insert("all", all_fn, id_index) @@ -649,15 +655,16 @@ function declare_intrinsic_fns() result(fns) any_fn%type%type = bool_type allocate(any_fn%params(1)) - any_fn%params(1)%type = array_type + any_fn%params(1)%type%type = array_type - any_fn%params(1)%array_type = bool_type - any_fn%params(1)%rank = -1 ! negative means any rank + allocate(any_fn%params(1)%type%array) + any_fn%params(1)%type%array%type = bool_type + any_fn%params(1)%type%array%rank = -1 ! negative means any rank any_fn%params(1)%name = "mask" !! TODO: add dim arg to any() like Fortran - !any_fn%params(2)%type = i32_type + !any_fn%params(2)%type%type = i32_type !any_fn%params(2)%name = "dim" call fns%insert("any", any_fn, id_index) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index de4ad6d8..b3644f6f 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -252,14 +252,15 @@ module function parse_fn_call(parser) result(fn_call) ! only way to do it for intrinsic fns, which don't actually have a val ! anywhere if (i <= size(fn%params)) then - param_val%type = fn%params(i)%type - param_val%array%type = fn%params(i)%array_type - param_val%array%rank = fn%params(i)%rank - param_val%struct_name = fn%params(i)%struct_name + param_val = fn%params(i)%type + !param_val%type = fn%params(i)%type%type + !param_val%array%type = fn%params(i)%type%array%type + !param_val%array%rank = fn%params(i)%type%array%rank + !param_val%struct_name = fn%params(i)%type%struct_name else param_val%type = fn%variadic_type - param_val%array%type = unknown_type - param_val%array%rank = 0 + !param_val%array%type = unknown_type + !param_val%array%rank = 0 param_val%struct_name = "" end if @@ -429,58 +430,36 @@ module function parse_fn_declaration(parser) result(decl) !print *, "struct num vars = ", struct%num_vars !print *, "struct name = ", types%v(i)%s - !! members are allocated here, vars%vals are not. probably ok, maybe - !! need a deep copy if the vars dict is really needed - !print *, "allocated = ", allocated(struct%members) - !print *, "allocated = ", allocated(struct%vars%vals) - val%struct_name = types%v(i)%s - !allocate(val%struct( struct%num_vars )) - !!allocate(val%members( struct%num_vars )) - !!val = struct - !do j = 1, struct%num_vars - ! !val%struct(j) = struct%members(j)%val - ! val%struct(j)%type = struct%members(j)%type - ! !val%struct(j) = struct%vars%vals(j) - - ! !inst%val%struct( member_id ) = mem%val - - ! ! ~~Test a fn with a 2nd-order struct arg (i.e. a struct made up - ! ! of other structs). Maybe more data needs to be copied here, - ! ! especially struct_name. Essentially every %type should be - ! ! bundled along with a %struct_name as in - ! ! parse_struct_declaration()~~ - ! ! - ! ! Unit test added in 012f1404. This code works, but I think it - ! ! could be significantly simplified by following my new mantra: - ! ! "a type is a value!" Roughly a dozen lines here could be - ! ! replaced by a single value_t copy to handle the parameter - ! ! types. The return type has already accomplished this - ! ! simplification by assigning `parser%fn_type = fn%type` below. - ! ! Parameters could probably be simplified similarly, but it will - ! ! take a little refactoring. member_t contains an int `type` - ! ! and param_t also contains an int `type` and associated array - ! ! type enums, etc. Both member_t and param_t should be changed - ! ! to simply wrap a `value_t` to contain the type meta-data. - ! ! Perhaps member_t and/or param_t could be entirely eliminated - ! ! if they become only a wrapper for the value_t. - - !end do + + ! Unit test added in 012f1404. This code works, but I think it + ! could be significantly simplified by following my new mantra: "a + ! type is a value!" Roughly a dozen lines here could be replaced by + ! a single value_t copy to handle the parameter types. The return + ! type has already accomplished this simplification by assigning + ! `parser%fn_type = fn%type` below. Parameters could probably be + ! simplified similarly, but it will take a little refactoring. + ! member_t contains an int `type` and param_t also contains an int + ! `type` and associated array type enums, etc. Both member_t and + ! param_t should be changed to simply wrap a `value_t` to contain + ! the type meta-data. Perhaps member_t and/or param_t could be + ! entirely eliminated if they become only a wrapper for the value_t. end if + !fn%params(i)%type = val if (is_array%v(i)) then - fn%params(i)%type = array_type - fn%params(i)%array_type = itype - fn%params(i)%rank = ranks%v(i) + fn%params(i)%type%type = array_type + allocate(fn%params(i)%type%array) + fn%params(i)%type%array%type = itype + fn%params(i)%type%array%rank = ranks%v(i) !print *, "rank = ", fn%params(i)%rank else - fn%params(i)%type = itype + fn%params(i)%type%type = itype !print *, "(scalar)" end if - if (itype == struct_type) then - fn%params(i)%struct_name = val%struct_name + fn%params(i)%type%struct_name = val%struct_name !print *, "struct_name = ", val%struct_name end if @@ -491,14 +470,15 @@ module function parse_fn_declaration(parser) result(decl) decl%params(i) = parser%num_vars ! Create a value_t object to store the type - val%type = fn%params(i)%type - if (is_array%v(i)) then - if (allocated(val%array)) deallocate(val%array) - allocate(val%array) - val%array%type = fn%params(i)%array_type - val%array%rank = fn%params(i)%rank - !print *, "rank = ", val%array%rank - end if + val = fn%params(i)%type + !val%type = fn%params(i)%type + !if (is_array%v(i)) then + ! if (allocated(val%array)) deallocate(val%array) + ! allocate(val%array) + ! val%array%type = fn%params(i)%array_type + ! val%array%rank = fn%params(i)%rank + ! !print *, "rank = ", val%array%rank + !end if !print *, "insert var type ", kind_name(val%type) call parser%vars%insert(fn%params(i)%name, val, parser%num_vars) diff --git a/src/types.f90 b/src/types.f90 index 0c26f564..c0e6139a 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -21,7 +21,8 @@ module syntran__types_m !******** type member_t - ! Struct member. Basically the same as a fn param_t + ! Struct member. Basically the same as a fn param_t. TODO: delete this + ! whole struct integer :: type character(len = :), allocatable :: name @@ -35,11 +36,8 @@ module syntran__types_m type param_t ! Function parameter (argument) - integer :: type character(len = :), allocatable :: name - character(len = :), allocatable :: struct_name - - integer :: array_type, rank + type(value_t) :: type ! TODO: add a way to represent polymorphic intrinsic fn params, e.g. ! i32 min(1, 2) vs f32 min(1.0, 2.0), but not bool min(true, false). From c4811d02b60127e78b27c0be6f4e6d7c017ee105 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 13:06:17 -0400 Subject: [PATCH 123/137] get rid of whole member_t class --- src/parse_fn.f90 | 77 ++++++++++-------------------------------------- src/types.f90 | 18 +++-------- 2 files changed, 19 insertions(+), 76 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index b3644f6f..2b9ff6d6 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -253,14 +253,8 @@ module function parse_fn_call(parser) result(fn_call) ! anywhere if (i <= size(fn%params)) then param_val = fn%params(i)%type - !param_val%type = fn%params(i)%type%type - !param_val%array%type = fn%params(i)%type%array%type - !param_val%array%rank = fn%params(i)%type%array%rank - !param_val%struct_name = fn%params(i)%type%struct_name else param_val%type = fn%variadic_type - !param_val%array%type = unknown_type - !param_val%array%rank = 0 param_val%struct_name = "" end if @@ -425,29 +419,7 @@ module function parse_fn_declaration(parser) result(decl) parser%context(), span, types%v(i)%s)) end if - if (itype == struct_type) then - !print *, "struct_type" - !print *, "struct num vars = ", struct%num_vars - !print *, "struct name = ", types%v(i)%s - - val%struct_name = types%v(i)%s - - ! Unit test added in 012f1404. This code works, but I think it - ! could be significantly simplified by following my new mantra: "a - ! type is a value!" Roughly a dozen lines here could be replaced by - ! a single value_t copy to handle the parameter types. The return - ! type has already accomplished this simplification by assigning - ! `parser%fn_type = fn%type` below. Parameters could probably be - ! simplified similarly, but it will take a little refactoring. - ! member_t contains an int `type` and param_t also contains an int - ! `type` and associated array type enums, etc. Both member_t and - ! param_t should be changed to simply wrap a `value_t` to contain - ! the type meta-data. Perhaps member_t and/or param_t could be - ! entirely eliminated if they become only a wrapper for the value_t. - - end if - - !fn%params(i)%type = val + ! Create a value_t object to store the type if (is_array%v(i)) then fn%params(i)%type%type = array_type allocate(fn%params(i)%type%array) @@ -459,7 +431,7 @@ module function parse_fn_declaration(parser) result(decl) !print *, "(scalar)" end if if (itype == struct_type) then - fn%params(i)%type%struct_name = val%struct_name + fn%params(i)%type%struct_name = types%v(i)%s !print *, "struct_name = ", val%struct_name end if @@ -469,17 +441,7 @@ module function parse_fn_declaration(parser) result(decl) ! Save parameters by id_index. TODO: stack frames decl%params(i) = parser%num_vars - ! Create a value_t object to store the type val = fn%params(i)%type - !val%type = fn%params(i)%type - !if (is_array%v(i)) then - ! if (allocated(val%array)) deallocate(val%array) - ! allocate(val%array) - ! val%array%type = fn%params(i)%array_type - ! val%array%rank = fn%params(i)%rank - ! !print *, "rank = ", val%array%rank - !end if - !print *, "insert var type ", kind_name(val%type) call parser%vars%insert(fn%params(i)%name, val, parser%num_vars) @@ -601,10 +563,6 @@ module function parse_struct_declaration(parser) result(decl) integer :: itype, i, io, pos0, pos1, pos2, rank - ! TODO: this is the only use of member_t. Maybe eliminate it - type(member_t), allocatable :: members(:) - - !type(struct_t), save :: struct type(struct_t) :: struct, dummy_struct type(syntax_token_t) :: identifier, comma, lbrace, rbrace, dummy, & @@ -617,6 +575,7 @@ module function parse_struct_declaration(parser) result(decl) type(integer_vector_t) :: ranks, pos_mems type(value_t) :: val + type(value_t), allocatable :: members(:) ! local type meta-data !call parser%vars%push_scope() @@ -708,17 +667,15 @@ module function parse_struct_declaration(parser) result(decl) ! Now that we have the number of members, save them struct%num_vars = 0 - allocate(members( names%len_ )) + allocate(members( names%len_ )) ! TODO: just use a scalar within loop instead of array allocate(struct%member_names%v( names%len_ )) - !allocate(decl %params( names%len_ )) ! if this is needed, we need a new - !! name. "members" already means the member statements of a block statement !allocate(struct%vars) do i = 1, names%len_ !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s - members(i)%name = names%v(i)%s + !members(i)%name = names%v(i)%s struct%member_names%v(i)%s = names%v(i)%s itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) @@ -730,9 +687,9 @@ module function parse_struct_declaration(parser) result(decl) if (is_array%v(i)) then members(i)%type = array_type - members(i)%array_type = itype - members(i)%rank = ranks%v(i) - !print *, "rank = ", members(i)%rank + allocate(members(i)%array) + members(i)%array%type = itype + members(i)%array%rank = ranks%v(i) else members(i)%type = itype !print *, "(scalar)" @@ -747,15 +704,9 @@ module function parse_struct_declaration(parser) result(decl) !decl%params(i) = parser%num_vars ! Create a value_t object to store the type - val%type = members(i)%type + !val%type = members(i)%type + val = members(i) val%struct_name = types%v(i)%s - if (is_array%v(i)) then - if (allocated(val%array)) deallocate(val%array) - allocate(val%array) - val%array%type = members(i)%array_type - val%array%rank = members(i)%rank - !print *, "rank = ", val%array%rank - end if ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. @@ -763,7 +714,7 @@ module function parse_struct_declaration(parser) result(decl) ! type, just like `parser%vars`. Just add one inside of the `struct_t` ! type. - call struct%vars%insert(members(i)%name, val, & + call struct%vars%insert(names%v(i)%s, val, & struct%num_vars, io, overwrite = .false.) !print *, 'io = ', io if (io /= exit_success) then @@ -771,7 +722,7 @@ module function parse_struct_declaration(parser) result(decl) call parser%diagnostics%push(err_redeclare_mem( & parser%context(), & span, & - members(i)%name)) + names%v(i)%s)) end if end do @@ -975,7 +926,6 @@ module function parse_struct_instance(parser) result(inst) ! There could be more than 1 unset member but we only log diag for the ! 1st one id1 = findlocl1(member_set, .false.) - !unset_name = struct%members(id1(1))%name unset_name = struct%member_names%v(id1(1))%s !print *, "id1 = ", id1 !print *, "name = ", unset_name @@ -1007,6 +957,9 @@ end function parse_struct_instance module subroutine parse_type(parser, type_text, rank) + ! TODO: it might simplify several things if this returned a value_t. A type + ! is a value! + ! TODO: encapsulate out-args in struct if adding any more class(parser_t) :: parser diff --git a/src/types.f90 b/src/types.f90 index c0e6139a..73a17f2f 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -20,21 +20,12 @@ module syntran__types_m !******** - type member_t - ! Struct member. Basically the same as a fn param_t. TODO: delete this - ! whole struct - - integer :: type - character(len = :), allocatable :: name - - integer :: array_type, rank - - end type member_t - - !******** - type param_t ! Function parameter (argument) + ! + ! TODO: this is basically a wrapper of a value_t. Move name into an + ! array of names in fn_t and get rid of param_t type, like I got rid of + ! member_t. character(len = :), allocatable :: name type(value_t) :: type @@ -271,7 +262,6 @@ module syntran__types_m type struct_t ! User-defined structure, aka derived type - !type(member_t), allocatable :: members(:) type(string_vector_t) :: member_names type(vars_t) :: vars ! can't compile w/o allocatable if vars_t is defined below From b45cad0b01ec569d4481a05697373a7934ae4871 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 13:11:18 -0400 Subject: [PATCH 124/137] remove copy --- src/parse_fn.f90 | 29 ++++++++++------------------- 1 file changed, 10 insertions(+), 19 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 2b9ff6d6..79347a28 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -574,10 +574,7 @@ module function parse_struct_declaration(parser) result(decl) type(logical_vector_t) :: is_array type(integer_vector_t) :: ranks, pos_mems - type(value_t) :: val - type(value_t), allocatable :: members(:) ! local type meta-data - - !call parser%vars%push_scope() + type(value_t) :: member ! local type meta-data struct_kw = parser%match(struct_keyword) @@ -667,7 +664,6 @@ module function parse_struct_declaration(parser) result(decl) ! Now that we have the number of members, save them struct%num_vars = 0 - allocate(members( names%len_ )) ! TODO: just use a scalar within loop instead of array allocate(struct%member_names%v( names%len_ )) !allocate(struct%vars) @@ -675,7 +671,6 @@ module function parse_struct_declaration(parser) result(decl) do i = 1, names%len_ !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s - !members(i)%name = names%v(i)%s struct%member_names%v(i)%s = names%v(i)%s itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) @@ -685,13 +680,14 @@ module function parse_struct_declaration(parser) result(decl) parser%context(), span, types%v(i)%s)) end if + ! Create a value_t object to store the type if (is_array%v(i)) then - members(i)%type = array_type - allocate(members(i)%array) - members(i)%array%type = itype - members(i)%array%rank = ranks%v(i) + member%type = array_type + allocate(member%array) + member%array%type = itype + member%array%rank = ranks%v(i) else - members(i)%type = itype + member%type = itype !print *, "(scalar)" end if @@ -703,10 +699,7 @@ module function parse_struct_declaration(parser) result(decl) !! Save parameters by id_index !decl%params(i) = parser%num_vars - ! Create a value_t object to store the type - !val%type = members(i)%type - val = members(i) - val%struct_name = types%v(i)%s + member%struct_name = types%v(i)%s ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. @@ -714,7 +707,7 @@ module function parse_struct_declaration(parser) result(decl) ! type, just like `parser%vars`. Just add one inside of the `struct_t` ! type. - call struct%vars%insert(names%v(i)%s, val, & + call struct%vars%insert(names%v(i)%s, member, & struct%num_vars, io, overwrite = .false.) !print *, 'io = ', io if (io /= exit_success) then @@ -725,6 +718,7 @@ module function parse_struct_declaration(parser) result(decl) names%v(i)%s)) end if + if (allocated(member%array)) deallocate(member%array) end do ! Insert struct into parser dict @@ -840,9 +834,6 @@ module function parse_struct_instance(parser) result(inst) !print *, "name%text = ", name%text - !call struct%vars%insert(struct%members(i)%name, val, & - ! struct%num_vars, io, overwrite = .false.) - !print *, "allocated = ", allocated(struct%vars%dicts(1)%root) !print *, "char root = ", struct%vars%dicts(1)%root%split_char !print *, "char mid = ", struct%vars%dicts(1)%root%mid%split_char From 8adea92dc5fb2c1079523f2a92b559c8601aa4df Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 14:23:43 -0400 Subject: [PATCH 125/137] return rich type meta-data from parse_type() --- src/parse.f90 | 6 +- src/parse_fn.f90 | 185 ++++++++++++++++++++++++++++++++--------------- src/types.f90 | 8 +- src/value.f90 | 73 +++++++++++++++++++ 4 files changed, 207 insertions(+), 65 deletions(-) diff --git a/src/parse.f90 b/src/parse.f90 index a4752412..19162396 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -114,10 +114,12 @@ module function parse_fn_call(parser) result(fn_call) type(syntax_node_t) :: fn_call end function parse_fn_call - module subroutine parse_type(parser, type_text, rank) + !module subroutine parse_type(parser, type_text, rank) + module subroutine parse_type(parser, type_text, vtype) class(parser_t) :: parser character(len = :), intent(out), allocatable :: type_text - integer, intent(out) :: rank + !integer, intent(out) :: rank + type(value_t), intent(out) :: vtype end subroutine parse_type ! TODO: move struct stuff to another translation unit? parse_fn.f90 is a diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 79347a28..1a5c77e2 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -319,7 +319,9 @@ module function parse_fn_declaration(parser) result(decl) type(text_span_t) :: span - type(value_t) :: val + type(value_t) :: val, vtype + !type(value_t), allocatable :: vtypes(:) + type(value_vector_t) :: vtypes ! Like a for statement, a fn declaration has its own scope (for its ! parameters). Its block body will have yet another scope @@ -345,9 +347,10 @@ module function parse_fn_declaration(parser) result(decl) ! Parse parameter names and types. Save in temp string vectors initially names = new_string_vector() types = new_string_vector() - is_array = new_logical_vector() - ranks = new_integer_vector() + !is_array = new_logical_vector() + !ranks = new_integer_vector() pos_args = new_integer_vector() ! technically params not args + vtypes = new_value_vector() ! Array params use this syntax: ! @@ -365,9 +368,11 @@ module function parse_fn_declaration(parser) result(decl) ! } ! Parse fn parameters (arguments) + i = 0 do while ( & - parser%current_kind() /= rparen_token .and. & - parser%current_kind() /= eof_token) + parser%current_kind() /= rparen_token .and. & + parser%current_kind() /= eof_token) + i = i + 1 pos0 = parser%current_pos() call pos_args%push(pos0) @@ -377,14 +382,18 @@ module function parse_fn_declaration(parser) result(decl) !print *, 'matching colon' colon = parser%match(colon_token) - call parser%parse_type(type_text, rank) + call parser%parse_type(type_text, vtype) + !call parser%parse_type(type_text, vtypes(i)) + ! TODO: just push vtype (and maybe name). Delete unused stuff call names%push( name%text ) call types%push( type_text ) - call ranks%push( rank ) + !call ranks%push( rank ) + !vtypes(i) = vtype + call vtypes%push(vtype) ! This array is technically redundant but helps readability? - call is_array%push( rank >= 0 ) + !call is_array%push( rank >= 0 ) if (parser%current_kind() /= rparen_token) then !print *, 'matching comma' @@ -411,6 +420,7 @@ module function parse_fn_declaration(parser) result(decl) fn%params(i)%name = names%v(i)%s + ! TODO: already done inside parse_type() now itype = lookup_type(types%v(i)%s, parser%structs, struct) !print *, "itype = ", itype if (itype == unknown_type) then @@ -419,21 +429,22 @@ module function parse_fn_declaration(parser) result(decl) parser%context(), span, types%v(i)%s)) end if - ! Create a value_t object to store the type - if (is_array%v(i)) then - fn%params(i)%type%type = array_type - allocate(fn%params(i)%type%array) - fn%params(i)%type%array%type = itype - fn%params(i)%type%array%rank = ranks%v(i) - !print *, "rank = ", fn%params(i)%rank - else - fn%params(i)%type%type = itype - !print *, "(scalar)" - end if - if (itype == struct_type) then - fn%params(i)%type%struct_name = types%v(i)%s - !print *, "struct_name = ", val%struct_name - end if + ! Copy a value_t object to store the type + fn%params(i)%type = vtypes%v(i) + !if (is_array%v(i)) then + ! fn%params(i)%type%type = array_type + ! allocate(fn%params(i)%type%array) + ! fn%params(i)%type%array%type = itype + ! fn%params(i)%type%array%rank = ranks%v(i) + ! !print *, "rank = ", fn%params(i)%rank + !else + ! fn%params(i)%type%type = itype + ! !print *, "(scalar)" + !end if + !if (itype == struct_type) then + ! fn%params(i)%type%struct_name = types%v(i)%s + ! !print *, "struct_name = ", val%struct_name + !end if ! Declare the parameter variable parser%num_vars = parser%num_vars + 1 @@ -441,6 +452,7 @@ module function parse_fn_declaration(parser) result(decl) ! Save parameters by id_index. TODO: stack frames decl%params(i) = parser%num_vars + ! TODO: get rid of unnecessary `val` var val = fn%params(i)%type !print *, "insert var type ", kind_name(val%type) call parser%vars%insert(fn%params(i)%name, val, parser%num_vars) @@ -463,7 +475,7 @@ module function parse_fn_declaration(parser) result(decl) colon = parser%match(colon_token) pos1 = parser%current_pos() - call parser%parse_type(type_text, rank) + call parser%parse_type(type_text, vtype) pos2 = parser%current_pos() itype = lookup_type(type_text, parser%structs, struct) @@ -475,16 +487,17 @@ module function parse_fn_declaration(parser) result(decl) !parser%contexts%v(parser%current_unit()), span, type_text)) end if - if (rank >= 0) then - fn%type%type = array_type - allocate(fn%type%array) - fn%type%array%rank = rank - fn%type%array%type = itype - else - fn%type%type = itype - end if - !fn%struct_name = type_text - fn%type%struct_name = type_text + fn%type = vtype + !if (rank >= 0) then + ! fn%type%type = array_type + ! allocate(fn%type%array) + ! fn%type%array%rank = rank + ! fn%type%array%type = itype + !else + ! fn%type%type = itype + !end if + !!fn%struct_name = type_text + fn%type%struct_name = type_text ! TODO: should be unnecessary end if !print *, 'fn%type = ', fn%type @@ -575,6 +588,9 @@ module function parse_struct_declaration(parser) result(decl) type(integer_vector_t) :: ranks, pos_mems type(value_t) :: member ! local type meta-data + type(value_t) :: vtype + !type(value_t), allocatable :: vtypes(:) + type(value_vector_t) :: vtypes struct_kw = parser%match(struct_keyword) @@ -617,15 +633,20 @@ module function parse_struct_declaration(parser) result(decl) ! Parse member names and types. Save in temp vectors initially names = new_string_vector() types = new_string_vector() - is_array = new_logical_vector() - ranks = new_integer_vector() + !is_array = new_logical_vector() + !ranks = new_integer_vector() + + vtypes = new_value_vector() + !allocate(vtypes(100)) ! TODO: value_t vector type w/ push fn ! For diagnostic text spans pos_mems = new_integer_vector() + i = 0 do while ( & - parser%current_kind() /= rbrace_token .and. & - parser%current_kind() /= eof_token) + parser%current_kind() /= rbrace_token .and. & + parser%current_kind() /= eof_token) + i = i + 1 pos0 = parser%current_pos() @@ -636,15 +657,18 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'matching colon' colon = parser%match(colon_token) - call parser%parse_type(type_text, rank) + call parser%parse_type(type_text, vtype) !print *, "type = ", type_text + !vtypes(i) = vtype + call vtypes%push(vtype) + call names%push( name%text ) call types%push( type_text ) - call ranks%push( rank ) + !call ranks%push( rank ) ! This array is technically redundant but helps readability? - call is_array%push( rank >= 0 ) + !call is_array%push( rank >= 0 ) if (parser%current_kind() /= rbrace_token) then !print *, 'matching comma' @@ -680,16 +704,17 @@ module function parse_struct_declaration(parser) result(decl) parser%context(), span, types%v(i)%s)) end if - ! Create a value_t object to store the type - if (is_array%v(i)) then - member%type = array_type - allocate(member%array) - member%array%type = itype - member%array%rank = ranks%v(i) - else - member%type = itype - !print *, "(scalar)" - end if + ! Copy a value_t object to store the type + member = vtypes%v(i) + !if (is_array%v(i)) then + ! member%type = array_type + ! allocate(member%array) + ! member%array%type = itype + ! member%array%rank = ranks%v(i) + !else + ! member%type = itype + ! !print *, "(scalar)" + !end if ! Declare the member !parser%num_vars = parser%num_vars + 1 @@ -699,7 +724,7 @@ module function parse_struct_declaration(parser) result(decl) !! Save parameters by id_index !decl%params(i) = parser%num_vars - member%struct_name = types%v(i)%s + member%struct_name = types%v(i)%s ! TODO: unnecessary ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. @@ -946,25 +971,28 @@ end function parse_struct_instance !=============================================================================== -module subroutine parse_type(parser, type_text, rank) - - ! TODO: it might simplify several things if this returned a value_t. A type - ! is a value! - - ! TODO: encapsulate out-args in struct if adding any more +!module subroutine parse_type(parser, type_text, rank) +module subroutine parse_type(parser, type_text, vtype) class(parser_t) :: parser character(len = :), intent(out), allocatable :: type_text - integer, intent(out) :: rank + !integer, intent(out) :: rank + type(value_t), intent(out) :: vtype !******** - integer :: pos0 + integer :: rank, itype + integer :: pos0, pos1, pos2 + + type(struct_t) :: struct type(syntax_token_t) :: colon, type, comma, lbracket, rbracket, semi, dummy + type(text_span_t) :: span + + pos1 = parser%current_pos() if (parser%current_kind() == lbracket_token) then ! Array param @@ -998,9 +1026,46 @@ module subroutine parse_type(parser, type_text, rank) type = parser%match(identifier_token) rank = -1 end if + pos2 = parser%current_pos() type_text = type%text + !itype = lookup_type(type_text, parser%structs, struct) + !if (itype == unknown_type) then + ! span = new_span(pos1, pos2 - pos1 + 1) + ! call parser%diagnostics%push(err_bad_type( & + ! parser%context(), span, type_text)) + !end if + !if (rank >= 0) then + ! fn%type%type = array_type + ! allocate(fn%type%array) + ! fn%type%array%rank = rank + ! fn%type%array%type = itype + !else + ! fn%type%type = itype + !end if + !fn%type%struct_name = type_text + + + itype = lookup_type(type_text, parser%structs, struct) + + if (itype == unknown_type) then + span = new_span(pos1, pos2 - pos1 + 1) + call parser%diagnostics%push(err_bad_type( & + parser%context(), span, type_text)) + end if + + if (rank >= 0) then + vtype%type = array_type + allocate(vtype%array) + vtype%array%rank = rank + vtype%array%type = itype + else + vtype%type = itype + if (allocated(vtype%array)) deallocate(vtype%array) + end if + vtype%struct_name = type_text ! TODO: only if struct_type + end subroutine parse_type !=============================================================================== diff --git a/src/types.f90 b/src/types.f90 index 73a17f2f..f74ab0ec 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -23,9 +23,11 @@ module syntran__types_m type param_t ! Function parameter (argument) ! - ! TODO: this is basically a wrapper of a value_t. Move name into an - ! array of names in fn_t and get rid of param_t type, like I got rid of - ! member_t. + + ! TODO: this is basically a wrapper of a value_t. Move name into an + ! array of names in fn_t and get rid of param_t type, like I got rid of + ! member_t. + character(len = :), allocatable :: name type(value_t) :: type diff --git a/src/value.f90 b/src/value.f90 index 1803cb04..c8856c8f 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -111,12 +111,85 @@ module syntran__value_m end type value_t + type value_vector_t + type(value_t), allocatable :: v(:) + integer :: len_, cap + contains + procedure :: push => push_value + end type value_vector_t + !=============================================================================== contains !=============================================================================== +function new_value_vector() result(vector) + + type(value_vector_t) :: vector + + vector%len_ = 0 + vector%cap = 2 ! I think a small default makes sense here + + allocate(vector%v( vector%cap )) + +end function new_value_vector + +!=============================================================================== + +subroutine push_value(vector, val) + + class(value_vector_t) :: vector + type(value_t) :: val + + !******** + + type(value_t), allocatable :: tmp(:) + + integer :: tmp_cap, i + + vector%len_ = vector%len_ + 1 + + if (vector%len_ > vector%cap) then + !print *, 'growing vector =====================================' + + tmp_cap = 2 * vector%len_ + allocate(tmp( tmp_cap )) + + !print *, 'copy 1' + !!tmp(1: vector%cap) = vector%v + do i = 1, vector%cap + tmp(i) = vector%v(i) + end do + + !print *, 'move' + !!call move_alloc(tmp, vector%v) + + deallocate(vector%v) + allocate(vector%v( tmp_cap )) + + ! Unfortunately we have to copy TO tmp AND back FROM tmp. I guess the + ! fact that each node itself has allocatable members creates invalid + ! references otherwise. + + !print *, 'copy 2' + !!vector%v(1: vector%cap) = tmp(1: vector%cap) + do i = 1, vector%cap + vector%v(i) = tmp(i) + end do + + vector%cap = tmp_cap + + end if + + !print *, 'set val' + vector%v( vector%len_ ) = val + !print *, 'done push_value' + +end subroutine push_value + +!=============================================================================== + recursive subroutine value_copy(dst, src) ! Deep copy. Default Fortran assignment operator doesn't handle recursion From 2e03f26dd9dc4fef9a6c303fb627185a88b91c6c Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 14:39:26 -0400 Subject: [PATCH 126/137] cleanup --- src/parse_fn.f90 | 161 ++++++----------------------------------------- 1 file changed, 19 insertions(+), 142 deletions(-) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 1a5c77e2..00c445eb 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -75,6 +75,8 @@ module function parse_fn_call(parser) result(fn_call) fn_call%identifier = identifier ! Resolve special overloaded intrinsic fns + ! + ! TODO: split out to a routine if possible select case (identifier%text) case ("min") @@ -181,19 +183,9 @@ module function parse_fn_call(parser) result(fn_call) end if fn_call%val = fn%type - !fn_call%val%type = fn%type - !if (fn%type == array_type) then - ! if (.not. allocated(fn_call%val%array)) allocate(fn_call%val%array) - ! fn_call%val%array%type = fn%array_type - - ! ! i32_arr_fn returns same rank as arg (not -1) - ! if (fn%rank > 0) fn_call%val%array%rank = fn%rank - - !end if ! Intrinsic fns don't have a syntax node: they are implemented ! in Fortran, not syntran - !if (associated(fn%node)) then if (allocated(fn%node)) then !print *, 'assigning fn node' @@ -255,7 +247,7 @@ module function parse_fn_call(parser) result(fn_call) param_val = fn%params(i)%type else param_val%type = fn%variadic_type - param_val%struct_name = "" + !param_val%struct_name = "" end if if (types_match(param_val, args%v(i)%val) /= TYPE_MATCH) then @@ -303,13 +295,12 @@ module function parse_fn_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: i, j, io, pos0, pos1, pos2, rank, itype, fn_beg, fn_name_end + integer :: i, j, io, pos0, pos1, pos2, rank, fn_beg, fn_name_end type(fn_t) :: fn - type( string_vector_t) :: names, types - type(logical_vector_t) :: is_array - type(integer_vector_t) :: ranks, pos_args + type( string_vector_t) :: names + type(integer_vector_t) :: pos_args type(struct_t) :: struct @@ -320,7 +311,6 @@ module function parse_fn_declaration(parser) result(decl) type(text_span_t) :: span type(value_t) :: val, vtype - !type(value_t), allocatable :: vtypes(:) type(value_vector_t) :: vtypes ! Like a for statement, a fn declaration has its own scope (for its @@ -344,13 +334,10 @@ module function parse_fn_declaration(parser) result(decl) !print *, 'matching lparen' lparen = parser%match(lparen_token) - ! Parse parameter names and types. Save in temp string vectors initially + ! Parse parameter names and types. Save in temp vectors initially names = new_string_vector() - types = new_string_vector() - !is_array = new_logical_vector() - !ranks = new_integer_vector() pos_args = new_integer_vector() ! technically params not args - vtypes = new_value_vector() + vtypes = new_value_vector() ! Array params use this syntax: ! @@ -383,18 +370,10 @@ module function parse_fn_declaration(parser) result(decl) colon = parser%match(colon_token) call parser%parse_type(type_text, vtype) - !call parser%parse_type(type_text, vtypes(i)) - ! TODO: just push vtype (and maybe name). Delete unused stuff call names%push( name%text ) - call types%push( type_text ) - !call ranks%push( rank ) - !vtypes(i) = vtype call vtypes%push(vtype) - ! This array is technically redundant but helps readability? - !call is_array%push( rank >= 0 ) - if (parser%current_kind() /= rparen_token) then !print *, 'matching comma' comma = parser%match(comma_token) @@ -420,31 +399,8 @@ module function parse_fn_declaration(parser) result(decl) fn%params(i)%name = names%v(i)%s - ! TODO: already done inside parse_type() now - itype = lookup_type(types%v(i)%s, parser%structs, struct) - !print *, "itype = ", itype - if (itype == unknown_type) then - span = new_span(pos_args%v(i), pos_args%v(i+1) - pos_args%v(i) - 1) - call parser%diagnostics%push(err_bad_type( & - parser%context(), span, types%v(i)%s)) - end if - ! Copy a value_t object to store the type fn%params(i)%type = vtypes%v(i) - !if (is_array%v(i)) then - ! fn%params(i)%type%type = array_type - ! allocate(fn%params(i)%type%array) - ! fn%params(i)%type%array%type = itype - ! fn%params(i)%type%array%rank = ranks%v(i) - ! !print *, "rank = ", fn%params(i)%rank - !else - ! fn%params(i)%type%type = itype - ! !print *, "(scalar)" - !end if - !if (itype == struct_type) then - ! fn%params(i)%type%struct_name = types%v(i)%s - ! !print *, "struct_name = ", val%struct_name - !end if ! Declare the parameter variable parser%num_vars = parser%num_vars + 1 @@ -452,10 +408,7 @@ module function parse_fn_declaration(parser) result(decl) ! Save parameters by id_index. TODO: stack frames decl%params(i) = parser%num_vars - ! TODO: get rid of unnecessary `val` var - val = fn%params(i)%type - !print *, "insert var type ", kind_name(val%type) - call parser%vars%insert(fn%params(i)%name, val, parser%num_vars) + call parser%vars%insert(fn%params(i)%name, fn%params(i)%type, parser%num_vars) end do @@ -478,26 +431,8 @@ module function parse_fn_declaration(parser) result(decl) call parser%parse_type(type_text, vtype) pos2 = parser%current_pos() - itype = lookup_type(type_text, parser%structs, struct) - - if (itype == unknown_type) then - span = new_span(pos1, pos2 - pos1 + 1) - call parser%diagnostics%push(err_bad_type( & - parser%context(), span, type_text)) - !parser%contexts%v(parser%current_unit()), span, type_text)) - end if - fn%type = vtype - !if (rank >= 0) then - ! fn%type%type = array_type - ! allocate(fn%type%array) - ! fn%type%array%rank = rank - ! fn%type%array%type = itype - !else - ! fn%type%type = itype - !end if - !!fn%struct_name = type_text - fn%type%struct_name = type_text ! TODO: should be unnecessary + !fn%type%struct_name = type_text ! TODO: should be unnecessary end if !print *, 'fn%type = ', fn%type @@ -505,15 +440,6 @@ module function parse_fn_declaration(parser) result(decl) ! Copy for later return type checking while parsing body parser%fn_name = identifier%text parser%fn_type = fn%type - !!parser%fn_type = fn%type - !parser%fn_type%type = fn%type - !parser%fn_type%struct_name = fn%struct_name - !if (rank >= 0) then - ! !parser%fn_rank = fn%rank - ! !parser%fn_array_type = fn%array_type - ! parser%fn_type%array%rank = fn%rank - ! parser%fn_type%array%type = fn%array_type - !end if body = parser%parse_statement() @@ -526,7 +452,6 @@ module function parse_fn_declaration(parser) result(decl) ! Reset to allow the global scope to return anything parser%fn_type%type = any_type - !parser%fn_type = any_type ! Insert fn into parser%fns @@ -583,13 +508,11 @@ module function parse_struct_declaration(parser) result(decl) type(text_span_t) :: span - type( string_vector_t) :: names, types - type(logical_vector_t) :: is_array - type(integer_vector_t) :: ranks, pos_mems + type( string_vector_t) :: names + type(integer_vector_t) :: pos_mems type(value_t) :: member ! local type meta-data type(value_t) :: vtype - !type(value_t), allocatable :: vtypes(:) type(value_vector_t) :: vtypes struct_kw = parser%match(struct_keyword) @@ -631,13 +554,8 @@ module function parse_struct_declaration(parser) result(decl) ! there is no "body" for a struct, only members. ! Parse member names and types. Save in temp vectors initially - names = new_string_vector() - types = new_string_vector() - !is_array = new_logical_vector() - !ranks = new_integer_vector() - + names = new_string_vector() vtypes = new_value_vector() - !allocate(vtypes(100)) ! TODO: value_t vector type w/ push fn ! For diagnostic text spans pos_mems = new_integer_vector() @@ -660,15 +578,8 @@ module function parse_struct_declaration(parser) result(decl) call parser%parse_type(type_text, vtype) !print *, "type = ", type_text - !vtypes(i) = vtype call vtypes%push(vtype) - call names%push( name%text ) - call types%push( type_text ) - !call ranks%push( rank ) - - ! This array is technically redundant but helps readability? - !call is_array%push( rank >= 0 ) if (parser%current_kind() /= rbrace_token) then !print *, 'matching comma' @@ -693,28 +604,12 @@ module function parse_struct_declaration(parser) result(decl) !allocate(struct%vars) do i = 1, names%len_ - !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s + !print *, "name = ", names%v(i)%s struct%member_names%v(i)%s = names%v(i)%s - itype = lookup_type(types%v(i)%s, parser%structs, dummy_struct) - if (itype == unknown_type) then - span = new_span(pos_mems%v(i), pos_mems%v(i+1) - pos_mems%v(i)) - call parser%diagnostics%push(err_bad_type( & - parser%context(), span, types%v(i)%s)) - end if - ! Copy a value_t object to store the type member = vtypes%v(i) - !if (is_array%v(i)) then - ! member%type = array_type - ! allocate(member%array) - ! member%array%type = itype - ! member%array%rank = ranks%v(i) - !else - ! member%type = itype - ! !print *, "(scalar)" - !end if ! Declare the member !parser%num_vars = parser%num_vars + 1 @@ -724,7 +619,7 @@ module function parse_struct_declaration(parser) result(decl) !! Save parameters by id_index !decl%params(i) = parser%num_vars - member%struct_name = types%v(i)%s ! TODO: unnecessary + !member%struct_name = types%v(i)%s ! TODO: unnecessary ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. @@ -835,8 +730,8 @@ module function parse_struct_instance(parser) result(inst) !if (allocated(inst%struct)) deallocate(inst%struct) !allocate(inst%struct) !inst%struct = struct - inst%struct_name = identifier%text + inst%struct_name = identifier%text inst%val%struct_name = identifier%text !print *, "struct name = ", inst%struct_name @@ -971,14 +866,12 @@ end function parse_struct_instance !=============================================================================== -!module subroutine parse_type(parser, type_text, rank) module subroutine parse_type(parser, type_text, vtype) class(parser_t) :: parser character(len = :), intent(out), allocatable :: type_text - !integer, intent(out) :: rank type(value_t), intent(out) :: vtype !******** @@ -1030,27 +923,10 @@ module subroutine parse_type(parser, type_text, vtype) type_text = type%text - !itype = lookup_type(type_text, parser%structs, struct) - !if (itype == unknown_type) then - ! span = new_span(pos1, pos2 - pos1 + 1) - ! call parser%diagnostics%push(err_bad_type( & - ! parser%context(), span, type_text)) - !end if - !if (rank >= 0) then - ! fn%type%type = array_type - ! allocate(fn%type%array) - ! fn%type%array%rank = rank - ! fn%type%array%type = itype - !else - ! fn%type%type = itype - !end if - !fn%type%struct_name = type_text - - itype = lookup_type(type_text, parser%structs, struct) if (itype == unknown_type) then - span = new_span(pos1, pos2 - pos1 + 1) + span = new_span(pos1, pos2 - pos1) call parser%diagnostics%push(err_bad_type( & parser%context(), span, type_text)) end if @@ -1064,7 +940,8 @@ module subroutine parse_type(parser, type_text, vtype) vtype%type = itype if (allocated(vtype%array)) deallocate(vtype%array) end if - vtype%struct_name = type_text ! TODO: only if struct_type + + if (itype == struct_type) vtype%struct_name = type_text end subroutine parse_type From 29b27975c964b8c17e2ba14cedc8b2f10ef8bb75 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 14:45:21 -0400 Subject: [PATCH 127/137] rename --- src/parse.f90 | 6 ++-- src/parse_fn.f90 | 72 +++++++++++++++++++----------------------------- 2 files changed, 31 insertions(+), 47 deletions(-) diff --git a/src/parse.f90 b/src/parse.f90 index 19162396..3bfac875 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -114,12 +114,10 @@ module function parse_fn_call(parser) result(fn_call) type(syntax_node_t) :: fn_call end function parse_fn_call - !module subroutine parse_type(parser, type_text, rank) - module subroutine parse_type(parser, type_text, vtype) + module subroutine parse_type(parser, type_text, type) class(parser_t) :: parser character(len = :), intent(out), allocatable :: type_text - !integer, intent(out) :: rank - type(value_t), intent(out) :: vtype + type(value_t), intent(out) :: type end subroutine parse_type ! TODO: move struct stuff to another translation unit? parse_fn.f90 is a diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 00c445eb..4124d28d 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -295,7 +295,7 @@ module function parse_fn_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: i, j, io, pos0, pos1, pos2, rank, fn_beg, fn_name_end + integer :: i, j, io, pos0, rank, fn_beg, fn_name_end type(fn_t) :: fn @@ -310,8 +310,8 @@ module function parse_fn_declaration(parser) result(decl) type(text_span_t) :: span - type(value_t) :: val, vtype - type(value_vector_t) :: vtypes + type(value_t) :: val, type + type(value_vector_t) :: types ! Like a for statement, a fn declaration has its own scope (for its ! parameters). Its block body will have yet another scope @@ -329,7 +329,6 @@ module function parse_fn_declaration(parser) result(decl) ! TODO: be careful with parser%pos (token index) vs parser%current_pos() ! (character index) when constructing a span. I probably have similar bugs ! throughout to the one that I just fixed here - pos1 = parser%current_pos() !print *, 'matching lparen' lparen = parser%match(lparen_token) @@ -337,7 +336,7 @@ module function parse_fn_declaration(parser) result(decl) ! Parse parameter names and types. Save in temp vectors initially names = new_string_vector() pos_args = new_integer_vector() ! technically params not args - vtypes = new_value_vector() + types = new_value_vector() ! Array params use this syntax: ! @@ -369,10 +368,10 @@ module function parse_fn_declaration(parser) result(decl) !print *, 'matching colon' colon = parser%match(colon_token) - call parser%parse_type(type_text, vtype) + call parser%parse_type(type_text, type) call names%push( name%text ) - call vtypes%push(vtype) + call types%push(type) if (parser%current_kind() /= rparen_token) then !print *, 'matching comma' @@ -387,7 +386,6 @@ module function parse_fn_declaration(parser) result(decl) !print *, 'matching rparen' rparen = parser%match(rparen_token) - pos2 = parser%current_pos() ! Now that we have the number of params, save them @@ -400,7 +398,7 @@ module function parse_fn_declaration(parser) result(decl) fn%params(i)%name = names%v(i)%s ! Copy a value_t object to store the type - fn%params(i)%type = vtypes%v(i) + fn%params(i)%type = types%v(i) ! Declare the parameter variable parser%num_vars = parser%num_vars + 1 @@ -424,16 +422,9 @@ module function parse_fn_declaration(parser) result(decl) fn%type%type = void_type rank = 0 if (parser%current_kind() == colon_token) then - colon = parser%match(colon_token) - - pos1 = parser%current_pos() - call parser%parse_type(type_text, vtype) - pos2 = parser%current_pos() - - fn%type = vtype - !fn%type%struct_name = type_text ! TODO: should be unnecessary - + call parser%parse_type(type_text, type) + fn%type = type end if !print *, 'fn%type = ', fn%type @@ -499,7 +490,7 @@ module function parse_struct_declaration(parser) result(decl) character(len = :), allocatable :: type_text - integer :: itype, i, io, pos0, pos1, pos2, rank + integer :: itype, i, io, pos0, rank type(struct_t) :: struct, dummy_struct @@ -512,8 +503,8 @@ module function parse_struct_declaration(parser) result(decl) type(integer_vector_t) :: pos_mems type(value_t) :: member ! local type meta-data - type(value_t) :: vtype - type(value_vector_t) :: vtypes + type(value_t) :: type + type(value_vector_t) :: types struct_kw = parser%match(struct_keyword) @@ -531,8 +522,6 @@ module function parse_struct_declaration(parser) result(decl) identifier%text)) end if - pos1 = parser%current_pos() - lbrace = parser%match(lbrace_token) ! Structs use this syntax: @@ -555,7 +544,7 @@ module function parse_struct_declaration(parser) result(decl) ! Parse member names and types. Save in temp vectors initially names = new_string_vector() - vtypes = new_value_vector() + types = new_value_vector() ! For diagnostic text spans pos_mems = new_integer_vector() @@ -575,10 +564,10 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'matching colon' colon = parser%match(colon_token) - call parser%parse_type(type_text, vtype) + call parser%parse_type(type_text, type) !print *, "type = ", type_text - call vtypes%push(vtype) + call types%push(type) call names%push( name%text ) if (parser%current_kind() /= rbrace_token) then @@ -594,7 +583,6 @@ module function parse_struct_declaration(parser) result(decl) !print *, 'matching rbrace' rbrace = parser%match(rbrace_token) call pos_mems%push( rbrace%pos ) - pos2 = parser%current_pos() - 1 ! Now that we have the number of members, save them @@ -609,7 +597,7 @@ module function parse_struct_declaration(parser) result(decl) struct%member_names%v(i)%s = names%v(i)%s ! Copy a value_t object to store the type - member = vtypes%v(i) + member = types%v(i) ! Declare the member !parser%num_vars = parser%num_vars + 1 @@ -619,8 +607,6 @@ module function parse_struct_declaration(parser) result(decl) !! Save parameters by id_index !decl%params(i) = parser%num_vars - !member%struct_name = types%v(i)%s ! TODO: unnecessary - ! Each struct has its own dict of members. Create one and insert the ! member name into that dict instead of the (global) vars dict here. ! Might not need a new type, could probably just re-use the `vars_t` @@ -866,13 +852,13 @@ end function parse_struct_instance !=============================================================================== -module subroutine parse_type(parser, type_text, vtype) +module subroutine parse_type(parser, type_text, type) class(parser_t) :: parser character(len = :), intent(out), allocatable :: type_text - type(value_t), intent(out) :: vtype + type(value_t), intent(out) :: type !******** @@ -881,7 +867,7 @@ module subroutine parse_type(parser, type_text, vtype) type(struct_t) :: struct - type(syntax_token_t) :: colon, type, comma, lbracket, rbracket, semi, dummy + type(syntax_token_t) :: colon, ident, comma, lbracket, rbracket, semi, dummy type(text_span_t) :: span @@ -890,7 +876,7 @@ module subroutine parse_type(parser, type_text, vtype) ! Array param lbracket = parser%match(lbracket_token) - type = parser%match(identifier_token) + ident = parser%match(identifier_token) semi = parser%match(semicolon_token) rank = 0 @@ -916,12 +902,12 @@ module subroutine parse_type(parser, type_text, vtype) else ! Scalar param - type = parser%match(identifier_token) + ident = parser%match(identifier_token) rank = -1 end if pos2 = parser%current_pos() - type_text = type%text + type_text = ident%text itype = lookup_type(type_text, parser%structs, struct) @@ -932,16 +918,16 @@ module subroutine parse_type(parser, type_text, vtype) end if if (rank >= 0) then - vtype%type = array_type - allocate(vtype%array) - vtype%array%rank = rank - vtype%array%type = itype + type%type = array_type + allocate(type%array) + type%array%rank = rank + type%array%type = itype else - vtype%type = itype - if (allocated(vtype%array)) deallocate(vtype%array) + type%type = itype + if (allocated(type%array)) deallocate(type%array) end if - if (itype == struct_type) vtype%struct_name = type_text + if (itype == struct_type) type%struct_name = type_text end subroutine parse_type From 15b900282c62256fdcddccc0515f858af8769749 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 15:22:12 -0400 Subject: [PATCH 128/137] get rid of whole param_t class *lights another cigarette* --- src/core.f90 | 228 +++++++++++++++++++++++++++-------------------- src/parse_fn.f90 | 18 ++-- src/types.f90 | 34 ++++--- 3 files changed, 154 insertions(+), 126 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 694df510..9b2ec399 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -241,8 +241,9 @@ function declare_intrinsic_fns() result(fns) ! TODO: polymorphic in f32, f64, etc. exp_fn%type%type = f32_type allocate(exp_fn%params(1)) - exp_fn%params(1)%type%type = f32_type - exp_fn%params(1)%name = "x" + allocate(exp_fn%param_names%v(1)) + exp_fn%params(1)%type = f32_type + exp_fn%param_names%v(1)%s = "x" ! Insert the fn into the dict. These are global intrinsic fns, so there's no ! need to check iostat @@ -266,12 +267,13 @@ function declare_intrinsic_fns() result(fns) min_i32_fn%type%type = i32_type allocate(min_i32_fn%params(2)) + allocate(min_i32_fn%param_names%v(2)) - min_i32_fn%params(1)%type%type = i32_type - min_i32_fn%params(1)%name = "a0" + min_i32_fn%params(1)%type = i32_type + min_i32_fn%param_names%v(1)%s = "a0" - min_i32_fn%params(2)%type%type = i32_type - min_i32_fn%params(2)%name = "a1" + min_i32_fn%params(2)%type = i32_type + min_i32_fn%param_names%v(2)%s = "a1" min_i32_fn%variadic_min = 0 min_i32_fn%variadic_type = i32_type @@ -284,12 +286,13 @@ function declare_intrinsic_fns() result(fns) min_i64_fn%type%type = i64_type allocate(min_i64_fn%params(2)) + allocate(min_i64_fn%param_names%v(2)) - min_i64_fn%params(1)%type%type = i64_type - min_i64_fn%params(1)%name = "a0" + min_i64_fn%params(1)%type = i64_type + min_i64_fn%param_names%v(1)%s = "a0" - min_i64_fn%params(2)%type%type = i64_type - min_i64_fn%params(2)%name = "a1" + min_i64_fn%params(2)%type = i64_type + min_i64_fn%param_names%v(2)%s = "a1" min_i64_fn%variadic_min = 0 min_i64_fn%variadic_type = i64_type @@ -300,12 +303,13 @@ function declare_intrinsic_fns() result(fns) min_f32_fn%type%type = f32_type allocate(min_f32_fn%params(2)) + allocate(min_f32_fn%param_names%v(2)) - min_f32_fn%params(1)%type%type = f32_type - min_f32_fn%params(1)%name = "a0" + min_f32_fn%params(1)%type = f32_type + min_f32_fn%param_names%v(1)%s = "a0" - min_f32_fn%params(2)%type%type = f32_type - min_f32_fn%params(2)%name = "a1" + min_f32_fn%params(2)%type = f32_type + min_f32_fn%param_names%v(2)%s = "a1" min_f32_fn%variadic_min = 0 min_f32_fn%variadic_type = f32_type @@ -316,12 +320,13 @@ function declare_intrinsic_fns() result(fns) max_i32_fn%type%type = i32_type allocate(max_i32_fn%params(2)) + allocate(max_i32_fn%param_names%v(2)) - max_i32_fn%params(1)%type%type = i32_type - max_i32_fn%params(1)%name = "a0" + max_i32_fn%params(1)%type = i32_type + max_i32_fn%param_names%v(1)%s = "a0" - max_i32_fn%params(2)%type%type = i32_type - max_i32_fn%params(2)%name = "a1" + max_i32_fn%params(2)%type = i32_type + max_i32_fn%param_names%v(2)%s = "a1" max_i32_fn%variadic_min = 0 max_i32_fn%variadic_type = i32_type @@ -334,12 +339,13 @@ function declare_intrinsic_fns() result(fns) max_i64_fn%type%type = i64_type allocate(max_i64_fn%params(2)) + allocate(max_i64_fn%param_names%v(2)) - max_i64_fn%params(1)%type%type = i64_type - max_i64_fn%params(1)%name = "a0" + max_i64_fn%params(1)%type = i64_type + max_i64_fn%param_names%v(1)%s = "a0" - max_i64_fn%params(2)%type%type = i64_type - max_i64_fn%params(2)%name = "a1" + max_i64_fn%params(2)%type = i64_type + max_i64_fn%param_names%v(2)%s = "a1" max_i64_fn%variadic_min = 0 max_i64_fn%variadic_type = i64_type @@ -350,12 +356,13 @@ function declare_intrinsic_fns() result(fns) max_f32_fn%type%type = f32_type allocate(max_f32_fn%params(2)) + allocate(max_f32_fn%param_names%v(2)) - max_f32_fn%params(1)%type%type = f32_type - max_f32_fn%params(1)%name = "a0" + max_f32_fn%params(1)%type = f32_type + max_f32_fn%param_names%v(1)%s = "a0" - max_f32_fn%params(2)%type%type = f32_type - max_f32_fn%params(2)%name = "a1" + max_f32_fn%params(2)%type = f32_type + max_f32_fn%param_names%v(2)%s = "a1" max_f32_fn%variadic_min = 0 max_f32_fn%variadic_type = f32_type @@ -369,6 +376,7 @@ function declare_intrinsic_fns() result(fns) println_fn%type%type = void_type ! TODO? allocate(println_fn%params(0)) + allocate(println_fn%param_names%v(0)) println_fn%variadic_min = 0 println_fn%variadic_type = any_type @@ -380,6 +388,7 @@ function declare_intrinsic_fns() result(fns) str_fn%type%type = str_type allocate(str_fn%params(0)) + allocate(str_fn%param_names%v(0)) str_fn%variadic_min = 0 str_fn%variadic_type = any_type @@ -390,8 +399,9 @@ function declare_intrinsic_fns() result(fns) len_fn%type%type = i64_type allocate(len_fn%params(1)) - len_fn%params(1)%type%type = str_type - len_fn%params(1)%name = "str" + allocate(len_fn%param_names%v(1)) + len_fn%params(1)%type = str_type + len_fn%param_names%v(1)%s = "str" call fns%insert("len", len_fn, id_index) @@ -404,8 +414,9 @@ function declare_intrinsic_fns() result(fns) parse_i32_fn%type%type = i32_type allocate(parse_i32_fn%params(1)) - parse_i32_fn%params(1)%type%type = str_type - parse_i32_fn%params(1)%name = "str" + allocate(parse_i32_fn%param_names%v(1)) + parse_i32_fn%params(1)%type = str_type + parse_i32_fn%param_names%v(1)%s = "str" call fns%insert("parse_i32", parse_i32_fn, id_index) @@ -413,8 +424,9 @@ function declare_intrinsic_fns() result(fns) parse_i64_fn%type%type = i64_type allocate(parse_i64_fn%params(1)) - parse_i64_fn%params(1)%type%type = str_type - parse_i64_fn%params(1)%name = "str" + allocate(parse_i64_fn%param_names%v(1)) + parse_i64_fn%params(1)%type = str_type + parse_i64_fn%param_names%v(1)%s = "str" call fns%insert("parse_i64", parse_i64_fn, id_index) @@ -422,8 +434,9 @@ function declare_intrinsic_fns() result(fns) parse_f32_fn%type%type = f32_type allocate(parse_f32_fn%params(1)) - parse_f32_fn%params(1)%type%type = str_type - parse_f32_fn%params(1)%name = "str" + allocate(parse_f32_fn%param_names%v(1)) + parse_f32_fn%params(1)%type = str_type + parse_f32_fn%param_names%v(1)%s = "str" call fns%insert("parse_f32", parse_f32_fn, id_index) @@ -431,10 +444,11 @@ function declare_intrinsic_fns() result(fns) i32_sca_fn%type%type = i32_type allocate(i32_sca_fn%params(1)) + allocate(i32_sca_fn%param_names%v(1)) - i32_sca_fn%params(1)%type%type = any_type + i32_sca_fn%params(1)%type = any_type - i32_sca_fn%params(1)%name = "a" + i32_sca_fn%param_names%v(1)%s = "a" call fns%insert("0i32_sca", i32_sca_fn, id_index) @@ -446,10 +460,11 @@ function declare_intrinsic_fns() result(fns) i32_arr_fn%type%array%rank = -1 allocate(i32_arr_fn%params(1)) + allocate(i32_arr_fn%param_names%v(1)) - i32_arr_fn%params(1)%type%type = any_type + i32_arr_fn%params(1)%type = any_type - i32_arr_fn%params(1)%name = "a" + i32_arr_fn%param_names%v(1)%s = "a" call fns%insert("0i32_arr", i32_arr_fn, id_index) @@ -459,10 +474,11 @@ function declare_intrinsic_fns() result(fns) i64_sca_fn%type%type = i64_type allocate(i64_sca_fn%params(1)) + allocate(i64_sca_fn%param_names%v(1)) - i64_sca_fn%params(1)%type%type = any_type + i64_sca_fn%params(1)%type = any_type - i64_sca_fn%params(1)%name = "a" + i64_sca_fn%param_names%v(1)%s = "a" call fns%insert("0i64_sca", i64_sca_fn, id_index) @@ -474,10 +490,11 @@ function declare_intrinsic_fns() result(fns) i64_arr_fn%type%array%rank = -1 allocate(i64_arr_fn%params(1)) + allocate(i64_arr_fn%param_names%v(1)) - i64_arr_fn%params(1)%type%type = any_type + i64_arr_fn%params(1)%type = any_type - i64_arr_fn%params(1)%name = "a" + i64_arr_fn%param_names%v(1)%s = "a" call fns%insert("0i64_arr", i64_arr_fn, id_index) @@ -485,8 +502,9 @@ function declare_intrinsic_fns() result(fns) open_fn%type%type = file_type allocate(open_fn%params(1)) - open_fn%params(1)%type%type = str_type - open_fn%params(1)%name = "filename" + allocate(open_fn%param_names%v(1)) + open_fn%params(1)%type = str_type + open_fn%param_names%v(1)%s = "filename" call fns%insert("open", open_fn, id_index) @@ -494,8 +512,9 @@ function declare_intrinsic_fns() result(fns) readln_fn%type%type = str_type allocate(readln_fn%params(1)) - readln_fn%params(1)%type%type = file_type - readln_fn%params(1)%name = "file_handle" + allocate(readln_fn%param_names%v(1)) + readln_fn%params(1)%type = file_type + readln_fn%param_names%v(1)%s = "file_handle" call fns%insert("readln", readln_fn, id_index) @@ -503,8 +522,9 @@ function declare_intrinsic_fns() result(fns) writeln_fn%type%type = void_type allocate(writeln_fn%params(1)) - writeln_fn%params(1)%type%type = file_type - writeln_fn%params(1)%name = "file_handle" + allocate(writeln_fn%param_names%v(1)) + writeln_fn%params(1)%type = file_type + writeln_fn%param_names%v(1)%s = "file_handle" writeln_fn%variadic_min = 0 !writeln_fn%variadic_min = 1 @@ -516,8 +536,9 @@ function declare_intrinsic_fns() result(fns) eof_fn%type%type = bool_type allocate(eof_fn%params(1)) - eof_fn%params(1)%type%type = file_type - eof_fn%params(1)%name = "file_handle" + allocate(eof_fn%param_names%v(1)) + eof_fn%params(1)%type = file_type + eof_fn%param_names%v(1)%s = "file_handle" call fns%insert("eof", eof_fn, id_index) @@ -525,8 +546,9 @@ function declare_intrinsic_fns() result(fns) close_fn%type%type = void_type allocate(close_fn%params(1)) - close_fn%params(1)%type%type = file_type - close_fn%params(1)%name = "file_handle" + allocate(close_fn%param_names%v(1)) + close_fn%params(1)%type = file_type + close_fn%param_names%v(1)%s = "file_handle" call fns%insert("close", close_fn, id_index) @@ -534,8 +556,9 @@ function declare_intrinsic_fns() result(fns) exit_fn%type%type = void_type allocate(exit_fn%params(1)) - exit_fn%params(1)%type%type = i32_type - exit_fn%params(1)%name = "exit_status" + allocate(exit_fn%param_names%v(1)) + exit_fn%params(1)%type = i32_type + exit_fn%param_names%v(1)%s = "exit_status" call fns%insert("exit", exit_fn, id_index) @@ -543,17 +566,18 @@ function declare_intrinsic_fns() result(fns) size_fn%type%type = i64_type allocate(size_fn%params(2)) + allocate(size_fn%param_names%v(2)) - size_fn%params(1)%type%type = array_type + size_fn%params(1)%type = array_type - allocate(size_fn%params(1)%type%array) - size_fn%params(1)%type%array%type = any_type - size_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(size_fn%params(1)%array) + size_fn%params(1)%array%type = any_type + size_fn%params(1)%array%rank = -1 ! negative means any rank - size_fn%params(1)%name = "array" + size_fn%param_names%v(1)%s = "array" - size_fn%params(2)%type%type = i32_type - size_fn%params(2)%name = "dim" + size_fn%params(2)%type = i32_type + size_fn%param_names%v(2)%s = "dim" call fns%insert("size", size_fn, id_index) @@ -565,18 +589,19 @@ function declare_intrinsic_fns() result(fns) count_fn%type%type = i64_type allocate(count_fn%params(1)) + allocate(count_fn%param_names%v(1)) - count_fn%params(1)%type%type = array_type + count_fn%params(1)%type = array_type - allocate(count_fn%params(1)%type%array) - count_fn%params(1)%type%array%type = bool_type - count_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(count_fn%params(1)%array) + count_fn%params(1)%array%type = bool_type + count_fn%params(1)%array%rank = -1 ! negative means any rank - count_fn%params(1)%name = "mask" + count_fn%param_names%v(1)%s = "mask" !! TODO: add dim arg to count() like Fortran - !count_fn%params(2)%type%type = i32_type - !count_fn%params(2)%name = "dim" + !count_fn%params(2)%type = i32_type + !count_fn%param_names%v(2)%s = "dim" call fns%insert("count", count_fn, id_index) @@ -584,20 +609,21 @@ function declare_intrinsic_fns() result(fns) sum_i32_fn%type%type = i32_type allocate(sum_i32_fn%params(1)) + allocate(sum_i32_fn%param_names%v(1)) - sum_i32_fn%params(1)%type%type = array_type + sum_i32_fn%params(1)%type = array_type - allocate(sum_i32_fn%params(1)%type%array) - sum_i32_fn%params(1)%type%array%type = i32_type - sum_i32_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(sum_i32_fn%params(1)%array) + sum_i32_fn%params(1)%array%type = i32_type + sum_i32_fn%params(1)%array%rank = -1 ! negative means any rank - sum_i32_fn%params(1)%name = "array" + sum_i32_fn%param_names%v(1)%s = "array" !! TODO: add mask and dim args to sum() like Fortran. Maybe overload !! several distinct internal fn's like 0min_i32 vs 0min_i64? The return !! value is still the same so maybe there's an easier way - !sum_i32_fn%params(2)%type%type = i32_type - !sum_i32_fn%params(2)%name = "dim" + !sum_i32_fn%params(2)%type = i32_type + !sum_i32_fn%param_names%v(2)%s = "dim" call fns%insert("0sum_i32", sum_i32_fn, id_index) @@ -605,14 +631,15 @@ function declare_intrinsic_fns() result(fns) sum_i64_fn%type%type = i64_type allocate(sum_i64_fn%params(1)) + allocate(sum_i64_fn%param_names%v(1)) - sum_i64_fn%params(1)%type%type = array_type + sum_i64_fn%params(1)%type = array_type - allocate(sum_i64_fn%params(1)%type%array) - sum_i64_fn%params(1)%type%array%type = i64_type - sum_i64_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(sum_i64_fn%params(1)%array) + sum_i64_fn%params(1)%array%type = i64_type + sum_i64_fn%params(1)%array%rank = -1 ! negative means any rank - sum_i64_fn%params(1)%name = "array" + sum_i64_fn%param_names%v(1)%s = "array" call fns%insert("0sum_i64", sum_i64_fn, id_index) @@ -620,14 +647,15 @@ function declare_intrinsic_fns() result(fns) sum_f32_fn%type%type = f32_type allocate(sum_f32_fn%params(1)) + allocate(sum_f32_fn%param_names%v(1)) - sum_f32_fn%params(1)%type%type = array_type + sum_f32_fn%params(1)%type = array_type - allocate(sum_f32_fn%params(1)%type%array) - sum_f32_fn%params(1)%type%array%type = f32_type - sum_f32_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(sum_f32_fn%params(1)%array) + sum_f32_fn%params(1)%array%type = f32_type + sum_f32_fn%params(1)%array%rank = -1 ! negative means any rank - sum_f32_fn%params(1)%name = "array" + sum_f32_fn%param_names%v(1)%s = "array" call fns%insert("0sum_f32", sum_f32_fn, id_index) @@ -635,18 +663,19 @@ function declare_intrinsic_fns() result(fns) all_fn%type%type = bool_type allocate(all_fn%params(1)) + allocate(all_fn%param_names%v(1)) - all_fn%params(1)%type%type = array_type + all_fn%params(1)%type = array_type - allocate(all_fn%params(1)%type%array) - all_fn%params(1)%type%array%type = bool_type - all_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(all_fn%params(1)%array) + all_fn%params(1)%array%type = bool_type + all_fn%params(1)%array%rank = -1 ! negative means any rank - all_fn%params(1)%name = "mask" + all_fn%param_names%v(1)%s = "mask" !! TODO: add dim arg to all() like Fortran - !all_fn%params(2)%type%type = i32_type - !all_fn%params(2)%name = "dim" + !all_fn%params(2)%type = i32_type + !all_fn%param_names%v(2)%s = "dim" call fns%insert("all", all_fn, id_index) @@ -654,18 +683,19 @@ function declare_intrinsic_fns() result(fns) any_fn%type%type = bool_type allocate(any_fn%params(1)) + allocate(any_fn%param_names%v(1)) - any_fn%params(1)%type%type = array_type + any_fn%params(1)%type = array_type - allocate(any_fn%params(1)%type%array) - any_fn%params(1)%type%array%type = bool_type - any_fn%params(1)%type%array%rank = -1 ! negative means any rank + allocate(any_fn%params(1)%array) + any_fn%params(1)%array%type = bool_type + any_fn%params(1)%array%rank = -1 ! negative means any rank - any_fn%params(1)%name = "mask" + any_fn%param_names%v(1)%s = "mask" !! TODO: add dim arg to any() like Fortran - !any_fn%params(2)%type%type = i32_type - !any_fn%params(2)%name = "dim" + !any_fn%params(2)%type = i32_type + !any_fn%param_names%v(2)%s = "dim" call fns%insert("any", any_fn, id_index) diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 4124d28d..7be41e9b 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -244,10 +244,9 @@ module function parse_fn_call(parser) result(fn_call) ! only way to do it for intrinsic fns, which don't actually have a val ! anywhere if (i <= size(fn%params)) then - param_val = fn%params(i)%type + param_val = fn%params(i) else param_val%type = fn%variadic_type - !param_val%struct_name = "" end if if (types_match(param_val, args%v(i)%val) /= TYPE_MATCH) then @@ -267,7 +266,7 @@ module function parse_fn_call(parser) result(fn_call) span, & identifier%text, & i - 1, & ! 0-based index in err msg - fn%params(i)%name, & + fn%param_names%v(i)%s, & exp_type, & act_type)) @@ -336,7 +335,7 @@ module function parse_fn_declaration(parser) result(decl) ! Parse parameter names and types. Save in temp vectors initially names = new_string_vector() pos_args = new_integer_vector() ! technically params not args - types = new_value_vector() + types = new_value_vector() ! Array params use this syntax: ! @@ -389,16 +388,17 @@ module function parse_fn_declaration(parser) result(decl) ! Now that we have the number of params, save them - allocate(fn %params( names%len_ )) - allocate(decl%params( names%len_ )) + allocate(fn %params ( names%len_ )) + allocate(fn%param_names%v( names%len_ )) + allocate(decl%params ( names%len_ )) do i = 1, names%len_ !print *, "name, type = ", names%v(i)%s, ", ", types%v(i)%s - fn%params(i)%name = names%v(i)%s + fn%param_names%v(i)%s = names%v(i)%s ! Copy a value_t object to store the type - fn%params(i)%type = types%v(i) + fn%params(i) = types%v(i) ! Declare the parameter variable parser%num_vars = parser%num_vars + 1 @@ -406,7 +406,7 @@ module function parse_fn_declaration(parser) result(decl) ! Save parameters by id_index. TODO: stack frames decl%params(i) = parser%num_vars - call parser%vars%insert(fn%params(i)%name, fn%params(i)%type, parser%num_vars) + call parser%vars%insert(fn%param_names%v(i)%s, fn%params(i), parser%num_vars) end do diff --git a/src/types.f90 b/src/types.f90 index f74ab0ec..4224a56f 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -20,23 +20,15 @@ module syntran__types_m !******** - type param_t - ! Function parameter (argument) - ! - - ! TODO: this is basically a wrapper of a value_t. Move name into an - ! array of names in fn_t and get rid of param_t type, like I got rid of - ! member_t. - - - character(len = :), allocatable :: name - type(value_t) :: type - - ! TODO: add a way to represent polymorphic intrinsic fn params, e.g. - ! i32 min(1, 2) vs f32 min(1.0, 2.0), but not bool min(true, false). - ! Maybe add an array of types(:) for each allowable type of a param? - - end type param_t + !type param_t + ! ! Function parameter (argument) + ! ! + ! ! TODO: this is basically a wrapper of a value_t. Move name into an + ! ! array of names in fn_t and get rid of param_t type, like I got rid of + ! ! member_t. + ! character(len = :), allocatable :: name + ! type(value_t) :: type + !end type param_t !******** @@ -46,10 +38,16 @@ module syntran__types_m ! Return type. "A type is a value!" type(value_t) :: type + ! TODO: add a way to represent polymorphic intrinsic fn params, e.g. + ! i32 min(1, 2) vs f32 min(1.0, 2.0), but not bool min(true, false). + ! Maybe add an array of types(:) for each allowable type of a param? + ! Arguments/parameters. Technically, "arguments" in most languages are ! what Fortran calls "actual arguments" and "parameters" are Fortran ! "dummy arguments" - type(param_t), allocatable :: params(:) + type(value_t), allocatable :: params(:) + !type(param_t), allocatable :: params(:) + type(string_vector_t) :: param_names ! Min number of variadic params. Default < 0 means fn is not variadic ! From f1dbf366023f517bc086cdef0314d8e9887572e3 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 15:43:52 -0400 Subject: [PATCH 129/137] cleanup. structs are just about ready --- src/parse_expr.f90 | 6 +-- src/types.f90 | 108 +++++++++------------------------------------ src/value.f90 | 3 -- 3 files changed, 22 insertions(+), 95 deletions(-) diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index efedee5b..a63028fe 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -380,12 +380,10 @@ module function parse_primary_expr(parser) result(expr) !******** - integer :: io, dummy_id + integer :: io logical :: bool, exists - !type(struct_t) :: dummy - type(syntax_token_t) :: left, right, keyword, token if (debug > 1) print *, 'parse_primary_expr' @@ -459,7 +457,7 @@ module function parse_primary_expr(parser) result(expr) !print *, "text = ", parser%current_text() !dummy = parser%structs%search(parser%current_text(), dummy_id, io) - exists = parser%structs%exists(parser%current_text(), dummy_id, io) + exists = parser%structs%exists(parser%current_text()) !deallocate(dummy%members) !deallocate(dummy%vars) !print *, "io = ", io diff --git a/src/types.f90 b/src/types.f90 index 4224a56f..c086dbdf 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -20,18 +20,6 @@ module syntran__types_m !******** - !type param_t - ! ! Function parameter (argument) - ! ! - ! ! TODO: this is basically a wrapper of a value_t. Move name into an - ! ! array of names in fn_t and get rid of param_t type, like I got rid of - ! ! member_t. - ! character(len = :), allocatable :: name - ! type(value_t) :: type - !end type param_t - - !******** - type fn_t ! Function signature: input and output types @@ -40,13 +28,12 @@ module syntran__types_m ! TODO: add a way to represent polymorphic intrinsic fn params, e.g. ! i32 min(1, 2) vs f32 min(1.0, 2.0), but not bool min(true, false). - ! Maybe add an array of types(:) for each allowable type of a param? + ! Maybe add an matrix of types(:,:) for each allowable type of a param? ! Arguments/parameters. Technically, "arguments" in most languages are ! what Fortran calls "actual arguments" and "parameters" are Fortran ! "dummy arguments" type(value_t), allocatable :: params(:) - !type(param_t), allocatable :: params(:) type(string_vector_t) :: param_names ! Min number of variadic params. Default < 0 means fn is not variadic @@ -311,16 +298,11 @@ module syntran__types_m !! Flat array of structs, used for efficient interpreted evaluation !type(struct_t), allocatable :: structs(:) - ! TODO: is this needed for structs? Is it needed for fns? - integer :: scope = 1 - - ! TODO: scoping for nested structs? contains procedure :: & insert => struct_insert, & exists => struct_exists, & search => struct_search - ! push_scope, pop_scope end type structs_t @@ -379,7 +361,9 @@ recursive subroutine vars_copy(dst, src) end do if (allocated(src%vals)) then - if (.not. allocated(dst%vals)) allocate(dst%vals( size(src%vals) )) + !if (.not. allocated(dst%vals)) allocate(dst%vals( size(src%vals) )) + if (allocated(dst%vals)) deallocate(dst%vals) + allocate(dst%vals( size(src%vals) )) dst%vals = src%vals else if (allocated(dst%vals)) then deallocate(dst%vals) @@ -402,23 +386,9 @@ recursive subroutine struct_copy(dst, src) !print *, 'starting struct_copy()' + dst%member_names = src%member_names dst%num_vars = src%num_vars - - !! TODO: re-enable this or delete members from fortran type - !if (allocated(src%members)) then - ! if (.not. allocated(dst%members)) allocate(dst%members( size(src%members) )) - ! dst%members = src%members - !else if (allocated(dst%members)) then - ! deallocate(dst%members) - !end if - - !if (allocated(src%vars)) then - ! if (.not. allocated(dst%vars)) allocate(dst%vars) - dst%vars = src%vars - ! !dst%vars%dicts = src%vars%dicts - !else if (allocated(dst%vars)) then - ! deallocate(dst%vars) - !end if + dst%vars = src%vars !print *, 'done struct_copy()' @@ -444,7 +414,9 @@ recursive subroutine fn_copy(dst, src) dst%variadic_type = src%variadic_type if (allocated(src%params)) then - if (.not. allocated(dst%params)) allocate(dst%params( size(src%params) )) + !if (.not. allocated(dst%params)) allocate(dst%params( size(src%params) )) + if (allocated(dst%params)) deallocate(dst%params) + allocate(dst%params( size(src%params) )) dst%params = src%params else if (allocated(dst%params)) then deallocate(dst%params) @@ -1809,9 +1781,6 @@ function new_binary_expr(left, op, right) result(expr) !print *, 'larrtype = ', kind_name(larrtype) - ! TODO: whatever i've done for structs in is_binary_op_allowed() and - ! get_binary_op_kind() will need to be applied for unary ops too - ltype = left%val%type rtype = right%val%type @@ -2289,13 +2258,11 @@ end subroutine ternary_insert !=============================================================================== -recursive function struct_ternary_exists(node, key, id_index, iostat) result(exists) +recursive function struct_ternary_exists(node, key) result(exists) type(struct_ternary_tree_node_t), intent(in), allocatable :: node character(len = *), intent(in) :: key - integer, intent(out) :: id_index - integer, intent(out) :: iostat !type(struct_t) :: val logical :: exists @@ -2306,27 +2273,23 @@ recursive function struct_ternary_exists(node, key, id_index, iostat) result(exi !print *, 'searching key ', quote(key) - iostat = exit_success exists = .false. - if (.not. allocated(node)) then - ! Search key not found - iostat = exit_failure - return - end if + ! Search key not found + if (.not. allocated(node)) return ! :) k = key(1:1) ey = key(2:) if (k < node%split_char) then - exists = struct_ternary_exists(node%left , key, id_index, iostat) + exists = struct_ternary_exists(node%left , key) return else if (k > node%split_char) then - exists = struct_ternary_exists(node%right, key, id_index, iostat) + exists = struct_ternary_exists(node%right, key) return else if (len(ey) > 0) then - exists = struct_ternary_exists(node%mid , ey, id_index, iostat) + exists = struct_ternary_exists(node%mid , ey) return end if @@ -2334,14 +2297,10 @@ recursive function struct_ternary_exists(node, key, id_index, iostat) result(exi if (.not. allocated(node%val)) then exists = .false. - iostat = exit_failure return end if - !allocate(val) - !val = node%val exists = .true. - id_index = node%id_index !print *, 'done struct_ternary_exists' !print *, '' @@ -2601,11 +2560,11 @@ subroutine struct_insert(dict, key, val, id_index, iostat, overwrite) !print *, 'inserting ', quote(key) id_index = id_index + 1 - ! TODO: flip this like fns to check for redeclared structs. Catch in caller + ! Note that this is different than the fn insert default. Re-declared + ! structs are caught in the caller (in parse_struct_declaration()) overwritel = .true. if (present(overwrite)) overwritel = overwrite - i = dict%scope call struct_ternary_insert(dict%dict%root, key, val, id_index, io, overwritel) if (present(iostat)) iostat = io @@ -2614,42 +2573,25 @@ end subroutine struct_insert !=============================================================================== -function struct_exists(dict, key, id_index, iostat) result(exists) +function struct_exists(dict, key) result(exists) ! Check if a key exists, without copying an output val unlike ! struct_search() - ! - ! TODO: some of these args (iostat at least) are unnecessary class(structs_t), intent(in) :: dict character(len = *), intent(in) :: key - integer, intent(out) :: id_index - !type(struct_t) :: val logical :: exists - integer, intent(out), optional :: iostat - !******** - integer :: i, io - - i = dict%scope - - exists = struct_ternary_exists(dict%dict%root, key, id_index, io) - - ! If not found in current scope, search parent scopes too - do while (io /= exit_success .and. i > 1) - i = i - 1 - exists = struct_ternary_exists(dict%dict%root, key, id_index, io) - end do + integer :: i, io, id_index - if (present(iostat)) iostat = io + exists = struct_ternary_exists(dict%dict%root, key) end function struct_exists !=============================================================================== -!function struct_search(dict, key, id_index, iostat) result(val) subroutine struct_search(dict, key, id_index, iostat, val) ! An id_index is not normally part of dictionary searching, but we use it @@ -2669,21 +2611,11 @@ subroutine struct_search(dict, key, id_index, iostat, val) !print *, "starting struct search" - i = dict%scope - - !val = struct_ternary_search(dict%dict%root, key, id_index, io) call struct_ternary_search(dict%dict%root, key, id_index, io, val) !print *, "io = ", io - !! If not found in current scope, search parent scopes too - !do while (io /= exit_success .and. i > 1) - ! i = i - 1 - ! val = struct_ternary_search(dict%dict%root, key, id_index, io) - !end do - if (present(iostat)) iostat = io -!end function struct_search end subroutine struct_search !=============================================================================== diff --git a/src/value.f90 b/src/value.f90 index c8856c8f..c595e221 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -222,9 +222,6 @@ recursive subroutine value_copy(dst, src) end if if (allocated(src%struct)) then - ! TODO: some of the allocations above are wrong. make them like this - ! one which crashed on a 3rd-order Pyramid struct befored i fixed it. - ! there are similar potential issues in fn_copy() if (allocated(dst%struct)) deallocate(dst%struct) allocate(dst%struct( size(src%struct) )) do i = 1, size(src%struct) From c3edb1133c7a01ecb408980ba43cc7985e1f3777 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 16:47:16 -0400 Subject: [PATCH 130/137] fix dot expr str indexing --- src/core.f90 | 12 ++++-------- src/eval.f90 | 36 ++++++++++++++++++++++++++---------- src/tests/test.f90 | 24 ++++++++++++++++++++++++ src/types.f90 | 2 -- 4 files changed, 54 insertions(+), 20 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 9b2ec399..48869a26 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -30,6 +30,10 @@ module syntran__core_m ! TODO: ! - structs + ! * post-merge TODO struct items: + ! + update struct sample. include struct/array combos, nesting, etc. + ! maybe make separate simple and compound struct samples + ! + note in docs that structs don't work in interactive interpreter ! * mvp done: ! + struct fn return values ! + nested structs @@ -42,14 +46,6 @@ module syntran__core_m ! changed things later which automatically fixed unary ops? ! * tbd: ! + remove unused vars per cmake warnings - ! + remove unused things like mems/members copies in various - ! types/routines - ! > currently using members for fn param declarations - ! + struct type checking - ! > check dot member types in instantiation - ! * done for primitives, still need to compare struct subtypes - ! > check mismatches of assigning one struct to another, or passing a - ! struct to a fn ! + improved to_str() conversion with labels of struct name and member names ! - jumping control flow: ! * fn return statement done diff --git a/src/eval.f90 b/src/eval.f90 index be6ba0ae..cdaf7478 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -492,14 +492,22 @@ recursive subroutine set_val(node, var, state, val, index_) else i8 = sub_eval(node%member, var%struct(id), state) end if + + if (var%struct(id)%type == str_type) then + + var%struct(id)%sca%str%s(i8+1: i8+1) = val%sca%str%s + !res%sca%str%s = var%struct(id)%sca%str%s(i8+1: i8+1) + !res%type = str_type + + return + end if + if (var%struct(id)%array%type /= struct_type) then call set_array_val(var%struct(id)%array, i8, val) return end if var%struct(id)%struct(i8+1) = val - !res%type = struct_type - !res%struct_name = var%struct(id)%struct_name end subroutine set_val @@ -632,6 +640,17 @@ recursive subroutine get_val(node, var, state, res, index_) else i8 = sub_eval(node%member, var%struct(id), state) end if + + if (var%struct(id)%type == str_type) then + !state%vars%vals(node%id_index)%sca%str%s(i8+1: i8+1) = res%sca%str%s + !res%sca%str%s = state%vars%vals(node%id_index)%sca%str%s(i8+1: i8+1) + + res%sca%str%s = var%struct(id)%sca%str%s(i8+1: i8+1) + res%type = str_type + + return + end if + if (var%struct(id)%array%type /= struct_type) then !print *, "get_array_val 3" call get_array_val(var%struct(id)%array, i8, res) @@ -639,8 +658,6 @@ recursive subroutine get_val(node, var, state, res, index_) end if res = var%struct(id)%struct(i8+1) - res%type = struct_type - res%struct_name = var%struct(id)%struct_name end subroutine get_val @@ -2383,13 +2400,12 @@ function sub_eval(node, var, state) result(index_) !print *, 'starting sub_eval()' - !! TODO: i think member string indexing is broken without this - !! str scalar with single char subscript !if (state%vars%vals(node%id_index)%type == str_type) then - ! call syntax_eval(node%lsubscripts(1), state, subscript) - ! index_ = subscript%to_i64() - ! return - !end if + if (var%type == str_type) then + call syntax_eval(node%lsubscripts(1), state, subscript) + index_ = subscript%to_i64() + return + end if !if (state%vars%vals(node%id_index)%type /= array_type) then ! ! internal_error? diff --git a/src/tests/test.f90 b/src/tests/test.f90 index e5f21a73..97be8221 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -3291,6 +3291,30 @@ subroutine unit_test_struct_arr(npass, nfail) //'let e = E{e = d};' & //'return extract_a(e);' & , quiet = .false.) == '42', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 52 + //'let d0 = D{y=2024, m="Sep", d=21};' & + //'let c = d0.m[0];' & + //'return c;' & + , quiet) == 'S', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 53 + //'let d0 = D{y=2024, m="Sep", d=21};' & + //'let c = d0.m[1];' & + //'return c;' & + , quiet) == 'e', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 54 + //'let d0 = D{y=2024, m="Sep", d=21};' & + //'d0.m[0] = "P";' & + //'return d0.m;' & + , quiet) == 'Pep', & + eval('' & + //'struct D{y:i32, m:str, d:i32}' & ! 55 + //'let d0 = D{y=2024, m="Sep", d=21};' & + //'d0.m[2] = "a";' & + //'return d0.m;' & + , quiet) == 'Sea', & .false. & ! so I don't have to bother w/ trailing commas ] diff --git a/src/types.f90 b/src/types.f90 index c086dbdf..910e1037 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -361,7 +361,6 @@ recursive subroutine vars_copy(dst, src) end do if (allocated(src%vals)) then - !if (.not. allocated(dst%vals)) allocate(dst%vals( size(src%vals) )) if (allocated(dst%vals)) deallocate(dst%vals) allocate(dst%vals( size(src%vals) )) dst%vals = src%vals @@ -414,7 +413,6 @@ recursive subroutine fn_copy(dst, src) dst%variadic_type = src%variadic_type if (allocated(src%params)) then - !if (.not. allocated(dst%params)) allocate(dst%params( size(src%params) )) if (allocated(dst%params)) deallocate(dst%params) allocate(dst%params( size(src%params) )) dst%params = src%params From e5688fb8687f8c66b0f3875a9023ba22e1f74a1f Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 17:01:39 -0400 Subject: [PATCH 131/137] cleanup --- src/eval.f90 | 22 ---------------------- src/parse.f90 | 1 - 2 files changed, 23 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index cdaf7478..ae90e858 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -494,11 +494,7 @@ recursive subroutine set_val(node, var, state, val, index_) end if if (var%struct(id)%type == str_type) then - var%struct(id)%sca%str%s(i8+1: i8+1) = val%sca%str%s - !res%sca%str%s = var%struct(id)%sca%str%s(i8+1: i8+1) - !res%type = str_type - return end if @@ -642,12 +638,8 @@ recursive subroutine get_val(node, var, state, res, index_) end if if (var%struct(id)%type == str_type) then - !state%vars%vals(node%id_index)%sca%str%s(i8+1: i8+1) = res%sca%str%s - !res%sca%str%s = state%vars%vals(node%id_index)%sca%str%s(i8+1: i8+1) - res%sca%str%s = var%struct(id)%sca%str%s(i8+1: i8+1) res%type = str_type - return end if @@ -1322,9 +1314,6 @@ subroutine eval_assignment_expr(node, state, res) type(syntax_node_t) :: mem type(value_t) :: array_val, rhs, tmp - !type(value_t), pointer :: val, ptmp - type(value_t), allocatable :: val, ptmp, vals(:) - !type(value_t) :: val !print *, "eval assignment_expr" !print *, "node identifier = ", node%identifier%text @@ -1797,8 +1786,6 @@ subroutine eval_array_expr(node, state, res) end select res%type = array_type - !allocate(res%array) - !res%array = array else if (node%val%array%kind == bound_array) then !print *, 'impl_array' @@ -1857,8 +1844,6 @@ subroutine eval_array_expr(node, state, res) res%array%size = res%array%len_ res%type = array_type - !allocate(res%array) - !res%array = array else if (node%val%array%kind == size_array) then @@ -1929,17 +1914,10 @@ subroutine eval_array_expr(node, state, res) res%type = array_type - !res%struct_name = lbound_%struct_name - !res%struct_name = node%elems(1)%struct_name res%struct_name = node%val%struct_name !print *, "struct_name = ", res%struct_name - !!print *, 'copying array' - !allocate(res%array) - !res%array = array - !!print *, 'done' - else write(*,*) err_int_prefix//'unexpected array kind'//color_reset call internal_error() diff --git a/src/parse.f90 b/src/parse.f90 index 3bfac875..ac63ae73 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -53,7 +53,6 @@ module syntran__parse_m ! ! This won't work with nested fns but we don't allow that anyway type(value_t) :: fn_type - !integer :: fn_type, fn_rank, fn_array_type character(len = :), allocatable :: fn_name logical :: returned From 1474a348461f119230ffb1d1a8623fac0b3a729f Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 19:47:51 -0400 Subject: [PATCH 132/137] more cleanup --- src/core.f90 | 2 ++ src/parse_fn.f90 | 14 ++------------ src/types.f90 | 29 +++++++---------------------- 3 files changed, 11 insertions(+), 34 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 48869a26..e98182fb 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -30,6 +30,8 @@ module syntran__core_m ! TODO: ! - structs + ! * TODO: make one last release on main before merging structs. bump + ! version to 0.0.49 ! * post-merge TODO struct items: ! + update struct sample. include struct/array combos, nesting, etc. ! maybe make separate simple and compound struct samples diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index 7be41e9b..e52e135c 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -557,11 +557,8 @@ module function parse_struct_declaration(parser) result(decl) pos0 = parser%current_pos() - !print *, 'matching name' name = parser%match(identifier_token) - !print *, "name = ", name%text call pos_mems%push( name%pos ) - !print *, 'matching colon' colon = parser%match(colon_token) call parser%parse_type(type_text, type) @@ -571,7 +568,7 @@ module function parse_struct_declaration(parser) result(decl) call names%push( name%text ) if (parser%current_kind() /= rbrace_token) then - !print *, 'matching comma' + ! Delimiting commas are required; trailing comma is optional comma = parser%match(comma_token) end if @@ -589,8 +586,6 @@ module function parse_struct_declaration(parser) result(decl) struct%num_vars = 0 allocate(struct%member_names%v( names%len_ )) - !allocate(struct%vars) - do i = 1, names%len_ !print *, "name = ", names%v(i)%s @@ -695,7 +690,6 @@ module function parse_struct_instance(parser) result(inst) !print *, "parser structs root = ", parser%structs%dict%root%split_char !print *, "parser structs root mid = ", parser%structs%dict%root%mid%split_char - !struct = parser%structs%search(identifier%text, struct_id, io) call parser%structs%search(identifier%text, struct_id, io, struct) !print *, "struct io = ", io @@ -713,10 +707,6 @@ module function parse_struct_instance(parser) result(inst) member_set = spread(.false., 1, struct%num_vars) - !if (allocated(inst%struct)) deallocate(inst%struct) - !allocate(inst%struct) - !inst%struct = struct - inst%struct_name = identifier%text inst%val%struct_name = identifier%text @@ -924,7 +914,7 @@ module subroutine parse_type(parser, type_text, type) type%array%type = itype else type%type = itype - if (allocated(type%array)) deallocate(type%array) + !if (allocated(type%array)) deallocate(type%array) end if if (itype == struct_type) type%struct_name = type_text diff --git a/src/types.f90 b/src/types.f90 index 910e1037..616759c6 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -343,14 +343,8 @@ recursive subroutine vars_copy(dst, src) !print *, 'starting vars_copy()' - !type vars_t - ! type(var_dict_t) :: dicts(scope_max) - ! type(value_t), allocatable :: vals(:) - ! integer :: scope = 1 - dst%scope = src%scope - !dst%dicts = src%dicts do i = 1, size(src%dicts) if (allocated(src%dicts(i)%root)) then if (.not. allocated(dst%dicts(i)%root)) allocate(dst%dicts(i)%root) @@ -407,8 +401,6 @@ recursive subroutine fn_copy(dst, src) !print *, 'starting fn_copy()' dst%type = src%type - !dst%array_type = src%array_type - !dst%rank = src%rank dst%variadic_min = src%variadic_min dst%variadic_type = src%variadic_type @@ -715,6 +707,8 @@ recursive subroutine syntax_node_copy(dst, src) if (allocated(src%struct_name)) then dst%struct_name = src%struct_name + else if (allocated(dst%struct_name)) then + deallocate(dst%struct_name) end if dst%expecting = src%expecting @@ -723,6 +717,8 @@ recursive subroutine syntax_node_copy(dst, src) !print *, 'allocated(src%first_expected) = ', allocated(src%first_expected) if (allocated(src%first_expected)) then dst%first_expected = src%first_expected + else if (allocated(dst%first_expected)) then + deallocate(dst%first_expected) end if dst%diagnostics = src%diagnostics @@ -777,13 +773,6 @@ recursive subroutine syntax_node_copy(dst, src) deallocate(dst%body) end if - !if (allocated(src%struct)) then - ! if (.not. allocated(dst%struct)) allocate(dst%struct) - ! dst%struct = src%struct - !else if (allocated(dst%struct)) then - ! deallocate(dst%struct) - !end if - if (allocated(src%array)) then if (.not. allocated(dst%array)) allocate(dst%array) dst%array = src%array @@ -913,25 +902,21 @@ recursive subroutine ternary_tree_copy(dst, src) if (allocated(src%val)) then if (.not. allocated(dst%val)) allocate(dst%val) dst%val = src%val - !call ternary_tree_copy(dst%val, src%val) end if if (allocated(src%left)) then if (.not. allocated(dst%left)) allocate(dst%left) - !dst%left = src%left - call ternary_tree_copy(dst%left, src%left) + dst%left = src%left end if if (allocated(src%mid)) then if (.not. allocated(dst%mid)) allocate(dst%mid) - !dst%mid = src%mid - call ternary_tree_copy(dst%mid, src%mid) + dst%mid = src%mid end if if (allocated(src%right)) then if (.not. allocated(dst%right)) allocate(dst%right) - !dst%right = src%right - call ternary_tree_copy(dst%right, src%right) + dst%right = src%right end if end subroutine ternary_tree_copy From 3221641f2810dd38a383460274c7e386dc36609d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Sun, 8 Sep 2024 20:07:41 -0400 Subject: [PATCH 133/137] final cleanup? --- src/types.f90 | 7 +++---- src/value.f90 | 31 ------------------------------- 2 files changed, 3 insertions(+), 35 deletions(-) diff --git a/src/types.f90 b/src/types.f90 index 616759c6..5643e1a4 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -448,6 +448,7 @@ recursive subroutine fn_ternary_tree_copy(dst, src) if (allocated(src%val)) then if (.not. allocated(dst%val)) allocate(dst%val) dst%val = src%val + ! TODO: else deallocate? Other tree copiers too end if if (allocated(src%left)) then @@ -1185,7 +1186,8 @@ integer function lookup_type(name, structs, struct) result(type) case default - !call parser%structs%search(identifier%text, struct_id, io, struct) + ! TODO: this should be able to use %exists instead of %search, + ! possible minor perf boost call structs%search(name, struct_id, io, struct) !print *, "struct search io = ", io @@ -2246,7 +2248,6 @@ recursive function struct_ternary_exists(node, key) result(exists) type(struct_ternary_tree_node_t), intent(in), allocatable :: node character(len = *), intent(in) :: key - !type(struct_t) :: val logical :: exists !******** @@ -2292,7 +2293,6 @@ end function struct_ternary_exists !=============================================================================== -!recursive function struct_ternary_search(node, key, id_index, iostat) result(val) recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) type(struct_ternary_tree_node_t), intent(in), allocatable :: node @@ -2351,7 +2351,6 @@ recursive subroutine struct_ternary_search(node, key, id_index, iostat, val) !print *, 'done struct_ternary_search' !print *, '' -!end function struct_ternary_search end subroutine struct_ternary_search !=============================================================================== diff --git a/src/value.f90 b/src/value.f90 index c595e221..7c65e557 100644 --- a/src/value.f90 +++ b/src/value.f90 @@ -60,9 +60,6 @@ module syntran__value_m type(string_t ), allocatable :: str(:) - !type(value_t), allocatable :: struct(:) - !type(value_t), pointer :: struct(:) - ! TODO: file arrays integer :: rank @@ -550,12 +547,9 @@ recursive function value_to_str(val) result(ans) !******** - !character(len = 16) :: buf16 - integer :: j integer(kind = 8) :: i8, j8, prod, n, nj - !type(string_vector_t) :: str_vec type(char_vector_t) :: str_vec !print *, "val type = ", kind_name(val%type) @@ -606,10 +600,6 @@ recursive function value_to_str(val) result(ans) ! strings str_vec = new_char_vector() - !if (val%array%type == struct_type) then - ! call str_vec%push(val%struct_name) - !end if - call str_vec%push('[') if (val%array%rank > 1) call str_vec%push(line_feed) @@ -725,38 +715,17 @@ recursive function value_to_str(val) result(ans) n = size(val%struct) do i8 = 1, n - ! Just recurse instead of nesting a loop call str_vec%push( val%struct(i8)%to_str() ) - - ! It would be nice to label each member with its name - - !call str_vec%push("{") - !nj = size(val%struct(i8)%struct) - !do j8 = 1, nj - ! call str_vec%push( trimw(val%struct(i8)%struct(j8)%to_str()) ) - ! if (j8 < nj) call str_vec%push(", ") - !end do - !if (i8 < n) call str_vec%push("}, ") - if (i8 < n) call str_vec%push(", ") - end do - !call str_vec%push("}") else ! Do *not* print anything in this function, as recursive IO will ! cause a hang - - !call str_vec%push(err_prefix//"array str conversion not" & - ! //" implemented for this type") call str_vec%push(err_prefix//""//color_reset) - !write(*,*) 'Error: array ans conversion not implemented' & - ! //' for this type' - !call internal_error() - end if if (val%array%rank > 1) call str_vec%push(line_feed) From 081e70a2aca91bc6e460c510df3e761ce12c978d Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 9 Sep 2024 20:12:19 -0400 Subject: [PATCH 134/137] comments --- src/core.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index e98182fb..435a65cf 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -29,9 +29,11 @@ module syntran__core_m syntran_patch = 48 ! TODO: + ! - add version summary as a text file to release packages + ! * doc. readme? samples? + ! * try -static-libgcc etc. on win/mac to ease packaging + ! * ship syntran.a static lib? don't know who would want that ! - structs - ! * TODO: make one last release on main before merging structs. bump - ! version to 0.0.49 ! * post-merge TODO struct items: ! + update struct sample. include struct/array combos, nesting, etc. ! maybe make separate simple and compound struct samples From c847e7f91fa80d639c78df81dd8cbdc531135434 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 9 Sep 2024 20:21:58 -0400 Subject: [PATCH 135/137] so there was something that i missed in that giant whitespace merge --- .github/workflows/main.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 97a6c3f2..a59642aa 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -303,9 +303,7 @@ ##{"compiler": "intel", "version": "2022.2"}, # ifx 2022.2 doesn't have `do while ()` :( {"compiler": "intel-classic", "version": "2021.10"}, - {"compiler": "intel-classic", "version": "2021.1"}, - - ##{"compiler": "nvidia-hpc", "version": "23.11"} # setup fails + #{"compiler": "intel-classic", "version": "2021.1"}, # complains about coarrays??? ] } }, @@ -405,7 +403,7 @@ mv /opt/homebrew/bin /opt/homebrew/bin-BACKUP || true \n mv /opt/homebrew/opt /opt/homebrew/opt-BACKUP || true \n mv /opt/homebrew/Cellar /opt/homebrew/Cellar-BACKUP || true \n - ls /opt/homebrew/ \n + #ls /opt/homebrew/ \n curl -LO \"https://github.com/JeffIrwin/syntran/releases/latest/download/syntran-macos.zip\" \n unzip syntran-macos*.zip \n From 2a34f7b59f438778ef25bdf72511930da6cb155b Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Mon, 9 Sep 2024 22:56:51 -0400 Subject: [PATCH 136/137] fix uninitialized `kind` --- src/core.f90 | 7 +++---- src/eval.f90 | 13 ++++++++++--- src/syntran.f90 | 8 +++++++- src/tests/test.f90 | 32 ++++++++++++++++---------------- src/types.f90 | 2 +- 5 files changed, 37 insertions(+), 25 deletions(-) diff --git a/src/core.f90 b/src/core.f90 index 35ac0d84..c3792ea2 100644 --- a/src/core.f90 +++ b/src/core.f90 @@ -218,10 +218,9 @@ module syntran__core_m !=============================================================================== -function declare_intrinsic_fns() result(fns) - ! TODO: this should be a subroutine to help with gfortran-13 +subroutine declare_intrinsic_fns(fns) - type(fns_t) :: fns + type(fns_t), intent(out) :: fns !******** @@ -740,7 +739,7 @@ function declare_intrinsic_fns() result(fns) any_fn & ] -end function declare_intrinsic_fns +end subroutine declare_intrinsic_fns !=============================================================================== diff --git a/src/eval.f90 b/src/eval.f90 index ae90e858..97c3a79d 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -20,7 +20,7 @@ module syntran__eval_m type(fns_t) :: fns - type(structs_t) :: structs + !type(structs_t) :: structs type(vars_t) :: vars @@ -53,7 +53,8 @@ recursive subroutine syntax_eval(node, state, res) integer :: i - !print *, 'starting syntax_eval()' + !print *, "starting syntax_eval()" + !print *, "node kind = ", kind_name(node%kind) if (node%is_empty) then !print *, 'returning' @@ -385,6 +386,7 @@ subroutine eval_dot_expr(node, state, res) type(value_t) :: val, tmp_val !print *, "eval dot_expr" + !print *, "id_index = ", node%id_index !print *, "struct[", str(i), "] = ", state%vars%vals(node%id_index)%struct(i)%to_str() ! This won't work for struct literal member access. It only works for @@ -535,6 +537,8 @@ recursive subroutine get_val(node, var, state, res, index_) integer :: id integer(kind = 8) :: i8, j8 + !print *, "get_val()" + if (allocated(node%lsubscripts) .and. allocated(node%member)) then if (present(index_)) then @@ -611,7 +615,9 @@ recursive subroutine get_val(node, var, state, res, index_) id = node%member%id_index if (node%member%kind == dot_expr) then - ! Recurse + ! Recurse. This branch was incorrectly entering sometimes because + ! `kind` was uninitialized, only on Windows in release build + !print *, "recursing" call get_val(node%member, var%struct(id), state, res) return end if @@ -619,6 +625,7 @@ recursive subroutine get_val(node, var, state, res, index_) ! Base case if (.not. allocated(node%member%lsubscripts)) then + !print *, "base" res = var%struct(id) return end if diff --git a/src/syntran.f90 b/src/syntran.f90 index 31ce9923..fb49c1b4 100644 --- a/src/syntran.f90 +++ b/src/syntran.f90 @@ -308,7 +308,7 @@ subroutine init_state(state) type(state_t), intent(inout) :: state - state%fns = declare_intrinsic_fns() + call declare_intrinsic_fns(state%fns) state%returned = .false. @@ -342,7 +342,9 @@ function syntran_eval(str_, quiet, src_file, chdir_) result(res) type(syntax_node_t) :: tree type(value_t) :: val + !print *, '' !print *, 'str_ = ', str_ + !print *, '' call init_state(state) state%quiet = .false. @@ -361,7 +363,9 @@ function syntran_eval(str_, quiet, src_file, chdir_) result(res) ! TODO: make a helper fn that all the eval_* fns use + !print *, "parsing" tree = syntax_parse(str_, state%vars, state%fns, src_filel) + !print *, "done" if (.not. state%quiet) call tree%log_diagnostics() if (tree%diagnostics%len_ > 0) then @@ -385,7 +389,9 @@ function syntran_eval(str_, quiet, src_file, chdir_) result(res) end if + !print *, "evaling " call syntax_eval(tree, state, val) + !print *, "done" res = val%to_str() !print *, 'res = ', res diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 97be8221..0a1bef77 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2458,7 +2458,7 @@ subroutine unit_test_struct(npass, nfail) character(len = *), parameter :: label = 'structs' - logical, parameter :: quiet = .true. + logical, parameter :: quiet = .false. logical, allocatable :: tests(:) write(*,*) 'Unit testing '//label//' ...' @@ -2467,56 +2467,56 @@ subroutine unit_test_struct(npass, nfail) [ & eval( 'struct D{y:i64, m:str, d:i32}' & ! 1 //'let d = D{y=i64(1912), m="Apr", d=14};' & - //'d.y;', quiet) == '1912', & + //'return d.y;', quiet) == '1912', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 2 //'let d = D{y=i64(1912), m="Apr", d=14};' & - //'d.m;', quiet) == 'Apr', & + //'return d.m;', quiet) == 'Apr', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 3 //'let d = D{y=i64(1912), m="Apr", d=14};' & - //'d.d;', quiet) == '14', & + //'return d.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 4 //'let d = D{y=i64(1900)+12, m="Apr", d=14};' & - //'d.y;', quiet) == '1912', & + //'return d.y;', quiet) == '1912', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 5 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & - //'let e=d; e.d;', quiet) == '14', & + //'let e=d; return e.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 6 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d;' & //'e = D{y=i64(1945), m="May", d=5*3};' & - //'e.d;', quiet) == '15', & + //'return e.d;', quiet) == '15', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 7 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d;' & //'e = D{y=i64(1945), m="May", d=5*3};' & - //'d.d;', quiet) == '14', & + //'return d.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 8 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = 42;' & //'x = d.d;' & - //'x;', quiet) == '14', & + //'return x;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 9 - //'let d = D{y=i64(1912), m="Apr", d=7*2};' & + //'let d = D{y=i64(1912), m="Apr", d=7*2}; ' & //'let x = d.y + 5;' & - //'x;', quiet) == '1917', & + //'return x;', quiet) == '1917', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 10 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = 6 + d.y;' & - //'x;', quiet) == '1918', & + //'return x;', quiet) == '1918', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 11 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.d = 18;' & - //'d.d;', quiet) == '18', & + //'return d.d;', quiet) == '18', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 12 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.d += 3;' & - //'d.d;', quiet) == '17', & + //'return d.d;', quiet) == '17', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 13 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & - //'d.m + "il";', quiet) == 'April', & + //'return d.m + "il";', quiet) == 'April', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 14 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & - //'"month " + d.m;', quiet) == 'month Apr', & + //'return "month " + d.m;', quiet) == 'month Apr', & eval( 'struct C{r:i32, g:i32, b:i32}' & ! 15 //'let c = C{r = 32, g = 64, b = 128};' & //'max(c.r, c.g);', quiet) == '64', & diff --git a/src/types.f90 b/src/types.f90 index 5643e1a4..d0252708 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -127,7 +127,7 @@ module syntran__types_m ! FIXME: when adding new members here, make sure to explicitly copy them ! in syntax_node_copy, or else assignment will yield bugs - integer :: kind + integer :: kind = 0 ! This structure could be more efficient. For example, unary ! expressions don't use left, name expressions don't use left or right, From 4cd3a7259d0033b3d3f80cef39d2af87236a6426 Mon Sep 17 00:00:00 2001 From: Jeff Irwin Date: Tue, 10 Sep 2024 19:34:19 -0400 Subject: [PATCH 137/137] revert test changes from 2a34f7b5. add 'recursive' because gfort complains with -fcheck=all --- src/eval.f90 | 24 ++++++++++++------------ src/parse.f90 | 22 +++++++++++----------- src/parse_array.f90 | 4 ++-- src/parse_control.f90 | 10 +++++----- src/parse_expr.f90 | 4 ++-- src/parse_fn.f90 | 2 +- src/parse_misc.f90 | 2 +- src/syntran.f90 | 2 +- src/tests/test.f90 | 32 ++++++++++++++++---------------- src/types.f90 | 2 +- 10 files changed, 52 insertions(+), 52 deletions(-) diff --git a/src/eval.f90 b/src/eval.f90 index 97c3a79d..b4b46198 100644 --- a/src/eval.f90 +++ b/src/eval.f90 @@ -144,7 +144,7 @@ end subroutine syntax_eval !=============================================================================== -subroutine eval_binary_expr(node, state, res) +recursive subroutine eval_binary_expr(node, state, res) type(syntax_node_t), intent(in) :: node @@ -237,7 +237,7 @@ end subroutine eval_binary_expr !=============================================================================== -subroutine eval_name_expr(node, state, res) +recursive subroutine eval_name_expr(node, state, res) type(syntax_node_t), intent(in) :: node @@ -702,7 +702,7 @@ end subroutine eval_struct_instance !=============================================================================== -subroutine eval_fn_call(node, state, res) +recursive subroutine eval_fn_call(node, state, res) type(syntax_node_t), intent(in) :: node @@ -1124,7 +1124,7 @@ end subroutine eval_fn_call !=============================================================================== -subroutine eval_for_statement(node, state, res) +recursive subroutine eval_for_statement(node, state, res) type(syntax_node_t), intent(in) :: node @@ -1304,7 +1304,7 @@ end subroutine eval_for_statement !=============================================================================== -subroutine eval_assignment_expr(node, state, res) +recursive subroutine eval_assignment_expr(node, state, res) type(syntax_node_t), intent(in) :: node @@ -1562,7 +1562,7 @@ end subroutine eval_translation_unit !=============================================================================== -subroutine eval_array_expr(node, state, res) +recursive subroutine eval_array_expr(node, state, res) type(syntax_node_t), intent(in) :: node @@ -1934,7 +1934,7 @@ end subroutine eval_array_expr !=============================================================================== -subroutine eval_while_statement(node, state, res) +recursive subroutine eval_while_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state @@ -1956,7 +1956,7 @@ end subroutine eval_while_statement !=============================================================================== -subroutine eval_if_statement(node, state, res) +recursive subroutine eval_if_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state @@ -1984,7 +1984,7 @@ end subroutine eval_if_statement !=============================================================================== -subroutine eval_return_statement(node, state, res) +recursive subroutine eval_return_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state @@ -2010,7 +2010,7 @@ end subroutine eval_return_statement !=============================================================================== -subroutine eval_block_statement(node, state, res) +recursive subroutine eval_block_statement(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state @@ -2061,7 +2061,7 @@ end subroutine eval_block_statement !=============================================================================== -subroutine eval_unary_expr(node, state, res) +recursive subroutine eval_unary_expr(node, state, res) type(syntax_node_t), intent(in) :: node type(state_t), intent(inout) :: state @@ -2419,7 +2419,7 @@ end function sub_eval !=============================================================================== -function subscript_eval(node, state) result(index_) +recursive function subscript_eval(node, state) result(index_) ! Evaluate subscript indices and convert a multi-rank subscript to a rank-1 ! subscript index_ diff --git a/src/parse.f90 b/src/parse.f90 index ac63ae73..7464c89d 100644 --- a/src/parse.f90 +++ b/src/parse.f90 @@ -108,7 +108,7 @@ module function parse_fn_declaration(parser) result(decl) type(syntax_node_t) :: decl end function parse_fn_declaration - module function parse_fn_call(parser) result(fn_call) + recursive module function parse_fn_call(parser) result(fn_call) class(parser_t) :: parser type(syntax_node_t) :: fn_call end function parse_fn_call @@ -138,7 +138,7 @@ end function parse_struct_instance interface ! Implemented in parse_array.f90 - module function parse_array_expr(parser) result(expr) + recursive module function parse_array_expr(parser) result(expr) class(parser_t) :: parser type(syntax_node_t) :: expr end function @@ -148,7 +148,7 @@ module function parse_size(parser) result(size) type(syntax_node_vector_t) :: size end function parse_size - module subroutine parse_subscripts(parser, expr) + recursive module subroutine parse_subscripts(parser, expr) class(parser_t) :: parser type(syntax_node_t), intent(inout) :: expr end subroutine parse_subscripts @@ -160,7 +160,7 @@ end subroutine parse_subscripts interface ! Implemented in parse_control.f90 - module function parse_if_statement(parser) result(statement) + recursive module function parse_if_statement(parser) result(statement) class(parser_t) :: parser type(syntax_node_t) :: statement end function parse_if_statement @@ -170,22 +170,22 @@ module function parse_return_statement(parser) result(statement) type(syntax_node_t) :: statement end function parse_return_statement - module function parse_for_statement(parser) result(statement) + recursive module function parse_for_statement(parser) result(statement) class(parser_t) :: parser type(syntax_node_t) :: statement end function parse_for_statement - module function parse_while_statement(parser) result(statement) + recursive module function parse_while_statement(parser) result(statement) class(parser_t) :: parser type(syntax_node_t) :: statement end function parse_while_statement - module function parse_block_statement(parser) result(block) + recursive module function parse_block_statement(parser) result(block) class(parser_t) :: parser type(syntax_node_t) :: block end function parse_block_statement - module function parse_statement(parser) result(statement) + recursive module function parse_statement(parser) result(statement) class(parser_t) :: parser type(syntax_node_t) :: statement end function parse_statement @@ -208,12 +208,12 @@ recursive module function parse_expr(parser, parent_prec) result(expr) type(syntax_node_t) :: expr end function parse_expr - module function parse_primary_expr(parser) result(expr) + recursive module function parse_primary_expr(parser) result(expr) class(parser_t) :: parser type(syntax_node_t) :: expr end function parse_primary_expr - module function parse_name_expr(parser) result(expr) + recursive module function parse_name_expr(parser) result(expr) class(parser_t) :: parser type(syntax_node_t) :: expr end function parse_name_expr @@ -241,7 +241,7 @@ module function match(parser, kind) result(token) type(syntax_token_t) :: token end function match - module subroutine preprocess(parser, tokens_in, src_file, contexts, unit_) + recursive module subroutine preprocess(parser, tokens_in, src_file, contexts, unit_) class(parser_t) :: parser type(syntax_token_t), intent(in) :: tokens_in(:) character(len = *), intent(in) :: src_file diff --git a/src/parse_array.f90 b/src/parse_array.f90 index 91bdb654..ef87e295 100644 --- a/src/parse_array.f90 +++ b/src/parse_array.f90 @@ -15,7 +15,7 @@ !=============================================================================== -module function parse_array_expr(parser) result(expr) +recursive module function parse_array_expr(parser) result(expr) ! These are the possible kinds of array literals: ! @@ -435,7 +435,7 @@ end function parse_array_expr !=============================================================================== -module subroutine parse_subscripts(parser, expr) +recursive module subroutine parse_subscripts(parser, expr) ! Parse array subscripts, if present diff --git a/src/parse_control.f90 b/src/parse_control.f90 index ccbe8f66..c121e515 100644 --- a/src/parse_control.f90 +++ b/src/parse_control.f90 @@ -76,7 +76,7 @@ end function parse_return_statement !=============================================================================== -module function parse_if_statement(parser) result(statement) +recursive module function parse_if_statement(parser) result(statement) class(parser_t) :: parser @@ -140,7 +140,7 @@ end function parse_if_statement !=============================================================================== -module function parse_for_statement(parser) result(statement) +recursive module function parse_for_statement(parser) result(statement) class(parser_t) :: parser @@ -247,7 +247,7 @@ end function parse_for_statement !=============================================================================== -module function parse_while_statement(parser) result(statement) +recursive module function parse_while_statement(parser) result(statement) class(parser_t) :: parser @@ -288,7 +288,7 @@ end function parse_while_statement !=============================================================================== -module function parse_block_statement(parser) result(block) +recursive module function parse_block_statement(parser) result(block) class(parser_t) :: parser @@ -339,7 +339,7 @@ end function parse_block_statement !=============================================================================== -module function parse_statement(parser) result(statement) +recursive module function parse_statement(parser) result(statement) class(parser_t) :: parser diff --git a/src/parse_expr.f90 b/src/parse_expr.f90 index a63028fe..a7bdbfe7 100644 --- a/src/parse_expr.f90 +++ b/src/parse_expr.f90 @@ -372,7 +372,7 @@ end function parse_expr !=============================================================================== -module function parse_primary_expr(parser) result(expr) +recursive module function parse_primary_expr(parser) result(expr) class(parser_t) :: parser @@ -503,7 +503,7 @@ end function parse_primary_expr !=============================================================================== -module function parse_name_expr(parser) result(expr) +recursive module function parse_name_expr(parser) result(expr) class(parser_t) :: parser diff --git a/src/parse_fn.f90 b/src/parse_fn.f90 index e52e135c..bc076572 100644 --- a/src/parse_fn.f90 +++ b/src/parse_fn.f90 @@ -15,7 +15,7 @@ !=============================================================================== -module function parse_fn_call(parser) result(fn_call) +recursive module function parse_fn_call(parser) result(fn_call) class(parser_t) :: parser diff --git a/src/parse_misc.f90 b/src/parse_misc.f90 index 700efe53..bb54e009 100644 --- a/src/parse_misc.f90 +++ b/src/parse_misc.f90 @@ -113,7 +113,7 @@ end function match !=============================================================================== -module subroutine preprocess(parser, tokens_in, src_file, contexts, unit_) +recursive module subroutine preprocess(parser, tokens_in, src_file, contexts, unit_) ! src_file is the filename of the current file being processed, i.e. the ! *includer*, not the includee diff --git a/src/syntran.f90 b/src/syntran.f90 index fb49c1b4..1690051b 100644 --- a/src/syntran.f90 +++ b/src/syntran.f90 @@ -344,7 +344,6 @@ function syntran_eval(str_, quiet, src_file, chdir_) result(res) !print *, '' !print *, 'str_ = ', str_ - !print *, '' call init_state(state) state%quiet = .false. @@ -397,6 +396,7 @@ function syntran_eval(str_, quiet, src_file, chdir_) result(res) ! popd if (chdirl) call chdir(cwd) + !print *, "done syntran_eval()" end function syntran_eval diff --git a/src/tests/test.f90 b/src/tests/test.f90 index 0a1bef77..97be8221 100644 --- a/src/tests/test.f90 +++ b/src/tests/test.f90 @@ -2458,7 +2458,7 @@ subroutine unit_test_struct(npass, nfail) character(len = *), parameter :: label = 'structs' - logical, parameter :: quiet = .false. + logical, parameter :: quiet = .true. logical, allocatable :: tests(:) write(*,*) 'Unit testing '//label//' ...' @@ -2467,56 +2467,56 @@ subroutine unit_test_struct(npass, nfail) [ & eval( 'struct D{y:i64, m:str, d:i32}' & ! 1 //'let d = D{y=i64(1912), m="Apr", d=14};' & - //'return d.y;', quiet) == '1912', & + //'d.y;', quiet) == '1912', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 2 //'let d = D{y=i64(1912), m="Apr", d=14};' & - //'return d.m;', quiet) == 'Apr', & + //'d.m;', quiet) == 'Apr', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 3 //'let d = D{y=i64(1912), m="Apr", d=14};' & - //'return d.d;', quiet) == '14', & + //'d.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 4 //'let d = D{y=i64(1900)+12, m="Apr", d=14};' & - //'return d.y;', quiet) == '1912', & + //'d.y;', quiet) == '1912', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 5 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & - //'let e=d; return e.d;', quiet) == '14', & + //'let e=d; e.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 6 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d;' & //'e = D{y=i64(1945), m="May", d=5*3};' & - //'return e.d;', quiet) == '15', & + //'e.d;', quiet) == '15', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 7 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let e=d;' & //'e = D{y=i64(1945), m="May", d=5*3};' & - //'return d.d;', quiet) == '14', & + //'d.d;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 8 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = 42;' & //'x = d.d;' & - //'return x;', quiet) == '14', & + //'x;', quiet) == '14', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 9 - //'let d = D{y=i64(1912), m="Apr", d=7*2}; ' & + //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = d.y + 5;' & - //'return x;', quiet) == '1917', & + //'x;', quiet) == '1917', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 10 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'let x = 6 + d.y;' & - //'return x;', quiet) == '1918', & + //'x;', quiet) == '1918', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 11 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.d = 18;' & - //'return d.d;', quiet) == '18', & + //'d.d;', quiet) == '18', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 12 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & //'d.d += 3;' & - //'return d.d;', quiet) == '17', & + //'d.d;', quiet) == '17', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 13 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & - //'return d.m + "il";', quiet) == 'April', & + //'d.m + "il";', quiet) == 'April', & eval( 'struct D{y:i64, m:str, d:i32}' & ! 14 //'let d = D{y=i64(1912), m="Apr", d=7*2};' & - //'return "month " + d.m;', quiet) == 'month Apr', & + //'"month " + d.m;', quiet) == 'month Apr', & eval( 'struct C{r:i32, g:i32, b:i32}' & ! 15 //'let c = C{r = 32, g = 64, b = 128};' & //'max(c.r, c.g);', quiet) == '64', & diff --git a/src/types.f90 b/src/types.f90 index d0252708..72db533d 100644 --- a/src/types.f90 +++ b/src/types.f90 @@ -1218,7 +1218,7 @@ end function new_syntax_node_vector !=============================================================================== -subroutine syntax_nodes_copy(dst, src) +recursive subroutine syntax_nodes_copy(dst, src) ! Array copy