Centralize (almost) all exports to :export in define-module.

6 files changed, 156 insertions, 84 deletions

diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index 1fa3eb83..1e79781f 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -2,20 +2,66 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:use-module (srfi srfi-88)           ; postfix keywords
-  #:use-module ((ice-9 optargs) #:select (define*-public))
   #:use-module ((sxml fold) #:select (fold-values))
   #:use-module ((srfi srfi-9 gnu) #:select (set-fields))
-  #:re-export (define*-public fold-values)
-  #:export (for sort* sort*!
-                set/r!
-                -> ->> set set-> aif awhen
-                let-lazy
-                case*
-                and=>> label
-                print-and-return
-                begin1
-                catch*
-                )
+  #:re-export (fold-values)
+  #:export (aif
+            awhen
+            for
+            begin1
+            print-and-return
+            swap
+            case*
+            set/r!
+            label
+            sort* sort*!
+            find-extreme find-min find-max
+            filter-sorted
+            !=
+            take-to
+            string-take-to
+            string-first
+            string-last
+            as-symb
+            enumerate
+            unval
+            flatten
+            let-lazy
+            map/dotted
+
+            assq-merge
+            kvlist->assq
+            assq-limit
+
+            group-by
+            split-by
+
+            span-upto
+            cross-product
+
+            string-flatten
+            intersperse
+            insert-ordered
+
+            -> ->>
+            set set->
+            and=>>
+
+            downcase-symbol
+            group
+            iterate
+            valued-map
+
+            assoc-ref-all
+            assq-ref-all
+            assv-ref-all
+
+            vector-last
+
+            ->str ->string ->quoted-string
+
+            catch*
+            )
   #:replace (set! define-syntax
                   when unless))
 
@@ -92,7 +138,7 @@
 
 
 
-(define-public (swap f)
+(define (swap f)
   (lambda args (apply f (reverse args))))
 
 
@@ -183,7 +229,7 @@
 ;; Returns 2 values. The extremest item in @var{items},
 ;; and the other items in some order.
 ;; Ord b => (list a) [, (b, b -> bool), (a -> b)] -> a, (list a)
-(define*-public (find-extreme items optional: (< <) (access identity))
+(define* (find-extreme items optional: (< <) (access identity))
   (when (null? items)
     (scm-error 'wrong-type-arg "find-extreme"
                "Can't find extreme in an empty list"
@@ -199,51 +245,51 @@
    ;; seeds:
    (car items) '()))
 
-(define*-public (find-min list optional: (access identity))
+(define* (find-min list optional: (access identity))
   (find-extreme list < access))
 
-(define*-public (find-max list optional: (access identity))
+(define* (find-max list optional: (access identity))
   (find-extreme list > access))
 
-(define-public (filter-sorted proc list)
+(define (filter-sorted proc list)
   (take-while
    proc (drop-while
          (negate proc) list)))
 
 ;; (define (!= a b) (not (= a b)))
-(define-public != (negate =))
+(define != (negate =))
 
-(define-public (take-to lst i)
+(define (take-to lst i)
   "Like @var{take}, but might lists shorter than length."
   (if (> i (length lst))
       lst (take lst i)))
 
-(define-public (string-take-to str i)
+(define (string-take-to str i)
   (if (> i (string-length str))
       str (string-take str i)))
 
-(define-public (string-first str)
+(define (string-first str)
   (string-ref str 0))
 
-(define-public (string-last str)
+(define (string-last str)
   (string-ref str (1- (string-length str))))
 
-(define-public (as-symb s)
+(define (as-symb s)
   (if (string? s) (string->symbol s) s))
 
-(define-public (enumerate lst)
+(define (enumerate lst)
   (zip (iota (length lst))
        lst))
 
 ;; Takes a procedure returning multiple values, and returns a procedure which
 ;; takes the same arguments as the original procedure, but only returns one of
 ;; the return values. Which value to return can be sent as an additional parameter.
-(define*-public (unval proc #:optional (n 0))
+(define* (unval proc #:optional (n 0))
   (lambda args
     (call-with-values (lambda () (apply proc args))
       (lambda args (list-ref args n)))))
 
-(define-public (flatten lst)
+(define (flatten lst)
   (fold (lambda (subl done)
           (append done ((if (list? subl) flatten list) subl)))
         '() lst))
@@ -256,7 +302,7 @@
        (let-syntax ((field (identifier-syntax (force field))) ...)
          body ...))]))
 
-(define-public (map/dotted proc dotted-list)
+(define (map/dotted proc dotted-list)
   (cond ((null? dotted-list) '())
         ((not-pair? dotted-list) (proc dotted-list))
         (else
@@ -271,24 +317,24 @@
 ;; (assq-merge '((k 1)) '((k 2)))
 ;; => ((k 2 1))
 ;; @end example
-(define-public (assq-merge a b)
+(define (assq-merge a b)
   (fold (lambda (entry alist)
           (let* ((k v (car+cdr entry))
                  (o (assq-ref alist k)))
             (assq-set! alist k (append v (or o '())))))
         (copy-tree a) b))
 
-(define-public (kvlist->assq kvlist)
+(define (kvlist->assq kvlist)
   (map (lambda (pair)
          (cons (keyword->symbol (car pair)) (cdr pair)))
        (group kvlist 2)))
 
-(define*-public (assq-limit alist optional: (number 1))
+(define* (assq-limit alist optional: (number 1))
   (map (lambda (pair)
          (take-to pair (1+ number)))
        alist))
 
-(define-public (group-by proc lst)
+(define (group-by proc lst)
   (let ((h (make-hash-table)))
     (for value in lst
          (let ((key (proc value)))
@@ -298,7 +344,7 @@
 
 ;; (split-by '(0 1 2 3 4 2 5 6) 2)
 ;; ⇒ ((0 1) (3 4) (5 6))
-(define-public (split-by list item)
+(define (split-by list item)
   (let loop ((done '())
              (current '())
              (rem list))
@@ -325,7 +371,7 @@
 ;; ⇒ ()
 ;; ⇒ (#\H #\1 #\2 #\3 #\4 #\5 #\6)
 ;; @end example
-(define-public (span-upto count predicate list)
+(define (span-upto count predicate list)
   (let loop ((remaining count)
              (taken '())
              (list list))
@@ -348,7 +394,7 @@
                l2))
         l1)))
 
-(define-public (cross-product . args)
+(define (cross-product . args)
   (if (null? args)
       '()
       (let ((last rest (car+cdr (reverse args))))
@@ -357,12 +403,12 @@
 
 ;; Given an arbitary tree, do a pre-order traversal, appending all strings.
 ;; non-strings allso allowed, converted to strings and also appended.
-(define-public (string-flatten tree)
+(define (string-flatten tree)
   (cond [(string? tree) tree]
         [(list? tree) (string-concatenate (map string-flatten tree))]
         [else (format #f "~a" tree)]))
 
-(define-public (intersperse item list)
+(define (intersperse item list)
   (let loop ((flipflop #f)
              (rem list))
     (if (null? rem)
@@ -376,7 +422,7 @@
 ;; (insert-ordered 5 (iota 10))
 ;; ⇒ (0 1 2 3 4 5 5 6 7 8 9)
 ;; @end example
-(define*-public (insert-ordered item collection optional: (< <))
+(define* (insert-ordered item collection optional: (< <))
   (cond [(null? collection)
          (list item)]
         [(< item (car collection))
@@ -430,7 +476,7 @@
      (and=>> (and=> value proc)
              rest ...)]))
 
-(define-public (downcase-symbol symb)
+(define (downcase-symbol symb)
   (-> symb
       symbol->string
       string-downcase
@@ -442,7 +488,7 @@
 ;; ⇒ ((0 1) (2 3) (4 5) (6 7) (8 9))
 ;; @end example
 ;; Requires that width|(length list)
-(define-public (group list width)
+(define (group list width)
   (unless (null? list)
     (let ((row rest (split-at list width)))
       (cons row (group rest width)))))
@@ -450,14 +496,14 @@
 ;; repeatedly apply @var{proc} to @var{base}
 ;; unitl @var{until} is satisfied.
 ;; (a → a), (a → bool), a → a
-(define-public (iterate proc until base)
+(define (iterate proc until base)
   (let loop ((o base))
     (if (until o)
         o
         (loop (proc o)))))
 
 ;; (a → values a), list ... → values a
-(define-public (valued-map proc . lists)
+(define (valued-map proc . lists)
   (apply values
    (apply append-map
           (lambda args
@@ -474,22 +520,22 @@
 ;; (assoc-ref-all '((a . 1) (b . 2) (a . 3)) 'a)
 ;; ⇒ (1 3)
 ;; @end
-(define-public (assoc-ref-all alist key) (ass%-ref-all alist key equal?))
-(define-public (assq-ref-all alist key)  (ass%-ref-all alist key eq?))
-(define-public (assv-ref-all alist key)  (ass%-ref-all alist key eqv?))
+(define (assoc-ref-all alist key) (ass%-ref-all alist key equal?))
+(define (assq-ref-all alist key)  (ass%-ref-all alist key eq?))
+(define (assv-ref-all alist key)  (ass%-ref-all alist key eqv?))
 
 
 
 
-(define-public (vector-last v)
+(define (vector-last v)
   (vector-ref v (1- (vector-length v))))
 
-(define-public (->str any)
+(define (->str any)
   (with-output-to-string (lambda () (display any))))
 
-(define-public ->string ->str)
+(define ->string ->str)
 
-(define-public (->quoted-string any)
+(define (->quoted-string any)
   (with-output-to-string (lambda () (write any))))
 
 
diff --git a/module/hnh/util/exceptions.scm b/module/hnh/util/exceptions.scm
index eed310bb..36b018d1 100644
--- a/module/hnh/util/exceptions.scm
+++ b/module/hnh/util/exceptions.scm
@@ -6,33 +6,38 @@
   #:use-module ((system vm frame)
                 :select (frame-bindings binding-ref))
 
-  )
+  :export (warning-handler
+           warnings-are-errors
+           warning
+           fatal
+           filter-stack
+           ))
 
 
-(define-public warning-handler
+(define warning-handler
   (make-parameter
    (lambda (fmt . args)
      (format #f "WARNING: ~?~%" fmt args))))
 
-(define-public warnings-are-errors
+(define warnings-are-errors
   (make-parameter #f))
 
 ;; forwards return from warning-hander. By default returns an unspecified value,
 ;; but instances are free to provide a proper return value and use it.
-(define-public (warning fmt . args)
+(define (warning fmt . args)
   (display (apply (warning-handler) fmt (or args '()))
            (current-error-port))
   (when (warnings-are-errors)
     (throw 'warning fmt args)))
 
-(define-public (fatal fmt . args)
+(define (fatal fmt . args)
   (display (format #f "FATAL: ~?~%" fmt (or args '()))
            (current-error-port))
   (raise 2)
   )
 
 
-(define-public (filter-stack pred? stk)
+(define (filter-stack pred? stk)
   (concatenate
    (for i in (iota (stack-length stk))
         (filter pred? (map binding-ref (frame-bindings (stack-ref stk i)))))))
diff --git a/module/hnh/util/graph.scm b/module/hnh/util/graph.scm
index 01e9a63a..9aff7c77 100644
--- a/module/hnh/util/graph.scm
+++ b/module/hnh/util/graph.scm
@@ -8,7 +8,16 @@
   :use-module (hnh util)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-71)
-  :use-module (srfi srfi-9 gnu))
+  :use-module (srfi srfi-9 gnu)
+  :export (make-graph
+           rebuild-graph
+           graph-empty?
+           add-node
+           get-node
+           remove-node
+           find-node-without-dependencies
+           find-and-remove-node-without-dependencies
+           resolve-dependency-graph))
 
 ;; Immutable directed graph
 (define-immutable-record-type <graph>
@@ -20,23 +29,23 @@
   (node-equal? node-equal?) ; node, node -> symb
   )
 
-(define*-public (make-graph optional:
-                            (node-key-proc identity)
-                            (node-equal? eq?))
+(define* (make-graph optional:
+                     (node-key-proc identity)
+                     (node-equal? eq?))
   (make-graph% '() '() node-key-proc node-equal?))
 
-(define*-public (rebuild-graph optional: old-graph
-                               (nodes '()) (edges '()))
+(define* (rebuild-graph optional: old-graph
+                        (nodes '()) (edges '()))
   (make-graph% nodes edges
                (if old-graph (node-key-proc old-graph) identity)
                (if old-graph (node-equal? old-graph) eq?)))
 
-(define-public (graph-empty? graph)
+(define (graph-empty? graph)
   (null? (graph-nodes graph)))
 
 ;; Add node to graph. Adds directed edges from node to neighbours
 ;; graph, node, (list node-key) → graph
-(define-public (add-node graph node edge-neighbours)
+(define (add-node graph node edge-neighbours)
   (rebuild-graph
    graph
    (lset-adjoin (node-equal? graph) (graph-nodes graph)
@@ -46,12 +55,12 @@
                     edge-neighbours))))
 
 ;; get node by key
-(define-public (get-node graph key)
+(define (get-node graph key)
   (find (lambda (node) (eq? key ((node-key-proc graph) node)))
         (graph-nodes graph)))
 
 ;; Remove node by @var{node-equal?}
-(define-public (remove-node graph node)
+(define (remove-node graph node)
   (rebuild-graph
    graph
    (remove (lambda (other) ((node-equal? graph) node other))
@@ -64,14 +73,14 @@
 ;; NOTE this is O(n^2) (maybe, sort of?)
 ;; Getting it faster would require building an index, which
 ;; is hard since there isn't a total order on symbols.
-(define-public (find-node-without-dependencies graph)
+(define (find-node-without-dependencies graph)
   (find (lambda (node)
           (let ((key ((node-key-proc graph) node)))
             (not (find (lambda (edge) (eq? key (car edge))) (graph-edges graph)))))
         (graph-nodes graph)))
 
 ;; graph → node x graph
-(define-public (find-and-remove-node-without-dependencies graph)
+(define (find-and-remove-node-without-dependencies graph)
   (let ((node (find-node-without-dependencies graph)))
     (unless node
       (scm-error 'graph-error "find-and-remove-node-without-dependencies"
@@ -83,7 +92,7 @@
 ;; Returns a list of all nodes so that each node is before its dependants.
 ;; A missing dependency (and probably a loop) is an error, and currently
 ;; leads to some weird error messages.
-(define-public (resolve-dependency-graph graph)
+(define (resolve-dependency-graph graph)
   (catch 'graph-error
     (lambda ()
       (let loop ((graph graph))
diff --git a/module/hnh/util/io.scm b/module/hnh/util/io.scm
index 3a595b67..d638ebb4 100644
--- a/module/hnh/util/io.scm
+++ b/module/hnh/util/io.scm
@@ -1,19 +1,23 @@
 (define-module (hnh util io)
   :use-module ((hnh util) :select (begin1))
-  :use-module ((ice-9 rdelim) :select (read-line)))
+  :use-module ((ice-9 rdelim) :select (read-line))
+  :export (open-input-port
+           open-output-port
+           read-lines
+           with-atomic-output-to-file))
 
-(define-public (open-input-port str)
+(define (open-input-port str)
   (if (string=? "-" str)
       (current-input-port)
       (open-input-file str)))
 
-(define-public (open-output-port str)
+(define (open-output-port str)
   (if (string=? "-" str)
       (current-output-port)
       (open-output-file str)))
 
 
-(define-public (read-lines port)
+(define (read-lines port)
   (let ((line (read-line port)))
     (if (eof-object? line)
         '() (cons line (read-lines port)))))
@@ -26,7 +30,7 @@
 ;; 
 ;; propagates the return value of @var{thunk} upon successfully writing
 ;; the file, and @code{#f} otherwise.
-(define-public (with-atomic-output-to-file filename thunk)
+(define (with-atomic-output-to-file filename thunk)
   ;; copy to enusre writable string
   (define tmpfile (string-copy (string-append
                                 (dirname filename)
diff --git a/module/hnh/util/options.scm b/module/hnh/util/options.scm
index 57473816..0faebf89 100644
--- a/module/hnh/util/options.scm
+++ b/module/hnh/util/options.scm
@@ -3,10 +3,13 @@
   :use-module (ice-9 match)
   :use-module (srfi srfi-1)
   :use-module (text markup)
-  )
+  :export (getopt-opt
+           format-arg-help
+           print-arg-help
+           ))
 
 ;; option-assoc → getopt-valid option-assoc
-(define-public (getopt-opt options)
+(define (getopt-opt options)
   (define ice-9-names '(single-char required? value predicate))
   (for (option-name flags ...) in options
        (cons option-name
@@ -38,8 +41,8 @@
                         `((blockquote ,@it)
                           (br))))))))
 
-(define-public (format-arg-help options)
+(define (format-arg-help options)
   (sxml->ansi-text (cons '*TOP* (map sxml->ansi-text (map fmt-help options)))))
 
-(define*-public (print-arg-help options optional: (port (current-error-port)))
+(define* (print-arg-help options optional: (port (current-error-port)))
   (display (format-arg-help options) port))
diff --git a/module/hnh/util/path.scm b/module/hnh/util/path.scm
index 340c2d8b..ac6df491 100644
--- a/module/hnh/util/path.scm
+++ b/module/hnh/util/path.scm
@@ -1,12 +1,18 @@
 (define-module (hnh util path)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-71)
-  :use-module (hnh util))
+  :use-module (hnh util)
+  :export (path-append
+           path-join
+           path-split
+           file-hidden?
+           filename-extension
+           realpath))
 
 (define // file-name-separator-string)
 (define /? file-name-separator?)
 
-(define-public (path-append . strings)
+(define (path-append . strings)
   (fold (lambda (s done)
           (string-append
            done
@@ -28,7 +34,7 @@
         (cdr strings)
         ))
 
-(define-public (path-join lst) (apply path-append lst))
+(define (path-join lst) (apply path-append lst))
 
 ;; @example
 ;; (path-split "usr/lib/test")
@@ -40,7 +46,7 @@
 ;; (path-split "//usr////lib/test")
 ;; ⇒ ("" "usr" "lib" "test")
 ;; @end example
-(define-public (path-split path)
+(define (path-split path)
   (let ((head tail
               (car+cdr
                (reverse
@@ -54,16 +60,15 @@
     (cons head (remove string-null? tail))))
 
 
-(define-public (file-hidden? path)
+(define (file-hidden? path)
   (define base (basename path))
   (and (not (string-null? base))
        (char=? #\. (string-ref base 0))))
 
-(define-public (filename-extension filename)
+(define (filename-extension filename)
   (car (reverse (string-split filename #\.))))
 
-
-(define-public (realpath filename)
+(define (realpath filename)
   (unless (string? filename)
     (scm-error 'wrong-type-arg "realpath"
                "filename not a string: ~a"