Merge pull request #5 from s-expressionists/new-entries

Improve dictionary loading and add a few entries

code/english.lisp

@@ -2,20 +2,29 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun load-english-dictionary (&key (verbose *compile-verbose*))
-    (let ((filename   (asdf:system-relative-pathname
-                       "spell" "data/english.txt"))
-          dictionary entry-count)
-      (flet ((note (format-control &rest format-arguments)
+    (labels ((note (format-control &rest format-arguments)
                (when verbose
                  (let ((stream *standard-output*))
                    (fresh-line stream)
                    (pprint-logical-block (stream nil :per-line-prefix "; ")
                      (apply #'format stream format-control format-arguments))
-                   (force-output stream)))))
-        (note "Loading dictionary ~:_~S" filename)
-        (setf (values dictionary entry-count) (load-dictionary filename))
-        (note "Will dump dictionary with ~:_~:D entr~:@P" entry-count))
-      dictionary)))
+                   (force-output stream))))
+             (load-file (dictionary relative-filename)
+               (let ((filename (asdf:system-relative-pathname
+                                "spell" relative-filename)))
+                 (cond ((probe-file filename)
+                        (note "Loading dictionary ~:_~S" filename)
+                        (load-dictionary filename :into dictionary))
+                       (t
+                        (note "Skipping non-existent file ~:_~S"
+                              filename)
+                        dictionary)))))
+      (let ((dictionary (reduce #'load-file '("data/english.txt"
+                                              "data/english-additions.txt")
+                                :initial-value (make-instance 'dictionary))))
+        (note "Will dump dictionary with ~:_~:D entr~:@P"
+              (entry-count dictionary))
+        dictionary))))
 
 (defparameter *english-dictionary* #.(load-english-dictionary))
 

code/package.lisp

@@ -57,6 +57,11 @@
    #:person
    #:refnumber)
 
+  ;; Dictionary protocol
+  (:export
+   #:entry-count
+   #:load-dictionary)
+
   (:export
    #:english-lookup
    #:english-check-paragraph))

code/protocol.lisp

@@ -2,10 +2,14 @@
 
 ;;; Dictionary protocol
 
+(defgeneric entry-count (dictionary))
+
 (defgeneric lookup (string dictionary))
 
 (defgeneric insert (object string dictionary))
 
+(defgeneric load-dictionary (source &key into))
+
 ;;; Trie node protocol
 
 (defgeneric entries (node))

code/spell.lisp

@@ -91,7 +91,10 @@
 ;;; Dictionary
 
 (defclass dictionary ()
-  ((%contents :initform (make-instance 'node) :accessor contents)))
+  ((%contents    :accessor contents
+                 :initform (make-instance 'node))
+   (%entry-count :accessor entry-count
+                 :initform 0)))
 
 (defmethod make-load-form ((object dictionary) &optional environment)
   (make-load-form-saving-slots object :environment environment))
@@ -103,22 +106,36 @@
 (defmethod insert ((object t) (string string) (dictionary dictionary))
   (%insert object string (length string) (contents dictionary)))
 
-(defvar *dictionary*)
-
-(defun load-dictionary (filename)
-  (with-open-file (stream filename)
-    (let* ((counter 0)
-           (*dictionary* (make-instance 'dictionary)))
-      (do ((line (read-line stream nil stream)
-                 (read-line stream nil stream)))
-          ((eq stream line))
-        (unless (eq #\; (aref line 0))
-          (let ((string (concatenate 'string "(" line ")")))
-            (destructuring-bind
-                (spelling &rest args &key type &allow-other-keys)
-                (read-from-string string)
-              (remf args :type)
-              (let ((word (apply #'word spelling type args)))
-                (insert word spelling *dictionary*)))
-            (incf counter))))
-      (values *dictionary* counter))))
+(defmethod load-dictionary ((source stream)
+                            &key (into (make-instance 'dictionary)))
+  (let ((count 0))
+    (do ((line (read-line source nil source)
+               (read-line source nil source)))
+        ((eq source line))
+      (unless (eq #\; (aref line 0))
+        (let ((string (concatenate 'string "(" line ")")))
+          (destructuring-bind
+              (spelling &rest args &key type &allow-other-keys)
+              (read-from-string string)
+            (remf args :type)
+            (let ((word (apply #'word spelling type args)))
+              (insert word spelling into)))
+          (incf count))))
+    (incf (entry-count into) count)
+    into))
+
+(defmethod load-dictionary ((source pathname) &rest args &key into)
+  (declare (ignore into))
+  (with-open-file (stream source)
+    (apply #'load-dictionary stream args)))
+
+(defmethod load-dictionary ((source string) &rest args &key into)
+  (declare (ignore into))
+  (apply #'load-dictionary (pathname source) args))
+
+(defmethod load-dictionary ((source sequence)
+                            &key (into (make-instance 'dictionary)))
+  (mapc (lambda (source)
+          (with-simple-restart (skip "Skip source ~A" source)
+            (apply #'load-dictionary source :into into)))
+        source))

data/english-additions.txt

@@ -0,0 +1,3 @@
+"constant" :base "constant" :type :noun :number :singular
+"constants" :base "constant" :type :noun :number :plural
+"utilities" :base "utility" :type :noun :number :plural