Browse Source

DrakonLua and DrakonJS: improved variable detection

stepan-mitkin 9 months ago
parent
commit
f52e727640
4 changed files with 94 additions and 44 deletions
  1. BIN
      generators/lua.drn
  2. 0 16
      generators/lua.tcl
  3. 83 28
      scripts/generators.tcl
  4. 11 0
      scripts/utils.tcl

BIN
generators/lua.drn


+ 0 - 16
generators/lua.tcl

@@ -103,8 +103,6 @@ proc build_handler { gdb name states message params_str output } {
                 "${in2}return ${method}($params_str\)"
                 #item 2177
                 set keyword "elseif"
-            } else {
-                
             }
         }
     }
@@ -203,8 +201,6 @@ proc extract_signature { text name } {
             if {$is_handler} {
                 #item 1862
                 lappend parameters "self"
-            } else {
-                
             }
             #item 34
             set count [ llength $lines ]
@@ -352,8 +348,6 @@ proc generate_kernel { db gdb filename is_clean } {
             #item 2124
             extract_variables $gdb $diagram_id
             gen::rewrite_clean $gdb $diagram_id $keys
-        } else {
-            
         }
         #item 1809
         gen::fix_graph_for_diagram $gdb $callbacks 0 $diagram_id
@@ -481,8 +475,6 @@ proc highlight { tokens } {
                                 if {$text == "\n"} {
                                     #item 2006
                                     set state "idle"
-                                } else {
-                                    
                                 }
                             }
                         }
@@ -534,8 +526,6 @@ proc highlight { tokens } {
                                 if {$text == "\n"} {
                                     #item 2022
                                     set state "idle"
-                                } else {
-                                    
                                 }
                             }
                         }
@@ -549,8 +539,6 @@ proc highlight { tokens } {
         #item 2085
         lappend result \
          $colors::syntax_operator
-    } else {
-        
     }
     #item 1934
     return $result
@@ -873,8 +861,6 @@ proc print_function { fhandle function } {
         if {$access == "local"} {
             #item 1580
             append line "local "
-        } else {
-            
         }
         #item 1581
         append line "function "
@@ -1032,8 +1018,6 @@ proc split_vars { $item_id var_list } {
     if {$result == {}} {
         #item 1662
         error "Bad variable list in $item_id"
-    } else {
-        
     }
     #item 1654
     return $result

+ 83 - 28
scripts/generators.tcl

@@ -521,41 +521,74 @@ proc get_clean_type { text } {
 }
 
 proc has_operator_chars { text } {
-	set map {, . \[ . \] . \( . \) . \" . \' . \{ . \} .}
+	set map {\[ . \] . \( . \) . \" . \' . \{ . \} .}
 	set mapped [ string map $map $text ]
 	set pattern "*\\.*"
 	return [string match $pattern $mapped ]
 }
 
-proc get_variable_name { line var_keyword } {
-	
+proc get_variables_from_line { line var_keyword } {
+
 	set parts [ split $line "=" ]
-	if { [ llength $parts ] < 2 } {
-		return ""
+
+	if { [ llength $parts ] == 1 } {
+		return [ extract_declarations_only $line $var_keyword ]
+	} else {
+		set first [ lindex $parts 0 ]
+		set first [ string trim $first ]		
+		if { ![has_operator_chars $first ] } {
+			return [ extract_declarations_or_use $first $var_keyword ]
+		}		
 	}
 	
-	set first [ lindex $parts 0 ]
-	set first [ string trim $first ]
+	return { {} {} }
+}
 
-	if { [has_operator_chars $first ] } {
-		return ""
-	}	
+proc extract_declarations_only { first var_keyword } {
+	set result [ extract_declarations_or_use $first $var_keyword ]
+	lassign $result dec used
+	if { $dec == "" } {
+		return { {} {} }
+	}
 	
+	return $result
+}
+		
 	
-	if {[llength $first ] > 1} {
-		return ""
+proc extract_declarations_or_use { first var_keyword } {
+	set names {}
+	set has_declaration 0
+	
+	set parts [ split $first "," ]
+	foreach part $parts {
+		set subs [ split_by_whitespace $part ]
+		if { [ llength $subs ] == 1} {
+			lappend names [ lindex $subs 0 ]
+		} else {
+			lassign $subs left right
+			if {$left == $var_keyword } {
+				lappend names $right
+				set has_declaration 1
+			}
+		}
 	}
 	
-	return $first	
+	if { $has_declaration } {
+		return [ list $names {} ]
+	} else {
+		return [ list {} $names ]
+	}
 }
 
-proc get_variables_from_item { text var_keyword } {
-	set result {}
-	set lines [ get_trimmed_lines $text ]
-	foreach line $lines {
-		set var_name [ get_variable_name $line $var_keyword ]
-		if { $var_name != "" } {
-			lappend result $var_name
+proc strip_declaration { text var_keyword } {
+	set parts [ split $text ]
+	set result ""
+	foreach part $parts {
+		if { $part == $var_keyword } {
+			return ""
+		}
+		if { $part != "" } {
+			set result $part
 		}
 	}
 	return $result
@@ -678,7 +711,7 @@ proc rewrite_clean { gdb diagram_id field_ass } {
 }
 
 proc extract_variables { gdb diagram_id var_keyword } {	
-	set res  [get_variables_from_diagram $gdb $diagram_id $var_keyword]
+	set res [get_variables_from_diagram $gdb $diagram_id $var_keyword]
 	return $res
 }
 
@@ -688,8 +721,7 @@ proc get_original { gdb diagram_id } {
 	return $original_id
 }
 
-proc get_variables_from_diagram { gdb diagram_id var_keyword } {
-	
+proc get_actions { gdb diagram_id } {
 	set original_id [ get_original $gdb $diagram_id ]
 	if { $original_id == "" } {
 		set did $diagram_id
@@ -709,16 +741,39 @@ proc get_variables_from_diagram { gdb diagram_id var_keyword } {
 			and (items.type = 'action' or items.type = 'loopstart')
 		} ]
 	}
+	return [list $actions $did]
+}
+	
+proc get_action_lines { gdb diagram_id } {
+	lassign [ get_actions $gdb $diagram_id ] actions did
 
-	set variables {}
+	set result {}
 	foreach item_id $actions {
 		set text [get_item_text $gdb $did $item_id]
-		set vars [ get_variables_from_item $text $var_keyword ]
-		set variables [ concat $variables $vars ]
+		set lines [ split $text "\n" ]
+		foreach line $lines {
+			set line [ string trim $line ]
+			if { $line != "" } {
+				lappend result $line
+			}
+		}
 	}
 	
-	set vars_final [lsort -unique $variables ]
-	return $vars_final
+	return $result
+}	
+
+proc get_variables_from_diagram { gdb diagram_id var_keyword } {
+	set declared {}
+	set used {}
+	set lines [ get_action_lines $gdb $diagram_id ]
+	foreach line $lines {
+		lassign [ get_variables_from_line $line $var_keyword ] dec use
+		set declared [ concat $declared $dec ]
+		set used [ concat $used $use ]
+	}
+	set used [ lsort -unique $used ]
+	set used2 [ subtract $used $declared ]
+	return $used2
 }
 
 proc fix_graph_for_diagram { gdb callbacks append_semicolon diagram_id } {

+ 11 - 0
scripts/utils.tcl

@@ -1017,6 +1017,17 @@ proc subtract { from what } {
 	return $output
 }
 
+proc split_by_whitespace { text } {
+	set result {}
+	set parts [ split $text ]
+	foreach part $parts {
+		if { $part != "" } {
+			lappend result $part
+		}
+	}
+	return $result
+}	
+
 proc clear_tree { tree parent } {
 	set children [ $tree children $parent ]
 	foreach child $children {