src/sigil/repl/commands.sgl

1;;; (sigil repl commands) - Shared REPL command handling

2;;;

3;;; This module provides the command registry and built-in commands

4;;; shared between the interactive REPL and nREPL server.

5;;;

6;;; Hooks allow REPL implementations to customize behavior:

7;;; - repl-module-switch-hook: called with (old-module new-module) when user switches

8;;; - repl-module-import-hook: called with (module-name) when user imports

9;;; - repl-exit-hook: called with no args when user requests exit

11(define-library (sigil repl commands)

12 (import (sigil io)

13 (sigil math)

14 (sigil hooks)

15 (sigil ansi)

16 (sigil string)

17 (sigil spec)

18 (sigil docs lookup)

19 (sigil docs search))

21 (export

22 ;; Command registry

23 *repl-commands*

24 register-command!

25 find-command

27 ;; Command detection and handling

28 repl-command?

29 handle-command

31 ;; Hooks for REPL customization

32 repl-module-switch-hook

33 repl-module-import-hook

34 repl-exit-hook

36 ;; Individual command handlers (for customization)

37 cmd-help

38 cmd-exit

39 cmd-load

40 cmd-module

41 cmd-use

42 cmd-doc

43 cmd-search

45 ;; Documentation lookup (shared with nREPL)

46 lookup-symbol-doc

47 decode-arity

48 build-signature

50 ;; Utilities

51 parse-module-name)

53 (begin

55 ;; ============================================================

56 ;; HOOKS

57 ;; ============================================================

59 (define repl-module-switch-hook (make-hook))

60 (define repl-module-import-hook (make-hook))

61 (define repl-exit-hook (make-hook))

63 ;; ============================================================

64 ;; COMMAND REGISTRY

65 ;; ============================================================

67 ;; Command registry: list of (name handler help-text)

68 (define *repl-commands* '())

70 (define (register-command! name handler help)

71 (set! *repl-commands*

72 (cons (list name handler help) *repl-commands*)))

74 (define (find-command name)

75 (let loop ((cmds *repl-commands*))

76 (cond

77 ((null? cmds) #f)

78 ((string=? (car (car cmds)) name) (car cmds))

79 (else (loop (cdr cmds))))))

81 ;; ============================================================

82 ;; COMMAND HANDLERS

83 ;; ============================================================

85 (define (cmd-help args-string)

86 (display "REPL Commands:\n")

87 (display " ,help ,h Show this help\n")

88 (display " ,exit ,quit ,q Exit the REPL\n")

89 (display " ,load <file> Load a Sigil file\n")

90 (display " ,module ,m (<name>) Switch to module (e.g., ,m (sigil io))\n")

91 (display " ,use (<name>) Import a module (e.g., ,use (sigil test))\n")

92 (display " ,doc ,d <symbol> Show documentation for a symbol\n")

93 (display " ,search ,s <query> Search for symbols by name or description\n")

94 (newline)

95 'continue)

97 (define (cmd-exit args-string)

98 (run-hook repl-exit-hook)

99 'exit)

100

101 (define (cmd-load args-string)

102 (if (string-blank? args-string)

103 (begin

104 (display "Usage: ,load <filename>\n")

105 'continue)

106 (begin

107 (load args-string)

108 'continue)))

109

110 ;; Parse module name from args-string like "(sigil io)" -> (sigil io)

111 (define (parse-module-name args-string)

112 (if (string-blank? args-string)

113 #f

114 (read-expr args-string)))

115

116 (define (cmd-module args-string)

117 (if (string-blank? args-string)

118 (let ((mod (current-module)))

119 (if mod

120 (display (format "Current module: ~a\n" (module-name mod)))

121 (display "No current module\n"))

122 'continue)

123 (let* ((name-list (parse-module-name args-string))

124 (mod (find-module name-list))

125 (old-mod (current-module)))

126 (if mod

127 (begin

128 (set-current-module! mod)

129 (run-hook-with-args repl-module-switch-hook old-mod mod)

130 (display (format "Switched to ~a\n" name-list)))

131 (display (format "Module not found: ~a\n" name-list)))

132 'continue)))

133

134 (define (cmd-use args-string)

135 (if (string-blank? args-string)

136 (begin

137 (display "Usage: ,use (<module-name>)\n")

138 (display "Example: ,use (sigil test)\n")

139 'continue)

140 (let ((name-list (parse-module-name args-string)))

141 ;; Use eval to run an import expression

142 (eval (list 'import name-list))

143 (run-hook-with-args repl-module-import-hook name-list)

144 (display (format "Imported ~a\n" name-list))

145 'continue)))

146

147 (define (cmd-doc args-string)

148 (if (string-blank? args-string)

149 (begin

150 (display "Usage: ,doc <symbol> or ,doc (<module-name>)\n")

151 (display "Examples: ,doc string-append\n")

152 (display " ,doc (sigil json)\n")

153 'continue)

154 (let ((trimmed (string-trim args-string)))

155 ;; Check if it looks like a module name (starts with paren)

156 (if (and (> (string-length trimmed) 0)

157 (char=? (string-ref trimmed 0) #\())

158 ;; Module documentation

159 (let* ((mod-name (read-expr trimmed))

160 (mod-details (load-module-details mod-name)))

161 (if mod-details

162 (print-module-doc mod-name mod-details)

163 (display (format "No documentation found for: ~a\n" mod-name)))

164 'continue)

165 ;; Symbol documentation

166 (let* ((sym (string->symbol trimmed))

167 (mod (current-module))

168 (doc-info (lookup-symbol-doc mod sym))

169 ;; Check if we got actual documentation (4th element)

170 (has-doc (and doc-info (cadddr doc-info))))

171 (if has-doc

172 (print-doc sym doc-info)

173 ;; Fall back to search index (even if we found the binding)

174 (let ((results (search-docs trimmed)))

175 (if (null? results)

176 (display (format "No documentation found for: ~a\n" sym))

177 ;; Find exact match or use first result

178 (let* ((match (or (find (lambda (r)

179 (string=? (search-result-name r) trimmed))

180 results)

181 (car results)))

182 (mod-name (search-result-module match)))

183 ;; Load detailed docs from the module

184 (let ((details (load-module-details

185 (read (open-input-string mod-name)))))

186 (if details

187 (print-doc-from-details sym mod-name details)

188 ;; Fall back to search result summary

189 (print-search-result-doc match)))))))

190 'continue)))))

191

192 (define (cmd-search args-string)

193 (if (string-blank? args-string)

194 (begin

195 (display "Usage: ,search <query>\n")

196 (display "Examples: ,search string\n")

197 (display " ,search file read\n")

198 'continue)

199 (let ((results (search-docs (string-trim args-string))))

200 (if (null? results)

201 (begin

202 (display (format "No results found for '~a'.\n" args-string))

203 'continue)

204 (begin

205 (display (a:bold (format "Search results for '~a':\n\n" args-string)))

206 (for-each

207 (lambda (r)

208 (display (a:bold (search-result-name r)))

209 (display " ")

210 (display (a:dim (search-result-module r)))

211 (display (format " (~a)\n" (search-result-kind r)))

212 (let ((summary (search-result-summary r)))

213 (when (and summary (> (string-length summary) 0))

214 (display (format " ~a\n" summary))))

215 (newline))

216 results)

217 'continue)))))

218

219 ;; ============================================================

220 ;;; DOCUMENTATION LOOKUP (shared with nREPL)

221 ;; ============================================================

222

223 ;; Extract first line of a docstring for summary

224 (define (extract-first-line doc)

225 (if (not doc)

226 #f

227 (let ((newline-pos (string-find doc "\n")))

228 (if newline-pos

229 (substring doc 0 newline-pos)

230 doc))))

231

232 ;; Find which imported module exports a syntax

233 ;; Returns module name list or #f

234 (define (find-syntax-home-module mod sym)

235 (let loop ((imports (module-imports mod)))

236 (if (null? imports)

237 #f

238 (let* ((imp-name (car imports))

239 (imp-mod (find-module imp-name)))

240 (if (and imp-mod (memq sym (module-syntaxes imp-mod)))

241 imp-name

242 (loop (cdr imports)))))))

243

244 ;; Look up documentation for a symbol in a module

245 ;; Returns (kind signature summary full spec-string) or #f

246 (define (lookup-symbol-doc mod sym)

247 (let ((mod-name (module-name mod))

248 (bindings (module-bindings mod)))

249 ;; First check if the symbol is bound to a procedure and get its home module

250 (let* ((val (if (memq sym bindings) (module-binding-ref mod sym) #f))

251 (home-mod-name (if (and val (procedure? val))

252 (procedure-module val)

253 #f))

254 ;; Try home module first, then current module

255 (export-doc (or (and home-mod-name

256 (get-export-details home-mod-name sym))

257 (get-export-details mod-name sym)))

258 ;; Get spec from runtime value if it's a procedure

259 (spec-str (and val (procedure? val)

260 (spec->string (procedure-spec val)))))

261 (cond

262 ;; Found JSON documentation

263 (export-doc

264 (let ((kind (export-details-kind export-doc))

265 (doc (export-details-description export-doc))

266 (sig (export-details-signature export-doc)))

267 ;; For procedures, use runtime arity if no signature in JSON

268 (let ((final-sig

269 (if (and (not sig) val (procedure? val))

270 (build-signature sym (procedure-arity val))

271 (or sig (format "(~a ...)" sym)))))

272 (list kind

273 final-sig

274 (if doc (extract-first-line doc) #f)

275 doc

276 spec-str))))

277 ;; No JSON doc - check if it's a runtime binding we know about

278 ((and val (procedure? val))

279 (let* ((arity (procedure-arity val))

280 (sig (build-signature sym arity)))

281 (list (if arity 'native 'procedure)

282 sig

283 #f

284 #f

285 spec-str)))

286 ;; Non-procedure binding

287 (val

288 (list 'variable

289 (symbol->string sym)

290 #f

291 #f

292 #f))

293 ;; Check if it's a syntax (macro) in current module

294 ((memq sym (module-syntaxes mod))

295 (list 'syntax

296 (format "(~a ...)" sym)

297 #f

298 #f

299 #f))

300 ;; Check imported modules for syntax

301 (else

302 (let ((syntax-home (find-syntax-home-module mod sym)))

303 (if syntax-home

304 ;; Found in an imported module - try to get JSON docs

305 (let ((doc (get-export-details syntax-home sym)))

306 (if doc

307 (list (export-details-kind doc)

308 (or (export-details-signature doc)

309 (format "(~a ...)" sym))

310 (if (export-details-description doc)

311 (extract-first-line (export-details-description doc))

312 #f)

313 (export-details-description doc)

314 #f)

315 ;; No JSON doc, just show it's a syntax

316 (list 'syntax

317 (format "(~a ...)" sym)

318 #f

319 #f

320 #f)))

321 #f)))))))

322

323 ;; Decode arity integer to (min . max) or #f

324 ;; Arity encoding: positive = exact, -1 = variadic, negative = range

325 (define (decode-arity arity)

326 (cond

327 ((not arity) #f)

328 ((not (number? arity)) #f)

329 ((>= arity 0) (cons arity arity)) ; exact arity

330 ((= arity -1) (cons 0 #f)) ; variadic (0+)

331 (else

332 ;; Range encoding: min = (-arity & 0x7F), max = ((-arity >> 8) & 0xFF)

333 (let* ((neg (- arity))

334 (min-args (bitwise-and neg #x7F))

335 (max-args (bitwise-and (arithmetic-shift neg -8) #xFF)))

336 (if (= max-args 255)

337 (cons min-args #f) ; at-least-n (variadic)

338 (cons min-args max-args))))))

339

340 ;; Build a signature string from procedure name and arity

341 (define (build-signature name arity)

342 (let ((decoded (decode-arity arity)))

343 (if (not decoded)

344 (format "(~a ...)" name)

345 (let ((min-args (car decoded))

346 (max-args (cdr decoded)))

347 (cond

348 ;; Variadic procedure

349 ((not max-args)

350 (if (= min-args 0)

351 (format "(~a . args)" name)

352 (format "(~a~a . rest)" name (make-arg-list min-args))))

353 ;; Fixed arity

354 ((= min-args max-args)

355 (format "(~a~a)" name (make-arg-list min-args)))

356 ;; Optional arguments

357 (else

358 (format "(~a~a [~a optional])" name

359 (make-arg-list min-args)

360 (- max-args min-args))))))))

361

362 ;; Build argument placeholder list

363 (define (make-arg-list n)

364 (if (= n 0)

365 ""

366 (let loop ((i 1) (acc ""))

367 (if (> i n)

368 acc

369 (loop (+ i 1)

370 (string-append acc " arg" (number->string i)))))))

371

372 ;; Check if a line is a code fence start (```scheme or ```)

373 (define (code-fence-start? line)

374 (let ((trimmed (string-trim line)))

375 (or (string-starts-with? trimmed "```scheme")

376 (string-starts-with? trimmed "```scm")

377 (string=? trimmed "```"))))

378

379 ;; Check if a line is a code fence end (``` alone)

380 (define (code-fence-end? line)

381 (string=? (string-trim line) "```"))

382

383 ;; Format a docstring for REPL display

384 ;; Strips code fences, indents code blocks, and applies dim styling

385 (define (format-docstring doc)

386 (if (not doc)

387 #f

388 (let ((lines (string-split doc "\n")))

389 (let loop ((remaining lines)

390 (result '())

391 (in-code #f))

392 (if (null? remaining)

393 (string-join (reverse result) "\n")

394 (let ((line (car remaining))

395 (rest (cdr remaining)))

396 (cond

397 ;; Starting a code block

398 ((and (not in-code) (code-fence-start? line))

399 (loop rest result #t))

400 ;; Ending a code block

401 ((and in-code (code-fence-end? line))

402 (loop rest result #f))

403 ;; Inside code block - indent and apply dim styling

404 (in-code

405 (loop rest (cons (a:dim (string-append " " line)) result) #t))

406 ;; Regular text

407 (else

408 (loop rest (cons line result) #f)))))))))

409

410 ;; Print documentation nicely (uses 5-element format)

411 (define (print-doc sym info)

412 (let ((kind (car info))

413 (sig (cadr info))

414 ;; summary is caddr, full doc is cadddr, spec-str is 5th

415 (doc (cadddr info))

416 (spec-str (and (> (length info) 4) (list-ref info 4))))

417 (display sig)

418 (display " -> ")

419 (display kind)

420 (newline)

421 (when spec-str

422 (display (a:dim (format " Spec: ~a" spec-str)))

423 (newline))

424 (if doc

425 (let ((formatted (format-docstring doc)))

426 (newline)

427 (display formatted)

428 (newline))

429 (display "(no documentation)\n"))))

430

431 ;; Print documentation from module details (for index fallback)

432 (define (print-doc-from-details sym mod-name details)

433 (let ((export (find (lambda (e)

434 (string=? (symbol->string (export-details-name e))

435 (symbol->string sym)))

436 (module-details-exports details))))

437 (if export

438 (begin

439 (display (a:bold (format "~a" sym)))

440 (display " ")

441 (display (a:dim mod-name))

442 (display (format " (~a)\n" (export-details-kind export)))

443 (let ((doc (export-details-description export)))

444 (if doc

445 (let ((formatted (format-docstring doc)))

446 (newline)

447 (display formatted)

448 (newline))

449 (display "(no documentation)\n"))))

450 (display (format "Export '~a' not found in ~a\n" sym mod-name)))))

451

452 ;; Print documentation from search result (minimal fallback)

453 (define (print-search-result-doc result)

454 (display (a:bold (search-result-name result)))

455 (display " ")

456 (display (a:dim (search-result-module result)))

457 (display (format " (~a)\n" (search-result-kind result)))

458 (let ((summary (search-result-summary result)))

459 (if (and summary (> (string-length summary) 0))

460 (begin

461 (newline)

462 (display summary)

463 (newline))

464 (display "(no documentation)\n"))))

465

466 ;; Print module documentation

467 (define (print-module-doc mod-name mod-details)

468 (display (a:bold (format "~a" mod-name)))

469 (newline)

470 (let ((desc (module-details-description mod-details)))

471 (if desc

472 (let ((formatted (format-docstring desc)))

473 (newline)

474 (display formatted)

475 (newline))

476 (display "(no module documentation)\n")))

477 ;; Show exports summary

478 (let ((exports (module-details-exports mod-details)))

479 (when (not (null? exports))

480 (newline)

481 (display (a:bold "Exports:"))

482 (newline)

483 (for-each

484 (lambda (exp)

485 (let ((name (export-details-name exp))

486 (kind (export-details-kind exp)))

487 (display (format " ~a" name))

488 (display (a:dim (format " (~a)" kind)))

489 (newline)))

490 exports))))

491

492 ;; ============================================================

493 ;; REGISTER BUILT-IN COMMANDS

494 ;; ============================================================

495

496 (register-command! "help" cmd-help "Show this help")

497 (register-command! "h" cmd-help "Show this help")

498 (register-command! "exit" cmd-exit "Exit the REPL")

499 (register-command! "quit" cmd-exit "Exit the REPL")

500 (register-command! "q" cmd-exit "Exit the REPL")

501 (register-command! "load" cmd-load "Load a Sigil file")

502 (register-command! "module" cmd-module "Switch to module context")

503 (register-command! "m" cmd-module "Switch to module context")

504 (register-command! "use" cmd-use "Import a module")

505 (register-command! "import" cmd-use "Import a module")

506 (register-command! "doc" cmd-doc "Show documentation for a symbol")

507 (register-command! "d" cmd-doc "Show documentation for a symbol")

508 (register-command! "search" cmd-search "Search for symbols by name or description")

509 (register-command! "s" cmd-search "Search for symbols by name or description")

510

511 ;; ============================================================

512 ;; COMMAND PARSING

513 ;; ============================================================

514

515 ;; Check if input is a REPL command (starts with comma)

516 (define (repl-command? input)

517 (let ((trimmed (string-trim-start input)))

518 (and (> (string-length trimmed) 0)

519 (char=? (string-ref trimmed 0) #\,))))

520

521 ;; Parse and execute a REPL command

522 ;; Returns: 'continue, 'exit, or a value to print

523 (define (handle-command input)

524 (let* ((trimmed (string-trim-start input))

525 (without-comma (substring trimmed 1 (string-length trimmed)))

526 (content (string-trim without-comma))

527 ;; Find first space to split command name from args

528 (space-pos (string-find content " "))

529 (cmd-name (if space-pos

530 (substring content 0 space-pos)

531 content))

532 (args-string (if space-pos

533 (string-trim (substring content (+ space-pos 1) (string-length content)))

534 ""))

535 (cmd (find-command cmd-name)))

536 (if cmd

537 ((cadr cmd) args-string)

538 (begin

539 (display (format "Unknown command: ,~a\n" cmd-name))

540 (display "Type ,help for available commands.\n")

541 'continue))))

542

543 )) ; end define-library