feat: add pigibrack macro expansion tool
This commit is contained in:
@@ -13,6 +13,7 @@ Tools:
|
|||||||
- `pigibrack_delete_form(path, name)`
|
- `pigibrack_delete_form(path, name)`
|
||||||
- `pigibrack_check_syntax({ path } | { source })`
|
- `pigibrack_check_syntax({ path } | { source })`
|
||||||
- `pigibrack_eval_expr(expr, module?)`
|
- `pigibrack_eval_expr(expr, module?)`
|
||||||
|
- `pigibrack_macro_expand(expr, module?)`
|
||||||
|
|
||||||
Commands:
|
Commands:
|
||||||
|
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
(use-modules (ice-9 pretty-print)
|
(use-modules (ice-9 pretty-print)
|
||||||
(ice-9 rdelim)
|
(ice-9 rdelim)
|
||||||
(ice-9 textual-ports))
|
(ice-9 textual-ports)
|
||||||
|
(language tree-il))
|
||||||
|
|
||||||
(define (->string obj)
|
(define (->string obj)
|
||||||
(call-with-output-string
|
(call-with-output-string
|
||||||
@@ -66,6 +67,32 @@
|
|||||||
(write-text error-path (string-append (symbol->string key) " " (->string args) "\n"))
|
(write-text error-path (string-append (symbol->string key) " " (->string args) "\n"))
|
||||||
(reply "DONE\tERR"))))))
|
(reply "DONE\tERR"))))))
|
||||||
|
|
||||||
|
(define (handle-mexp parts)
|
||||||
|
(if (< (length parts) 5)
|
||||||
|
(reply "DONE\tERR")
|
||||||
|
(let* ((expr-path (list-ref parts 1))
|
||||||
|
(module-raw (list-ref parts 2))
|
||||||
|
(value-path (list-ref parts 3))
|
||||||
|
(error-path (list-ref parts 4)))
|
||||||
|
(catch #t
|
||||||
|
(lambda ()
|
||||||
|
(let ((module-spec (module-spec-from-string module-raw)))
|
||||||
|
(when module-spec
|
||||||
|
(set-current-module (resolve-interface module-spec))))
|
||||||
|
|
||||||
|
(let* ((expr-source (read-text expr-path))
|
||||||
|
(datum (call-with-input-string expr-source read))
|
||||||
|
(expanded (tree-il->scheme (macroexpand datum)))
|
||||||
|
(value-port (open-output-string)))
|
||||||
|
(pretty-print expanded value-port)
|
||||||
|
(write-text value-path (get-output-string value-port))
|
||||||
|
(write-text error-path "")
|
||||||
|
(reply "DONE\tOK")))
|
||||||
|
(lambda (key . args)
|
||||||
|
(write-text value-path "")
|
||||||
|
(write-text error-path (string-append (symbol->string key) " " (->string args) "\n"))
|
||||||
|
(reply "DONE\tERR"))))))
|
||||||
|
|
||||||
(define (handle-reset)
|
(define (handle-reset)
|
||||||
(set-current-module (resolve-module '(guile-user) #:ensure #t))
|
(set-current-module (resolve-module '(guile-user) #:ensure #t))
|
||||||
(reply "DONE\tOK"))
|
(reply "DONE\tOK"))
|
||||||
@@ -77,6 +104,9 @@
|
|||||||
((string=? command "EVAL")
|
((string=? command "EVAL")
|
||||||
(handle-eval parts)
|
(handle-eval parts)
|
||||||
#t)
|
#t)
|
||||||
|
((string=? command "MEXP")
|
||||||
|
(handle-mexp parts)
|
||||||
|
#t)
|
||||||
((string=? command "RESET")
|
((string=? command "RESET")
|
||||||
(handle-reset)
|
(handle-reset)
|
||||||
#t)
|
#t)
|
||||||
|
|||||||
@@ -687,6 +687,44 @@ export default function pigibrackExtension(pi: ExtensionAPI) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
async function guileMacroExpand(
|
||||||
|
expr: string,
|
||||||
|
moduleSpec: string | undefined,
|
||||||
|
cwd: string,
|
||||||
|
signal?: AbortSignal,
|
||||||
|
): Promise<string> {
|
||||||
|
const dir = await mkdtemp(join(tmpdir(), 'pigibrack-mexp-'));
|
||||||
|
const exprPath = join(dir, 'expr.scm');
|
||||||
|
const valuePath = join(dir, 'value.txt');
|
||||||
|
const errorPath = join(dir, 'error.txt');
|
||||||
|
|
||||||
|
await writeFile(exprPath, expr, 'utf8');
|
||||||
|
|
||||||
|
const command = ['MEXP', exprPath, sanitizeModuleSpec(moduleSpec), valuePath, errorPath].join(
|
||||||
|
'\t',
|
||||||
|
);
|
||||||
|
|
||||||
|
try {
|
||||||
|
const response = await sidecarCommand(cwd, command, signal);
|
||||||
|
const value = (await readFile(valuePath, 'utf8').catch(() => '')).trimEnd();
|
||||||
|
const error = (await readFile(errorPath, 'utf8').catch(() => '')).trim();
|
||||||
|
|
||||||
|
if (response === 'DONE\tOK') {
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (response === 'DONE\tERR') {
|
||||||
|
throw new Error(error || 'Guile sidecar macro expansion failed.');
|
||||||
|
}
|
||||||
|
|
||||||
|
throw new Error(`Unexpected sidecar response: ${response}`);
|
||||||
|
} catch {
|
||||||
|
const fallbackExpr = `(begin (use-modules (language tree-il)) (tree-il->scheme (macroexpand ${expr})))`;
|
||||||
|
const result = await guileEvalDirect(fallbackExpr, moduleSpec, cwd, signal);
|
||||||
|
return result.value;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
pi.registerCommand('pigibrack-status', {
|
pi.registerCommand('pigibrack-status', {
|
||||||
description: 'Show pigibrack extension status and guile availability',
|
description: 'Show pigibrack extension status and guile availability',
|
||||||
handler: async (_args, ctx) => {
|
handler: async (_args, ctx) => {
|
||||||
@@ -979,6 +1017,32 @@ export default function pigibrackExtension(pi: ExtensionAPI) {
|
|||||||
},
|
},
|
||||||
});
|
});
|
||||||
|
|
||||||
|
pi.registerTool({
|
||||||
|
name: 'pigibrack_macro_expand',
|
||||||
|
label: 'pigibrack macro expand',
|
||||||
|
description:
|
||||||
|
'Macro-expand a Scheme expression in guile. Optional module is a module spec, e.g. (my module).',
|
||||||
|
promptSnippet:
|
||||||
|
'Expand a Scheme form to inspect macro output before debugging runtime behavior.',
|
||||||
|
parameters: Type.Object({
|
||||||
|
expr: Type.String({ description: 'A Scheme expression to macro-expand' }),
|
||||||
|
module: Type.Optional(Type.String({ description: 'Optional module spec, e.g. (my module)' })),
|
||||||
|
}),
|
||||||
|
async execute(_toolCallId, params, signal, _onUpdate, ctx) {
|
||||||
|
const normalizedExpr = ensureSingleTopLevelForm(params.expr);
|
||||||
|
const expanded = await guileMacroExpand(normalizedExpr, params.module, ctx.cwd, signal);
|
||||||
|
|
||||||
|
const output = `expanded:\n${expanded || '<no expansion>'}`;
|
||||||
|
|
||||||
|
return {
|
||||||
|
content: [{ type: 'text', text: formatTruncated(output, 'tail') }],
|
||||||
|
details: {
|
||||||
|
module: params.module,
|
||||||
|
},
|
||||||
|
};
|
||||||
|
},
|
||||||
|
});
|
||||||
|
|
||||||
pi.registerTool({
|
pi.registerTool({
|
||||||
name: 'pigibrack_eval_expr',
|
name: 'pigibrack_eval_expr',
|
||||||
label: 'pigibrack eval expr',
|
label: 'pigibrack eval expr',
|
||||||
|
|||||||
16
playground/macros.scm
Normal file
16
playground/macros.scm
Normal file
@@ -0,0 +1,16 @@
|
|||||||
|
(define-module (playground macros)
|
||||||
|
#:export (inc unless* demo))
|
||||||
|
|
||||||
|
(define-syntax-rule (inc x)
|
||||||
|
(+ x 1))
|
||||||
|
|
||||||
|
(define-syntax unless*
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ test body ...)
|
||||||
|
(if (not test)
|
||||||
|
(begin body ...)))))
|
||||||
|
|
||||||
|
(define (demo x)
|
||||||
|
(unless* (> x 0)
|
||||||
|
(display "non-positive"))
|
||||||
|
(inc x))
|
||||||
Reference in New Issue
Block a user