load multiple modules at ones.

elisp/ghc-comp.el

@@ -50,15 +50,12 @@
   (let* ((syms '(ghc-module-names
 		ghc-language-extensions
 		ghc-keyword-Prelude))
-	 (vals (ghc-read-lisp-list
+	 (vals (ghc-boot (length syms))))
-		(lambda () (call-process ghc-module-command nil t nil "-l" "boot"))
-		(length syms))))
     (ghc-set syms vals))
   (ghc-add ghc-module-names "qualified")
   (ghc-add ghc-module-names "hiding")
   (ghc-add ghc-language-extensions "LANGUAGE")
-  (setq ghc-loaded-module '("Prelude"))
+  (ghc-merge-keywords '("Prelude"))
-  (ghc-merge-keywords)
   (run-with-idle-timer ghc-idle-timer-interval 'repeat 'ghc-idle-timer))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -66,15 +63,26 @@
 ;;; Executing command
 ;;;
 
-(defun ghc-load-keyword (&rest args)
+(defun ghc-boot (n)
   (if (not (ghc-which ghc-module-command))
       (message "%s not found" ghc-module-command)
-    (ghc-read-lisp
+    (ghc-read-lisp-list
      (lambda ()
-       (let ((msg (mapconcat 'identity (cons ghc-module-command args) " ")))
+       (message "Initializing...")
-	 (message "Executing \"%s\"..." msg)
+       (call-process ghc-module-command nil t nil "-l" "boot")
-	 (apply 'call-process ghc-module-command nil t nil (cons "-l" args))
+       (message "Initializing...done"))
-	 (message "Executing \"%s\"...done" msg))))))
+     n)))
+
+(defun ghc-load-modules (mods)
+  (if (not (ghc-which ghc-module-command))
+      (message "%s not found" ghc-module-command)
+    (ghc-read-lisp-list
+     (lambda ()
+       (message "Loading names...")
+       (apply 'call-process ghc-module-command nil t nil
+	      (cons "-l" (cons "browse" mods)))
+       (message "Loading names...done"))
+     (length mods))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -172,59 +180,73 @@
 ;;; Loading keywords
 ;;;
 
-(add-hook 'find-file-hook 'ghc-load-module-buffer)
+(add-hook 'find-file-hook 'ghc-import-module)
 
-(defun ghc-load-module-buffer ()
+(defun ghc-import-module ()
   (interactive)
   (when (eq major-mode 'haskell-mode)
-    (ghc-load-module-this-buffer)))
+    (ghc-load-module-buffer)))
 
-(defun ghc-load-module-this-buffer ()
+(defun ghc-unloaded-modules (mods)
-  (dolist (mod (ghc-gather-import-modules))
+  (ghc-filter (lambda (mod)
-    (ghc-load-module mod))
+		(and (member mod ghc-module-names)
-  (ghc-merge-keywords))
+		     (not (member mod ghc-loaded-module))))
+	      mods))
 
-(defun ghc-load-module (mod)
+(defun ghc-load-module-all-buffers ()
-  (when (and (member mod ghc-module-names)
+  (ghc-load-merge-modules (ghc-gather-import-modules-all-buffers)))
-	     (not (member mod ghc-loaded-module)))
-    (let ((keywords (ghc-load-keyword "browse" mod)))
-      (when (or (consp keywords) (null keywords))
-	(set (intern (concat ghc-keyword-prefix mod)) keywords)
-	(ghc-add ghc-loaded-module mod)))))
 
-(defun ghc-merge-keywords ()
+(defun ghc-load-module-buffer ()
+  (ghc-load-merge-modules (ghc-gather-import-modules-buffer)))
+
+(defun ghc-load-merge-modules (mods)
+  (let* ((umods (ghc-unloaded-modules mods))
+	 (syms (mapcar 'ghc-module-symbol umods))
+	 (names (ghc-load-modules umods)))
+    (ghc-set syms names)
+    (ghc-merge-keywords umods)))
+
+(defun ghc-merge-keywords (mods)
+  (setq ghc-loaded-module (append mods ghc-loaded-module))
   (let* ((modkeys (mapcar 'ghc-module-keyword ghc-loaded-module))
 	 (keywords (cons ghc-reserved-keyword modkeys))
 	 (uniq-sorted (sort (ghc-uniq-lol keywords) 'string<)))
     (setq ghc-merged-keyword uniq-sorted)))
 
+(defun ghc-module-symbol (mod)
+  (intern (concat ghc-keyword-prefix mod)))
+
+(defun ghc-module-keyword (mod)
+  (symbol-value (ghc-module-symbol mod)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun ghc-gather-import-modules-all-buffers ()
+  (let ((bufs (mapcar 'buffer-name (buffer-list)))
+	ret)
+    (save-excursion
+      (dolist (buf bufs (ghc-uniq-lol ret))
+	(when (string-match "\\.hs$" buf)
+	  (set-buffer buf)
+	  (ghc-add ret (ghc-gather-import-modules-buffer)))))))
+
+(defun ghc-gather-import-modules-buffer ()
+  (let (ret)
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward "^import\\( *qualified\\)? +\\([^\n ]+\\)" nil t)
+	(ghc-add ret (match-string-no-properties 2))
+	(forward-line)))
+    ret))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Background Idle Timer
 ;;;
 
-(defalias 'ghc-idle-timer 'ghc-load-module-this-buffer)
+(defalias 'ghc-idle-timer 'ghc-load-module-all-buffer)
 
-(defun ghc-gather-import-modules ()
+(defun ghc-load-module-all-buffer () nil)
-  (let ((bufs (mapcar 'buffer-name (buffer-list)))
-	ret)
-    (save-excursion
-      (dolist (buf bufs)
-	(when (string-match "\\.hs$" buf)
-	  (set-buffer buf)
-	  (ghc-add ret (ghc-gather-import-modules-buffer)))))
-    (ghc-uniq-lol ret)))
-
-(defun ghc-gather-import-modules-buffer ()
-  (let (ret)
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward "^import *\\([^\n ]+\\)" nil t)
-	(ghc-add ret (match-string-no-properties 1))
-	(forward-line)))
-    ret))
-
-(defun ghc-module-keyword (mod)
-  (symbol-value (intern (concat ghc-keyword-prefix mod))))
 
 (provide 'ghc-comp)

elisp/ghc-func.el

@@ -31,6 +31,13 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defun ghc-filter (pred lst)
+  (let (ret)
+    (dolist (x lst (reverse ret))
+      (if (funcall pred x) (ghc-add ret x)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defun ghc-which (cmd)
   (catch 'loop
     (dolist (suffix '("" ".exe"))
@@ -68,9 +75,8 @@
     (condition-case nil
 	(let ((m (set-marker (make-marker) 1 (current-buffer)))
 	      ret)
-	  (dotimes (i n)
+	  (dotimes (i n (nreverse ret))
-	    (ghc-add ret (read m)))
+	    (ghc-add ret (read m))))
-	  (nreverse ret))
       (error ()))))
 
 (provide 'ghc-func)

elisp/ghc.el

@@ -54,7 +54,7 @@
   (unless ghc-initialized
     (define-key haskell-mode-map ghc-completion-key  'ghc-complete)
     (define-key haskell-mode-map ghc-document-key    'ghc-browse-document)
-    (define-key haskell-mode-map ghc-import-key      'ghc-load-module-buffer)
+    (define-key haskell-mode-map ghc-import-key      'ghc-import-module)
     (define-key haskell-mode-map ghc-previous-key    'flymake-goto-prev-error)
     (define-key haskell-mode-map ghc-next-key        'flymake-goto-next-error)
     (define-key haskell-mode-map ghc-help-key        'ghc-flymake-display-errors)