Merge pull request #17 from jbouwman/housekeeping-b

continue trimming unused functions

src/epsilon.sexp

@@ -36,14 +36,14 @@
                "sys-utils"
                "sbcl"
                "utils"
-               "libraries"
                "early-types"
+               "foreign-vars"
+               "libraries"
                "types"
                "enum"
                "strings"
                "structures"
-               "functions"
-               "foreign-vars")
+               "functions")
         "fs"
         "gc"
         ("sync" "error"
@@ -119,11 +119,11 @@
                "ssl-funcall"
                "init"
                "ffi-buffer"
+               "verify-hostname"
                "streams"
                "x509"
                "random"
-               "context"
-               "verify-hostname")
+               "context")
         ("http" "chunked-stream"
                 "parser"
                 "encoding"

src/lib/archive/zippy.lisp

@@ -151,8 +151,7 @@
                          (vector-push-extend (make-instance 'zip-entry :content path :file-name (enough-namestring path file)) entries)))
                       ((or (pathname-name file) (pathname-type file))
                        (vector-push-extend (make-instance 'zip-entry :content file) entries))
-                      (T
-                       (setf file (sys.fs:resolve-symbolic-links file))
+                      (t
                        (loop with base = (truename file)
                              :for path in (sys.fs:list-dir file)
                              :for file-name = (enough-namestring path base)

src/lib/regex/package.lisp

@@ -21,7 +21,6 @@
    #:define-parse-tree-synonym
    #:do-matches
    #:do-matches-as-strings
-   #:do-register-groups
    #:do-scans
    #:parse-string
    #:parse-tree-synonym
@@ -35,7 +34,6 @@
    #:regex-apropos-list
    #:regex-replace
    #:regex-replace-all
-   #:register-groups-bind
    #:scan
    #:scan-to-strings
    #:split))

src/lib/regex/public.lisp

@@ -225,50 +225,9 @@ share structure with TARGET-STRING."
                            ,target-string ,@rest))
         (t form)))
 
-(defmacro register-groups-bind (var-list (regex target-string
-                                                &key start end sharedp)
-                                &body body)
-  "Executes BODY with the variables in VAR-LIST bound to the
-corresponding register groups after TARGET-STRING has been matched
-against REGEX, i.e. each variable is either bound to a string or to
-NIL.  If there is no match, BODY is _not_ executed. For each element
-of VAR-LIST which is NIL there's no binding to the corresponding
-register group.  The number of variables in VAR-LIST must not be
-greater than the number of register groups.  If SHAREDP is true, the
-substrings may share structure with TARGET-STRING."
-  (with-rebinding (target-string)
-    (with-unique-names (match-start match-end reg-starts reg-ends
-                                    start-index substr-fn)
-      (let ((var-bindings
-              (loop for (function var) in (normalize-var-list var-list)
-                    for counter from 0
-                    when var
-                      collect `(,var (let ((,start-index
-                                             (aref ,reg-starts ,counter)))
-                                       (if ,start-index
-                                           (funcall ,function
-                                                    (funcall ,substr-fn
-                                                             ,target-string
-                                                             ,start-index
-                                                             (aref ,reg-ends ,counter)))
-                                           nil))))))
-        `(multiple-value-bind (,match-start ,match-end ,reg-starts ,reg-ends)
-             (scan ,regex ,target-string :start (or ,start 0)
-                                         :end (or ,end (length ,target-string)))
-           (declare (ignore ,match-end))
-           ,@(unless var-bindings
-               `((declare (ignore ,reg-starts ,reg-ends))))
-           (when ,match-start
-             ,@(if var-bindings
-                   `((let* ,(list*
-                             `(,substr-fn (if ,sharedp #'nsubseq #'subseq))
-                             var-bindings)
-                       ,@body))
-                   body)))))))
-
 (defmacro do-scans ((match-start match-end reg-starts reg-ends regex
                                  target-string
-                                 &optional result-form
+                                 result-form
                                  &key start end)
                     &body body
                     &environment env)
@@ -372,46 +331,6 @@ with declarations."
                            ,target-string ,match-start ,match-end)))
             ,@body))))))
 
-(defmacro do-register-groups (var-list (regex target-string
-                                              &optional result-form
-                                              &key start end sharedp)
-                                       &body body)
-  "Iterates over TARGET-STRING and tries to match REGEX as often as
-possible evaluating BODY with the variables in VAR-LIST bound to the
-corresponding register groups for each match in turn, i.e. each
-variable is either bound to a string or to NIL.  For each element of
-VAR-LIST which is NIL there's no binding to the corresponding register
-group. The number of variables in VAR-LIST must not be greater than
-the number of register groups.  After the last match, returns
-RESULT-FORM if provided or NIL otherwise.  An implicit block named NIL
-surrounds DO-REGISTER-GROUPS; RETURN may be used to terminate the loop
-immediately. If REGEX matches an empty string the scan is continued
-one position behind this match.  If SHAREDP is true, the substrings
-may share structure with TARGET-STRING.  BODY may start with
-declarations."
-  (with-rebinding (target-string)
-    (with-unique-names (substr-fn match-start match-end
-                                  reg-starts reg-ends start-index)
-      `(let ((,substr-fn (if ,sharedp
-                          #'nsubseq
-                          #'subseq)))
-        (do-scans (,match-start ,match-end ,reg-starts ,reg-ends
-                                ,regex ,target-string
-                                ,result-form :start ,start :end ,end)
-          (let ,(loop for (function var) in (normalize-var-list var-list)
-                      for counter from 0
-                      when var
-                        collect `(,var (let ((,start-index
-                                               (aref ,reg-starts ,counter)))
-                                         (if ,start-index
-                                           (funcall ,function
-                                                    (funcall ,substr-fn
-                                                             ,target-string
-                                                             ,start-index
-                                                             (aref ,reg-ends ,counter)))
-                                           nil))))
-            ,@body))))))
-
 (defun count-matches (regex target-string
                       &key (start 0)
                            (end (length target-string)))

src/lib/regex/util.lisp

@@ -48,17 +48,6 @@ match [\\s] in Perl."
               :displaced-to sequence
               :displaced-index-offset start))
 
-(defun normalize-var-list (var-list)
-  "Utility function for REGISTER-GROUPS-BIND and DO-REGISTER-GROUPS.
-Creates the long form \(a list of \(FUNCTION VAR) entries) out of the
-short form of VAR-LIST."
-  (loop for element in var-list
-        if (consp element)
-          nconc (loop for var in (rest element)
-                      collect (list (first element) var))
-        else
-          collect (list '(function identity) element)))
-
 (defun string-list-to-simple-string (string-list)
   "Concatenates a list of strings to one simple-string."
   ;; this function provided by JP Massar; note that we can't use APPLY

src/net/tls/init.lisp

@@ -97,7 +97,7 @@ will use this value.")
       (t
        (error "fell through")))))
 
-(defvar *threads* (sys.gc:make-weak-hash-table :weakness :key))
+(defvar *threads* (make-hash-table :weakness :key))
 (defvar *thread-counter* 0)
 
 (defparameter *global-lock*

src/sys/env.lisp

@@ -33,5 +33,5 @@ use getenvp to return NIL in such a case."
   "Predicate that is true if the named variable is present in the libc environment,
 then returning the non-empty string value of the variable"
   (let ((g (getenv x)))
-    (and (not (emptyp g))
+    (and (not (= 0 (length g)))
          g)))

src/sys/ffi/libraries.lisp

@@ -244,7 +244,7 @@ in *DARWIN-FRAMEWORK-DIRECTORIES*. If unable to find FRAMEWORK-NAME,
 it signals a LOAD-FOREIGN-LIBRARY-ERROR."
   (let ((framework (find-darwin-framework framework-name)))
     (if framework
-        (load-foreign-library-path name (native-namestring framework))
+        (load-foreign-library-path name framework)
         (fl-error "Unable to find framework ~A" framework-name))))
 
 (defun report-simple-error (name error)
@@ -267,7 +267,7 @@ ourselves."
       (let ((dirs (parse-directories *foreign-library-directories*)))
         (if-let (file (find-file path (append search-path dirs)))
           (handler-case
-              (values (%load-foreign-library name (native-namestring file))
+              (values (%load-foreign-library name file)
                       file)
             (simple-error (error)
               (report-simple-error name error)))

src/sys/ffi/package.lisp

@@ -50,7 +50,6 @@
    ;; Foreign libraries
    #:%load-foreign-library
    #:%close-foreign-library
-   #:native-namestring
 
    ;; Callbacks
    #:%defcallback

src/sys/ffi/sbcl.lisp

@@ -355,9 +355,6 @@ WITH-POINTER-TO-VECTOR-DATA."
   "Closes a foreign library."
   (sb-alien:unload-shared-object handle))
 
-(defun native-namestring (pathname)
-  (sb-ext:native-namestring pathname))
-
 ;;;# Foreign Globals
 
 (defun %foreign-symbol-pointer (name library)

src/sys/fs.lisp

@@ -26,7 +26,6 @@
    #:list-contents
    #:list-directories
    #:list-files
-   #:resolve-symbolic-links
    #:symbolic-link-p
 
    #:access-time
@@ -130,15 +129,8 @@
                (not (dir-p (lib.string:join #\/ (list directory entry)))))
              (list-dir directory)))
 
-(defun resolve-symbolic-links (pathname)
-  (if (or (typep pathname 'logical-pathname)
-          (not (absolute-p pathname)))
-      pathname
-      (or (file-p pathname)
-          (normalize-pathname pathname))))
-
 (defun symbolic-link-p (file)
-  (eql :symlink (sb-impl::native-file-kind (native-namestring file))))
+  (eql :symlink (sb-impl::native-file-kind file)))
 
 (defun create-symbolic-link (link-file destination-file)
   (sb-posix:symlink destination-file link-file))

src/sys/gc.lisp

@@ -1,106 +1,11 @@
 (defpackage #:sys.gc
   (:use #:cl)
-  (:shadow #:make-hash-table)
   (:export
-   #:gc
-   #:make-weak-pointer
-   #:weak-pointer-value
-   #:weak-pointer-p
-   #:make-weak-hash-table
-   #:hash-table-weakness
    #:finalize
    #:cancel-finalization))
 
 (in-package #:sys.gc)
 
-;;;; GC
-
-(defun gc (&key full verbose)
-  "Initiates a garbage collection. @code{full} forces the collection
-   of all generations, when applicable. When @code{verbose} is
-   @em{true}, diagnostic information about the collection is printed
-   if possible."
-  (sb-ext:gc :full full))
-
-;;;; Weak Pointers
-
-(defun make-weak-pointer (object)
-  "Creates a new weak pointer which points to @code{object}. For
-   portability reasons, @code{object} must not be @code{nil}."
-  (assert (not (null object)))
-  (sb-ext:make-weak-pointer object))
-
-(defun weak-pointer-p (object)
-  "Returns @em{true} if @code{object} is a weak pointer and @code{nil}
-   otherwise."
- (sb-ext:weak-pointer-p object))
-
-(defun weak-pointer-value (weak-pointer)
-  "If @code{weak-pointer} is valid, returns its value. Otherwise,
-   returns @code{nil}."
- (values (sb-ext:weak-pointer-value weak-pointer)))
-
-;;;; Weak Hash-tables
-
-(defun weakness-keyword-arg (weakness)
-  :weakness)
-
-(defun weakness-keyword-opt (weakness errorp)
-  (declare (ignorable errorp))
-  (ecase weakness
-    (:key
-     :key)
-    (:value
-     :value)
-    (:key-or-value
-     :key-or-value)
-    (:key-and-value
-     :key-and-value)))
-
-(defun make-weak-hash-table (&rest args &key weakness (weakness-matters t)
-                             &allow-other-keys)
-  "Returns a new weak hash table. In addition to the standard
-   arguments accepted by @code{cl:make-hash-table}, this function adds
-   extra keywords: @code{:weakness} being the kind of weak table it
-   should create, and @code{:weakness-matters} being whether an error
-   should be signalled when that weakness isn't available (the default
-   is to signal an error).  @code{weakness} can be one of @code{:key},
-   @code{:value}, @code{:key-or-value}, @code{:key-and-value}.
-
-   If @code{weakness} is @code{:key} or @code{:value}, an entry is
-   kept as long as its key or value is reachable, respectively. If
-   @code{weakness} is @code{:key-or-value} or @code{:key-and-value},
-   an entry is kept if either or both of its key and value are
-   reachable, respectively.
-
-   @code{tg::make-hash-table} is available as an alias for this
-   function should you wish to import it into your package and shadow
-   @code{cl:make-hash-table}."
-  (remf args :weakness)
-  (remf args :weakness-matters)
-  (if weakness
-      (let ((arg (weakness-keyword-arg weakness))
-            (opt (weakness-keyword-opt weakness weakness-matters)))
-        (apply #'cl:make-hash-table
-               (if arg
-                   (list* arg opt args)
-                   args)))
-      (apply #'cl:make-hash-table args)))
-
-(defun make-hash-table (&rest args)
-  (apply #'make-weak-hash-table args))
-
-(defun hash-table-weakness (ht)
-  "Returns one of @code{nil}, @code{:key}, @code{:value},
-   @code{:key-or-value} or @code{:key-and-value}."
-  ;; keep this first if any of the other lisps bugously insert a NIL
-  ;; for the returned (values) even when *read-suppress* is NIL (e.g. clisp)
-  #.(if (find :sbcl *features*)
-        (if (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")
-            (read-from-string "(sb-ext:hash-table-weakness ht)")
-            nil)
-        (values)))
-
 ;;;; Finalizers
 
 (defun finalize (object function)

tests/lib/regex-tests.lisp

@@ -35,23 +35,3 @@
 
   (is (equalp (multiple-value-list (re:scan-to-strings "(([^b])*)b" "aaabd"))
               (list "aaab" #("aaa" "a")))))
-
-(deftest register-groups-bind ()
-  (is (equalp (re:register-groups-bind (first second third fourth)
-                  ("((a)|(b)|(c))+" "abababc" :sharedp t)
-                (list first second third fourth))
-              (list "c" "a" "b" "c")))
-
-  (is (equalp (re:register-groups-bind (nil second third fourth)
-                  ("((a)|(b)|(c))()+" "abababc" :start 6)
-                (list second third fourth))
-              (list nil nil "c")))
-
-  (is (null (re:register-groups-bind (first)
-                ("(a|b)+" "accc" :start 1)
-              first)))
-
-  (is (equalp (re:register-groups-bind (fname lname (#'parse-integer date month year))
-                  ("(\\w+)\\s+(\\w+)\\s+(\\d{1,2})\\.(\\d{1,2})\\.(\\d{4})" "Frank Zappa 21.12.1940")
-                (list fname lname (encode-universal-time 0 0 0 date month year 0)))
-              (list "Frank" "Zappa" 1292889600))))