Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Recognizing named-let in get-optionals-signature.

Browse source 
Importing (scheme small) in the default doc example environment.
This commit is contained in:
Alex Shinn 2015-05-02 21:47:04 +09:00
parent a11ef977a8
commit 29e2077ac2
2 changed files with 24 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
lib/chibi/doc-test.sld
View file

@ -7,7 +7,22 @@
(test '(spec (args config)) (test '(spec (args config))
(get-optionals-signature (get-optionals-signature
'(spec . o) '(spec . o)
'(let ((args (or (and (pair? o) (car o)) (command-line))) '((let ((args (or (and (pair? o) (car o)) (command-line)))
(config (and (pair? o) (pair? (cdr o)) (cadr o)))) (config (and (pair? o) (pair? (cdr o)) (cadr o))))
(foo)))) (foo)))))
(test '(filename (port len))
(get-optionals-signature
'(filename . o)
'((let ((port (if (pair? o) (car o) (open-input-file filename)))
(len (if (and (pair? o) (pair? (cdr o))) (cadr o) 4096)))
(foo)))))
(test '(f kons knil source (index))
(get-optionals-signature
'(f kons knil source . o)
'((let lp ((p (if (string? source)
(string->parse-stream source)
source))
(index (if (pair? o) (car o) 0))
(acc knil))
(f p index fk)))))
(test-end)))) (test-end))))

10
lib/chibi/doc.scm
View file

@ -206,7 +206,7 @@
(define (make-module-doc-env mod-name) (define (make-module-doc-env mod-name)
(env-extend (make-default-doc-env) (env-extend (make-default-doc-env)
'(example-env) '(example-env)
(list (environment '(scheme base) (list (environment '(scheme small)
'(only (chibi) import) '(only (chibi) import)
mod-name)))) mod-name))))
@ -492,7 +492,7 @@ div#footer {padding-bottom: 50px}
(if (contains? val o) (if (contains? val o)
(extract #f vars i) (extract #f vars i)
(extract rest vars i))) (extract rest vars i)))
(((or 'let 'let* 'letrec 'letrec*) (y ...) . body) ((((or 'let 'let* 'letrec 'letrec*) (y ...) . body) . rest)
(let ((ordered? (memq (car x) '(let* letrec*)))) (let ((ordered? (memq (car x) '(let* letrec*))))
(let lp ((ls y) (vars vars) (j i)) (let lp ((ls y) (vars vars) (j i))
(cond (cond
@ -521,8 +521,10 @@ div#footer {padding-bottom: 50px}
(lp (cdr ls) vars j)))) (lp (cdr ls) vars j))))
(else (else
(extract body vars j)))))) (extract body vars j))))))
(((or 'let-optionals 'let-optionals*) ls ((var default) ...) ((('let (? symbol?) (y ...) . body) . rest)
. body) (extract `((let ,y . ,body) . ,rest) vars i))
((((or 'let-optionals 'let-optionals*) ls ((var default) ...)
. body) . rest)
(let lp ((ls var) (vars vars) (i i)) (let lp ((ls var) (vars vars) (i i))
(cond (cond
((pair? ls) ((pair? ls)