diff --git a/src/functions.lisp b/src/functions.lisp
index 6bda2af..441117b 100644
--- a/src/functions.lisp
+++ b/src/functions.lisp
@@ -218,30 +218,101 @@ arguments and does type promotion for the variadic arguments."
 ;;; present, its name is derived from the other. See the user
 ;;; documentation for an explanation of the derivation rules.
 
-(defun lisp-name (spec &optional varp)
-  (etypecase spec
-    (list (if (keywordp (second spec))
-              (lisp-name (first spec) varp)
-              (if (symbolp (first spec))
-                  (first spec)
-                  (lisp-name (second spec) varp))))
-    (string (intern
-             (format nil (if varp "*~A*" "~A")
-                     (canonicalize-symbol-name-case
-                      (substitute #\- #\_ spec)))))
-    (symbol spec)))
-
-(defun foreign-name (spec &optional varp)
-  (etypecase spec
-    (list (if (stringp (second spec))
-              (second spec)
-              (foreign-name (first spec) varp)))
-    (string spec)
-    (symbol (let ((name (substitute #\_ #\-
-                                    (string-downcase (symbol-name spec)))))
-              (if varp
-                  (string-trim '(#\*) name)
-                  name)))))
+(defgeneric translate-underscore-separated-name (name)
+  (:method ((name string))
+           (canonicalize-symbol-name-case (substitute #\- #\_ name)))
+  (:method ((name symbol))
+           (substitute #\_ #\- (string-downcase (symbol-name name)))))
+
+(defun collapse-prefix (l special-words)
+  (unless (null l)
+    (multiple-value-bind (newpre skip) (check-prefix l special-words)
+      (cons newpre (collapse-prefix (nthcdr skip l) special-words)))))
+
+(defun check-prefix (l special-words)
+  (let ((pl (loop for i from (1- (length l)) downto 0
+              collect (apply #'concatenate 'simple-string (butlast l i)))))
+    (loop for w in special-words
+          for p = (position-if #'(lambda (s) (string= s w)) pl)
+          when p do (return-from check-prefix (values (nth p pl) (1+ p))))
+    (values (first l) 1)))
+
+(defun split-if (test seq &optional (dir :before))
+  (remove-if #'(lambda (x) (equal x (subseq seq 0 0)))
+             (loop for start fixnum = 0 
+               then (if (eq dir :before)
+                      stop
+                      (the fixnum (1+ (the fixnum stop))))
+               while (< start (length seq))
+               for stop = (position-if 
+                           test seq 
+                           :start (if (eq dir :elide)
+                                    start
+                                    (the fixnum (1+ start))))
+               collect (subseq 
+                        seq start 
+                        (if (and stop (eq dir :after)) 
+                          (the fixnum (1+ (the fixnum stop))) 
+                          stop))
+               while stop)))
+
+(defgeneric translate-camelcase-name
+            (name &key upper-initial-p special-words)
+  (:method ((name string) &key upper-initial-p special-words)
+           (declare (ignore upper-initial-p))
+           (intern
+            (reduce #'(lambda (s1 s2) (concatenate 'simple-string s1 "-" s2))
+                    (mapcar #'string-upcase
+                            (collapse-prefix
+                             (split-if #'(lambda (ch)
+                                           (or (upper-case-p ch)
+                                               (digit-char-p ch)))
+                                       name)
+                             special-words)))
+            *package*))
+  (:method ((name symbol) &key upper-initial-p special-words)
+           (apply #'concatenate
+                  'string
+                  (loop for str in (split-if #'(lambda (ch) (eq ch #\-))
+                                             (string name)
+                                             :elide)
+                    for first-word-p = t then nil
+                    for e = (member str special-words
+                                    :test #'equal :key #'string-upcase)
+                    collect (cond
+                             ((and first-word-p (not upper-initial-p)) str)
+                             (e (first e))
+                             (t (string-capitalize str)))))))
+
+(defgeneric lisp-name (spec package &optional varp)
+  (:method ((spec list) package &optional varp)
+           (if (keywordp (second spec))
+             (lisp-name (first spec) package varp)
+             (if (symbolp (first spec))
+               (first spec)
+               (lisp-name (second spec) package varp))))
+  (:method ((spec string) package &optional varp)
+           (declare (ignore package))
+           (intern (format nil (if varp "*~A*" "~A")
+                           (translate-underscore-separated-name spec))))
+  (:method ((name symbol) package &optional varp)
+           (declare (ignore package varp))
+           name))
+
+(defgeneric foreign-name (spec package &optional varp)
+  (:method ((spec list) package &optional varp)
+           (if (stringp (second spec))
+             (second spec)
+             (foreign-name (first spec) package varp)))
+  (:method ((spec string) package &optional varp)
+           (declare (ignore package varp))
+           spec)
+  (:method ((spec symbol) package &optional varp)
+           (declare (ignore package))
+           (let ((name (translate-underscore-separated-name spec)))
+             (if varp
+                 (string-trim '(#\*) name)
+                 name))))
 
 (defun foreign-options (spec varp)
   (let ((opts (if (listp spec)
@@ -254,8 +325,8 @@ arguments and does type promotion for the variadic arguments."
         (parse-function-options opts))))
 
 (defun parse-name-and-options (spec &optional varp)
-  (values (lisp-name spec varp)
-          (foreign-name spec varp)
+  (values (lisp-name spec *package* varp)
+          (foreign-name spec *package* varp)
           (foreign-options spec varp)))
 
 ;;; If we find a &REST token at the end of ARGS, it means this is a