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

Improving automated "optionals" signature extraction in (chibi doc).

Browse source
This commit is contained in:
Alex Shinn 2015-04-30 08:54:11 +09:00
parent ea9ba3b5cb
commit 315d87174c
4 changed files with 37 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/chibi/doc-test.sld Normal file
View file

@ -0,0 +1,13 @@
(define-library (chibi doc-test)
(export run-tests)
(import (scheme base) (chibi doc) (chibi test))
(begin
(define (run-tests)
(test-begin "doc")
(test '(spec (args config))
(get-optionals-signature
'(spec . o)
'(let ((args (or (and (pair? o) (car o)) (command-line)))
(config (and (pair? o) (pair? (cdr o)) (cadr o))))
(foo))))
(test-end))))

30
lib/chibi/doc.scm
View file

@ -476,7 +476,7 @@ div#footer {padding-bottom: 50px}
;; Try to determine the names of optional parameters checking common
;; patterns.
(define (get-optionals ls body)
(define (get-optionals-signature ls body)
(let lp ((ls ls) (pre '()))
(cond
((pair? ls) (lp (cdr ls) (cons (car ls) pre)))
@ -492,30 +492,37 @@ div#footer {padding-bottom: 50px}
(if (contains? val o)
(extract #f vars i)
(extract rest vars i)))
((((or 'let 'let* 'letrec 'letrec*) (y ...) . body))
(((or 'let 'let* 'letrec 'letrec*) (y ...) . body)
(let ((ordered? (memq (car x) '(let* letrec*))))
(let lp ((ls y) (vars vars) (j i))
(cond
((pair? ls)
(match (car ls)
;; handle rebinding o
(((? o?) ('if ('pair? (? o?)) ('cdr (? o?)) default))
(lp (cdr ls) vars (+ j 1)))
(((? o?) expr)
(extract #f vars i))
;; binding vars to o
((v ('if ('pair? (? o?)) ('car (? o?)) default))
(lp (cdr ls) (cons (cons v (if ordered? j i)) vars) j))
((v ('and ('pair? (? o?)) ('car (? o?))))
(lp (cdr ls) (cons (cons v (if ordered? j i)) vars) j))
((v ('or ('and ('pair? (? o?)) ('car (? o?))) default))
(lp (cdr ls) (cons (cons v (if ordered? j i)) vars) j))
((v ('if ('and ('pair? (? o?)) ('pair? ('cdr (? o?))))
('cadr (? o?))
default))
(lp (cdr ls) (cons (cons v (if ordered? j i)) vars) j))
((v ('and ('pair? (? o?)) ('pair? ('cdr (? o?)))
('cadr (? o?))))
(lp (cdr ls) (cons (cons v (if ordered? j i)) vars) j))
(else
(lp (cdr ls) vars j))))
(else
(extract body vars j))))))
((((or 'let-optionals 'let-optionals*) ls ((var default) ...)
. body))
(((or 'let-optionals 'let-optionals*) ls ((var default) ...)
. body)
(let lp ((ls var) (vars vars) (i i))
(cond
((pair? ls)
@ -524,15 +531,17 @@ div#footer {padding-bottom: 50px}
(extract body vars i)))))
(else
(let ((opts (map car (sort vars < cdr)))
(dotted? (contains? x o)))
(rest-var? (contains? x o)))
(append (reverse pre)
(cond
((and (pair? opts) dotted?)
((and (pair? opts) rest-var?)
(list (append opts o)))
(dotted?
(rest-var?
o)
((pair? opts)
(list opts))
(else
(list opts)))))))))))))
'()))))))))))))
(define (get-procedure-signature mod id proc)
(cond ((and mod (procedure? proc) (procedure-signature id mod))
@ -544,7 +553,8 @@ div#footer {padding-bottom: 50px}
(match value
(('(or let let* letrec letrec*) vars body0 ... body)
(get-value-signature mod id proc name body))
(('lambda args . body) (list (cons name (get-optionals args body))))
(('lambda args . body)
(list (cons name (get-optionals-signature args body))))
((('lambda args body0 ... body) vals ...)
(get-value-signature mod id proc name body))
(('begin body0 ... body) (get-value-signature mod id proc name body))
@ -557,7 +567,7 @@ div#footer {padding-bottom: 50px}
(('define (name args ...) . body)
(list (cons name args)))
(('define (name . args) . body)
(list (cons name (get-optionals args body))))
(list (cons name (get-optionals-signature args body))))
(('define name value)
(get-value-signature mod id proc name value))
(('define-syntax name ('syntax-rules () (clause . body) ...))

3
lib/chibi/doc.sld
View file

@ -10,5 +10,6 @@
print-module-docs print-module-binding-docs
generate-docs expand-docs fixup-docs
extract-module-docs extract-module-file-docs extract-file-docs
make-default-doc-env make-module-doc-env)
make-default-doc-env make-module-doc-env
get-optionals-signature)
(include "doc.scm"))

2
tests/lib-tests.scm
View file

@ -15,6 +15,7 @@
(rename (chibi crypto md5-test) (run-tests run-md5-tests))
(rename (chibi crypto rsa-test) (run-tests run-rsa-tests))
(rename (chibi crypto sha2-test) (run-tests run-sha2-tests))
(rename (chibi doc-test) (run-tests run-doc-tests))
;;(rename (chibi filesystem-test) (run-tests run-filesystem-tests))
(rename (chibi generic-test) (run-tests run-generic-tests))
(rename (chibi io-test) (run-tests run-io-tests))
@ -51,6 +52,7 @@
(run-srfi-95-tests)
(run-srfi-99-tests)
(run-base64-tests)
(run-doc-tests)
(run-generic-tests)
(run-io-tests)
(run-iset-tests)