coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tcl: apply command — anonymous proc call reusing tcl-call-proc frame machinery
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Details

Browse Source
This commit is contained in:
giles
2026-05-06 15:37:26 +00:00
parent 0cc36450c4
commit 40ce4df6b1
1 changed files with 23 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
lib/tcl/runtime.sx
View File

@@ -2903,6 +2903,28 @@
(define tcl-cmd-tell (fn (interp args) (assoc interp :result "0")))
(define tcl-cmd-flush (fn (interp args) (assoc interp :result "")))
(define
tcl-cmd-apply
(fn
(interp args)
(if
(< (len args) 1)
(error "apply: wrong # args: should be "apply lambdaList ?arg ...?"")
(let
((func-list (tcl-list-split (first args)))
(call-args (rest args)))
(if
(< (len func-list) 2)
(error "apply: lambdaList must be a 2 or 3 element list")
(let
((param-spec (first func-list))
(body (nth func-list 1))
(ns (if (> (len func-list) 2) (nth func-list 2) nil)))
(let
((proc-def {:args param-spec :body body :ns ns}))
(tcl-call-proc interp "#apply" proc-def call-args))))))))
(define
tcl-cmd-regexp
(fn
@@ -3172,4 +3194,4 @@
((i (tcl-register i "flush" tcl-cmd-flush)))
(let ((i (tcl-register i "file" tcl-cmd-file)))
(let ((i (tcl-register i "regexp" tcl-cmd-regexp)))
(tcl-register i "regsub" tcl-cmd-regsub))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
(let ((i (tcl-register i "regsub" tcl-cmd-regsub))) (tcl-register i "apply" tcl-cmd-apply)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))