Refactor MCP tree server: dispatch table, caching, validation, subprocess cleanup
Break up the 1735-line handle_tool match into 45 individual handler functions with hashtable-based dispatch. Add mtime-based file parse caching (AST + CST), consolidated run_command helper replacing 9 bare open_process_in patterns, require_file/require_dir input validation, and pagination (limit/offset) for sx_find_across, sx_comp_list, sx_comp_usage. Also includes pending VM changes: rest-arity support, hyperscript parser, compiler/transpiler updates. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -640,29 +640,38 @@
|
||||
(fn-scope (make-scope scope))
|
||||
(fn-em (make-emitter)))
|
||||
(dict-set! fn-scope "is-function" true)
|
||||
(for-each
|
||||
(fn
|
||||
(p)
|
||||
(let
|
||||
((name (cond (= (type-of p) "symbol") (symbol-name p) (and (list? p) (not (empty? p)) (= (type-of (first p)) "symbol")) (symbol-name (first p)) :else p)))
|
||||
(when
|
||||
(and (not (= name "&key")) (not (= name "&rest")))
|
||||
(scope-define-local fn-scope name))))
|
||||
params)
|
||||
(compile-begin fn-em body fn-scope true)
|
||||
(emit-op fn-em 50)
|
||||
(let
|
||||
((upvals (get fn-scope "upvalues"))
|
||||
(code {:upvalue-count (len upvals) :arity (len (get fn-scope "locals")) :constants (get (get fn-em "pool") "entries") :bytecode (get fn-em "bytecode")})
|
||||
(code-idx (pool-add (get em "pool") code)))
|
||||
(emit-op em 51)
|
||||
(emit-u16 em code-idx)
|
||||
((rest-pos -1) (rest-name nil))
|
||||
(for-each
|
||||
(fn
|
||||
(uv)
|
||||
(emit-byte em (if (get uv "is-local") 1 0))
|
||||
(emit-byte em (get uv "index")))
|
||||
upvals)))))
|
||||
(p)
|
||||
(let
|
||||
((name (cond (= (type-of p) "symbol") (symbol-name p) (and (list? p) (not (empty? p)) (= (type-of (first p)) "symbol")) (symbol-name (first p)) :else p)))
|
||||
(cond
|
||||
(= name "&rest")
|
||||
(set! rest-pos (len (get fn-scope "locals")))
|
||||
(= name "&key")
|
||||
nil
|
||||
:else (do
|
||||
(when
|
||||
(and (> rest-pos -1) (nil? rest-name))
|
||||
(set! rest-name name))
|
||||
(scope-define-local fn-scope name)))))
|
||||
params)
|
||||
(compile-begin fn-em body fn-scope true)
|
||||
(emit-op fn-em 50)
|
||||
(let
|
||||
((upvals (get fn-scope "upvalues"))
|
||||
(code (if (> rest-pos -1) {:upvalue-count (len upvals) :arity (len (get fn-scope "locals")) :constants (get (get fn-em "pool") "entries") :rest-arity rest-pos :bytecode (get fn-em "bytecode")} {:upvalue-count (len upvals) :arity (len (get fn-scope "locals")) :constants (get (get fn-em "pool") "entries") :bytecode (get fn-em "bytecode")}))
|
||||
(code-idx (pool-add (get em "pool") code)))
|
||||
(emit-op em 51)
|
||||
(emit-u16 em code-idx)
|
||||
(for-each
|
||||
(fn
|
||||
(uv)
|
||||
(emit-byte em (if (get uv "is-local") 1 0))
|
||||
(emit-byte em (get uv "index")))
|
||||
upvals))))))
|
||||
(define
|
||||
compile-define
|
||||
(fn
|
||||
|
||||
@@ -512,267 +512,266 @@
|
||||
(define
|
||||
parse-go-cmd
|
||||
(fn () (match-kw "to") (list (quote go) (parse-expr))))
|
||||
(do
|
||||
(define
|
||||
parse-arith
|
||||
(fn
|
||||
(left)
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(if
|
||||
(and
|
||||
(= typ "op")
|
||||
(or
|
||||
(= val "+")
|
||||
(= val "-")
|
||||
(= val "*")
|
||||
(= val "/")
|
||||
(= val "%")))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((= val "%") (make-symbol "%")))))
|
||||
(let
|
||||
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
|
||||
(parse-arith (list op left right)))))
|
||||
left))))
|
||||
(define
|
||||
parse-the-expr
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(if
|
||||
(or (= typ "ident") (= typ "keyword"))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (make-symbol ".") (parse-expr) val)
|
||||
(cond
|
||||
((= val "result") (list (quote it)))
|
||||
((= val "first") (parse-pos-kw (quote first)))
|
||||
((= val "last") (parse-pos-kw (quote last)))
|
||||
((= val "closest") (parse-trav (quote closest)))
|
||||
((= val "next") (parse-trav (quote next)))
|
||||
((= val "previous") (parse-trav (quote previous)))
|
||||
(true (list (quote ref) val)))))
|
||||
(parse-atom)))))
|
||||
(define
|
||||
parse-array-lit
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
al-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (= (tp-type) "bracket-close") (at-end?))
|
||||
(do (if (= (tp-type) "bracket-close") (adv!) nil) acc)
|
||||
(let
|
||||
((elem (parse-expr)))
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(al-collect (append acc (list elem)))))))
|
||||
(cons (quote array) (al-collect (list)))))
|
||||
(define
|
||||
parse-return-cmd
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
parse-arith
|
||||
(fn
|
||||
(left)
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(if
|
||||
(or
|
||||
(at-end?)
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(or
|
||||
(= (tp-val) "end")
|
||||
(= (tp-val) "then")
|
||||
(= (tp-val) "else"))))
|
||||
(list (quote return) nil)
|
||||
(list (quote return) (parse-expr)))))
|
||||
(define parse-throw-cmd (fn () (list (quote throw) (parse-expr))))
|
||||
(define
|
||||
parse-append-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote append!) value target)))))
|
||||
(define
|
||||
parse-tell-cmd
|
||||
(fn
|
||||
()
|
||||
(and
|
||||
(= typ "op")
|
||||
(or
|
||||
(= val "+")
|
||||
(= val "-")
|
||||
(= val "*")
|
||||
(= val "/")
|
||||
(= val "%")))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((= val "%") (make-symbol "%")))))
|
||||
(let
|
||||
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
|
||||
(parse-arith (list op left right)))))
|
||||
left))))
|
||||
(define
|
||||
parse-the-expr
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(if
|
||||
(or (= typ "ident") (= typ "keyword"))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (make-symbol ".") (parse-expr) val)
|
||||
(cond
|
||||
((= val "result") (list (quote it)))
|
||||
((= val "first") (parse-pos-kw (quote first)))
|
||||
((= val "last") (parse-pos-kw (quote last)))
|
||||
((= val "closest") (parse-trav (quote closest)))
|
||||
((= val "next") (parse-trav (quote next)))
|
||||
((= val "previous") (parse-trav (quote previous)))
|
||||
(true (list (quote ref) val)))))
|
||||
(parse-atom)))))
|
||||
(define
|
||||
parse-array-lit
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
al-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (= (tp-type) "bracket-close") (at-end?))
|
||||
(do (if (= (tp-type) "bracket-close") (adv!) nil) acc)
|
||||
(let
|
||||
((elem (parse-expr)))
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(al-collect (append acc (list elem)))))))
|
||||
(cons (quote array) (al-collect (list)))))
|
||||
(define
|
||||
parse-return-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(or
|
||||
(at-end?)
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(or
|
||||
(= (tp-val) "end")
|
||||
(= (tp-val) "then")
|
||||
(= (tp-val) "else"))))
|
||||
(list (quote return) nil)
|
||||
(list (quote return) (parse-expr)))))
|
||||
(define parse-throw-cmd (fn () (list (quote throw) (parse-expr))))
|
||||
(define
|
||||
parse-append-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote append!) value target)))))
|
||||
(define
|
||||
parse-tell-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote tell) target body)))))
|
||||
(define
|
||||
parse-for-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((var-name (tp-val)))
|
||||
(adv!)
|
||||
(expect-kw! "in")
|
||||
(let
|
||||
((collection (parse-expr)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote tell) target body)))))
|
||||
(define
|
||||
parse-for-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((var-name (tp-val)))
|
||||
(adv!)
|
||||
(expect-kw! "in")
|
||||
(let
|
||||
((collection (parse-expr)))
|
||||
(let
|
||||
((idx (if (match-kw "index") (let ((iname (tp-val))) (adv!) iname) nil)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(if
|
||||
idx
|
||||
(list (quote for) var-name collection body :index idx)
|
||||
(list (quote for) var-name collection body))))))))
|
||||
(define
|
||||
parse-make-cmd
|
||||
(fn
|
||||
()
|
||||
(if (= (tp-val) "a") (adv!) nil)
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((called (if (match-kw "called") (let ((n (tp-val))) (adv!) n) nil)))
|
||||
(if
|
||||
called
|
||||
(list (quote make) type-name called)
|
||||
(list (quote make) type-name))))))
|
||||
(define
|
||||
parse-install-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(adv!)
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(cons (quote install) (cons name args)))
|
||||
(list (quote install) name)))))
|
||||
(define
|
||||
parse-measure-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (parse-expr)))
|
||||
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
|
||||
(define
|
||||
parse-param-list
|
||||
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
|
||||
(define
|
||||
parse-feat-body
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
fb-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or
|
||||
(at-end?)
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "end")))
|
||||
acc
|
||||
(let
|
||||
((feat (parse-feat)))
|
||||
(if
|
||||
(nil? feat)
|
||||
acc
|
||||
(fb-collect (append acc (list feat))))))))
|
||||
(fb-collect (list))))
|
||||
(define
|
||||
parse-def-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((params (parse-param-list)))
|
||||
((idx (if (match-kw "index") (let ((iname (tp-val))) (adv!) iname) nil)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote def) name params body))))))
|
||||
(define
|
||||
parse-behavior-feat
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
idx
|
||||
(list (quote for) var-name collection body :index idx)
|
||||
(list (quote for) var-name collection body))))))))
|
||||
(define
|
||||
parse-make-cmd
|
||||
(fn
|
||||
()
|
||||
(if (= (tp-val) "a") (adv!) nil)
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(adv!)
|
||||
((called (if (match-kw "called") (let ((n (tp-val))) (adv!) n) nil)))
|
||||
(if
|
||||
called
|
||||
(list (quote make) type-name called)
|
||||
(list (quote make) type-name))))))
|
||||
(define
|
||||
parse-install-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(adv!)
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((params (parse-param-list)))
|
||||
((args (parse-call-args)))
|
||||
(cons (quote install) (cons name args)))
|
||||
(list (quote install) name)))))
|
||||
(define
|
||||
parse-measure-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (parse-expr)))
|
||||
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
|
||||
(define
|
||||
parse-param-list
|
||||
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
|
||||
(define
|
||||
parse-feat-body
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
fb-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or
|
||||
(at-end?)
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "end")))
|
||||
acc
|
||||
(let
|
||||
((body (parse-feat-body)))
|
||||
(match-kw "end")
|
||||
(list (quote behavior) name params body))))))
|
||||
(define
|
||||
parse-render-kwargs
|
||||
(fn
|
||||
()
|
||||
((feat (parse-feat)))
|
||||
(if
|
||||
(nil? feat)
|
||||
acc
|
||||
(fb-collect (append acc (list feat))))))))
|
||||
(fb-collect (list))))
|
||||
(define
|
||||
parse-def-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((params (parse-param-list)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote def) name params body))))))
|
||||
(define
|
||||
parse-behavior-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((params (parse-param-list)))
|
||||
(let
|
||||
((body (parse-feat-body)))
|
||||
(match-kw "end")
|
||||
(list (quote behavior) name params body))))))
|
||||
(define
|
||||
parse-render-kwargs
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
collect-kw
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(= (tp-type) "local")
|
||||
(let
|
||||
((key (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((val (parse-expr)))
|
||||
(collect-kw (append acc (list key val)))))
|
||||
acc)))
|
||||
(collect-kw (list))))
|
||||
(define
|
||||
parse-render-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((comp (cond ((= (tp-type) "component") (let ((name (tp-val))) (adv!) name)) ((= (tp-type) "paren-open") (do (adv!) (let ((expr (parse-expr))) (if (= (tp-type) "paren-close") (adv!) nil) expr))) (true (let ((name (tp-val))) (adv!) name)))))
|
||||
(let
|
||||
((kwargs (parse-render-kwargs)))
|
||||
(let
|
||||
((pos (cond ((match-kw "into") "into") ((match-kw "before") "before") ((match-kw "after") "after") (true nil))))
|
||||
(let
|
||||
((target (if pos (parse-expr) nil)))
|
||||
(if
|
||||
pos
|
||||
(list (quote render) comp kwargs pos target)
|
||||
(list (quote render) comp kwargs))))))))
|
||||
(define
|
||||
collect-sx-source
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((start-pos (get (tp) "pos")))
|
||||
(adv!)
|
||||
(define
|
||||
collect-kw
|
||||
skip-to-close
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(= (tp-type) "local")
|
||||
(let
|
||||
((key (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((val (parse-expr)))
|
||||
(collect-kw (append acc (list key val)))))
|
||||
acc)))
|
||||
(collect-kw (list))))
|
||||
(define
|
||||
parse-render-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((comp (cond ((= (tp-type) "component") (let ((name (tp-val))) (adv!) name)) ((= (tp-type) "paren-open") (do (adv!) (let ((expr (parse-expr))) (if (= (tp-type) "paren-close") (adv!) nil) expr))) (true (let ((name (tp-val))) (adv!) name)))))
|
||||
(let
|
||||
((kwargs (parse-render-kwargs)))
|
||||
(let
|
||||
((pos (cond ((match-kw "into") "into") ((match-kw "before") "before") ((match-kw "after") "after") (true nil))))
|
||||
(let
|
||||
((target (if pos (parse-expr) nil)))
|
||||
(depth)
|
||||
(cond
|
||||
((at-end?) start-pos)
|
||||
((= (tp-type) "paren-open")
|
||||
(do (adv!) (skip-to-close (+ depth 1))))
|
||||
((= (tp-type) "paren-close")
|
||||
(if
|
||||
pos
|
||||
(list (quote render) comp kwargs pos target)
|
||||
(list (quote render) comp kwargs))))))))
|
||||
(define
|
||||
collect-sx-source
|
||||
(fn
|
||||
()
|
||||
(= depth 0)
|
||||
(let
|
||||
((end-pos (+ (get (tp) "pos") 1)))
|
||||
(adv!)
|
||||
end-pos)
|
||||
(do (adv!) (skip-to-close (- depth 1)))))
|
||||
(true (do (adv!) (skip-to-close depth))))))
|
||||
(let
|
||||
((start-pos (get (tp) "pos")))
|
||||
(adv!)
|
||||
(define
|
||||
skip-to-close
|
||||
(fn
|
||||
(depth)
|
||||
(cond
|
||||
((at-end?) start-pos)
|
||||
((= (tp-type) "paren-open")
|
||||
(do (adv!) (skip-to-close (+ depth 1))))
|
||||
((= (tp-type) "paren-close")
|
||||
(if
|
||||
(= depth 0)
|
||||
(let
|
||||
((end-pos (+ (get (tp) "pos") 1)))
|
||||
(adv!)
|
||||
end-pos)
|
||||
(do (adv!) (skip-to-close (- depth 1)))))
|
||||
(true (do (adv!) (skip-to-close depth))))))
|
||||
(let
|
||||
((end-pos (skip-to-close 0)))
|
||||
(substring src start-pos end-pos))))))
|
||||
((end-pos (skip-to-close 0)))
|
||||
(substring src start-pos end-pos)))))
|
||||
(define
|
||||
parse-cmd
|
||||
(fn
|
||||
|
||||
21
lib/vm.sx
21
lib/vm.sx
@@ -137,18 +137,21 @@
|
||||
code-from-value
|
||||
(fn
|
||||
(v)
|
||||
"Convert a compiler output dict to a vm-code object."
|
||||
"Convert a compiler output dict to a vm-code dict. Idempotent — if v\n already has vm-code keys (vc-bytecode), returns as-is."
|
||||
(if
|
||||
(not (dict? v))
|
||||
(make-vm-code 0 16 (list) (list))
|
||||
(let
|
||||
((bc-raw (get v "bytecode"))
|
||||
(bc (if (nil? bc-raw) (list) bc-raw))
|
||||
(consts-raw (get v "constants"))
|
||||
(consts (if (nil? consts-raw) (list) consts-raw))
|
||||
(arity-raw (get v "arity"))
|
||||
(arity (if (nil? arity-raw) 0 arity-raw)))
|
||||
(make-vm-code arity (+ arity 16) bc consts)))))
|
||||
(if
|
||||
(has-key? v "vc-bytecode")
|
||||
v
|
||||
(let
|
||||
((bc-raw (get v "bytecode"))
|
||||
(bc (if (nil? bc-raw) (list) bc-raw))
|
||||
(consts-raw (get v "constants"))
|
||||
(consts (if (nil? consts-raw) (list) consts-raw))
|
||||
(arity-raw (get v "arity"))
|
||||
(arity (if (nil? arity-raw) 0 arity-raw)))
|
||||
(make-vm-code arity (+ arity 16) bc consts))))))
|
||||
(define vm-closure? (fn (v) (and (dict? v) (has-key? v "vm-code"))))
|
||||
(define *active-vm* nil)
|
||||
(define *jit-compile-fn* nil)
|
||||
|
||||
Reference in New Issue
Block a user