From a5d12ad707c0b132d0ab5fb94e9f0ecffd6f3c57 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 28 Oct 2010 16:24:45 +0900 Subject: [PATCH] adding defstruct. --- elisp/ghc-doc.el | 31 ++++++++++++++++--------------- elisp/ghc-func.el | 45 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+), 15 deletions(-) diff --git a/elisp/ghc-doc.el b/elisp/ghc-doc.el index e0464c3..baaba1e 100644 --- a/elisp/ghc-doc.el +++ b/elisp/ghc-doc.el @@ -23,8 +23,9 @@ (call-process "ghc-pkg" nil t nil "find-module" "--simple-output" mod) (goto-char (point-min)) (when (re-search-forward "\\([^ ]+\\)-\\([0-9]*\\(\\.[0-9]+\\)*\\)$") - (cons (match-string-no-properties 1) - (match-string-no-properties 2))))) + (ghc-make-pkg-ver + :pkg (match-string-no-properties 1) + :ver (match-string-no-properties 2))))) (defun ghc-resolve-document-path (pkg) (with-temp-buffer @@ -39,20 +40,20 @@ (defconst ghc-doc-hackage-format "http://hackage.haskell.org/packages/archive/%s/%s/doc/html/%s.html") -(defun ghc-display-document (pkg mod haskell-org) - (when (and pkg mod) - (let* ((mod- (ghc-replace-character mod ?. ?-)) - (url (if haskell-org - (format ghc-doc-hackage-format (car pkg) (cdr pkg) mod-) - (let* ((pkg-with-ver (format "%s-%s" (car pkg) (cdr pkg))) - (path (ghc-resolve-document-path pkg-with-ver))) - (if (file-exists-p (format "%s/%s.html" path mod-)) - (format ghc-doc-local-format path mod-) - ;; fall back to online version if local file - ;; doesn't exist: - (format ghc-doc-hackage-format (car pkg) (cdr pkg) mod-)))))) - (browse-url url)))) +(ghc-defstruct pkg-ver pkg ver) +(defun ghc-display-document (pkg-ver mod haskell-org) + (when (and pkg-ver mod) + (let* ((mod- (ghc-replace-character mod ?. ?-)) + (pkg (ghc-pkg-ver-get-pkg pkg-ver)) + (ver (ghc-pkg-ver-get-ver pkg-ver)) + (pkg-with-ver (format "%s-%s" pkg ver)) + (path (ghc-resolve-document-path pkg-with-ver)) + (local (format ghc-doc-local-format path mod-)) + (remote (format ghc-doc-hackage-format pkg ver mod-)) + (file (format "%s/%s.html" path mod-)) + (url (if (or haskell-org (not (file-exists-p file))) remote local))) + (browse-url url)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el index 07dd2cb..009b4f2 100644 --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -90,4 +90,49 @@ (defconst ghc-null 0) (defconst ghc-newline 10) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ghc-keyword-number-pair (spec) + (let ((len (length spec)) key ret) + (dotimes (i len (nreverse ret)) + (setq key (intern (concat ":" (symbol-name (car spec))))) + (setq ret (cons (cons key i) ret)) + (setq spec (cdr spec))))) + +(defmacro ghc-defstruct (type &rest spec) + `(progn + (ghc-defstruct-constructor ,type ,@spec) + (ghc-defstruct-s/getter ,type ,@spec))) + +(defmacro ghc-defstruct-constructor (type &rest spec) + `(defun ,(intern (concat "ghc-make-" (symbol-name type))) (&rest args) + (let* ((alist (quote ,(ghc-keyword-number-pair spec))) + (struct (make-list (length alist) nil)) + key val key-num) + (while args ;; cannot use dolist + (setq key (car args)) + (setq args (cdr args)) + (setq val (car args)) + (setq args (cdr args)) + (unless (keywordp key) + (error "'%s' is not a keyword" key)) + (setq key-num (assoc key alist)) + (if key-num + (setcar (nthcdr (cdr key-num) struct) val) + (error "'%s' is unknown" key))) + struct))) + +(defmacro ghc-defstruct-s/getter (type &rest spec) + `(let* ((type-name (symbol-name ',type)) + (keys ',spec) + (len (length keys)) + member-name setter getter) + (dotimes (i len) + (setq member-name (symbol-name (car keys))) + (setq setter (intern (format "ghc-%s-set-%s" type-name member-name))) + (fset setter (list 'lambda '(struct value) (list 'setcar (list 'nthcdr i 'struct) 'value) 'struct)) + (setq getter (intern (format "ghc-%s-get-%s" type-name member-name))) + (fset getter (list 'lambda '(struct) (list 'nth i 'struct))) + (setq keys (cdr keys))))) + (provide 'ghc-func)