Changeset 39582 in project


Ignore:
Timestamp:
02/06/21 17:47:01 (3 weeks ago)
Author:
juergen
Message:

premodules 0.7 with support for restricted exports

Location:
release/5/premodules
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/premodules/tags/0.7/premodules.egg

    r39564 r39582  
    33((synopsis "Converting a premodule into module, test and doc files")
    44 (category doc-tools)
    5  (version "0.6.1")
     5 (version "0.7")
    66 (license "BSD")
    77 (dependencies simple-tests)
  • release/5/premodules/tags/0.7/premodules.scm

    r39564 r39582  
    147147(define (comment-separator? line)
    148148  (and (string? line)
    149        (irregex-match? '(: bos
     149       (irregex-match? `(: bos
    150150                           (* space)
    151151                           "---"
    152152                           (* #\-)
    153153                           (+ space)
    154                            (or "macro" "procedure" "parameter")
     154                           ;(or "macro" "procedure" "parameter")
     155                           (or ,(string->sre "macro[ 0-9a-zA-Z!$%&*+-./:<=>?@^_~]*")
     156                               "procedure"
     157                               "parameter")
    155158                           (+ space)
    156159                           "---"
     
    174177
    175178(define (check-xpr? xpr)
    176   (or (eq? (car xpr) 'define-tester)
    177       (eq? (car xpr) 'define-checks)
    178       (eq? (car xpr) 'do-checks)))
     179  (eq? (car xpr) 'define-tester))
     180  ;(or (eq? (car xpr) 'define-tester)
     181  ;    (eq? (car xpr) 'define-checks)
     182  ;    (eq? (car xpr) 'do-checks)))
    179183
    180184(define (extract-check-name xpr)
     
    222226    (error 'comment-type "not a comment separator" separator)))
    223227
     228(define (restricted-exports separator)
     229  (if (comment-separator? separator)
     230    (let loop ((lst (list-tail (string-split separator) 2)) (result '()))
     231      (if (string=? (substring (car lst) 0 3) "---")
     232        result
     233        (loop (cdr lst) (cons (car lst) result))))
     234    (error 'comment-type "not a comment separator" separator)))
     235
    224236(define (comment-name signature)
    225237  (let* ((lst (string-split signature))
     
    254266            "without sym: list of exported symbols"))))
    255267
     268(define (filter ok? lst)
     269  (let recur ((lst lst))
     270    (cond
     271      ((null? lst) '())
     272      ((ok? (car lst))
     273       (cons (car lst) (recur (cdr lst))))
     274      (else (recur (cdr lst))))))
     275
    256276(define (module-exports module.lst)
    257   (let* ((export.lst
    258            (map comment-name
    259                 (map car (module-comments module.lst))))
    260          (export.str
    261            (apply string-append
    262               (map (lambda (s) (string-append "\n  " s))
    263                    export.lst))))
    264     (substring export.str 1)))
     277  (let ((separator.lst ;;;
     278          (append
     279            (filter comment-separator? module.lst)
     280            (list "--- procedure ---"))) ; internal doc
     281        (export.lst
     282          (map comment-name
     283               (map car (module-comments module.lst)))))
     284    (let* ((enhanced-export.lst
     285             (map (lambda (s e)
     286                    (let* ((rs (restricted-exports s))
     287                           (rss (apply string-append
     288                                       (map (lambda (str)
     289                                              (string-append " " str))
     290                                            rs))))
     291                      (if (null? rs)
     292                        e
     293                        (string-append "(" e rss ")"))))
     294                  separator.lst export.lst))
     295           (export.str
     296             (apply string-append
     297               (map (lambda (s) (string-append "\n  " s))
     298                    enhanced-export.lst))))
     299      (substring export.str 1))))
    265300
    266301(define license.lst ;(file->list "license.txt"))
     
    273308    (lambda ()
    274309      (read-lines))))
    275 
    276310
    277311(define (license-author licens)
     
    308342                  docs)
    309343                ))))))
    310 
    311344
    312345(define (internal-doc-proc module.lst)
     
    437470                 (for-each (lambda (sym)
    438471                             (write-line
    439                                (string-append "  ("
    440                                               (symbol->string sym)
    441                                               ")")))
     472                               (string-append "  "
     473                                              (symbol->string sym))))
    442474                           (reverse checks))
    443475                 (write-line "  )"))
     
    500532                  (lst (string-split
    501533                         (seconds->string
    502                            (file-modification-time; "preloops.scm"))))
     534                           (file-modification-time ; "preloops.scm"))))
    503535                             pre-file))))
    504536                  )
     
    579611) ; endmodule
    580612
     613;(import premodules)
     614;(premodule->module "preloops.scm" "loops.scm")
     615;(premodule->docs "preloops.scm" "loops")
     616;(premodule->tests "preloops.scm" "run-loops.scm")
  • release/5/premodules/trunk/premodules.egg

    r39564 r39582  
    33((synopsis "Converting a premodule into module, test and doc files")
    44 (category doc-tools)
    5  (version "0.6.1")
     5 (version "0.7")
    66 (license "BSD")
    77 (dependencies simple-tests)
  • release/5/premodules/trunk/premodules.scm

    r39564 r39582  
    147147(define (comment-separator? line)
    148148  (and (string? line)
    149        (irregex-match? '(: bos
     149       (irregex-match? `(: bos
    150150                           (* space)
    151151                           "---"
    152152                           (* #\-)
    153153                           (+ space)
    154                            (or "macro" "procedure" "parameter")
     154                           ;(or "macro" "procedure" "parameter")
     155                           (or ,(string->sre "macro[ 0-9a-zA-Z!$%&*+-./:<=>?@^_~]*")
     156                               "procedure"
     157                               "parameter")
    155158                           (+ space)
    156159                           "---"
     
    174177
    175178(define (check-xpr? xpr)
    176   (or (eq? (car xpr) 'define-tester)
    177       (eq? (car xpr) 'define-checks)
    178       (eq? (car xpr) 'do-checks)))
     179  (eq? (car xpr) 'define-tester))
     180  ;(or (eq? (car xpr) 'define-tester)
     181  ;    (eq? (car xpr) 'define-checks)
     182  ;    (eq? (car xpr) 'do-checks)))
    179183
    180184(define (extract-check-name xpr)
     
    222226    (error 'comment-type "not a comment separator" separator)))
    223227
     228(define (restricted-exports separator)
     229  (if (comment-separator? separator)
     230    (let loop ((lst (list-tail (string-split separator) 2)) (result '()))
     231      (if (string=? (substring (car lst) 0 3) "---")
     232        result
     233        (loop (cdr lst) (cons (car lst) result))))
     234    (error 'comment-type "not a comment separator" separator)))
     235
    224236(define (comment-name signature)
    225237  (let* ((lst (string-split signature))
     
    254266            "without sym: list of exported symbols"))))
    255267
     268(define (filter ok? lst)
     269  (let recur ((lst lst))
     270    (cond
     271      ((null? lst) '())
     272      ((ok? (car lst))
     273       (cons (car lst) (recur (cdr lst))))
     274      (else (recur (cdr lst))))))
     275
    256276(define (module-exports module.lst)
    257   (let* ((export.lst
    258            (map comment-name
    259                 (map car (module-comments module.lst))))
    260          (export.str
    261            (apply string-append
    262               (map (lambda (s) (string-append "\n  " s))
    263                    export.lst))))
    264     (substring export.str 1)))
     277  (let ((separator.lst ;;;
     278          (append
     279            (filter comment-separator? module.lst)
     280            (list "--- procedure ---"))) ; internal doc
     281        (export.lst
     282          (map comment-name
     283               (map car (module-comments module.lst)))))
     284    (let* ((enhanced-export.lst
     285             (map (lambda (s e)
     286                    (let* ((rs (restricted-exports s))
     287                           (rss (apply string-append
     288                                       (map (lambda (str)
     289                                              (string-append " " str))
     290                                            rs))))
     291                      (if (null? rs)
     292                        e
     293                        (string-append "(" e rss ")"))))
     294                  separator.lst export.lst))
     295           (export.str
     296             (apply string-append
     297               (map (lambda (s) (string-append "\n  " s))
     298                    enhanced-export.lst))))
     299      (substring export.str 1))))
    265300
    266301(define license.lst ;(file->list "license.txt"))
     
    273308    (lambda ()
    274309      (read-lines))))
    275 
    276310
    277311(define (license-author licens)
     
    308342                  docs)
    309343                ))))))
    310 
    311344
    312345(define (internal-doc-proc module.lst)
     
    437470                 (for-each (lambda (sym)
    438471                             (write-line
    439                                (string-append "  ("
    440                                               (symbol->string sym)
    441                                               ")")))
     472                               (string-append "  "
     473                                              (symbol->string sym))))
    442474                           (reverse checks))
    443475                 (write-line "  )"))
     
    500532                  (lst (string-split
    501533                         (seconds->string
    502                            (file-modification-time; "preloops.scm"))))
     534                           (file-modification-time ; "preloops.scm"))))
    503535                             pre-file))))
    504536                  )
     
    579611) ; endmodule
    580612
     613;(import premodules)
     614;(premodule->module "preloops.scm" "loops.scm")
     615;(premodule->docs "preloops.scm" "loops")
     616;(premodule->tests "preloops.scm" "run-loops.scm")
Note: See TracChangeset for help on using the changeset viewer.