Posted to tcl by mjanssen at Thu Oct 08 12:27:49 GMT 2020view raw

  1. proc tokenize {script} {
  2. #puts [lindex [info level 0] 0]
  3. set ctxt(rest) [split $script {}]
  4. set ctxt(parsed) {}
  5. set ctxt(currentCmd) {}
  6. while {$ctxt(rest) ne {}} {
  7. tokenizeCommentOrCommand ctxt
  8. }
  9. return $ctxt(parsed)
  10. }
  11.  
  12. proc handleContinuation {ctxtVar} {
  13.  
  14. upvar $ctxtVar ctxt
  15. lassign $ctxt(rest) char next
  16. if {$char eq "\\" && $next eq "\n"} {
  17. #puts [lindex [info level 0] 0]
  18. lset ctxt(rest) 1 " "
  19. set ctxt(rest) [lrange $ctxt(rest) 1 end]
  20. dropSpace ctxt
  21. }
  22. }
  23.  
  24. proc dropSpace {ctxtVar} {
  25. #puts [lindex [info level 0] 0]
  26. upvar $ctxtVar ctxt
  27. while {1} {
  28. set new [lassign $ctxt(rest) char]
  29. if {[string is space $char] && $char ne {}} {
  30. set ctxt(rest) $new
  31. continue
  32. }
  33. break
  34. }
  35. }
  36.  
  37. proc tokenizeCommentOrCommand {ctxtVar} {
  38. #puts [lindex [info level 0] 0]
  39. upvar $ctxtVar ctxt
  40. # parray ctxt
  41. while {1} {
  42. dropSpace ctxt
  43. handleContinuation ctxt
  44. lassign $ctxt(rest) char
  45. if {$char eq "#"} {
  46. tokenizeComment ctxt
  47. } else {
  48. tokenizeCommand ctxt
  49. }
  50. return
  51. }
  52. }
  53.  
  54. proc tokenizeComment {ctxtVar} {
  55. #puts [lindex [info level 0] 0]
  56. upvar $ctxtVar ctxt
  57. set comment {}
  58. while {1} {
  59. handleContinuation ctxt
  60. set ctxt(rest) [lassign $ctxt(rest) char]
  61. if {$char eq "\n" || $char eq {}} {
  62. lappend ctxt(parsed) [list comment $comment]
  63. return
  64. }
  65. append comment $char
  66. }
  67. }
  68.  
  69.  
  70. proc tokenizeWord {ctxtVar} {
  71. #puts [lindex [info level 0] 0]
  72. upvar $ctxtVar ctxt
  73.  
  74. set word {}
  75.  
  76. # expand ?
  77. if {[join [lrange $ctxt(rest) 0 3] {}] eq "{*}" && ![string is space [lindex $ctxt(rest) 4]]} {
  78. append word "{*}"
  79. set ctxt(rest) [lrange $ctxt(rest) 0 3]
  80. }
  81. if {[string is space [lindex $ctxt(rest) 0 ]]} {
  82. error "Unexpected space at start of word"
  83. }
  84. set ctxt(rest) [lassign $ctxt(rest) char]
  85. append word $char
  86. switch -exact $char {
  87. "\{" {append word [tokenizeBraceWord ctxt]}
  88. "\"" {append word [tokenizeQuoteWord ctxt]}
  89. "\[" {append word [tokenizeSubstWord ctxt]}
  90. default {append word [tokenizeBareWord ctxt]}
  91. }
  92. lappend ctxt(currentCmd) $word
  93.  
  94. }
  95.  
  96. proc tokenizeCommand {ctxtVar} {
  97. #puts [lindex [info level 0] 0]
  98. upvar $ctxtVar ctxt
  99. # parray ctxt
  100. set ctxt(currentCmd) {}
  101. set word {}
  102. while {1} {
  103. set new [lassign $ctxt(rest) char]
  104. if {$char eq "\n" || $char eq {}} {
  105. if {[llength $ctxt(currentCmd)] > 0} {
  106. lappend ctxt(parsed) [list command $ctxt(currentCmd)]
  107. }
  108. set ctxt(rest) $new
  109. return
  110. }
  111. dropSpace ctxt
  112. handleContinuation ctxt
  113. tokenizeWord ctxt
  114. }
  115. }
  116.  
  117. proc tokenizeQuoteWord {ctxtVar} {
  118. #puts [lindex [info level 0] 0]
  119. upvar $ctxtVar ctxt
  120. set word {}
  121. while {1} {
  122. handleContinuation ctxt
  123. set ctxt(rest) [lassign $ctxt(rest) char]
  124. append word $char
  125. if {$char eq "\\"} {
  126. set ctxt(rest) [lassign $ctxt(rest) char]
  127. append word $char
  128. continue
  129. }
  130. if {$char eq "\""} {
  131. break
  132. }
  133. }
  134. return $word
  135. }
  136.  
  137. proc tokenizeBraceWord {ctxtVar} {
  138. #puts [lindex [info level 0] 0]
  139. upvar $ctxtVar ctxt
  140. set word {}
  141. while {1} {
  142. handleContinuation ctxt
  143. set ctxt(rest) [lassign $ctxt(rest) char]
  144. append word $char
  145. if {$char eq "\\"} {
  146. set ctxt(rest) [lassign $ctxt(rest) char]
  147. append word $char
  148. continue
  149. }
  150. if {$char eq "\}"} {
  151. break
  152. }
  153. }
  154. return $word
  155. }
  156.  
  157. proc tokenizeSubstWord {ctxtVar} {
  158. #puts [lindex [info level 0] 0]
  159. upvar $ctxtVar ctxt
  160. set word {}
  161. while {1} {
  162. handleContinuation ctxt
  163. set ctxt(rest) [lassign $ctxt(rest) char]
  164. append word $char
  165. if {$char eq "\]"} {
  166. break
  167. }
  168. }
  169. return $word
  170. }
  171.  
  172. proc tokenizeBareWord {ctxtVar} {
  173. #puts [lindex [info level 0] 0]
  174. upvar $ctxtVar ctxt
  175. set word {}
  176. while {1} {
  177. handleContinuation ctxt
  178. set ctxt(rest) [lassign $ctxt(rest) char]
  179. if {$char eq "\\"} {
  180. set ctxt(rest) [lassign $ctxt(rest) char]
  181. append word $char
  182. continue
  183. }
  184. if {[string is space $char]} {
  185. break
  186. }
  187. append word $char
  188. }
  189. return $word
  190. }