ide/emacs/esml-gen.el

   1 ;; Copyright (C) 2005 Vesa Karvonen
   2 ;;
   3 ;; MLton is released under a BSD-style license.
   4 ;; See the file MLton-LICENSE for details.
   5
   6 (require 'esml-util)
   7
   8 ;; Installation
   9 ;; ============
  10 ;;
  11 ;; Push the path to this file (and `esml-util.el') to `load-path' and use
  12 ;; (require 'esml-gen).
  13 ;;
  14 ;; Ideas for future development
  15 ;; ============================
  16 ;;
  17 ;; - ?
  18
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20
  21 (defgroup esml-gen nil
  22   "Code generation functions for Standard ML."
  23   :group 'sml)
  24
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;; Prelude
  27
  28 ;; TBD: Consider moving these to another place if/when it makes sense.
  29
  30 (defun esml-extract-field-names (pattern-or-type)
  31   (let ((fields nil))
  32     (with-temp-buffer
  33       (insert pattern-or-type)
  34       (goto-char 0)
  35       (skip-chars-forward " \t\n{},")
  36       (while (not (eobp))
  37         (let ((start (point)))
  38           (if (find (char-after) esml-sml-symbolic-chars)
  39               (skip-chars-forward esml-sml-symbolic-chars)
  40             (skip-chars-forward esml-sml-alphanumeric-chars))
  41           (push (buffer-substring start (point)) fields))
  42         (skip-chars-forward " \t\n")
  43         (when (and (not (eobp))
  44                    (= ?\: (char-after)))
  45           (let ((open-parens 0))
  46             (while (not (or (eobp)
  47                             (and (zerop open-parens)
  48                                  (= ?\, (char-after)))))
  49               (cond ((or (= ?\( (char-after))
  50                          (= ?\{ (char-after)))
  51                      (setq open-parens (1+ open-parens)))
  52                     ((or (= ?\) (char-after))
  53                          (= ?\} (char-after)))
  54                      (setq open-parens (1- open-parens))))
  55               (forward-char 1)
  56               (skip-chars-forward "^,(){}"))))
  57         (skip-chars-forward " \t\n{},")))
  58     fields))
  59
  60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61 ;; Functional Record Update (see http://mlton.org/FunctionalRecordUpdate)
  62
  63 (defcustom esml-gen-fru-setter-template
  64   '("fun set f =\nlet\nfun t2r (%1) = {%2}\nfun r2t {%3} = (%4)
  65 in\nRecords.wrapSet (Tuples.set%n, t2r, t2r, r2t) f\nend\n"
  66     "v%i, "
  67     "%f = v%i, "
  68     "%f = v%i, "
  69     "v%i, ")
  70   "Template for `esml-gen-fru-setter'. Indentation is automatic. The last
  71 two characters of a pattern are deleted at the end."
  72   :type '(list :tag "Template"
  73                (string :tag "Code (`%1' = 1., `%2' = 2., ..., `%n' = n)")
  74                (string :tag "1. pattern (`%i' = index, `%f' = field)")
  75                (string :tag "2. pattern (`%i' = index, `%f' = field)")
  76                (string :tag "3. pattern (`%i' = index, `%f' = field)")
  77                (string :tag "4. pattern (`%i' = index, `%f' = field)"))
  78   :group 'esml-gen)
  79
  80 (defun esml-gen-fru-setter (pattern-or-type)
  81   "Generates a functional record update function. The parameter must be in
  82 the format `[{]id[: ty][,] ...[,] id[}]' where `[]' marks optional parts."
  83   (interactive "sSimple record pattern or type: ")
  84   (let* ((fields (esml-extract-field-names pattern-or-type))
  85          (n (length fields)))
  86     (if (< n 2)
  87         (compat-error "%s" "Record must have at least two fields")
  88       (let ((fields (sort fields 'string-lessp))
  89             (start (point)))
  90         (labels ((format-fields
  91                   (fmt)
  92                   (with-temp-buffer
  93                     (loop
  94                       for f in fields
  95                       for i from 1 to n
  96                       do (insert
  97                           (let* ((result fmt)
  98                                  (result (compat-replace-regexp-in-string
  99                                           result "\\%f" f))
 100                                  (result (compat-replace-regexp-in-string
 101                                           result "\\%i" (int-to-string i))))
 102                             result)))
 103                     (delete-char -2) ;; TBD
 104                     (buffer-string))))
 105           (insert
 106            (let* ((result (nth 0 esml-gen-fru-setter-template))
 107                   (result (compat-replace-regexp-in-string
 108                            result "%1" (format-fields (nth 1 esml-gen-fru-setter-template))))
 109                   (result (compat-replace-regexp-in-string
 110                            result "%2" (format-fields (nth 2 esml-gen-fru-setter-template))))
 111                   (result (compat-replace-regexp-in-string
 112                            result "%3" (format-fields (nth 3 esml-gen-fru-setter-template))))
 113                   (result (compat-replace-regexp-in-string
 114                            result "%4" (format-fields (nth 4 esml-gen-fru-setter-template))))
 115                   (result (compat-replace-regexp-in-string
 116                            result "%n" (int-to-string n))))
 117              result))
 118           (indent-region start (point) nil))))))
 119
 120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 121 ;; Functional Tuple Update (see http://mlton.org/FunctionalRecordUpdate)
 122
 123 (defcustom esml-gen-ftu-setters-template
 124   '("fun set%n f v (%1) =\nlet\ndatatype (%2) t =\n%3
 125 fun g h v =\n(%4)\nin\nf (%5) v\nend\n"
 126     "v%i, "
 127     "'v%i, "
 128     " V%i of 'v%i |"
 129     "case h v of V%i v%i => v%i | _ => v%i,\n"
 130     "g V%i, ")
 131   "Template for `esml-gen-ftu-setters'. Indentation is automatic. The last
 132 two characters of a pattern are deleted at the end."
 133   :type '(list :tag "Format"
 134                (string :tag "Code (`%1' = 1., `%2' = 2., ..., `%n' = n)")
 135                (string :tag "1. pattern (`%i' = index)")
 136                (string :tag "2. pattern (`%i' = index)")
 137                (string :tag "3. pattern (`%i' = index)")
 138                (string :tag "4. pattern (`%i' = index)")
 139                (string :tag "5. pattern (`%i' = index)"))
 140   :group 'esml-gen)
 141
 142 (defun esml-gen-ftu-setters (n)
 143   "Generates functional tuple update, or `set<N>', functions."
 144   (interactive "nMaximum number of fields [2-100]: ")
 145   (if (not (and (<= 2 n)
 146                 (<= n 100)))
 147       (compat-error "%s" "Number of fields must be between 2 and 100")
 148     (labels ((format-fields
 149               (fmt n)
 150               (with-temp-buffer
 151                 (loop for i from 1 to n
 152                   do (insert
 153                       (let* ((result fmt)
 154                              (result (compat-replace-regexp-in-string
 155                                       result "%i" (int-to-string i))))
 156                         result)))
 157                 (delete-char -2) ;; TBD
 158                 (buffer-string))))
 159       (let ((start (point)))
 160         (loop for i from 2 to n do
 161           (unless (= i 2)
 162             (insert "\n"))
 163           (insert
 164            (let* ((result (nth 0 esml-gen-ftu-setters-template))
 165                   (result (compat-replace-regexp-in-string
 166                            result "%1" (format-fields (nth 1 esml-gen-ftu-setters-template) i)))
 167                   (result (compat-replace-regexp-in-string
 168                            result "%2" (format-fields (nth 2 esml-gen-ftu-setters-template) i)))
 169                   (result (compat-replace-regexp-in-string
 170                            result "%3" (format-fields (nth 3 esml-gen-ftu-setters-template) i)))
 171                   (result (compat-replace-regexp-in-string
 172                            result "%4" (format-fields (nth 4 esml-gen-ftu-setters-template) i)))
 173                   (result (compat-replace-regexp-in-string
 174                            result "%5" (format-fields (nth 5 esml-gen-ftu-setters-template) i)))
 175                   (result (compat-replace-regexp-in-string
 176                            result "%n" (int-to-string i))))
 177              result)))
 178         (indent-region start (point) nil)))))
 179
 180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 181
 182 (provide 'esml-gen)