From 5c47f3b97ff0fbeafab4dd585c64dde45117b8c7 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 8 Aug 2026 15:47:50 +1000 Subject: [PATCH] bootsupport promotion: G-176 coherent set + make.tcl libunknown guard follow-on Release-step-(9) commit of the src/bootsupport refresh (user-run 'make.tcl bootsupport'): commandstack 0.7.1->0.8.0, punk 0.2.8->0.3.0, ansi 0.2.0->0.2.1, args 0.18.0->0.25.2, moduledoc tclcore 0.4.0->0.4.2, libunknown 0.2.4->0.3.1, ns 0.9.3->0.11.0 - all seven verified byte-identical to the minted modules/ tree. make.tcl regains committed provenance for the tooling it boots from; the staleness gate is satisfied by committed content again. With it, at the G-176 follow-on's own due point ("before or with the bootsupport/kit promotion"): the libunknown skip-guard swapped from 'info commands ::punk::libunknown::package' (a proc the 0.3.x commandstack-managed install no longer creates) to a 'package provide punk::libunknown' probe - satisfied by every vintage's boot-site source (verified in 0.2.4 and 0.3.1; tclsh-driven boot smoke green). Disposition flipped to landed in the archived goal; goals_lint clean. No project bump: promoted content already versioned (0.63.0-0.65.0 arc), guard swap is interface/output-unchanged make tooling internals. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- .../G-176-commandstack-doc-integration.md | 2 +- ...ndstack-0.7.1.tm => commandstack-0.8.0.tm} | 157 +++- .../modules/{punk-0.2.8.tm => punk-0.3.0.tm} | 293 ++++++- .../punk/{ansi-0.2.0.tm => ansi-0.2.1.tm} | 8 +- .../punk/{args-0.18.0.tm => args-0.25.2.tm} | 810 ++++++++++++++++-- .../{tclcore-0.4.0.tm => tclcore-0.4.2.tm} | 39 +- ...ibunknown-0.2.4.tm => libunknown-0.3.1.tm} | 136 ++- .../punk/{ns-0.9.3.tm => ns-0.11.0.tm} | 300 +++++-- src/make.tcl | 13 +- 9 files changed, 1544 insertions(+), 214 deletions(-) rename src/bootsupport/modules/{commandstack-0.7.1.tm => commandstack-0.8.0.tm} (89%) rename src/bootsupport/modules/{punk-0.2.8.tm => punk-0.3.0.tm} (96%) rename src/bootsupport/modules/punk/{ansi-0.2.0.tm => ansi-0.2.1.tm} (99%) rename src/bootsupport/modules/punk/{args-0.18.0.tm => args-0.25.2.tm} (94%) rename src/bootsupport/modules/punk/args/moduledoc/{tclcore-0.4.0.tm => tclcore-0.4.2.tm} (99%) rename src/bootsupport/modules/punk/{libunknown-0.2.4.tm => libunknown-0.3.1.tm} (93%) rename src/bootsupport/modules/punk/{ns-0.9.3.tm => ns-0.11.0.tm} (95%) diff --git a/goals/archive/G-176-commandstack-doc-integration.md b/goals/archive/G-176-commandstack-doc-integration.md index f2eefeb5..18545010 100644 --- a/goals/archive/G-176-commandstack-doc-integration.md +++ b/goals/archive/G-176-commandstack-doc-integration.md @@ -222,4 +222,4 @@ Increments land as separate commits, each leaving all suites green: ## Follow-ons Follow-on: boot-site commandstack pre-sourcing - punkboot core.tcl, make.tcl, punk::repl's two boot blocks and punk::lib's interp_sync child-seeding all pre-source LIBUNKNOWN by path expressly to avoid triggering the old package unknown pre-init; libunknown 0.3.x init's 'package require commandstack 0.8-' resolves in all of them but performs one ordinary unknown-path resolution pre-init when commandstack is not yet provided (a root-depth sibling scan lands in 'untracked' - functional, marginally looser epoch bookkeeping; in punkshell app boot packagepreference::install provides commandstack first so the require is a no-op there); extending the same glob+source technique to commandstack-*.tm at those sites would preserve the minimal-untracked intent exactly => open -Follow-on: make.tcl skip-guard modernization - the 'info commands ::punk::libunknown::package' check that skips re-load when make.tcl is driven by a built punk shell tests a proc the 0.3.x commandstack install no longer creates; old kits (0.2.4) still satisfy it so nothing breaks today, but once kits carry 0.3.x the check never fires and make.tcl re-sources libunknown into the driving shell (harmless - init's stack-query guard no-ops - but noisy and wasteful); switch it to a package-provide check before or with the bootsupport/kit promotion of libunknown 0.3.x + commandstack 0.8.0 => open +Follow-on: make.tcl skip-guard modernization - the 'info commands ::punk::libunknown::package' check that skips re-load when make.tcl is driven by a built punk shell tests a proc the 0.3.x commandstack install no longer creates; old kits (0.2.4) still satisfy it so nothing breaks today, but once kits carry 0.3.x the check never fires and make.tcl re-sources libunknown into the driving shell (harmless - init's stack-query guard no-ops - but noisy and wasteful); switch it to a package-provide check before or with the bootsupport/kit promotion of libunknown 0.3.x + commandstack 0.8.0 => landed 2026-08-08 (make.tcl guard swapped to 'package provide punk::libunknown' in the same commit as the bootsupport promotion of libunknown 0.3.1 + commandstack 0.8.0; both vintages' boot-site source executes the provide, verified against 0.2.4 and 0.3.1) diff --git a/src/bootsupport/modules/commandstack-0.7.1.tm b/src/bootsupport/modules/commandstack-0.8.0.tm similarity index 89% rename from src/bootsupport/modules/commandstack-0.7.1.tm rename to src/bootsupport/modules/commandstack-0.8.0.tm index c78a6c8a..f49fcbb8 100644 --- a/src/bootsupport/modules/commandstack-0.7.1.tm +++ b/src/bootsupport/modules/commandstack-0.8.0.tm @@ -107,6 +107,30 @@ namespace eval commandstack { } } +namespace eval commandstack::stackdocs { + #Doc blocks attached by 'rename_command -punkargs' for LIVE stack records + #(G-176): PUNKARGS mirrors those records' punk::args definitionlists so a + #punk::args that loads AFTER the renames (early-boot renames precede it) + #picks them up lazily via the ::punk::args::register::NAMESPACES mechanism. + #Maintained by rename_command (attach) and remove_rename (detach - every + #removal path funnels through it). Guarded per the reload contract. + variable PUNKARGS + if {![info exists PUNKARGS]} { + set PUNKARGS [list] + } +} +namespace eval ::punk::args::register { + #inert registration - consumed if/when punk::args loads (idempotent across + #re-source; punk::args need not be present) + variable NAMESPACES + if {![info exists NAMESPACES]} { + set NAMESPACES [list] + } + if {"::commandstack::stackdocs" ni $NAMESPACES} { + lappend NAMESPACES ::commandstack::stackdocs + } +} + namespace eval commandstack::util { #note - we can't use something like md5 to ID proc body text because we don't want to require additional packages. #We could store the full text of the body to compare - but we need to identify magic strings from cooperating packages such as packageTrace @@ -220,6 +244,22 @@ namespace eval commandstack { commandstack::next {*}$args The record also carries a trailing did_rename 0|1 verdict. + set record [commandstack::rename_command -renamer -punkargs ] + As above, additionally attaching punk::args doc blocks to the stack + record - each element is one definitionlist exactly as + given to punk::args::define (e.g documenting a subcommand the + override adds, with a space-form id such as {::package epoch}). + The docs are live while the record is on the stack and are removed + with it by ANY removal path (remove_rename, pop_rename, + remove_renamer, restore_original). Renames performed BEFORE + punk::args loads are supported: definitions are mirrored in the + registered ::commandstack::stackdocs namespace and load lazily with + punk::args; when punk::args is already loaded they are defined + immediately. Use one live record per doc id - same-id declarations + in two records shadow each other, and removing either removes the + doc. The record carries the attached deflists under a trailing + punkargs key. + commandstack::remove_rename Undo a rename. Accepts the token from the rename record ([dict get $record token] = { }), @@ -268,8 +308,9 @@ namespace eval commandstack { `i commandstack::rename_command` in punkshell, or `punk::args::usage ::commandstack::rename_command` when punk::args is loaded. - In-tree users: punk::packagepreference, punk::nav::fs, punk (auto_execok), - packagetrace, packagesuppress. + In-tree users: punk::packagepreference, punk::libunknown (the ::package + epoch/forget override), punk::nav::fs, punk (auto_execok), packagetrace, + packagesuppress. } } @@ -458,6 +499,7 @@ namespace eval commandstack { Returns the new stack record - a dict with keys: token renamer next_implementor next_getter implementation did_rename + (plus a trailing punkargs key when -punkargs was given). The tokenid (third token element) is unique and monotonic per (renamer, command) pairing, so repeat renames by the same renamer are individually addressable. When no rename was @@ -475,8 +517,28 @@ namespace eval commandstack { "Identity string recorded for this rename - defaults to the calling namespace. Cooperating packages use their package/namespace name. Note: this flag is recognised - only as the FIRST argument (manual parse) - appearing - in any later position is an error." + only in the leading option positions (manual parse) - + appearing after the positional arguments begin is an + error." + -punkargs -type list -optional 1 -typesynopsis {list-of-definitionlists} -help -& + "punk::args doc blocks attached to this rename's stack + record - each element is one definitionlist exactly as + given to punk::args::define (e.g documenting a + subcommand the override adds, with a space-form id + such as {::package epoch}). The docs are live while + the record is on the stack and are removed with it by + ANY removal path (remove_rename, pop_rename, + remove_renamer, restore_original). Renames performed + BEFORE punk::args loads are supported: the definitions + are mirrored in the registered + ::commandstack::stackdocs namespace and load lazily + with punk::args (keep such deflists free of + dollar-brace tstr substitutions needing your own + namespace context - the lazy load evaluates them in + the stackdocs namespace). + Use one live record per doc id: same-id declarations + in two records shadow each other. Recognised only in + the leading option positions, like -renamer." @values -min 3 -max 3 command -type string -help -& "Command to rename (resolved with 'namespace which' in @@ -493,18 +555,31 @@ namespace eval commandstack { #todo: consider -forcebase 1 or similar to allow this rename to point to bottom of stack (original command) bypassing existing renames # - need to consider that upon removing, that any remaining rename that was higher on the stack should not also be diverted to the base - but rather to the next lower in the stack # - if {[lindex $args 0] eq "-renamer"} { - set renamer [lindex $args 1] - set arglist [lrange $args 2 end] - } else { - set renamer "" - set arglist $args + set renamer "" + set punkargs_defs [list] + set arglist $args + while {[llength $arglist] > 3 && [string match -* [lindex $arglist 0]]} { + switch -- [lindex $arglist 0] { + -renamer { + set renamer [lindex $arglist 1] + set arglist [lrange $arglist 2 end] + } + -punkargs { + set punkargs_defs [lindex $arglist 1] + set arglist [lrange $arglist 2 end] + } + default { + error "commandstack::rename_command unrecognised leading option '[lindex $arglist 0]'. usage: rename_command ?-renamer ? ?-punkargs ? command procargs procbody" + } + } } - if {"-renamer" in $arglist} { - error "commandstack::rename_command -renamer is recognised only as the leading argument. usage: rename_command ?-renamer ? command procargs procbody" + foreach opt {-renamer -punkargs} { + if {$opt in $arglist} { + error "commandstack::rename_command $opt is recognised only in the leading option positions. usage: rename_command ?-renamer ? ?-punkargs ? command procargs procbody" + } } if {[llength $arglist] != 3} { - error "commandstack::rename_command usage: rename_command ?-renamer ? command procargs procbody" + error "commandstack::rename_command usage: rename_command ?-renamer ? ?-punkargs ? command procargs procbody" } lassign $arglist command procargs procbody @@ -646,6 +721,12 @@ namespace eval commandstack { } return [dict create implementation "" did_rename 0] } + if {[llength $punkargs_defs]} { + #additive key - appended after the leading key-order contract keys + #(token idx 0-1, renamer idx 2-3); docs attach only for a rename + #that actually lands (aborted renames returned above) + dict set new_record punkargs $punkargs_defs + } catch {rename ::commandstack::temp::testproc ""} set nextinit [string map [list %command% $command %renamer% $renamer %next_getter% [dict get $new_record next_getter] %original_implementation% [dict get $new_record implementation]] { #IMPLEMENTOR_%renamer%! (mechanism: 'commandstack::rename_command -renamer %renamer% %command% ) @@ -661,10 +742,52 @@ namespace eval commandstack { uplevel 1 [list rename ::commandstack::temp::testproc $command] dict lappend all_stacks $command $new_record dict set token_implementations [dict get $nextinfo token] [dict get $nextinfo next_target] + if {[llength $punkargs_defs]} { + Stackdocs_attach $punkargs_defs + } return $new_record } + #G-176: doc blocks attached to stack records via 'rename_command -punkargs'. + #Attach appends each definitionlist to the commandstack::stackdocs PUNKARGS + #mirror (consumed lazily if punk::args loads later - the namespace is + #registered inert at module load) and defines immediately when punk::args + #is already present (a namespace already consumed into punk::args' + #loaded_packages never lazy-loads later appends; redefining an unchanged id + #is idempotent - a define error surfaces to the rename_command caller with + #the rename already installed, inspectable via show_stack). Detach removes + #ONE mirror occurrence per deflist and undefines via + #punk::args::undefine_deflist (deflist-keyed; silently skips never-defined + #deflists). One live record per doc id is the supported shape - two records + #declaring the same id shadow each other and removing either removes the + #doc. + proc Stackdocs_attach {deflists} { + foreach deflist $deflists { + lappend ::commandstack::stackdocs::PUNKARGS $deflist + if {[llength [info commands ::punk::args::define]]} { + punk::args::define {*}$deflist + } + } + return + } + proc Stackdocs_detach {deflists} { + variable debug + upvar 0 ::commandstack::stackdocs::PUNKARGS docmirror + foreach deflist $deflists { + set posn [lsearch -exact $docmirror $deflist] + if {$posn > -1} { + set docmirror [lreplace $docmirror $posn $posn] + } + if {[llength [info commands ::punk::args::undefine_deflist]]} { + if {[catch {punk::args::undefine_deflist $deflist} errM] && $debug} { + puts stderr "(commandstack::Stackdocs_detach) WARNING: undefine_deflist failed: $errM" + } + } + } + return + } + namespace eval argdoc { lappend PUNKARGS [list { @id -id ::commandstack::next @@ -800,6 +923,12 @@ namespace eval commandstack { set stack [lreplace $stack $doomed_posn $doomed_posn] dict set all_stacks $command $stack dict unset token_implementations [dict get $doomed_record token] + if {[dict exists $doomed_record punkargs]} { + #G-176: docs attached with 'rename_command -punkargs' die with + #the record. Every removal path (pop_rename/remove_renamer/ + #restore_original) funnels through here. + Stackdocs_detach [dict get $doomed_record punkargs] + } } return $stack @@ -1258,7 +1387,7 @@ namespace eval ::punk::args::register { } package provide commandstack [namespace eval commandstack { - set version 0.7.1 + set version 0.8.0 }] diff --git a/src/bootsupport/modules/punk-0.2.8.tm b/src/bootsupport/modules/punk-0.3.0.tm similarity index 96% rename from src/bootsupport/modules/punk-0.2.8.tm rename to src/bootsupport/modules/punk-0.3.0.tm index ce6dd983..38b7331a 100644 --- a/src/bootsupport/modules/punk-0.2.8.tm +++ b/src/bootsupport/modules/punk-0.3.0.tm @@ -6403,37 +6403,52 @@ namespace eval punk { namespace eval argdoc { punk::args::define { @id -id ::punk::path - @cmd -name "punk::path"\ - -summary\ - "Display PATH executable shadowing and conflicts with TCL commands"\ - -help\ + @cmd -name "punk::path" -& + -summary -& + "Display PATH executable shadowing and conflicts with TCL commands" -& + -help -& {Introspection of the PATH environment variable. This tool will examine executables within each PATH entry and show which binaries are overshadowed by earlier PATH entries. It can also be used to examine the contents of each PATH entry, and to filter results using glob patterns. - + ${[punk::args::helpers::example { #show all executables in all PATH entries punk::path #show all executables in all PATH entries that contain 'Windows' in the path - punk::path -pathglob *Windows* + punk::path -pathglob *Windows* #show all executables in all PATH entries that contain 'scoop' in the path, #and filter the executables to show only those that are named dir, ls or start with 'ca' punk::path -pathglob *scoop* dir ls ca* - #show all executables that conflict with TCL commands starting with 'a' in the current namespace. + #show all executables that conflict with TCL commands starting with 'a' in the current namespace. punk::path {*}[nscommandlist a*] #show all executables that conflict with TCL commands resolvable from the current namespace. punk::path {*}[info commands] }]} - see also the punk::auto_exec package. + see also the punk::auto_exec package. } @opts - -pathglob -type string -default {*} -multiple true -help "Case insensitive glob pattern to filter path entries. Default '*' to include all PATH directories." + -pathglob -type string -default {*} -multiple true -help -& + "Case insensitive glob pattern to filter path entries. Default '*' to include all PATH directories." + -return -type string -default table -choices {table text dict json} -help -& + "Return form of the results. 'table' (default) is the human ANSI table. + 'text' is a plain-ASCII fixed-key layout (no ANSI, no table layout) for pipes/LLMs. + 'dict' returns a Tcl dict of the structured data. + 'json' returns a JSON string (via tcllib json::write) of the same structure. + The text/dict/json forms contain no ANSI escapes regardless of other options." + -context -type string -default {} -help -& + "Namespace whose commands are checked for conflicts with PATH executables. + Default empty = the caller's namespace (the historical behaviour). + Naming a namespace explicitly makes the conflict verdict stable for a machine consumer invoked through a wrapper." + -conflicts -type boolean -default 1 -help -& + "Whether to compute TCL-context conflicts. + Set 0 to skip (a small perf win); the dict/json/text conflict fields are then empty." @values -min 0 -max -1 - binglob -type list -default {*} -multiple true -optional 1 -help "glob pattern to filter results. Default '*' to include all entries." + binglob -type list -default {*} -multiple true -optional 1 -help -& + "glob pattern to filter results. Default '*' to include all entries." } } @@ -6452,6 +6467,9 @@ namespace eval punk { lassign [dict values $argd] leaders opts values received set pathglobs [dict get $opts -pathglob] set binglobs [dict get $values binglob] + set returnmode [dict get $opts -return] + set context_opt [dict get $opts -context] + set do_conflicts [dict get $opts -conflicts] if {$is_windows} { set sep ";" } else { @@ -6716,6 +6734,28 @@ namespace eval punk { # } #} + #G-173: machine-parsable return modes (text/dict/json). The table mode below + #is byte-unchanged from the historical implementation; the structured modes + #build a parallel entry list from the same collected dicts and render without + #ANSI/textblock. Conflict verdicts use a clean exact|nocase classification + #(independent of the table render's ANSI path) and are stable for a machine + #consumer via the -context option. + if {$returnmode ne "table"} { + if {$context_opt ne ""} { + set nscaller $context_opt + if {![namespace exists $nscaller]} { + return -code error "punk::path: -context namespace '$nscaller' does not exist" + } + } else { + set nscaller [uplevel 1 {::tcl::namespace::current}] + } + set machine_args [list $returnmode $is_windows $sep] + lappend machine_args {*}[list [llength $pathglobs] $matched_paths $binglobs] + lappend machine_args {*}[list $d_path_info $d_bin_info $d_index_executables $all_paths] + lappend machine_args $nscaller $do_conflicts + return [punk::path_machine_return {*}$machine_args] + } + set nscaller [uplevel 1 {::tcl::namespace::current}] set context_commands [namespace eval $nscaller {info commands}] @@ -6963,7 +7003,236 @@ namespace eval punk { } - #------------------------------------------------------------------- +#G-173: structured renderers for punk::path -return text/dict/json. The + #collect phase above (d_path_info/d_bin_info/d_index_executables) is shared + #with the table render; these procs walk the same dicts into an ordered entry + #list and serialise without ANSI/textblock. Conflict verdicts use a clean + #exact|nocase classification independent of the table render's ANSI path. + #Body style: no line-continuation backslashes (src/modules/AGENTS.md); dict + #literals use the expand {dict create {*}...} form, json::write builds via + #accumulators so no single call needs continuation. + + #per-executable conflict set: returns a list of {command match} pairs where + #command is the resolved (namespace origin) name and match is exact|nocase. + proc path_conflicts_for_exe {exe context_commands nscaller is_windows} { + set conflicts [list] + set probe_names [list [file rootname $exe] $exe] + foreach probe $probe_names { + if {$is_windows} { + set ncmatches [lsearch -all -inline -nocase $context_commands $probe] + } else { + set ncmatches [lsearch -all -inline -exact $context_commands $probe] + } + if {![llength $ncmatches]} { continue } + set exact [expr {$probe in $context_commands}] + foreach nc $ncmatches { + set resolved [catch {namespace eval $nscaller [list namespace origin $nc]} origin] + if {$resolved} { set origin $nc } + if {$is_windows} { + set match [expr {$exact ? "exact" : "nocase"}] + } else { + set match exact + } + lappend conflicts [list command $origin match $match] + } + break + } + return $conflicts + } + + #build the ordered entry list from the collected dicts. Each entry is a dict: + # idx path normalised is_directory is_duplicate duplicate_of exe_count + # overshadowed_count executables {{name overshadowed overshadowed_by tcl_conflicts {...}} ...} + proc path_collect_entries {is_windows binglobs d_path_info d_bin_info d_index_executables all_paths nscaller do_conflicts} { + if {$do_conflicts} { + set context_commands [namespace eval $nscaller {info commands}] + } else { + set context_commands [list] + } + set entries [list] + set pidx 0 + foreach p $all_paths { + if {$is_windows} { + set pnorm [string tolower $p] + } else { + set pnorm $p + } + if {[string length $pnorm] > 1} { + set lastchar [string index $pnorm end] + if {$lastchar eq "/" || $lastchar eq "\\"} { + set pnorm [string range $pnorm 0 end-1] + } + } + set pinfo [dict get $d_path_info $pnorm] + set indices [dict get $pinfo indices] + set is_duplicate [expr {[lindex $indices 0] != $pidx}] + set duplicate_of [expr {$is_duplicate ? [lindex $indices 0] : -1}] + set exe_record_list [list] + set overshadowed_count 0 + if {$is_duplicate} { + #a duplicate PATH entry has no own executable list in the + #collected dicts (only the first occurrence is globbed). Mirror + #the table column: exe_count from the original, executables empty. + set original_idx [lindex $indices 0] + if {[dict exists $d_index_executables $original_idx]} { + set exe_count [llength [dict get $d_index_executables $original_idx]] + } else { + set exe_count 0 + } + set executables [list] + } else { + if {[dict exists $d_index_executables $pidx]} { + set executables [dict get $d_index_executables $pidx] + } else { + set executables [list] + } + set exe_count [llength $executables] + } + foreach exe $executables { + set matched_binglob 0 + if {$is_windows} { + foreach bg $binglobs { + if {[string match -nocase $bg $exe]} { set matched_binglob 1; break } + } + } else { + foreach bg $binglobs { + if {[string match $bg $exe]} { set matched_binglob 1; break } + } + } + if {!$matched_binglob} { continue } + if {$is_windows} { + set exe_key [string tolower $exe] + } else { + set exe_key $exe + } + set overshadowed 0 + set overshadowed_by -1 + if {[dict exists $d_bin_info $exe_key]} { + set path_indices [dict get $d_bin_info $exe_key path_indices] + foreach pi $path_indices { + if {$pi < $pidx} { set overshadowed 1; set overshadowed_by $pi; break } + } + } + if {$overshadowed} { incr overshadowed_count } + set tcl_conflicts [list] + if {$do_conflicts} { + set tcl_conflicts [path_conflicts_for_exe $exe $context_commands $nscaller $is_windows] + } + lappend exe_record_list [dict create name $exe overshadowed $overshadowed overshadowed_by $overshadowed_by tcl_conflicts $tcl_conflicts] + } + set entry [dict create idx $pidx] + dict set entry path $p + dict set entry normalised $pnorm + dict set entry is_directory [file isdirectory $p] + dict set entry is_duplicate $is_duplicate + dict set entry duplicate_of $duplicate_of + dict set entry exe_count $exe_count + dict set entry overshadowed_count $overshadowed_count + dict set entry executables $exe_record_list + lappend entries $entry + incr pidx + } + return $entries + } + + proc path_machine_return {returnmode is_windows sep npathglobs matched_paths binglobs d_path_info d_bin_info d_index_executables all_paths nscaller do_conflicts} { + set entries [path_collect_entries $is_windows $binglobs $d_path_info $d_bin_info $d_index_executables $all_paths $nscaller $do_conflicts] + #filter: mirror the table render's row-visibility. With any path filter + #active, show all matching paths; otherwise show only rows with exe + #matches (unless a bare * binglob is present). + set has_star [expr {[lsearch -exact $binglobs "*"] >= 0}] + set filtered [list] + if {$npathglobs && ([llength $matched_paths] < [llength $all_paths])} { + foreach e $entries { + if {[dict get $e path] in $matched_paths} { lappend filtered $e } + } + } elseif {$has_star} { + set filtered $entries + } else { + foreach e $entries { + if {[llength [dict get $e executables]] > 0} { lappend filtered $e } + } + } + if {$returnmode eq "dict"} { + set summary [dict create context $nscaller] + dict set summary is_windows $is_windows + dict set summary separator $sep + dict set summary path_entries [llength $all_paths] + dict set summary shown_entries [llength $filtered] + dict set summary executable_total [path_count_executables $filtered] + dict set summary overshadowed_total [path_count_overshadowed $filtered] + dict set summary conflict_total [path_count_conflicts $filtered] + return [dict create summary $summary entries $filtered] + } elseif {$returnmode eq "json"} { + return [path_render_json $is_windows $sep $nscaller $all_paths $filtered] + } + return [path_render_text $is_windows $sep $nscaller $all_paths $filtered] + } + + proc path_count_executables {entries} { + set n 0 + foreach e $entries { incr n [llength [dict get $e executables]] } + return $n + } + proc path_count_overshadowed {entries} { + set n 0 + foreach e $entries { incr n [dict get $e overshadowed_count] } + return $n + } + proc path_count_conflicts {entries} { + set n 0 + foreach e $entries { + foreach exe [dict get $e executables] { + incr n [llength [dict get $exe tcl_conflicts]] + } + } + return $n + } + + proc path_render_text {is_windows sep nscaller all_paths entries} { + set lines [list] + lappend lines "=== punk::path context=$nscaller is_windows=$is_windows sep=$sep" + lappend lines "summary paths=[llength $all_paths] shown=[llength $entries] executables=[path_count_executables $entries] overshadowed=[path_count_overshadowed $entries] conflicts=[path_count_conflicts $entries]" + foreach e $entries { + set dup [dict get $e is_duplicate] + set dupof [dict get $e duplicate_of] + lappend lines "--- [dict get $e idx] [dict get $e path] dir=[dict get $e is_directory] dup=$dup dupof=[expr {$dup ? $dupof : -1}] exes=[dict get $e exe_count] shadow=[dict get $e overshadowed_count]" + foreach exe [dict get $e executables] { + set cl [list] + foreach c [dict get $exe tcl_conflicts] { + lappend cl "[dict get $c command]:[dict get $c match]" + } + lappend lines " [dict get $exe name] ov=[dict get $exe overshadowed] ovby=[dict get $exe overshadowed_by] conflict=[join $cl ,]" + } + } + return [join $lines \n] + } + + #JSON via tcllib json::write (G-173 preferred encoder - see goals/G-173 and + #the runtests json_emit hardening that settled the choice). Lazy-required so + #the fast -discover-only boot (which loads punk::path) is not slowed by a + #tcllib load for a mode nobody has asked for. Values are built into + #accumulator lists so each json::write call stands on one line (no + #line-continuation backslashes - src/modules/AGENTS.md). + proc path_render_json {is_windows sep nscaller all_paths entries} { + package require json::write + json::write indented 1 + json::write aligned 0 + set summary [json::write object context [json::write string $nscaller] is_windows [expr {$is_windows ? 1 : 0}] separator [json::write string $sep] path_entries [llength $all_paths] shown_entries [llength $entries] executable_total [path_count_executables $entries] overshadowed_total [path_count_overshadowed $entries] conflict_total [path_count_conflicts $entries]] + set entry_parts [list] + foreach e $entries { + set exe_parts [list] + foreach exe [dict get $e executables] { + set conf_parts [list] + foreach c [dict get $exe tcl_conflicts] { + lappend conf_parts [json::write object command [json::write string [dict get $c command]] match [json::write string [dict get $c match]]] + } + lappend exe_parts [json::write object name [json::write string [dict get $exe name]] overshadowed [expr {[dict get $exe overshadowed] ? 1 : 0}] overshadowed_by [dict get $exe overshadowed_by] tcl_conflicts [json::write array {*}$conf_parts]] + } + lappend entry_parts [json::write object idx [dict get $e idx] path [json::write string [dict get $e path]] normalised [json::write string [dict get $e normalised]] is_directory [expr {[dict get $e is_directory] ? 1 : 0}] is_duplicate [expr {[dict get $e is_duplicate] ? 1 : 0}] duplicate_of [dict get $e duplicate_of] exe_count [dict get $e exe_count] overshadowed_count [dict get $e overshadowed_count] executables [json::write array {*}$exe_parts]] + } + return [json::write object summary $summary entries [json::write array {*}$entry_parts]] + } #sh 'test' equivalent - to be used with exitcode of process # @@ -9512,7 +9781,7 @@ punkcheck::cli set_alias punkcheck package provide punk [namespace eval punk { #FUNCTL variable version - set version 0.2.8 + set version 0.3.0 }] diff --git a/src/bootsupport/modules/punk/ansi-0.2.0.tm b/src/bootsupport/modules/punk/ansi-0.2.1.tm similarity index 99% rename from src/bootsupport/modules/punk/ansi-0.2.0.tm rename to src/bootsupport/modules/punk/ansi-0.2.1.tm index 899ec5ad..217db954 100644 --- a/src/bootsupport/modules/punk/ansi-0.2.0.tm +++ b/src/bootsupport/modules/punk/ansi-0.2.1.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ansi 0.2.0 +# Application punk::ansi 0.2.1 # Meta platform tcl # Meta license # @@ Meta End @@ -16,7 +16,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::ansi 0 0.2.0] +#[manpage_begin punkshell_module_punk::ansi 0 0.2.1] #[copyright "2023"] #[titledesc {Ansi string functions}] [comment {-- Name section and table of contents description --}] #[moddesc {punk Ansi library}] [comment {-- Description at end of page heading --}] @@ -1549,7 +1549,7 @@ tcl::namespace::eval punk::ansi { #set testparts [regexp {*}$nocase -inline -- $pattern $plain_ln] ;#get fullmatch capturegroup... #set numgroups [expr {[llength $testparts] -1}] #option 2: use the regexp -about flag - set numgroups [lindex [regexp -about $pattern] 0] + set numgroups [lindex [regexp -about -- $pattern] 0] set allparts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln] #allparts includes each full match as well as each capturing group #early versions of tcl 8.6 still didn't support 'lsearch -stride' - avoid for now. @@ -13730,7 +13730,7 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ansi [tcl::namespace::eval punk::ansi { variable version - set version 0.2.0 + set version 0.2.1 }] return diff --git a/src/bootsupport/modules/punk/args-0.18.0.tm b/src/bootsupport/modules/punk/args-0.25.2.tm similarity index 94% rename from src/bootsupport/modules/punk/args-0.18.0.tm rename to src/bootsupport/modules/punk/args-0.25.2.tm index 9671277b..a11c0ff2 100644 --- a/src/bootsupport/modules/punk/args-0.18.0.tm +++ b/src/bootsupport/modules/punk/args-0.25.2.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::args 0.18.0 +# Application punk::args 0.25.2 # Meta platform tcl # Meta license # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args 0 0.18.0] +#[manpage_begin punkshell_module_punk::args 0 0.25.2] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] @@ -1026,15 +1026,66 @@ tcl::namespace::eval punk::args { -abc is valid and equivalent to -a -b -c -abcf is valid and equivalent to -a -b -c -f but -afc is not valid - -multiple (for leaders & values defines whether + -multiple (for leaders & values defines whether subsequent received values are stored against the same argument name - only applies to final leader OR final value) (for options/flags this allows the opt-val pair or solo flag to appear multiple times - not necessarily contiguously) + G-053 range form: a 2-element {min max} list (max -1 = + unbounded) declares occurrence arity. max == 1 stays scalar + (at most once; a second occurrence is an error); max > 1 or + -1 collects a list. {0 1} = at most once, {2 4} = two to four + times, {1 -1} = one or more. Boolean 0/1 are unchanged + (unlimited last-wins / unlimited collect respectively). The + -optional/range-min reconciliation: a non-zero min forces the + argument to be present, so it contradicts -optional (which + permits absence) - declare -optional 0 for a min >= 1 range. + Bounded ranges participate in positional ALLOCATION for + leaders and values: an argument that has taken its max + occurrences yields further words to later arguments + (greedy-up-to-max - so an untyped {3 3} followed by a + -multiple tail takes exactly 3), and a later REQUIRED + argument with a range minimum reserves min occurrences' + worth of words from earlier greedy collection (an explicit + '@values -min' overrides the derived reservation floor). + A word overflowing a bounded max that fits no later + argument reports the pointed occurrence limit. -multipleunique (only valid if -multiple is true) If true, when multiple values are stored against the same argument name due to -multiple being true, the values must be unique. If false, the same value can be stored multiple times. + -parsekey (options & values; NOT supported on leaders - + rejected at define time) + Renames the argument's STORAGE key: the key under which the + parsed value appears in the result's opts/values dicts and + in the received dict. The definition argument name is + unchanged for display and ARG_INFO lookups. Without + -parsekey an option's storage key is the last |-member of + its name with any trailing '=' trimmed, and a value's is + the value's own name. + Distinct OPTIONS may deliberately share one -parsekey (a + shared-key group - e.g modelling lsearch's matching-style + flags): in the default mode the LAST received member wins + the shared slot; declare the group with + '@opts -group -parsekey -parsekeymode error' to + make distinct members mutually exclusive at parse instead. + When several members of one shared-parsekey group declare + -default and none is received, the LAST-defined member's + -default wins (deterministic in definition order). + -multiple on a member of a shared-parsekey group is a + define-time error unless ALL members belong to one @opts + group marked -parsekeymode error (mutual exclusivity makes + per-member collection well-defined); a single -multiple + member with its own parsekey is unrestricted. + A -parsekey matching the NAME of another defined argument + is a define-time error unless that argument declares the + same -parsekey (an explicit shared group). + VALUE parsekeys must be unique within a form and must not + begin with '-' (dash-led keys belong to options in parse + results); both are define-time errors. Values cannot form + shared-key groups - trailing values consume positionally, + so distinct values sharing one result slot would silently + overwrite each other. -choices {} A list of allowable values for an argument. The -default value doesn't have to be in the list. @@ -1479,6 +1530,11 @@ tcl::namespace::eval punk::args { puts stderr "punk::args::undefine unable to find id: '$id'" } } + #G-084: explicit empty return - without this the proc returns the last + #expression (a 'dict unset rawdef_cache_about ...' which yields the WHOLE + #rawdef_cache_about dict, ~hundreds of KB of cached about-renders), so any + #caller capturing undefine's return value got a giant dump instead of "". + return "" } #'punk::args::parse $args withdef $deflist' can raise parsing error after an autoid was generated # In this case we don't see the autoid in order to delete it @@ -1510,6 +1566,9 @@ tcl::namespace::eval punk::args { dict unset argdefcache_display $deflist dict unset id_cache_rawdef $id } + #G-084: explicit empty return - same fix as undefine (without this the proc + #returns the last 'dict unset id_cache_rawdef ...' result, the whole id_cache_rawdef dict). + return "" } @@ -2659,7 +2718,7 @@ tcl::namespace::eval punk::args { -group { tcl::dict::set tmp_optspec_defaults -group $v if {$v ne "" && ![tcl::dict::exists $FDICT OPT_GROUPS $v]} { - tcl::dict::set FDICT OPT_GROUPS $v {-parsekey {} -help {}} + tcl::dict::set FDICT OPT_GROUPS $v {-parsekey {} -help {} -parsekeymode override} } if {$v ne ""} { if {[tcl::dict::exists $at_specs -parsekey]} { @@ -2678,15 +2737,37 @@ tcl::namespace::eval punk::args { set groupdict [tcl::dict::get $FDICT OPT_GROUPS] #set helprecords [tcl::dict::get $F $fid OPT_GROUPS_HELP] if {![tcl::dict::exists $groupdict $g]} { - tcl::dict::set FDICT OPT_GROUPS $g [dict create -parsekey {} -help $v] + tcl::dict::set FDICT OPT_GROUPS $g [dict create -parsekey {} -help $v -parsekeymode override] } else { tcl::dict::set FDICT OPT_GROUPS $g -help $v } } + -parsekeymode { + #G-083: @opts-level strict mode for a shared-parsekey group. + #override (default) = legacy last-wins among distinct members sharing the parsekey. + #error = distinct-member co-occurrence within the group raises optionconflict at parse. + #Applies to the group named by this @opts line's -group (and its -parsekey); + #-group is required when -parsekeymode is given so the target group is named. + if {$v ne "override" && $v ne "error"} { + error "punk::args::resolve Bad @opt line. -parsekeymode must be 'override' or 'error'. got '$v' @id:$DEF_definition_id" + } + if {![tcl::dict::exists $at_specs -group]} { + error "punk::args::resolve Bad @opt line. -parsekeymode requires -group to name the shared-parsekey group it applies to. @id:$DEF_definition_id" + } + set g [tcl::dict::get $at_specs -group] + if {$g eq ""} { + error "punk::args::resolve Bad @opt line. -parsekeymode requires a non-empty -group to name the shared-parsekey group it applies to. @id:$DEF_definition_id" + } + if {![tcl::dict::exists [tcl::dict::get $FDICT OPT_GROUPS] $g]} { + tcl::dict::set FDICT OPT_GROUPS $g [dict create -parsekey {} -help {} -parsekeymode $v] + } else { + tcl::dict::set FDICT OPT_GROUPS $g -parsekeymode $v + } + } -range { if {[dict exists $at_specs -type]} { set tp [dict get $at_specs -type] - } else { + } else { set tp [dict get $tmp_optspec_defaults -type] } if {[llength $tp] == 1} { @@ -2728,7 +2809,7 @@ tcl::namespace::eval punk::args { tcl::dict::set tmp_optspec_defaults $k $v } default { - set known { -parsekey -group -grouphelp + set known { -parsekey -group -grouphelp -parsekeymode -any -anyopts -mash -arbitrary -form -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -type -range -typeranges -default -defaultdisplaytype -typedefaults -choiceprefix -choiceprefixdenylist -choiceprefixreservelist -choicerestricted -nocase @@ -3376,6 +3457,17 @@ tcl::namespace::eval punk::args { -parsekey - -group { tcl::dict::set spec_merged $spec $specval } + -conflicts { + #G-083: per-argument relation. A list of parsekeys or flag names that + #must not be RECEIVED together with this argument. Checked against + #received arguments only (defaults never conflict); resolved through + #the alias/prefix machinery at check time. Cross-validated against + #the defined argument set after all specs merge. + if {[catch {llength $specval}]} { + error "punk::args::resolve - invalid value for key '$spec' in specifications for argument '$argname' - value must be a list of parsekeys or flag names @id:$DEF_definition_id" + } + tcl::dict::set spec_merged -conflicts $specval + } -mash { #allow when any alt in argname is a single letter flag such s -a or -Z #single letter flags do not have to be -type none to allow -mash to be set true. @@ -3533,7 +3625,7 @@ tcl::namespace::eval punk::args { } else { set known_argopts [list {*}{ -form -type - -parsekey -group + -parsekey -group -conflicts -range -typeranges -default -defaultdisplaytype -typedefaults -minsize -maxsize -choices -choicegroups @@ -3655,12 +3747,13 @@ tcl::namespace::eval punk::args { } } else { if {[dict get $FDICT argspace] eq "leaders"} { - if {[dict exists $spec_merged -parsekey]} { - #if parsekey exists, we use that in the required list instead of argname, as that's what the parser will be looking for when it checks for required args - set req_name [dict get $spec_merged -parsekey] - } else { - set req_name $argname + #G-084: -parsekey on a leader is not supported (no live + #caller; the leaders parse loop has no parsekey keying). + #Reject at define time per the goal's no-silent-ignore contract. + if {[dict exists $spec_merged -parsekey] && [dict get $spec_merged -parsekey] ne ""} { + error "punk::args::resolve - -parsekey is not supported on a leader argument ('$argname'). Use -parsekey on an option or a value, or rename the leader argument itself. @id:$DEF_definition_id" } + set req_name $argname if {$req_name ni $upd_LEADER_REQUIRED} { lappend upd_LEADER_REQUIRED $argname } @@ -3682,11 +3775,10 @@ tcl::namespace::eval punk::args { if {[tcl::dict::exists $spec_merged -default]} { if {$is_opt} { - #JJJ - set parsekey [dict get $FDICT ARG_INFO $argname -default] - if {$parsekey eq ""} { - set parsekey $argname - } + #G-084: OPT_DEFAULTS stays keyed by the optset argname - the + #defaults application loop in get_dict resolves the storage + #key (parsekey else trimmed tail) per optset at parse time. + #(A dead parsekey-from--default derivation was removed here.) dict set upd_OPT_DEFAULTS $argname [tcl::dict::get $spec_merged -default] #tcl::dict::set F $fid OPT_DEFAULTS $argname [tcl::dict::get $spec_merged -default] } else { @@ -3694,7 +3786,16 @@ tcl::namespace::eval punk::args { dict set upd_LEADER_DEFAULTS $argname [tcl::dict::get $spec_merged -default] #tcl::dict::set F $fid LEADER_DEFAULTS $argname [tcl::dict::get $spec_merged -default] } else { - dict set upd_VAL_DEFAULTS $argname [tcl::dict::get $spec_merged -default] + #G-084: key VAL_DEFAULTS by parsekey (when present) so the + #default lands on the same parsekey-keyed values_dict slot the + #parse loop stores received values under. Matches VAL_REQUIRED + #which is already parsekey-keyed. + set _valdef_key $argname + if {[dict exists $spec_merged -parsekey]} { + set _pk [dict get $spec_merged -parsekey] + if {$_pk ne ""} {set _valdef_key $_pk} + } + dict set upd_VAL_DEFAULTS $_valdef_key [tcl::dict::get $spec_merged -default] #tcl::dict::set F $fid VAL_DEFAULTS $argname [tcl::dict::get $spec_merged -default] } } @@ -3740,6 +3841,61 @@ tcl::namespace::eval punk::args { } } + #G-083: define-time integrity for -parsekey and the new relations vocabulary. + #Cross-arg checks run here because all ARG_INFO entries for the form exist by now. + set _g83_argnames [dict get $FDICT OPT_NAMES] + lappend _g83_argnames {*}[dict get $FDICT VAL_NAMES] + lappend _g83_argnames {*}[dict get $FDICT LEADER_NAMES] + + #(a) -parsekey colliding with a distinct defined arg's name silently forms an + #implicit shared-key group (parsekey_collides_with_defined_optname_GAP). Reject + #unless that other arg also declares the same -parsekey (a deliberate group). + foreach _g83_an $_g83_argnames { + set _g83_pk [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g83_an] -parsekey ""] + if {$_g83_pk eq ""} continue + foreach _g83_other $_g83_argnames { + if {$_g83_other eq $_g83_an} continue + if {$_g83_other ne $_g83_pk} continue + set _g83_other_pk [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g83_other] -parsekey ""] + if {$_g83_other_pk ne $_g83_pk} { + error "punk::args::resolve - -parsekey '$_g83_pk' for argument '$_g83_an' collides with the name of defined argument '$_g83_other' (which does not share that -parsekey). Use a distinct -parsekey, or give '$_g83_other' the same -parsekey to form an explicit shared-key group. @id:$DEF_definition_id" + } + } + } + + #(b) -conflicts targets must name a defined argname or a declared -parsekey. + #(the alias/prefix resolution of received args happens at parse time.) + set _g83_resolve_targets [dict create] + foreach _g83_t $_g83_argnames { + dict set _g83_resolve_targets $_g83_t 1 + set _g83_tpk [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g83_t] -parsekey ""] + if {$_g83_tpk ne ""} {dict set _g83_resolve_targets $_g83_tpk 1} + } + foreach _g83_an $_g83_argnames { + set _g83_conflicts [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g83_an] -conflicts {}] + if {![llength $_g83_conflicts]} continue + foreach _g83_target $_g83_conflicts { + if {![dict exists $_g83_resolve_targets $_g83_target]} { + error "punk::args::resolve - -conflicts for argument '$_g83_an' names '$_g83_target' which is neither a defined argument name nor a declared -parsekey in this form. @id:$DEF_definition_id" + } + } + } + unset -nocomplain _g83_argnames _g83_resolve_targets _g83_an _g83_pk _g83_other _g83_other_pk _g83_t _g83_tpk _g83_conflicts _g83_target + + #(c) a group marked -parsekeymode error must have a non-empty -parsekey - + #the strict mode only has meaning for a shared-parsekey group (distinct + #members collide on the shared result key); an unnamed or keyless group + #has no shared key to conflict on. + dict for {_g83_g _g83_ginfo} [dict get $FDICT OPT_GROUPS] { + if {[punk::args::system::Dict_getdef $_g83_ginfo -parsekeymode override] ne "error"} continue + if {$_g83_g eq ""} continue ;#-parsekeymode required -group at the @opts line already + set _g83_gpk [punk::args::system::Dict_getdef $_g83_ginfo -parsekey ""] + if {$_g83_gpk eq ""} { + error "punk::args::resolve - -parsekeymode error for group '$_g83_g' requires the group to also declare a non-empty -parsekey (the strict mode only applies to a shared-parsekey group). @id:$DEF_definition_id" + } + } + unset -nocomplain _g83_g _g83_ginfo _g83_gpk + #set mashargs [dict get $F $fid OPT_MASHES] set mashargs [dict get $FDICT OPT_MASHES] if {[llength $mashargs]} { @@ -3762,6 +3918,73 @@ tcl::namespace::eval punk::args { #review - when using resolved_def to create a definiation based on another - OPT_MAX may need to be overridden - a bit ugly? } } + #G-053: canonicalize -multiple into internal companion fields while + #preserving the stored boolean's hot-path meaning (list-shape collect). + #Legacy 0/1 stay boolean; a 2-element {min max} list is the range form + #(max -1 = unbounded). The stored -multiple becomes the computed boolean + #so every existing truth-test (collect-vs-replace, scalar-vs-list, + #leader/value single-multiple rules) stays correct. The range companions + #(min/max/maxbounded) live in a SEPARATE FDICT MULTIPLE_RANGES dict keyed + #by argname - NOT in ARG_INFO, so they do not ride along when ARG_INFO is + #round-tripped as a spec via resolved_def copyfrom (the spec key validator + #would reject the internal keys). + set MULTIPLE_RANGES [tcl::dict::create] + foreach {argname arginfo} [tcl::dict::get $FDICT ARG_INFO] { + set rawmult [tcl::dict::get $arginfo -multiple] + #G-053: a 2-element {min max} list of integers (max may be -1) is the + #range form; everything else is the legacy boolean (0/1/true/false/yes/ + #no/on/off, truth-tested as Tcl always did, coerced to 0/1 here so the + #stored -multiple is a clean boolean for the hot-path truth-tests). + set is_range 0 + if {[llength $rawmult] == 2} { + set e0 [lindex $rawmult 0] + set e1 [lindex $rawmult 1] + if {[tcl::string::is integer -strict $e0] && ($e0 >= 0) + && ([tcl::string::is integer -strict $e1] || $e1 eq "-1")} { + set is_range 1 + } + } + if {$is_range} { + lassign $rawmult mmin mmax + if {$mmax != -1 && $mmax < 1} { + error "punk::args::resolve - bad -multiple range '$rawmult' for argument '$argname' in command form:'$fid'. The maximum (second element) must be a positive integer or -1 (unbounded). @id:$DEF_definition_id" + } + if {$mmax != -1 && $mmin > $mmax} { + error "punk::args::resolve - bad -multiple range '$rawmult' for argument '$argname' in command form:'$fid'. The minimum ($mmin) must not exceed the maximum ($mmax). @id:$DEF_definition_id" + } + if {$mmax == 1} { + set mbool 0 ;#scalar (at most once) + } else { + set mbool 1 ;#list (max>1 or unbounded) + } + set mbounded [expr {$mmax != -1}] + } else { + #legacy boolean - unlimited occurrences; coerce to 0/1 + if {$rawmult} { + set mbool 1 + } else { + set mbool 0 + } + set mmin 0 + set mmax -1 + set mbounded 0 + } + #G-053: -optional vs range-min reconciliation - a non-zero min forces + #presence (the arg must occur at least min times), so it contradicts + #-optional (which permits 0 occurrences). Reject with a clear message. + if {$mmin >= 1} { + set isoptional [tcl::dict::get $arginfo -optional] + if {$isoptional} { + error "punk::args::resolve - contradictory -multiple range '$rawmult' for argument '$argname' in command form:'$fid'. A minimum of $mmin occurrence(s) requires the argument to be present, but -optional is set (permits absence). Declare -optional 0 for this argument. @id:$DEF_definition_id" + } + } + dict set FDICT ARG_INFO $argname -multiple $mbool + if {$mbounded || $mmin > 0} { + dict set MULTIPLE_RANGES $argname [tcl::dict::create min $mmin max $mmax maxbounded $mbounded] + } + } + dict set FDICT MULTIPLE_RANGES $MULTIPLE_RANGES + # REVIEW #no values specified - we can allow last leader to be multiple foreach leadername [lrange [tcl::dict::get $FDICT LEADER_NAMES] 0 end-1] { @@ -3788,6 +4011,82 @@ tcl::namespace::eval punk::args { } } + #G-084 define-time -parsekey integrity (deliberately AFTER the G-053 + #canonicalisation above - the -multiple truth-tests below need the + #canonical boolean; a raw {min max} range list is not a boolean). + #(d) value -parsekey rules. A dash-led value parsekey lands in the + #options namespace of the result/received dicts and gets mis-routed by + #the option-shaped validation paths (parse aborted with an internal + #error). Distinct values sharing one parsekey can never be alternatives - + #trailing values consume positionally, so both always consume and the + #shared result slot silently overwrites (the silent-loss class this goal + #eliminates). Reject both at define time. + set _g84_val_pks [dict create] + foreach _g84_vn [dict get $FDICT VAL_NAMES] { + set _g84_p [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g84_vn] -parsekey ""] + if {$_g84_p eq ""} continue + if {[string match -* $_g84_p]} { + error "punk::args::resolve - -parsekey '$_g84_p' for value argument '$_g84_vn' must not begin with '-' (dash-led keys belong to options in parse results and the received dict). Use a non-dash parsekey, or model the argument as an option. @id:$DEF_definition_id" + } + if {[dict exists $_g84_val_pks $_g84_p]} { + error "punk::args::resolve - -parsekey '$_g84_p' is declared by multiple value arguments ('[dict get $_g84_val_pks $_g84_p]' and '$_g84_vn'). Trailing values consume positionally, so distinct values sharing one result key silently overwrite each other. Give each value its own -parsekey. @id:$DEF_definition_id" + } + dict set _g84_val_pks $_g84_p $_g84_vn + } + unset -nocomplain _g84_val_pks _g84_vn _g84_p + + #(e) cross-member -multiple on a shared-parsekey OPTION group is + #ambiguous in the default override mode (one member's collected list + #would silently displace another's, and collect-vs-replace on one key is + #undefined). Reject at define time. A single -multiple member with its + #own parsekey is fine. -multiple per member is well-defined only when at + #most one member can ever be received - i.e. ALL members belong to the + #SAME @opts group marked -parsekeymode error (parse-time exclusivity is + #enforced per group, so a member outside that group - or in a different + #group - escapes it). The stored -multiple is the G-053 canonical + #boolean here: a {0 1} range is replace-shape and allowed; collect + #shapes ({2 4}, {1 -1}, boolean 1) are rejected. (No live caller + #declares -multiple on a shared-parsekey group - lsearch's groups are + #all single-valued.) + set _g84_pk_to_optsets [dict create] + foreach _g84_optset [dict get $FDICT OPT_NAMES] { + set _g84_p [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g84_optset] -parsekey ""] + if {$_g84_p eq ""} { + set _g84_grp [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g84_optset] -group ""] + if {$_g84_grp ne "" && [dict exists $FDICT OPT_GROUPS $_g84_grp]} { + set _g84_p [punk::args::system::Dict_getdef [dict get $FDICT OPT_GROUPS $_g84_grp] -parsekey ""] + } + } + if {$_g84_p ne ""} {tcl::dict::lappend _g84_pk_to_optsets $_g84_p $_g84_optset} + } + dict for {_g84_pk _g84_members} $_g84_pk_to_optsets { + if {[llength $_g84_members] < 2} continue + set _g84_excl 1 + set _g84_g0 "" + foreach _g84_m $_g84_members { + set _g84_grp [punk::args::system::Dict_getdef [dict get $FDICT ARG_INFO $_g84_m] -group ""] + if {$_g84_grp eq "" || ![dict exists $FDICT OPT_GROUPS $_g84_grp] + || [punk::args::system::Dict_getdef [dict get $FDICT OPT_GROUPS $_g84_grp] -parsekeymode override] ne "error"} { + set _g84_excl 0 + break + } + if {$_g84_g0 eq ""} { + set _g84_g0 $_g84_grp + } elseif {$_g84_grp ne $_g84_g0} { + set _g84_excl 0 + break + } + } + if {!$_g84_excl} { + foreach _g84_m $_g84_members { + if {[tcl::dict::get $FDICT ARG_INFO $_g84_m -multiple]} { + error "punk::args::resolve - -multiple is not supported on member '$_g84_m' of shared-parsekey group '$_g84_pk' in the default override mode: cross-member collection is ambiguous (one member's collected list would silently displace another's). Use a single -multiple member per parsekey, or put all members in one @opts group marked -parsekeymode error so they are mutually exclusive and -multiple per member is well-defined. @id:$DEF_definition_id" + } + } + } + } + unset -nocomplain _g84_pk _g84_members _g84_m _g84_grp _g84_p _g84_optset _g84_pk_to_optsets _g84_excl _g84_g0 + #todo - document that ambiguities in API are likely if both @leaders and @values used #todo - do some checks for obvious bad definitions involving a mix of @leaders and @values (e.g with optional options) @@ -5839,6 +6138,11 @@ tcl::namespace::eval punk::args { } else { set groupinfo "(common flag group)\nkey:$thisgroup_parsekey" } + #G-083: annotate a strict shared-parsekey group + set _g83_gmode [punk::args::system::Dict_getdef [dict get $form_dict OPT_GROUPS $thisgroup] -parsekeymode override] + if {$_g83_gmode eq "error"} { + append groupinfo "\nmutually exclusive (distinct members may not be combined)" + } if {$use_table} { $t add_row [list " $thisgroup" $groupinfo "" "" $help] if {$arg_status eq "bad"} { @@ -5917,7 +6221,22 @@ tcl::namespace::eval punk::args { set choicecolumns [Dict_getdef $arginfo -choicecolumns 4] set choiceprefixdenylist [Dict_getdef $arginfo -choiceprefixdenylist {}] set choiceprefixreservelist [Dict_getdef $arginfo -choiceprefixreservelist {}] ;#names used to calc prefix - but not available as actual choice. - if {[Dict_getdef $arginfo -multiple 0]} { + #G-053: Multi column reflects the declared -multiple range + #(e.g. "0-1", "2-4", "1+" for unbounded-with-floor). Legacy + #0/1 keep the greencheck/blank glyphs; is_multiple stays the + #stored boolean (list-shape) so the synopsis ?arg...? notation + #below is unaffected. + if {[tcl::dict::exists $form_dict MULTIPLE_RANGES $arg]} { + set _g53_mr [tcl::dict::get $form_dict MULTIPLE_RANGES $arg] + set _g53_mn [tcl::dict::get $_g53_mr min] + set _g53_mx [tcl::dict::get $_g53_mr max] + if {[tcl::dict::get $_g53_mr maxbounded]} { + set multiple "$_g53_mn-$_g53_mx" + } else { + set multiple "$_g53_mn+" + } + set is_multiple [Dict_getdef $arginfo -multiple 0] + } elseif {[Dict_getdef $arginfo -multiple 0]} { set multiple $greencheck set is_multiple 1 } else { @@ -6316,6 +6635,25 @@ tcl::namespace::eval punk::args { } } + #G-083: per-arg -conflicts hint - render the conflicting targets + #by their flag spelling (resolve parsekeys to their optset's last member). + set _g83_conflicts [Dict_getdef $arginfo -conflicts {}] + if {[llength $_g83_conflicts]} { + set _g83_cdisp [list] + foreach _g83_c $_g83_conflicts { + if {[dict exists $form_dict ARG_INFO $_g83_c]} { + lappend _g83_cdisp $_g83_c + } elseif {[dict exists $lookup_optset $_g83_c]} { + lappend _g83_cdisp [dict get $lookup_optset $_g83_c] + } else { + lappend _g83_cdisp $_g83_c + } + } + if {$help ne ""} {append help \n} + append help "conflicts with: [join $_g83_cdisp { }]" + unset _g83_conflicts _g83_c _g83_cdisp + } + # ============================================= #REVIEW if {"-help" ni $unindentedfields} { @@ -6354,7 +6692,17 @@ tcl::namespace::eval punk::args { if {[dict exists $arginfo -default]} { append linetail " DEFAULT:[string map [list \n " "] $default]" } - if {$is_multiple} { + #G-053: string renderer reflects the declared range + if {[tcl::dict::exists $form_dict MULTIPLE_RANGES $arg]} { + set _g53_mr [tcl::dict::get $form_dict MULTIPLE_RANGES $arg] + set _g53_mn [tcl::dict::get $_g53_mr min] + set _g53_mx [tcl::dict::get $_g53_mr max] + if {[tcl::dict::get $_g53_mr maxbounded]} { + append linetail " MULTI:$_g53_mn-$_g53_mx" + } else { + append linetail " MULTI:$_g53_mn+" + } + } elseif {$is_multiple} { append linetail " MULTI:yes" } if {$hint ne ""} { @@ -7093,6 +7441,23 @@ tcl::namespace::eval punk::args { missingrequiredleader - missingrequiredvalue - leadermissing - optionmissing - valuemissing - missingoptionvalue { return incomplete } + optionconflict { + #G-083: two received arguments marked as conflicting (per-arg -conflicts, or + #distinct members of a -parsekeymode error group) - a hard contradiction, + #not end-of-input exhaustion: appending words cannot resolve it. + return invalid + } + occurrencecount { + #G-053: payload is count min | max . An under-min + #occurrence (count < min) is pure end-of-input exhaustion - satisfiable by + #appending words - so the form is still viable (incomplete). An over-max + #occurrence (count > max) is a hard contradiction (too many supplied) - + #appending words cannot resolve it - so invalid. + if {"min" in $payload} { + return incomplete + } + return invalid + } leadingvaluecount - trailingvaluecount { #payload: min max set num [lindex $payload 0] @@ -7147,6 +7512,38 @@ tcl::namespace::eval punk::args { dict set lookup_optset $o $optionset } } + #G-084: storage-key maps. The parse result keys received/opts/values by each + #argument's STORAGE key (declared -parsekey; else an optset's last |-member + #with any trailing '=' trimmed; else a value's own name), which the + #member-spelling lookup above cannot resolve for declared -parsekey renames, + #'='-suffixed optset tails, or value parsekeys. Where a storage key is + #claimed by exactly one argument the mapping is unambiguous - normalize + #through it. A key claimed by several arguments (a shared-parsekey group) + #stays unresolved: per-member received attribution does not survive the + #storage fold (the recorded G-084 display gap - needs engine-level + #per-member tracking in the parse result). + set _sk_claims [dict create] + foreach optionset [dict get $form_dict OPT_NAMES] { + set _sk [Dict_getdef [dict get $form_dict ARG_INFO $optionset] -parsekey ""] + if {$_sk eq ""} { + set _sk [string trimright [lindex [split $optionset |] end] =] + } + dict lappend _sk_claims $_sk $optionset + } + foreach vname [dict get $form_dict VAL_NAMES] { + set _sk [Dict_getdef [dict get $form_dict ARG_INFO $vname] -parsekey ""] + if {$_sk eq ""} {set _sk $vname} + dict lappend _sk_claims $_sk $vname + } + set lookup_storagekey [dict create] ;#storage key -> argname (unique claims only) + set arg_storagekey [dict create] ;#argname -> storage key (unique claims only) + dict for {_sk _sk_claimants} $_sk_claims { + if {[llength $_sk_claimants] == 1} { + dict set lookup_storagekey $_sk [lindex $_sk_claimants 0] + dict set arg_storagekey [lindex $_sk_claimants 0] $_sk + } + } + unset -nocomplain _sk _sk_claims _sk_claimants #received argument names normalized to definition argument names. #received is dict-like but may repeat keys for -multiple arguments; values are clause ordinals. set receivednames [list] @@ -7154,6 +7551,8 @@ tcl::namespace::eval punk::args { foreach {r rpos} [Dict_getdef $parsedargs received {}] { if {[string match -* $r] && [dict exists $lookup_optset $r]} { set r [dict get $lookup_optset $r] + } elseif {[dict exists $lookup_storagekey $r]} { + set r [dict get $lookup_storagekey $r] } if {$r ni $receivednames} { lappend receivednames $r @@ -7197,11 +7596,19 @@ tcl::namespace::eval punk::args { set argfailclass "" } #value-in-effect (includes values the parse filled from -default). - #Direct lookup by definition argument name, matching the display renderers: - #aliased optionsets store under their canonical name and are not resolved here. + #Direct lookup by definition argument name first; a miss then tries + #the argument's unique storage key (G-084: declared -parsekey rename, + #or an aliased optset's trimmed last |-member fold). A shared + #storage key (shared-parsekey group) has no unique owner and stays + #unresolved here - parse_report's display bridge shows the group + #value on each member row (the recorded G-084 display gap). if {[dict exists $parsedvalues $arg]} { set hasvalue 1 set value [dict get $parsedvalues $arg] + } elseif {[dict exists $arg_storagekey $arg] + && [dict exists $parsedvalues [dict get $arg_storagekey $arg]]} { + set hasvalue 1 + set value [dict get $parsedvalues [dict get $arg_storagekey $arg]] } else { set hasvalue 0 set value "" @@ -8306,10 +8713,13 @@ tcl::namespace::eval punk::args { set hasvalue [tcl::dict::get $AST hasvalue] set value [tcl::dict::get $AST value] if {!$hasvalue} { - #bridge the storage-key folds the build's direct ARG_INFO-name lookup - #misses: -parsekey renames the storage key; aliased optionsets store - #under their last |-member (the finalopts fold in get_dict). G-084 owns - #the storage-key model - this is display-level bridging only. + #bridge the storage-key folds parse_status_build could not resolve. + #Since G-084 the build resolves UNIQUE storage keys itself (-parsekey + #renames, aliased optsets' trimmed last |-member), so this fires only + #for SHARED-parsekey group members: each member row shows the group's + #value-in-effect while received attribution stays with the raw shared + #key (the recorded G-084 display gap - engine-level per-member + #tracking in the parse result would retire this). switch -- $class { leader {set sectionkey leaders} option {set sectionkey opts} @@ -8567,6 +8977,28 @@ tcl::namespace::eval punk::args { set thistype [dict get $ARG_INFO $thisname -type] set tailnames [lrange $names $nameidx+1 end] + #G-053 allocation participation (directed work 2026-08-08): a BOUNDED + #-multiple occurrence range caps greedy collection - once this argument has + #taken max occurrences it cannot take another, so return no-consume and let + #the caller's retreat advance to the next argument (the same yield path as a + #failed type screen). Previously ranges were post-loop enforcement only: + #greedy collection overran a bounded max whenever the type screen could not + #stop it, and occurrencecount then reported the overrun allocation itself + #created (untyped {3 3} followed by a -multiple tail collected 4). A first + #occurrence is never capped (resolve guarantees range max >= 1). Serves both + #the leaders and values loops (shared proc). + if {[dict get $ARG_INFO $thisname -multiple] && $thisname in $namesreceived + && [dict exists $formdict MULTIPLE_RANGES $thisname]} { + set mrange [dict get $formdict MULTIPLE_RANGES $thisname] + if {[dict get $mrange maxbounded] + && [llength [lsearch -all -exact $namesreceived $thisname]] >= [dict get $mrange max]} { + #the G-082 rejection record lets an overflow raise report the pointed + #occurrence limit (kind 'occurrence') instead of a generic overflow + set rejection [dict create kind occurrence argname $thisname word [lindex $all_remaining 0] max [dict get $mrange max]] + return [dict create consumed 0 resultlist {} typelist $thistype rejection $rejection] + } + } + #todo - work backwards with any (optional or not) literals at tail that match our values - and remove from assignability. set ridx 0 #puts "-=============- thisname:'$thisname' thistype:'$thistype' tailnames:'$tailnames' all_remaining:'$all_remaining' [info level -2]" @@ -8797,15 +9229,24 @@ tcl::namespace::eval punk::args { set num_remaining [llength $all_remaining] if {[dict get $ARG_INFO $thisname -optional] || ([dict get $ARG_INFO $thisname -multiple] && $thisname in $namesreceived)} { - #2026-07-14 Agent-Updated: occurrence min/max for -multiple is goal G-053 - #(proposed: -multiple accepts a {min max} range alongside the legacy booleans). - #Not implemented - only boolean -multiple semantics apply here. - #thisname already satisfied, or not required + #thisname already satisfied, or not required - reserve words for later + #REQUIRED arguments so greed here cannot starve them. set tail_needs 0 foreach t $tailnames { if {![dict get $ARG_INFO $t -optional]} { set min_clause_length [llength [lsearch -all -not [dict get $ARG_INFO $t -type] {\?*\?}]] - incr tail_needs $min_clause_length + #G-053 allocation participation (directed work 2026-08-08): a + #required argument with a range minimum needs min OCCURRENCES + #reserved, not one - e.g a following required -multiple {3 3} + #reserves 3 clauses' worth of words. (Legacy boolean -multiple + #has no MULTIPLE_RANGES entry; an -optional arg can never carry + #min >= 1 - resolve rejects the contradiction.) + set t_occurrences 1 + if {[dict exists $formdict MULTIPLE_RANGES $t]} { + set t_occurrences [dict get $formdict MULTIPLE_RANGES $t min] + if {$t_occurrences < 1} {set t_occurrences 1} + } + incr tail_needs [expr {$t_occurrences * $min_clause_length}] } } set all_remaining [lrange $all_remaining 0 end-$tail_needs] @@ -9326,7 +9767,7 @@ tcl::namespace::eval punk::args { break } regex - regexp { - if {[catch {regexp -about $e_check} re_about_msg]} { + if {[catch {regexp -about -- $e_check} re_about_msg]} { set msg "$argclass $argname for %caller% requires type regexp. $re_about_msg. Received: '$e_check'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] } else { @@ -10369,6 +10810,37 @@ tcl::namespace::eval punk::args { #ending INSIDE a multi-member type clause raises (clause allocation cannot #affirm the partial words) - such prefixes report non-viable even when the #partial clause words match. + #G-053: occurrence-range enforcement for -multiple {min max} ranges. Called + #after each section's parse loop (opts/leaders/values). Checks every declared + #arg in $names against its MULTIPLE_RANGES entry (if any): over-supply beyond a + #bounded max raises occurrencecount with the max payload (a hard contradiction - + #fires in both normal and viability-probe modes); under-supply below a nonzero min + #raises occurrencecount with the min payload (pure end-of-input exhaustion - + #SUPPRESSED in the G-152 viability probe so a viable form reports incomplete + #rather than invalid). $received_list is the section's per-arg occurrence + #tracker (optsets_received / leadernames_received / valnames_received); + #$classlabel is the human label (Option/Leader/Value). Returns {} if ok, or a + #2-element list {errorcode-options error-message} to raise. + proc private::multiple_range_enforce {received_list names ranges argspecs classlabel {viabilitycheck 0}} { + if {![llength $ranges]} {return ""} + foreach argname $names { + if {![tcl::dict::exists $ranges $argname]} continue + set mr [tcl::dict::get $ranges $argname] + set cnt [llength [lsearch -all $received_list $argname]] + set mn [tcl::dict::get $mr min] + set mx [tcl::dict::get $mr max] + if {[tcl::dict::get $mr maxbounded] && $cnt > $mx} { + set msg "Bad arguments for %caller%. $classlabel $argname may be supplied at most $mx time(s) but received $cnt occurrence(s)." + return [list [list -code error -errorcode [list PUNKARGS VALIDATION [list occurrencecount $argname count $cnt max $mx] -badarg $argname -argspecs $argspecs]] $msg] + } + if {!$viabilitycheck && $mn > 0 && $cnt < $mn} { + set msg "Bad arguments for %caller%. $classlabel $argname requires at least $mn occurrence(s) but received $cnt." + return [list [list -code error -errorcode [list PUNKARGS VALIDATION [list occurrencecount $argname count $cnt min $mn] -badarg $argname -argspecs $argspecs]] $msg] + } + } + return "" + } + proc private::get_dict_form {argspecs fid rawargs {viabilitycheck 0}} { #G-164: the probe's alternative-allocation re-probe invokes this proc with a #2-element viabilitycheck {1 reseat_words} - words the valmin reservation @@ -10381,6 +10853,7 @@ tcl::namespace::eval punk::args { } #puts "-arg_info->$arg_info" set flagsreceived [list] ;#for checking if required flags satisfied + set optsets_received [list] ;#G-083: per-optset received tracker (options only) for -conflicts/-parsekeymode checks - flagsreceived collapses shared-parsekey members onto one api_opt, so the optset is tracked separately here set solosreceived [list] set multisreceived [list] #secondary purpose: @@ -10407,6 +10880,7 @@ tcl::namespace::eval punk::args { #individual var extraction is faster than 'dict with' - even though we need nearly every key set ARG_INFO [dict get $formdict ARG_INFO] set ARG_CHECKS [dict get $formdict ARG_CHECKS] + set MULTIPLE_RANGES [Dict_getdef $formdict MULTIPLE_RANGES {}] set LEADER_DEFAULTS [dict get $formdict LEADER_DEFAULTS] set LEADER_REQUIRED [dict get $formdict LEADER_REQUIRED] @@ -10429,7 +10903,7 @@ tcl::namespace::eval punk::args { set OPT_ALL_MASH_LETTERS [dict get $formdict OPT_ALL_MASH_LETTERS] set OPTSPEC_DEFAULTS [dict get $formdict OPTSPEC_DEFAULTS] set OPT_CHECKS_DEFAULTS [dict get $formdict OPT_CHECKS_DEFAULTS] - #set OPT_GROUPS [dict get $formdict OPT_GROUPS] + set OPT_GROUPS [dict get $formdict OPT_GROUPS] ;#G-083: -parsekeymode per-group strict mode set VAL_DEFAULTS [dict get $formdict VAL_DEFAULTS] set VAL_REQUIRED [dict get $formdict VAL_REQUIRED] @@ -10443,6 +10917,22 @@ tcl::namespace::eval punk::args { set FORMDISPLAY [dict get $formdict FORMDISPLAY] + #G-084: value parsekey->argname reverse map. VAL_REQUIRED and VAL_DEFAULTS + #are keyed by parsekey (so they match the parsekey-keyed result/received + #dicts), but ARG_INFO is keyed by argname - so any ARG_INFO lookup by a + #required/default key (e.g the valmin clause-length fallback below) must + #resolve the parsekey back to an argname. Iterates only VAL_NAMES (usually + #few) to keep the per-parse cost down; for a value with no -parsekey the + #parsekey IS the argname (self-entry). No leader map is needed - a leader + #-parsekey is rejected at define time, so leader keys are always argnames. + #Duplicate value parsekeys are rejected at resolve, so entries are unique. + set val_pk2name [dict create] + foreach vn $VAL_NAMES { + set pk [Dict_getdef [dict get $ARG_INFO $vn] -parsekey ""] + if {$pk eq ""} {set pk $vn} + if {![dict exists $val_pk2name $pk]} {dict set val_pk2name $pk $vn} + } + #G-082 single-form error selection: words the allocation screens rejected for an #OPTIONAL argument (restricted choices, basic type), keyed by the word itself. #First rejection per word wins (nearest/earliest defined argument - the one the @@ -10458,17 +10948,30 @@ tcl::namespace::eval punk::args { set valmin 0 #set VAL_MIN 0 foreach v $VAL_REQUIRED { + #G-084: VAL_REQUIRED is keyed by parsekey; resolve to argname for ARG_INFO. + set vname $v + if {[dict exists $val_pk2name $v]} {set vname [dict get $val_pk2name $v]} # todo variable clause lengths (items marked optional in types using leading&trailing questionmarks) # e.g -types {a ?xxx?} #this has one required and one optional set clause_length 0 #for each t in typelist - foreach t [dict get $ARG_INFO $v -type] { + foreach t [dict get $ARG_INFO $vname -type] { if {![string match {\?*\?} $t]} { incr clause_length } } - incr valmin $clause_length + #G-053 allocation participation (directed work 2026-08-08): a required + #value with a range minimum contributes min OCCURRENCES to the floor, + #not one - so the leader/value split and the option-scan reservation + #keep enough words back for e.g a required -multiple {3 3} value. + #(An explicit '@values -min' overrides this whole derivation.) + set v_occurrences 1 + if {[dict exists $MULTIPLE_RANGES $vname]} { + set v_occurrences [dict get $MULTIPLE_RANGES $vname min] + if {$v_occurrences < 1} {set v_occurrences 1} + } + incr valmin [expr {$v_occurrences * $clause_length}] } } else { set valmin $VAL_MIN @@ -10554,6 +11057,19 @@ tcl::namespace::eval punk::args { } else { set leader_posn_name [lindex $LEADER_NAMES $nameidx] ;#may return empty string } + #G-053 allocation participation (directed work 2026-08-08): a + #bounded -multiple range on the (last) leader caps the leader + #scan - once max occurrences are assigned, remaining words belong + #to the opts/values sections rather than overrunning the leader. + if {$is_multiple && $leader_posn_name ne "" + && [dict exists $MULTIPLE_RANGES $leader_posn_name] + && [dict exists $leader_posn_names_assigned $leader_posn_name]} { + set lmr [dict get $MULTIPLE_RANGES $leader_posn_name] + if {[dict get $lmr maxbounded] + && [dict get $leader_posn_names_assigned $leader_posn_name] >= [dict get $lmr max]} { + break + } + } if {$OPT_MAX ne "0" && [string match -* $raw]} { #all_opts includes end_of_opts marker -- if configured - no need to explicitly check for it separately set possible_flagname $raw @@ -11104,6 +11620,7 @@ tcl::namespace::eval punk::args { } } lappend flagsreceived $api_opt + lappend optsets_received $mashflagoptionset incr posn } #update vals_remaining_possible by one or 2 if the last flag took a value. @@ -11344,6 +11861,7 @@ tcl::namespace::eval punk::args { lappend solosreceived $api_opt ;#dups ok } lappend flagsreceived $api_opt ;#dups ok + lappend optsets_received $optionset ;#G-083 } else { #starts with - but unmatched option flag #comparison to valmin already done above @@ -11465,11 +11983,17 @@ tcl::namespace::eval punk::args { #set values [list {*}$pre_values {*}$post_values] set leaders $pre_values set values $post_values + #G-053: occurrence-range enforcement for options (after the opts loop) + set _g53_e [private::multiple_range_enforce $optsets_received $OPT_NAMES $MULTIPLE_RANGES $argspecs Option $viabilitycheck] + if {[llength $_g53_e]} {lassign $_g53_e _g53_eo _g53_em; return -options $_g53_eo $_g53_em} } else { set leaders $pre_values set values $remaining_rawargs #set values [list {*}$pre_values {*}$remaining_rawargs] ;#no -flags detected set arglist [list] + #G-053: occurrence-range enforcement for options (no-flags branch) + set _g53_e [private::multiple_range_enforce $optsets_received $OPT_NAMES $MULTIPLE_RANGES $argspecs Option $viabilitycheck] + if {[llength $_g53_e]} {lassign $_g53_e _g53_eo _g53_em; return -options $_g53_eo $_g53_em} } @@ -11532,7 +12056,13 @@ tcl::namespace::eval punk::args { if {$parsekey ne $optset} { set tailopt [string trimright [lindex [split $optset |] end] =] if {$tailopt ne $parsekey} { - #defaults for multiple options sharing a -parsekey value ? review + #G-084: settled precedence rule for multiple defaulted members of + #one shared-parsekey group (none received): the LAST-defined member's + #-default wins. This loop visits optsets in definition order and applies + #each unreceived member's default via dict set (last wins), so the + #outcome is deterministic in definition order. (No live caller declares + #multiple defaults on one shared-parsekey group - e.g lsearch's + #MATCHSTYLE group defaults only -glob - so this rules the synthetic case.) dict set ordered_opts $tailopt|$parsekey [dict get $OPT_DEFAULTS $optset] } else { dict set ordered_opts $parsekey [dict get $OPT_DEFAULTS $optset] @@ -11593,15 +12123,18 @@ tcl::namespace::eval punk::args { #-unnamed fallback, and the G-082 alloc_rejections overflow error selection. #Known asymmetries: interplay with the upstream leader/value split, #LEADER_TAKEWHENARGSMODULO, missingrequiredleader vs missingrequiredvalue, and the - #values loop's api_valname (-parsekey) identifiers which this loop lacks (G-084). - #Refactor assessment (2026-07-14): folding both loops into one clause-assignment - #helper is indicated - drift is real (G-082 had to duplicate its selection block; - #parsekey idents exist only on the values side) - but it should ride the G-084 - #leaders/values parsekey parity work, which must touch both loops anyway, and must - #respect the parse hot-path constraints established by G-046: naive proc extraction - #means heavy state plumbing (upvar/dict) for many loop-local variables. Until then, - #any edit to one loop must be mirrored in the other or the divergence justified in - #a comment at the point of divergence. + #values loop's api_valname (-parsekey) storage keying which this loop lacks - a + #PERMANENT asymmetry as of G-084: a leader -parsekey is rejected at define time, + #so no leaders-side parsekey keying is coming. + #Refactor assessment (2026-07-14, premise updated by G-084): folding both loops + #into one clause-assignment helper remains indicated on its own merits - drift is + #real (G-082 had to duplicate its selection block) - but no longer has a G-084 + #vehicle (the planned leaders/values parsekey parity work resolved as define-time + #rejection instead). Any such refactor must respect the parse hot-path constraints + #established by G-046: naive proc extraction means heavy state plumbing + #(upvar/dict) for many loop-local variables. Until then, any edit to one loop must + #be mirrored in the other or the divergence justified in a comment at the point of + #divergence. #------------------------------------------------------------------------------- for {set ldridx 0} {$ldridx < [llength $leaders]} {incr ldridx} { set leadername [lindex $LEADER_NAMES $nameidx] @@ -11761,6 +12294,14 @@ tcl::namespace::eval punk::args { set rj_name [dict get $rj name] set msg [private::unavailable_choice_msg $rj_argclass $rj_argname $ldr $rj_name [Dict_getdef $argstate $rj_argname -choicelabels {}] [dict get $rj choices]] return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceunavailable $rj_name choices [dict get $rj choices]] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg + } elseif {[dict get $rj kind] eq "occurrence"} { + #G-053 allocation participation: the argument reached its + #bounded -multiple max and this word overflowed - report the + #occurrence limit (same errorcode class as post-loop + #enforcement; count is the attempted occurrence) + set rj_max [dict get $rj max] + set msg "$rj_argclass '$rj_argname' for %caller% accepts at most $rj_max occurrence(s). Received extra word: '$ldr'" + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list occurrencecount $rj_argname count [expr {$rj_max + 1}] max $rj_max] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg } else { set rj_type [dict get $rj type] set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '$ldr'" @@ -11802,6 +12343,9 @@ tcl::namespace::eval punk::args { } #----------------------------------------------------- + #G-053: occurrence-range enforcement for leaders (after the leaders loop) + set _g53_e [private::multiple_range_enforce $leadernames_received $LEADER_NAMES $MULTIPLE_RANGES $argspecs Leader $viabilitycheck] + if {[llength $_g53_e]} {lassign $_g53_e _g53_eo _g53_em; return -options $_g53_eo $_g53_em} set validx 0 set valname_multiple "" @@ -11816,27 +12360,33 @@ tcl::namespace::eval punk::args { ## set values_dict $val_defaults set values_dict [dict create] foreach valname [lrange $VAL_NAMES 0 $num_values-1] { - #set ALL valnames to lock in positioning - #note - later we need to unset any optional that had no default and was not received (no phantom default) - dict set values_dict $valname {} - } + #set ALL valnames to lock in positioning. G-084: key by parsekey so received + #values (stored under api_valname=parsekey) land on the same slot, and the + #VAL_DEFAULTS merge (also parsekey-keyed) overlays the default here. + set _vkey $valname + set _vpk [Dict_getdef [dict get $ARG_INFO $valname] -parsekey ""] + if {$_vpk ne ""} {set _vkey $_vpk} + dict set values_dict $_vkey {} + } + unset -nocomplain _vkey _vpk set values_dict [dict merge $values_dict $VAL_DEFAULTS] #------------------------------------------ set nameidx 0 set start_position $positionalidx - set seen_pks [list] - #2026-07-14 Agent-Updated (was: "MAINTENANCE - (*nearly*?) same loop logic as for leaders") #MAINTENANCE: near-clone of the leaders loop above - see the refactor assessment - #comment there (shared logic, known asymmetries, defer-to-G-084 decision). + #comment there (shared logic, known asymmetries). #Any edit here must be mirrored in the leaders loop or justified at the divergence. for {set validx 0} {$validx < [llength $values]} {incr validx} { set valname [lindex $VAL_NAMES $nameidx] set val [lindex $values $validx] #---------------------------------- - #2026-07-14 Agent-Updated (was a bare "#todo"): values/leaders -parsekey - #completeness is goal G-084 - this api_valname derivation is the values-side - #start of it (currently a value's -parsekey aborts parse further on, and the - #leaders loop has no equivalent). + #G-084: api_valname is the value's STORAGE key - its -parsekey when + #declared (unique per form, non-dash - both resolve-enforced), else its + #own name. values_dict storage, VAL_DEFAULTS/VAL_REQUIRED matching and + #the received dict all key by it; valnames_received stays argname-keyed + #for the -multiple first/continuation gate and G-053 occurrence + #enforcement. (Leaders deliberately have no equivalent - a leader + #-parsekey is rejected at define time.) set api_valname "" if {[tcl::dict::exists $argstate $valname -parsekey]} { set api_valname [tcl::dict::get $argstate $valname -parsekey] @@ -11845,23 +12395,6 @@ tcl::namespace::eval punk::args { #parsekey is the same as valname set api_valname $valname } - if {$api_valname eq $valname} { - #if parsekey is the same as valname, we can just use valname as the identifier for opts and values - set val_ident $valname - set val_ident_is_parsekey 0 - } else { - #initially key our values on a long form allowing us to know which specific value position was used (for when multiple map to same parsekey) - #e.g -increasing|-SORTOPTION - set val_ident $valname|$api_valname - set val_ident_is_parsekey 1 - } - lappend seen_pks $api_valname - #---------------------------------- - #2026-07-14 Agent-Updated: a pasted reference copy of the opts-path - #flag_ident/-parsekey logic was removed here (the val_ident derivation - #above is its values-loop analogue). Values/leaders -parsekey support is - #incomplete - see goal G-084 (parse currently errors for a value's - #-parsekey and ignores a leader's). #---------------------------------- if {$valname ne ""} { set valtypelist [tcl::dict::get $argstate $valname -type] @@ -11943,15 +12476,15 @@ tcl::namespace::eval punk::args { # tcl::dict::lappend values_dict $valname $clauseval #} if {$valname in $valnames_received} { - tcl::dict::lappend values_dict $valname $clauseval + tcl::dict::lappend values_dict $api_valname $clauseval tcl::dict::lappend argument_clause_typestate $valname $newtypelist } else { - tcl::dict::set values_dict $valname [list $clauseval] + tcl::dict::set values_dict $api_valname [list $clauseval] tcl::dict::set argument_clause_typestate $valname [list $newtypelist] } set valname_multiple $valname } else { - tcl::dict::set values_dict $valname $clauseval + tcl::dict::set values_dict $api_valname $clauseval tcl::dict::set argument_clause_typestate $valname [list $newtypelist] ;#list protect set valname_multiple "" incr nameidx @@ -11976,9 +12509,16 @@ tcl::namespace::eval punk::args { lappend clauseval [lindex $values $validx] } } - tcl::dict::lappend values_dict $valname_multiple $clauseval + set _vmkey $valname_multiple + set _vmpk [Dict_getdef [tcl::dict::get $argstate $valname_multiple] -parsekey ""] + if {$_vmpk ne ""} {set _vmkey $_vmpk} + tcl::dict::lappend values_dict $_vmkey $clauseval #name already seen - but must add to valnames_received anyway (as with opts and leaders) lappend valnames_received $valname_multiple + #G-084: continuation occurrences of a -multiple value must also land + #under the parsekey and register in api_valnames_received (the + #parsekey-keyed received/satisfaction tracker) - not just the first. + lappend api_valnames_received $_vmkey } else { if {$VAL_UNNAMED} { tcl::dict::set values_dict $positionalidx $val @@ -12019,6 +12559,15 @@ tcl::namespace::eval punk::args { set rj_name [dict get $rj name] set msg [private::unavailable_choice_msg $rj_argclass $rj_argname $val $rj_name [Dict_getdef $argstate $rj_argname -choicelabels {}] [dict get $rj choices]] return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceunavailable $rj_name choices [dict get $rj choices]] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg + } elseif {[dict get $rj kind] eq "occurrence"} { + #G-053 allocation participation: the argument reached its + #bounded -multiple max and this word overflowed - report the + #occurrence limit (same errorcode class as post-loop + #enforcement; count is the attempted occurrence) + #(MAINTENANCE - same selection logic as leaders loop above) + set rj_max [dict get $rj max] + set msg "$rj_argclass '$rj_argname' for %caller% accepts at most $rj_max occurrence(s). Received extra word: '$val'" + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list occurrencecount $rj_argname count [expr {$rj_max + 1}] max $rj_max] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg } else { set rj_type [dict get $rj type] set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '$val'" @@ -12040,7 +12589,7 @@ tcl::namespace::eval punk::args { #review - always trailing - could break? continue } - if {![dict exists $VAL_DEFAULTS $vname] && $vname ni $valnames_received} { + if {![dict exists $VAL_DEFAULTS $vname] && $vname ni $api_valnames_received} { #remove the name with empty-string default we used to establish fixed order of names #The 'values' key in the final result shouldn't contain an entry for an argument that wasn't received and had no default. dict unset values_dict $vname @@ -12048,6 +12597,10 @@ tcl::namespace::eval punk::args { } #----------------------------------------------------- + #G-053: occurrence-range enforcement for values (after the values loop) + set _g53_e [private::multiple_range_enforce $valnames_received $VAL_NAMES $MULTIPLE_RANGES $argspecs Value $viabilitycheck] + if {[llength $_g53_e]} {lassign $_g53_e _g53_eo _g53_em; return -options $_g53_eo $_g53_em} + #G-152 viability probe: a below-minimum count is pure end-of-input exhaustion - #satisfiable by appending words - only while the parse position can still reach #that section: the leaders section only when nothing was consumed beyond it (no @@ -12206,16 +12759,88 @@ tcl::namespace::eval punk::args { } } if {[llength $VAL_REQUIRED] && !$skip_valuemissing} { - if {[llength [set missing [punk::args::system::punklib_ldiff $VAL_REQUIRED $valnames_received]]]} { + if {[llength [set missing [punk::args::system::punklib_ldiff $VAL_REQUIRED $api_valnames_received]]]} { set msg "Required value missing for %caller%. missing values: '$missing' marked with -optional false - so must be present" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list valuemissing $missing received $valnames_received] -argspecs $argspecs]] $msg #arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs } } + #--------------------------------------------------------------------------------------------- + #G-083: optionconflict - per-arg -conflicts and @opts -parsekeymode error group exclusivity. + #Checked against RECEIVED arguments only (defaults never conflict), after prefix/ + #abbreviation resolution, on the OPTSET identity (not the received-name form - flagsreceived + #collapses distinct shared-parsekey members onto one api_opt, so the matched optset is + #tracked in optsets_received for options). Runs unconditionally: a received conflict is a + #hard contradiction in any mode (candidacy probe or live parse), not end-of-input + #exhaustion, so it is not gated by the skip_* flags above. Mirrors the optionmissing + #errorcode shape: PUNKARGS VALIDATION {optionconflict received }. + set _g83_received_optsets $optsets_received + foreach _g83_n $leadernames_received {if {[dict exists $ARG_INFO $_g83_n]} {lappend _g83_received_optsets $_g83_n}} + foreach _g83_n $valnames_received {if {[dict exists $ARG_INFO $_g83_n]} {lappend _g83_received_optsets $_g83_n}} + #effective parsekey of an optset: its own -parsekey, else the group's -parsekey if it + #is in a named group that declares one, else "" (the member then keys on its api_opt). + set _g83_effpk [dict create] + set _g83_pk_to_optsets [dict create] + foreach _g83_optset $OPT_NAMES { + set _g83_p [punk::args::system::Dict_getdef [dict get $ARG_INFO $_g83_optset] -parsekey ""] + if {$_g83_p eq ""} { + set _g83_grp [punk::args::system::Dict_getdef [dict get $ARG_INFO $_g83_optset] -group ""] + if {$_g83_grp ne "" && [dict exists $OPT_GROUPS $_g83_grp]} { + set _g83_p [punk::args::system::Dict_getdef [dict get $OPT_GROUPS $_g83_grp] -parsekey ""] + } + } + dict set _g83_effpk $_g83_optset $_g83_p + if {$_g83_p ne ""} {tcl::dict::lappend _g83_pk_to_optsets $_g83_p $_g83_optset} + } + #G-083 conflict check: per-arg -conflicts (iterate received optsets in definition order + #for deterministic output; report the first conflicting pair). + foreach _g83_optset $OPT_NAMES { + if {$_g83_optset ni $_g83_received_optsets} continue + set _g83_conflicts [punk::args::system::Dict_getdef [dict get $ARG_INFO $_g83_optset] -conflicts {}] + if {![llength $_g83_conflicts]} continue + foreach _g83_t $_g83_conflicts { + #resolve target to optset(s): flagname spelling, then argname, then parsekey + if {[dict exists $lookup_optset $_g83_t]} { + set _g83_t_optsets [list [dict get $lookup_optset $_g83_t]] + } elseif {[dict exists $ARG_INFO $_g83_t]} { + set _g83_t_optsets [list $_g83_t] + } elseif {[dict exists $_g83_pk_to_optsets $_g83_t]} { + set _g83_t_optsets [dict get $_g83_pk_to_optsets $_g83_t] + } else { + set _g83_t_optsets [list] ;#define-time should have rejected it - defensive skip + } + foreach _g83_t_optset $_g83_t_optsets { + if {$_g83_t_optset eq $_g83_optset} continue ;#not a conflict with itself + if {$_g83_t_optset ni $_g83_received_optsets} continue ;#target not received + set msg "Arguments '$_g83_optset' and '$_g83_t_optset' for %caller% are marked as conflicting (-conflicts) and may not be supplied together." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list optionconflict $_g83_optset $_g83_t_optset received [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received]] -argspecs $argspecs]] $msg + } + } + } + #G-083 group exclusivity: @opts -parsekeymode error - distinct members of a shared- + #parsekey group received together is an error (iterate groups for deterministic output). + dict for {_g83_g _g83_ginfo} $OPT_GROUPS { + if {[punk::args::system::Dict_getdef $_g83_ginfo -parsekeymode override] ne "error"} continue + set _g83_g_received [list] + foreach _g83_optset $OPT_NAMES { + if {$_g83_optset ni $_g83_received_optsets} continue + set _g83_grp [punk::args::system::Dict_getdef [dict get $ARG_INFO $_g83_optset] -group ""] + if {$_g83_grp ne $_g83_g} continue + if {$_g83_optset in $_g83_g_received} continue + lappend _g83_g_received $_g83_optset + } + if {[llength $_g83_g_received] > 1} { + set _g83_a [lindex $_g83_g_received 0] + set _g83_b [lindex $_g83_g_received 1] + set msg "Arguments '$_g83_a' and '$_g83_b' for %caller% belong to mutually exclusive group '$_g83_g' (-parsekeymode error) and may not be supplied together." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list optionconflict $_g83_a $_g83_b received [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received]] -argspecs $argspecs]] $msg + } + } + unset -nocomplain _g83_received_optsets _g83_n _g83_effpk _g83_pk_to_optsets _g83_optset _g83_p _g83_grp _g83_conflicts _g83_t _g83_t_optsets _g83_t_optset _g83_g _g83_ginfo _g83_g_received _g83_a _g83_b #--------------------------------------------------------------------------------------------- #maintain order of opts $opts values $values as caller may use lassign. - set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received] + set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$api_valnames_received] if {[llength $receivednames]} { #flat zip of names with overall posn, including opts #set received_posns [concat {*}[lmap a $receivednames b [zero_based_posns [llength $receivednames]] {list $a $b}]] @@ -12294,6 +12919,14 @@ tcl::namespace::eval punk::args { } else { #leader or value. set argname $argname_or_ident + #G-084: values_dict is keyed by parsekey, but arg_checks/argstate are + #argname-keyed - resolve the parsekey back to its argname. (For a value + #without -parsekey the parsekey IS the argname, so the map holds a + #self-entry and this is a no-op. Leaders are always argname-keyed - a + #leader -parsekey is rejected at define time.) + if {[dict exists $val_pk2name $argname]} { + set argname [dict get $val_pk2name $argname] + } #set pkoverride [Dict_getdef $argstate $argname -parsekey ""] #TODO? if {$pkoverride ne ""} { @@ -13687,6 +14320,19 @@ tcl::namespace::eval punk::args { set opt_groupdict [dict get $optlist -groupdict] set opt_columns [dict get $optlist -columns] + if {![string match ::* $ensemble]} { + #normalize to fully-qualified in the caller's context: the id_checks below + #derive namespaces via 'namespace qualifiers' - a relative multi-component + #name (e.g 'tcl::prefix') would send an unqualified ns ('tcl') to + #update_definitions, which warns on stderr for every subcommand. + set fqensemble [uplevel 1 [list ::tcl::namespace::which $ensemble]] + if {$fqensemble ne ""} { + set ensemble $fqensemble + } else { + set ensemble ::$ensemble + } + } + #warning - circular package dependency if we try to use this function on punk::ns! package require punk::ns set subdict [uplevel 1 [list punk::ns::ensemble_subcommands -return dict $ensemble]] @@ -15081,7 +15727,7 @@ package provide punk::args [tcl::namespace::eval punk::args { tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version - set version 0.18.0 + set version 0.25.2 }] return diff --git a/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.4.0.tm b/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.4.2.tm similarity index 99% rename from src/bootsupport/modules/punk/args/moduledoc/tclcore-0.4.0.tm rename to src/bootsupport/modules/punk/args/moduledoc/tclcore-0.4.2.tm index f54c012e..6887ca20 100644 --- a/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.4.0.tm +++ b/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.4.2.tm @@ -8,7 +8,7 @@ # (C) 2025 # # @@ Meta Begin -# Application punk::args::moduledoc::tclcore 0.4.0 +# Application punk::args::moduledoc::tclcore 0.4.2 # Meta platform tcl # Meta license MIT # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args::moduledoc::tclcore 0 0.4.0] +#[manpage_begin punkshell_module_punk::args::moduledoc::tclcore 0 0.4.2] #[copyright "2025"] #[titledesc {punk::args definitions for tcl core commands}] [comment {-- Name section and table of contents description --}] #[moddesc {tcl core argument definitions}] [comment {-- Description at end of page heading --}] @@ -4408,7 +4408,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { # --------------------------------------------------------------------------------------------------------------------------- proc tclprefix_subcommands {} { dict set groups "" {all longest match} - return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 1 tcl::prefix] + return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 1 ::tcl::prefix] } set DYN_TCLPREFIX_SUBCOMMANDS {${[punk::args::moduledoc::tclcore::argdoc::tclprefix_subcommands]}} lappend PUNKARGS [list { @@ -7506,10 +7506,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "This command searches the elements of list to see if one of them matches pattern. If so, the command returns the index of the first matching element (unless the options -all or -inline are specified.) If not, the command returns -1 or (if options -all or -inline are specified) the empty string. The option arguments indicates how - the elements of the list are to be matched against pattern. - - (documentation incomplete - punk::args fixes required for grouped mutually exlusive options and prefix calculation) - " + the elements of the list are to be matched against pattern. " @leaders -min 0 -max 0 @opts -type none -parsekey "-MATCHSTYLE" -group "MATCHING STYLE OPTIONS" -grouphelp\ "If all matching style options are omitted, the default matching style is -glob. @@ -7524,13 +7521,15 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { -regexp -typedefaults "-regexp" -help\ "Pattern is treated as a regular expression and matched against each list element using the rules described in the re_syntax reference page." - -sorted -typedefaults "-sorted" -help\ + -sorted -typedefaults "-sorted" -conflicts {-glob -regexp} -help\ "The list elements are in sorted order. If this option is specified, lsearch will use a more efficient searching algorithm to search list. If no other options are specified, list is assumed to be sorted in increasing order, and to contain ASCII strings. This option is mutually exclusive with -glob and -regexp, and is treated exactly like -exact when either -all or -not are specified." - + #G-083: -sorted mutually exclusive with -glob and -regexp (per the man page) - + #modelled with per-arg -conflicts while keeping the MATCHING STYLE OPTIONS group at + #the default override mode (last-wins among -exact/-glob/-regexp). @opts -type string -parsekey "" -group "GENERAL MODIFIER OPTIONS" -all -type none -help\ @@ -7570,7 +7569,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "The list elements are sorted in decreasing order. This option is only meaningful when used with -sorted." -increasing -typedefaults "-increasing" -default "-increasing" -help\ "The list elements are sorted in increasing order. This option is only meaningful when used with -sorted." - -bisect -typedefaults "-bisect" -help\ + -bisect -typedefaults "-bisect" -conflicts {-all -not} -help\ "Inexact search when the list elements are in sorted order. For an increasing list the last index where the element is less than or equal to the pattern is returned. For a decreasing list the last index where the element is greater than or equal to the pattern is returned. If the pattern is before the first @@ -10074,7 +10073,19 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #set string_class_choices [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choices] set string_class_choicelabels [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choicelabels] dict for {sclass slabel} $string_class_choicelabels { - punk::args::define [string map [list %sc% $sclass %slabel% $slabel] { + #G-166: the virtual ids for forward classes THIS runtime lacks lead their help + #with the unavailability statement. The static class description already carries + #a version annotation, but it sits at the END of the prose (dict's "(class not + #present in Tcl 8.6)" is the twelfth line) - a reader of 'i string is dict' on 8.6 + #met the full class documentation before learning the class does not exist here. + #Runtimes that HAVE the class generate the id unchanged (the loop's condition is + #empty there, since string_is_unavailable is computed per-runtime above). + if {$sclass in $string_is_unavailable} { + set sclass_help " NOT AVAILABLE in this Tcl\n runtime ([info patchlevel]).\n Recognised forward class:\n the name is known and its\n prefix reserved here, but\n 'string is $sclass' is\n rejected by this\n interpreter.\n\n$slabel" + } else { + set sclass_help $slabel + } + punk::args::define [string map [list %sc% $sclass %slabel% $sclass_help] { @id -id "::tcl::string::is %sc%" @cmd -name "Built-in: string is %sc%" -help\ {%slabel%} @@ -11017,7 +11028,9 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #@form -form "setvalues" -synopsis "variable ?name value...? ?name?" @form -form "setvalues" @values -min 0 -max -1 - #todo - fix -parsekey for leaders and values + #G-084 (2026-08-07): value -parsekey now supported (name value pairs + #collect under the parsekey name_value). A leader -parsekey is settled as + #a define-time rejection (no silent ignore). "name value" -parsekey name_value -type {string any} -optional 1 -multiple 1 name -type string -optional 1 -multiple 0 @@ -12610,7 +12623,7 @@ namespace eval ::punk::args::register { package provide punk::args::moduledoc::tclcore [tcl::namespace::eval punk::args::moduledoc::tclcore { variable pkg punk::args::moduledoc::tclcore variable version - set version 0.4.0 + set version 0.4.2 }] return diff --git a/src/bootsupport/modules/punk/libunknown-0.2.4.tm b/src/bootsupport/modules/punk/libunknown-0.3.1.tm similarity index 93% rename from src/bootsupport/modules/punk/libunknown-0.2.4.tm rename to src/bootsupport/modules/punk/libunknown-0.3.1.tm index 9debffb8..bb2d4a7b 100644 --- a/src/bootsupport/modules/punk/libunknown-0.2.4.tm +++ b/src/bootsupport/modules/punk/libunknown-0.3.1.tm @@ -7,7 +7,7 @@ # (C) 2025 # # @@ Meta Begin -# Application punk::libunknown 0.2.4 +# Application punk::libunknown 0.3.1 # Meta platform tcl # Meta license MIT # @@ Meta End @@ -18,6 +18,33 @@ # from src/modules/AGENTS.md "Versioning And Releases" - bumping means # renaming the file AND updating the Meta line above, the manpage_begin line # below and the provide-block version, then appending a line here): +#0.3.1 - G-176 increment 4: the 'package epoch' subcommand is now DOCUMENTED - +# a punk::args doc block with the space-form id {::package epoch} is +# attached to the override's commandstack record via the new +# 'rename_command -punkargs' mechanism (commandstack 0.8.0). The doc +# lives and dies with the override: mirrored for lazy pickup when +# punk::args loads after init (normal early boot), defined immediately +# when punk::args is already present, and removed by any commandstack +# removal path (e.g restore_original ::package). 'i package epoch' in a +# punk shell now renders real usage instead of falling back to the +# parent ::package render. +#0.3.0 - G-176 increment 2: the ::package override installs via +# commandstack::rename_command (renamer punk::libunknown) instead of the +# former 'rename ::package ::package::' + namespace-import mechanism, so +# both live ::package overrides (this + punk::packagepreference's) share +# one managed stack whatever the install order. init now does +# 'package require commandstack' (a no-op where commandstack is already +# provided, e.g whenever punk::packagepreference::install ran first) and +# re-entry is guarded by a stack query for our renamer record instead of +# the old ::punk::libunknown::package proc-existence check. The override +# body runs at :: (namespace-relative epoch_incr_* calls fully +# qualified; the dead 'variable has_package_files' declaration dropped - +# its only use was already commented out) and delegates via +# COMMANDSTACKNEXT (no ::package:: parking name; nothing in the tree +# called it). Behaviour of every arm is unchanged - pinned by +# tests/modules/punk/libunknown testsuites/discovery/packageoverride.test +# (the increment-1 characterisation; only its marked install-shape pins +# flipped with this change). #0.2.4 - register_all_tm: skip the G-155 workdirs _mint and _bake alongside # legacy _build, in both the filesystem directory walk and the tm-file # filter (the latter also guards the zipfs whole-tree listing) - loose @@ -71,7 +98,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::libunknown 0 0.2.4] +#[manpage_begin punkshell_module_punk::libunknown 0 0.3.1] #[copyright "2025"] #[titledesc {Module API}] [comment {-- Name section and table of contents description --}] #[moddesc {-}] [comment {-- Description at end of page heading --}] @@ -1509,10 +1536,12 @@ tcl::namespace::eval ::punk::libunknown { -summary\ "Install punk::libunknown's custom package unknown handlers and epoch system in the current interp."\ -help\ - "Renames the builtin ::package to ::package:: and installs a custom ::package proc - that intercepts 'forget' (controlled forgetting) and adds an 'epoch' subcommand - (for introspection). Sets package unknown to a two-handler chain: - zipfs_tm_UnknownHandler (tm paths) and zipfs_tclPkgUnknown (auto_path/pkgIndex). + "Installs a ::package override via commandstack::rename_command (renamer + punk::libunknown) that intercepts 'forget' (controlled forgetting) and adds an + 'epoch' subcommand (for introspection); all other subcommands delegate to the + previous implementation on the commandstack. Sets package unknown to a + two-handler chain: zipfs_tm_UnknownHandler (tm paths) and zipfs_tclPkgUnknown + (auto_path/pkgIndex). Installs traces on ::auto_path and ::tcl::tm::paths that increment the epoch when these change, invalidating stale scan cache entries. @@ -1571,14 +1600,22 @@ tcl::namespace::eval ::punk::libunknown { puts stderr "punk::libunknown::init - init while empty/unreadable tcl::tm::list and empty/unreadable ::auto_path" } - if {[info commands ::punk::libunknown::package] ne ""} { - puts stderr "punk::libunknown::init already done - unnecessary call? info frame -1: [info frame -1]" - return + #commandstack is the install mechanism for the ::package override (G-176). + #A no-op when already provided (e.g whenever punk::packagepreference::install + #ran first, or a boot context pre-sourced it); otherwise resolves via the + #standard package machinery - commandstack is lean and dependency-free. + #0.8- floor: rename_command -punkargs (the attached 'package epoch' doc) + #arrived at commandstack 0.8.0 - an older stable copy must fail HERE with a + #version message, not mid-call with a usage error (with the default stable + #preference an old stable copy would otherwise beat an alpha dev copy). + package require commandstack 0.8- + #re-entry guard: our override record on the ::package commandstack + foreach stackrecord [commandstack::get_stack ::package] { + if {[dict get $stackrecord renamer] eq "punk::libunknown"} { + puts stderr "punk::libunknown::init already done - unnecessary call? info frame -1: [info frame -1]" + return + } } - #if {[namespace origin ::package] eq "::punk::libunknown::package"} { - # #This is far from conclusive - there may be other renamers (e.g commandstack) - # return - #} @@ -1686,13 +1723,57 @@ tcl::namespace::eval ::punk::libunknown { trace add variable ::auto_path write ::punk::libunknown::epoch_incr_pkg trace add variable ::tcl::tm::paths write ::punk::libunknown::epoch_incr_tm - #set stackrecord [commandstack::rename_command -renamer punk::libunknown package {args} { - # #::package override installed by punk::libunknown::init - #} - proc package args { + #::package override - installed via commandstack (G-176) so both live + #::package overrides (this + punk::packagepreference's) share one managed + #stack whatever the install order. The body runs at :: - namespace-relative + #references must be fully qualified. + #The added 'epoch' subcommand's documentation travels WITH the override: + #attached to the stack record via -punkargs, live while the record is on + #the stack, removed with it by any commandstack removal path. The deflist + #stays free of dollar-brace tstr substitutions - when punk::args loads + #after us (normal early boot) it is lazily evaluated in the registered + #::commandstack::stackdocs namespace, not in ours. + set epochdoc {@id -id {::package epoch} + @cmd -name "punk::libunknown override: package epoch"\ + -summary\ + "package/module discovery epoch introspection."\ + -help\ + "Introspect (or manually advance) the punk::libunknown discovery epoch + counters that key the package/module scan caches. Added by the + ::package override that punk::libunknown::init installs - this + subcommand (and this documentation) is present only while that + override is live. + + Forms: + package epoch - dict {tm pkg } - the current + epoch counters + package epoch tm|pkg - one-entry dict keyed by the current + epoch: { } + package epoch incr - increment BOTH the tm and pkg epochs, + invalidating the scan caches (e.g after + adding a .tm file to an already-scanned + directory) + package epoch tm|pkg incr - increment one epoch (also accepted as: + package epoch incr tm|pkg) + package epoch tm|pkg - the epochinfo record for epoch + (error for an unknown ) + package epoch tm|pkg ... + - walk keys into that epochinfo record + (an unknown key errors naming the + available toplevel keys) + + The epochs also advance automatically via traces on ::auto_path and + ::tcl::tm::paths." + @values -min 0 -max -1 + which -type string -optional 1 -choices {tm pkg incr} -choicerestricted 0 -help\ + "epoch selector (tm or pkg), or incr to advance both epochs." + arg -type any -optional 1 -multiple 1 -help\ + "index (or incr) and optional key path - see the forms above." + } + set stackrecord [commandstack::rename_command -renamer punk::libunknown -punkargs [list [list $epochdoc]] package {args} { + #::package override installed by punk::libunknown::init (epoch/forget arms; all else delegates) switch -- [lindex $args 0] { fo - for - forge - forget { - variable has_package_files #experimental - silently disallow forgetting things that didn't involve sourcing files #What about static libs that also sourced files? #packages loaded by c extensions? @@ -1731,7 +1812,7 @@ tcl::namespace::eval ::punk::libunknown { } } if {[llength $ok_forgets]} { - return [uplevel 1 [list ::package:: forget {*}$ok_forgets]] + return [uplevel 1 [list $COMMANDSTACKNEXT forget {*}$ok_forgets]] } else { return } @@ -1756,8 +1837,8 @@ tcl::namespace::eval ::punk::libunknown { return [dict create $cur [dict get $epoch pkg epochs $cur]] } incr { - epoch_incr_pkg - epoch_incr_tm + ::punk::libunknown::epoch_incr_pkg + ::punk::libunknown::epoch_incr_tm } default { error "package epoch [lindex $epoch_args 0] unsupported - known options: tm pkg incr" @@ -1768,10 +1849,10 @@ tcl::namespace::eval ::punk::libunknown { set a2 [list [lindex $epoch_args 0] [lindex $epoch_args 1]] switch -- $a2 { {pkg incr} - {incr pkg} { - epoch_incr_pkg + ::punk::libunknown::epoch_incr_pkg } {tm incr} - {incr tm} { - epoch_incr_tm + ::punk::libunknown::epoch_incr_tm } default { set which [lindex $epoch_args 0] @@ -1813,13 +1894,10 @@ tcl::namespace::eval ::punk::libunknown { } } default { - return [uplevel 1 [list ::package:: {*}$args]] + return [uplevel 1 [list $COMMANDSTACKNEXT {*}$args]] } } - } - rename ::package ::package:: - #all lowercase procs already exported from ::punk::libunknown - namespace eval :: [list ::namespace import ::punk::libunknown::package] + }] #if {[info commands ::tcl::zipfs::root] ne ""} { # set has_zipfs_tm 0 @@ -2183,7 +2261,7 @@ namespace eval ::punk::args::register { package provide punk::libunknown [tcl::namespace::eval ::punk::libunknown { variable pkg punk::libunknown variable version - set version 0.2.4 + set version 0.3.1 }] return diff --git a/src/bootsupport/modules/punk/ns-0.9.3.tm b/src/bootsupport/modules/punk/ns-0.11.0.tm similarity index 95% rename from src/bootsupport/modules/punk/ns-0.9.3.tm rename to src/bootsupport/modules/punk/ns-0.11.0.tm index af297a1d..240cbbd2 100644 --- a/src/bootsupport/modules/punk/ns-0.9.3.tm +++ b/src/bootsupport/modules/punk/ns-0.11.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ns 0.9.3 +# Application punk::ns 0.11.0 # Meta platform tcl # Meta license # @@ Meta End @@ -4652,7 +4652,35 @@ y" {return quirkykeyscript} -summary\ "Subcommand resolution of ensemble-like tree of commands."\ -help\ - "Return a dict with command resolution info for ensemble-like tree of commands with subcommands" + "Return a dict with command resolution info for ensemble-like tree of commands with subcommands + + Result keys: + origin - the resolved command (or the docid path for a + documentation-only landing) + cmdtype - what KIND of executable thing resolution landed on + (proc, native, alias, ensemble, doconly, notfound...) + unavailable - (G-166) empty string, or the canonical + -choiceunavailable name the resolution addressed. + A SEPARATE axis from cmdtype: it describes the + resolved word's availability in this + runtime/context, not the kind of thing found. + Non-empty means the landing is documentation the + current runtime cannot actually run - e.g + 'string is dict' on Tcl 8.6. + overridden - (G-176) empty list, or one entry per LIVE + commandstack rename record on the BASE command + (bottom-up): a dict {renamer docids + } where docids are the punk::args ids of + any doc blocks the record attached via + 'rename_command -punkargs'. A second axis like + 'unavailable': it describes the live override + state of the command, not the kind of thing + resolution landed on. Always empty when the + commandstack package is not loaded. + args_resolved - the command words consumed by resolution + args_remaining- the trailing words resolution did not consume + docid - the punk::args definition id documenting the landing + stack - per-level record of the traversal" @leaders -min 0 -max 0 @opts -form -default * -help\ @@ -4683,8 +4711,9 @@ y" {return quirkykeyscript} set commands [list] set consumed_args [list] set docid "" + set unavailable "" ;#G-166: availability attribution of the FINAL landing (each record overwrites) while {$final == 0} { - lassign [$reduce $origin] final origin consumed remainingargs docid + lassign [$reduce $origin] final origin consumed remainingargs docid unavailable #if {$final != 1} { if {[string match (autodef)* $origin]} { set origin [string range $origin 9 end] @@ -4715,8 +4744,50 @@ y" {return quirkykeyscript} #genuinely unknown command. The docid remains authoritative for display. set cmdtype doconly } - return [list origin $origin cmdtype $cmdtype args_resolved [list [lindex $commands 0] {*}$consumed_args] args_remaining $remainingargs docid $docid stack $stack] + #G-166: 'unavailable' is deliberately a SECOND axis beside cmdtype - cmdtype + #answers what kind of executable thing resolution landed on, availability + #answers whether the resolved word is selectable in this runtime/context. + #Overloading cmdtype (e.g a 'doconly_unavailable' value) would break every + #consumer switching on cmdtype eq "doconly", and the two only co-occur + #incidentally (an unavailable name has no real command behind it today). + #G-176: 'overridden' is a further second-axis key - the live commandstack + #override state of the BASE command word, queried at call time (never + #cached) so it is correct by construction as stacks change. + return [list origin $origin cmdtype $cmdtype unavailable $unavailable overridden [_cmdinfo_overridden [lindex $commands 0]] args_resolved [list [lindex $commands 0] {*}$consumed_args] args_remaining $remainingargs docid $docid stack $stack] } + #G-176: live commandstack override records for a command - one dict + #{renamer docids } per record, bottom-up. docids are the + #punk::args ids of doc blocks the record attached via 'rename_command + #-punkargs' (derived with punk::args::rawdef_id - deflists whose id cannot + #be derived are simply not listed). Guarded: empty list when the + #commandstack package is not loaded - no hard dependency. + proc _cmdinfo_overridden {command} { + if {![llength [info commands ::commandstack::get_stack]]} { + return [list] + } + if {[catch {commandstack::get_stack $command} stackrecords]} { + return [list] + } + set overridden [list] + foreach crec $stackrecords { + if {![dict exists $crec renamer]} {continue} + set docids [list] + if {[dict exists $crec punkargs] && [llength [info commands ::punk::args::rawdef_id]]} { + foreach deflist [dict get $crec punkargs] { + if {![catch {punk::args::rawdef_id $deflist} rawid] && $rawid ne ""} { + lappend docids $rawid + } + } + } + lappend overridden [dict create renamer [dict get $crec renamer] docids $docids] + } + return $overridden + } + #Each record yielded/returned by cmd_traverse is: + # [list ] + # (G-166) is the canonical -choiceunavailable name this level's + #resolution addressed, or empty. cmdinfo keeps the FINAL record's value - the + #availability of the landing it reports. proc cmd_traverse {ns formid args} { set autodefined [dict create] #puts "cmd_traverse args: $args yielding: [info coroutine]" @@ -4746,7 +4817,7 @@ y" {return quirkykeyscript} set origin $which ;#Flip our traversal to be on the documented 'which' rather than the actual origin if {$whichtype eq "alias"} { #*documented* alias - return [list 1 $origin {} [lrange $args 1 end] $docid] + return [list 1 $origin {} [lrange $args 1 end] $docid {}] } } } @@ -4773,10 +4844,10 @@ y" {return quirkykeyscript} #} else { if {$docid ne "" && ![llength [lrange $args 1 end]]} { - return [list 0a $origin {} {} $docid] + return [list 0a $origin {} {} $docid {}] } - set origin [yield [list 0 $origin {} [lrange $args 1 end] $docid]] + set origin [yield [list 0 $origin {} [lrange $args 1 end] $docid {}]] set whichinfo [namespace eval $ns [list punk::ns::cmdwhich $cmd]] set origin [dict get $whichinfo origin] set origintype [dict get $whichinfo origintype] @@ -4867,7 +4938,7 @@ y" {return quirkykeyscript} } #} if {[llength $args] == 1} { - return [list 2 $origin $resolvedargs {} $docid] + return [list 2 $origin $resolvedargs {} $docid {}] } set terminate 0 for {set i 1} {$i < [llength $args]} {incr i} { @@ -4894,19 +4965,18 @@ y" {return quirkykeyscript} set docid_exists 0 set eparams [list] set a_spaceform "" - if {[punk::args::id_exists "$origin [lindex $args $i]"]} { - set a_spaceform [lindex $args $i] - } elseif {$docid ne "" && [punk::args::id_exists $docid]} { - #G-051 space-form docid prefix parity: no space-form id exists for the - #exact word - if the current level's definition has a choices-bearing - #first leader, resolve the word with the same shared resolver argument - #parsing uses (punk::args::choiceword_match - honouring -choiceprefix, - #-nocase, -choicealiases, -choiceprefixdenylist, - #-choiceprefixreservelist) and retry the space-form lookup with the - #canonical word - so 'i string is tr' lands on the documentation for - #what 'string is tr' actually executes. No second matching rule: a word - #parse would reject resolves nothing here either, and a canonical with - #no space-form id falls through to the normal per-level handling. + set a_unavailable "" ;#G-166 availability attribution for this level's landing + set a_word [lindex $args $i] + #G-051 space-form docid prefix parity / G-166 availability attribution: + #resolve the word against the current level's choices-bearing first leader + #with the same shared resolver argument parsing uses + #(punk::args::choiceword_match - honouring -choiceprefix, -nocase, + #-choicealiases, -choiceprefixdenylist, -choiceprefixreservelist and + #-choiceunavailable). Computed once here because BOTH the exact-word + #space-form landing and the prefix retry consult it: the exact landing only + #for the availability verdict, the prefix retry for the canonical word too. + set lvl_matchinfo "" + if {$docid ne "" && [punk::args::id_exists $docid]} { set pf_spec [punk::args::get_spec $docid] set pf_fid [lindex [dict get $pf_spec form_names] 0] set pf_leaders [dict get $pf_spec FORMS $pf_fid LEADER_NAMES] @@ -4917,7 +4987,7 @@ y" {return quirkykeyscript} lappend pf_allchoices {*}$pf_members } if {[llength $pf_allchoices]} { - set pf_matchinfo [punk::args::choiceword_match [lindex $args $i]\ + set lvl_matchinfo [punk::args::choiceword_match $a_word\ [punk::args::system::Dict_getdef $pf_arginfo -nocase 0]\ $pf_allchoices\ [punk::args::system::Dict_getdef $pf_arginfo -choicealiases {}]\ @@ -4926,15 +4996,46 @@ y" {return quirkykeyscript} [punk::args::system::Dict_getdef $pf_arginfo -choiceprefixreservelist {}]\ [punk::args::system::Dict_getdef $pf_arginfo -choiceunavailable {}]\ ] - if {[dict get $pf_matchinfo matched]} { - set pf_canonical [dict get $pf_matchinfo canonical] - if {$pf_canonical ne [lindex $args $i] && [punk::args::id_exists "$origin $pf_canonical"]} { - set a_spaceform $pf_canonical - } - } } } } + if {[punk::args::id_exists "$origin $a_word"]} { + set a_spaceform $a_word + #G-166: the exact word may address a recognised-but-unavailable name. + #Its virtual docid exists by G-073 design (documentation REACHABILITY + #for unavailable words), so resolution succeeds - but the landing is + #attributed so consumers can tell it from a usable one. + if {$lvl_matchinfo ne "" && [dict get $lvl_matchinfo unavailable]} { + set a_unavailable [dict get $lvl_matchinfo canonical] + } + } elseif {$lvl_matchinfo ne "" && [dict get $lvl_matchinfo matched]} { + #retry the space-form lookup with the canonical word - so 'i string is + #tr' lands on the documentation for what 'string is tr' actually + #executes. No second matching rule: a word parse would reject resolves + #nothing here either, and a canonical with no space-form id falls + #through to the normal per-level handling. + set pf_canonical [dict get $lvl_matchinfo canonical] + if {$pf_canonical ne $a_word && [punk::args::id_exists "$origin $pf_canonical"]} { + set a_spaceform $pf_canonical + } + } elseif {$lvl_matchinfo ne "" && [dict get $lvl_matchinfo unavailable]} { + #G-166 DECISION (enacting the G-073 follow-on): a unique prefix landing + #on an unavailable name resolves that name's virtual docid, marked - + #it no longer conservatively resolves nothing. Rationale: documentation + #ADDRESSING and word AVAILABILITY are separate axes (the whole point of + #the attribution added here). Encoding availability as + #resolve-vs-don't-resolve conflated them and made addressing + #inconsistent - 'string is tr' resolved but 'string is dic' did not, + #while exact 'string is true' and 'string is dict' both did. Now every + #form of address that names a documented word resolves it, and the + #availability key (plus cmdhelp's marking) carries the rejection story + #that parse reports for the same word. + set pf_canonical [dict get $lvl_matchinfo canonical] + if {[punk::args::id_exists "$origin $pf_canonical"]} { + set a_spaceform $pf_canonical + set a_unavailable $pf_canonical + } + } if {$a_spaceform ne ""} { set a $a_spaceform #review - tests? @@ -4966,7 +5067,7 @@ y" {return quirkykeyscript} #review - get_spec needs to resolve if @dynamic #we don't really need the spec if we have no queryargs if {![llength $queryargs]} { - return [list X $origin $resolvedargs $queryargs_untested $docid] + return [list X $origin $resolvedargs $queryargs_untested $docid $a_unavailable] } @@ -5063,7 +5164,7 @@ y" {return quirkykeyscript} #ledit queryargs_untested 0 0 #jjj #continue - return [list 3 $origin $resolvedargs [list {*}$eparams {*}$queryargs_untested] $docid] + return [list 3 $origin $resolvedargs [list {*}$eparams {*}$queryargs_untested] $docid $a_unavailable] break } #G-040: resolve the subcommand word with the same shared resolver argument @@ -5078,9 +5179,10 @@ y" {return quirkykeyscript} #doc-only ids without implying the word parses - that is how per-class ids #like 'string is true' have always documented argument words, and how an #UNAVAILABLE word's virtual id ('string is dict' on 8.6) documents since - #G-073. Consequence: cmdinfo classes both landings 'doconly' with no - #availability distinction - surfacing that (cmdinfo axis / render marking) - #is deliberately not decided here. + #G-073. G-166 settled the surfacing: the addressing branches above resolve + #such landings and cmdinfo reports them on its own 'unavailable' axis, + #while THIS traverse keeps its parity claim intact - an unavailable word + #still identifies no subcommand here, it is only attributed below. set ct_matchinfo [punk::args::choiceword_match $q\ [punk::args::system::Dict_getdef $arginfo -nocase 0]\ $allchoices\ @@ -5093,7 +5195,14 @@ y" {return quirkykeyscript} if {![dict get $ct_matchinfo matched]} { #no match under parse rules (covers: unknown word, ambiguous prefix, #reserved word, denied prefix, and non-exact word when -choiceprefix 0) - return [list 4 $origin $resolvedargs $queryargs_untested $docid] + #G-166: a landing on a recognised-but-unavailable name is still not a + #subcommand match, but it IS attributed - this is the path taken when + #the unavailable name has no space-form virtual docid to address. + set ct_unavailable "" + if {[dict get $ct_matchinfo unavailable]} { + set ct_unavailable [dict get $ct_matchinfo canonical] + } + return [list 4 $origin $resolvedargs $queryargs_untested $docid $ct_unavailable] break } set resolved_q [dict get $ct_matchinfo canonical] @@ -5191,10 +5300,10 @@ y" {return quirkykeyscript} #punk::args::update_definitions [list [namespace qualifiers $mapped_subcmd]] if {[llength $queryargs_untested] == 0} { - return [list 6 $mapped_subcmd $resolvedargs [list {*}$eparams {*}$queryargs_untested] $docid] + return [list 6 $mapped_subcmd $resolvedargs [list {*}$eparams {*}$queryargs_untested] $docid {}] } - set origin [yield [list 0 $mapped_subcmd $resolvedargs [list {*}$eparams {*}$queryargs_untested] $docid]] + set origin [yield [list 0 $mapped_subcmd $resolvedargs [list {*}$eparams {*}$queryargs_untested] $docid {}]] #set resolvedargs [list] #incr i [expr {-1 * [llength $resolvedargs]+1}] ;#wrong e.g test trace add execution blah enterstep cmd @@ -5223,22 +5332,22 @@ y" {return quirkykeyscript} break ;#out of foreach q $queryargs ... } else { #test with: i namespace which -v x - return [list 7 $origin $resolvedargs $queryargs_untested $prevdocid] + return [list 7 $origin $resolvedargs $queryargs_untested $prevdocid {}] } } ;#end loop foreach q $queryargs lname $leadernames_matched } else { #?? #puts stderr "cmdinfo.cmd_traverse returning 8 origin: $origin resolved: $resolvedargs remaining: [lrange $args $i end] docid: $docid" - return [list 8 $origin $resolvedargs [lrange $args $i end] $docid] + return [list 8 $origin $resolvedargs [lrange $args $i end] $docid $a_unavailable] } } else { #puts stderr "origin $origin not documented" - return [list 9 $origin {} [lrange $args $i end] ""] + return [list 9 $origin {} [lrange $args $i end] "" {}] } } #REVIEW!!! #puts stderr "cmd_traverse 10 $origin $resolvedargs $queryargs_untested $docid - review" - return [list 10 $origin $resolvedargs $queryargs_untested $docid] + return [list 10 $origin $resolvedargs $queryargs_untested $docid $a_unavailable] } @@ -5494,12 +5603,18 @@ y" {return quirkykeyscript} } -help\ "Return form of the usage information. 'dict' returns a dict with keys origin, docid, cmdtype, - args_remaining and parsestatus - where parsestatus is the - parse-status structure of the supplied argument words against - the resolved definition (see punk::args::parse_status for the - documented structure; empty if the command is undocumented). + unavailable, args_remaining and parsestatus - where parsestatus + is the parse-status structure of the supplied argument words + against the resolved definition (see punk::args::parse_status for + the documented structure; empty if the command is undocumented). Its per-argument statuses distinguish a fully-valid, an invalid and an incomplete argument set machine-parsably. + 'unavailable' (G-166) is empty, or the canonical + -choiceunavailable name the resolution addressed - a subject the + current runtime/context documents but cannot run (e.g + 'string is dict' on Tcl 8.6). The other return forms carry the + same fact as a visible marking, and never present such a subject + as a cleanly usable command line. 'text' returns plain text with no ANSI codes and no table layout, rendering the argument section of every command form (or of each form in an explicit -form selection) in a single @@ -5542,6 +5657,35 @@ y" {return quirkykeyscript} form (no words, an ambiguous match, or words no form accepts) keep the whole-command render." } + #G-166: the single wording for cmdhelp's recognised-but-unavailable marking, shared + #by the table and text return forms so every surface says the same thing. Vocabulary + #deliberately mirrors punk::args' tailored parse rejection + #(private::unavailable_choice_msg, G-073) - a user who meets both reads one story. + #The runtime-specific WHY is not repeated here: it belongs to the definition, and the + #unavailable subject's own help leads with it (the tclcore virtual ids do since G-166). + proc _cmdhelp_unavailable_marking {name} { + #(wording stays position-neutral: the table/string renderers place the message + #below the usage, the text form leads with it) + return "'$name' is a recognised name here, but is not available in this runtime/context - this command line is not usable here and the usage shown is reference documentation only." + } + #G-176: one-line override-in-place notice from cmdinfo's 'overridden' axis. + #basecmd is the command the records belong to (the cmdhelp subject); + #overridden is the list of {renamer .. docids ..} dicts (bottom-up). Returns + #the bare notice - the table render prefixes 'note: ', -return text prefixes + #'OVERRIDDEN: ' (its machine-facing leading-line convention). + proc _cmdhelp_override_notice {basecmd overridden} { + set renamers [list] + set docids [list] + foreach rec $overridden { + lappend renamers [dict get $rec renamer] + lappend docids {*}[dict get $rec docids] + } + set notice "'$basecmd' is currently overridden/extended via commandstack by: [join $renamers {, }]" + if {[llength $docids]} { + append notice " (override-attached docs: '[join $docids {', '}]')" + } + return $notice + } proc cmdhelp {args} { set nscaller [uplevel 1 [list ::tcl::namespace::current]] lassign [dict values [punk::args::parse $args -cache 1 withid ::punk::ns::cmdhelp]] leaders opts values received @@ -5589,9 +5733,15 @@ y" {return quirkykeyscript} #string renderer and the sections are joined below the common header. set dinfo [uplevel 1 [list ::punk::ns::cmdhelp -return dict -form $opt_form -- $querycommand {*}$queryargs]] set docid [dict get $dinfo docid] + set text_overridden [punk::args::system::Dict_getdef $dinfo overridden {}] ;#G-176 if {$docid eq ""} { - return "Undocumented command [dict get $dinfo origin]. Type: [dict get $dinfo cmdtype]" + set undoc "Undocumented command [dict get $dinfo origin]. Type: [dict get $dinfo cmdtype]" + if {[llength $text_overridden]} { + set undoc "OVERRIDDEN: [_cmdhelp_override_notice $querycommand $text_overridden]\n$undoc" + } + return $undoc } + set unavail [dict get $dinfo unavailable] ;#G-166 (the dict form always carries it) set spec [punk::args::get_spec $docid] set pstatus [dict get $dinfo parsestatus] if {$opt_form ne "*"} { @@ -5632,6 +5782,16 @@ y" {return quirkykeyscript} } set result [string trimright $result \n] } + if {[llength $text_overridden]} { + #G-176: override-in-place leading line for the machine/LLM-facing + #surface (sits below UNAVAILABLE when both apply) + set result "OVERRIDDEN: [_cmdhelp_override_notice $querycommand $text_overridden]\n$result" + } + if {$unavail ne ""} { + #G-166: mark the plain-text form too - it is the machine/LLM-facing + #surface, so the marking leads rather than trailing the usage block. + set result "UNAVAILABLE: [_cmdhelp_unavailable_marking $unavail]\n$result" + } if {$opt_grepstr ne ""} { if {[llength $opt_grepstr] == 1} { set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] @@ -5682,13 +5842,19 @@ y" {return quirkykeyscript} } else { dict set nextopts -form [dict get $pstatus form] } + set alias_overridden [punk::args::system::Dict_getdef $testinfo overridden {}] ;#G-176 if {$opt_return eq "dict"} { if {$scheme_received} { dict set pstatus scheme [dict get $opts -scheme] } - return [dict create origin $rootorigin docid $rootdoc cmdtype $rootorigintype args_remaining $queryargs parsestatus $pstatus] - } - if {[dict get $pstatus ok]} { + return [dict create origin $rootorigin docid $rootdoc cmdtype $rootorigintype unavailable [dict get $testinfo unavailable] overridden $alias_overridden args_remaining $queryargs parsestatus $pstatus] + } + #G-166: an unavailable subject never renders as a cleanly usable + #command line - see the matching site in the main cmdhelp body. + set unavail [dict get $testinfo unavailable] + if {$unavail ne ""} { + set result [punk::args::arg_error [_cmdhelp_unavailable_marking $unavail] [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0 -parsestatus $pstatus] + } elseif {[dict get $pstatus ok]} { #show usage - with goodargs marked if {!$scheme_received} { dict set nextopts -scheme info @@ -5697,6 +5863,10 @@ y" {return quirkykeyscript} } else { set result [punk::args::arg_error [dict get $pstatus message] [punk::args::get_spec $rootdoc] {*}$nextopts -aserror 0 -parsestatus $pstatus] } + if {[llength $alias_overridden]} { + #G-176: override-in-place notice leads the render + set result "note: [_cmdhelp_override_notice $querycommand $alias_overridden]\n$result" + } if {$opt_grepstr ne ""} { if {[llength $opt_grepstr] == 1} { set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] @@ -5753,6 +5923,8 @@ y" {return quirkykeyscript} set origindoc [dict get $cinfo docid] set args_remaining [dict get $cinfo args_remaining] set origintype [dict get $cinfo cmdtype] + set unavail [dict get $cinfo unavailable] ;#G-166 + set overridden [punk::args::system::Dict_getdef $cinfo overridden {}] ;#G-176 switch -- $origintype { script { @@ -5800,9 +5972,21 @@ y" {return quirkykeyscript} if {$scheme_received} { dict set pstatus scheme [dict get $opts -scheme] } - return [dict create origin $origin docid $origindoc cmdtype $origintype args_remaining $args_remaining parsestatus $pstatus] - } - if {[dict get $pstatus ok]} { + return [dict create origin $origin docid $origindoc cmdtype $origintype unavailable $unavail overridden $overridden args_remaining $args_remaining parsestatus $pstatus] + } + #G-166: a recognised-but-unavailable subject is never presented as cleanly + #usable. The advisory parse can succeed against the subject's virtual id + #(the id documents the word, and an argument tail like 'string is dict 5' + #satisfies it) - so an ok parse would otherwise switch to the 'info' scheme + #and mark the words good, rendering exactly like a usable command line. The + #unavailability marking takes precedence over BOTH the ok-parse info render + #and any parse failure message: the subject not existing here is the more + #fundamental report, and it is the one a parse against a virtual id cannot + #make. The parse status is still passed through, so argument positions keep + #their marking under the (non-info) scheme. + if {$unavail ne ""} { + set result [punk::args::arg_error [_cmdhelp_unavailable_marking $unavail] [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0 -parsestatus $pstatus] + } elseif {[dict get $pstatus ok]} { #show usage - with goodargs marked if {!$scheme_received} { dict set nextopts -scheme info @@ -5811,6 +5995,10 @@ y" {return quirkykeyscript} } else { set result [punk::args::arg_error [dict get $pstatus message] [punk::args::get_spec $origindoc] {*}$nextopts -aserror 0 -parsestatus $pstatus] } + if {[llength $overridden]} { + #G-176: override-in-place notice leads the render + set result "note: [_cmdhelp_override_notice $querycommand $overridden]\n$result" + } if {$opt_grepstr ne ""} { if {[llength $opt_grepstr] == 1} { set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] @@ -5821,9 +6009,13 @@ y" {return quirkykeyscript} return $result } else { if {$opt_return eq "dict"} { - return [dict create origin $origin docid "" cmdtype $origintype args_remaining $args_remaining parsestatus {}] + return [dict create origin $origin docid "" cmdtype $origintype unavailable $unavail overridden $overridden args_remaining $args_remaining parsestatus {}] + } + set result "Undocumented command $origin. Type: $origintype" + if {[llength $overridden]} { + set result "note: [_cmdhelp_override_notice $querycommand $overridden]\n$result" } - return "Undocumented command $origin. Type: $origintype" + return $result } } @@ -6746,6 +6938,6 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ns [tcl::namespace::eval punk::ns { variable version - set version 0.9.3 + set version 0.11.0 }] return diff --git a/src/make.tcl b/src/make.tcl index 1dcef5c5..70a5a801 100644 --- a/src/make.tcl +++ b/src/make.tcl @@ -1780,12 +1780,15 @@ if {$bootsupport_paths_exist || $sourcesupport_paths_exist} { } } if {$libunknown ne ""} { - if {[info commands ::punk::libunknown::package] ne ""} { + if {[package provide punk::libunknown] ne ""} { #libunknown already active in this interp - e.g make.tcl driven by a built punk - #executable whose boot (punk_main.tcl) initialised it. init's rename of ::package - #must not be repeated (its guard would emit an 'init already done' diagnostic and - #return), and re-sourcing would silently swap the running copy for the bootsupport - #copy - leave the active one in place. + #executable whose boot (punk_main.tcl) sourced and initialised it. init's + #::package override must not be repeated, and re-sourcing would silently swap + #the running copy for the bootsupport copy - leave the active one in place. + #(G-176 follow-on: probe by package-provide, not 'info commands + #::punk::libunknown::package' - the 0.3.x commandstack-managed install no + #longer creates that proc, while every vintage's boot-site source executes + #'package provide punk::libunknown'.) } else { source $libunknown if {[catch {punk::libunknown::init -caller make.tcl} errM]} {