home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / db-convert.el < prev    next >
Encoding:
Text File  |  1993-06-13  |  9.7 KB  |  249 lines
  1. ;;; db-convert.el --- part of EDB, the Emacs database
  2.  
  3. ;; See database.el for copyright notice, distribution conditions, etc.
  4.  
  5. ;; Author: Michael Ernst <mernst@theory.lcs.mit.edu>
  6. ;; Keywords: EDB
  7.  
  8. ;;; Commentary:
  9.  
  10. ;; Functions for changing the field structure of a database.
  11.  
  12. ;; This takes a database and rearranges the field order, converts fields
  13. ;; from one type to another, adds or removes fields, etc.  There are two
  14. ;; parts to the following code:  the user interface and the actual
  15. ;; conversion.
  16.  
  17. ;;; Code:
  18.  
  19.  
  20. ;;; Variables used dynamically; avoid compiler messages about free variables.
  21. ;; Should this be?  Perhaps get rid of it.
  22. (defvar computed-functions)
  23.  
  24.  
  25. (provide 'db-convert)
  26.  
  27.  
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. ;;; Creation methods
  30. ;;;
  31.  
  32. ;; To create a new database from an existing one, the user must specify a
  33. ;; creation method for each field of the new database.  This can be done
  34. ;; from a program by supplying a fieldnames-creation list, which is a list
  35. ;; of two-element lists of (fieldname creation-method).  It can also be
  36. ;; done interactively.
  37.  
  38. ;; A creation method (for field F, say) is one of the following:
  39. ;; * A field reference.  Field F is set to the value of the specified field
  40. ;;   in the corresponding old record.
  41. ;; * A literal value.  Field F of every record is set to that value.
  42. ;; * Result of a function call.  The user must specify the function, what
  43. ;;   arguments should be passed to it, and which of the results is desired.
  44. ;;   Each argument specifier (one for each argument accepted by the
  45. ;;   function) specifies a field of the old record, the entire old record,
  46. ;;   or a literal.  The result specifier indicates that the function's
  47. ;;   result should be used as is or that the function returns a list, one
  48. ;;   element of which should be used as the value for field F.  This
  49. ;;   permits one function to do the computation for several fields in the
  50. ;;   new record; since the results are memoized, the function need only be
  51. ;;   called once per record.  For instance, suppose the original database
  52. ;;   stored addresses as a single field, but the new one stored street,
  53. ;;   city, state, and ZIP code separately.  The parsing of the address
  54. ;;   would only have to be done once.
  55.  
  56. ;;; Represenation:
  57. ;; * Field reference:  a number (the field number in the old record) or a
  58. ;;   symbol (the field name in the old database).
  59. ;; * Literal value:  list of the symbol 'literal and the value; for
  60. ;;   strings, just the string itself.  Nil means the empty string.
  61. ;; * Function call:  The function is a symbol whose function cell should be
  62. ;;   bound.  Each argument specifier is a fieldnumber (or -1, for the
  63. ;;   entire record) or fieldname (or 'original-record, for the entire
  64. ;;   record), or a literal as above.  The result specifier is nil (for the
  65. ;;   entire result) or an integer (in which case the value of interest is
  66. ;;   obtained via (nth result-number result).)  (Should this be displayed
  67. ;;   in base 1 for the naive user's benefit?  No, because the naive user
  68. ;;   will be told by the function writer exactly which argument to
  69. ;;   specify.)  The full specification is a list of two elements, the first
  70. ;;   of which is a list of the function and the argument specifiers and the
  71. ;;   second of which is the result number.  Just the first element -- the
  72. ;;   list of the function and argument specifiers -- may be used if the
  73. ;;   result number is nil.
  74.  
  75. ;;; Canonical representation:
  76. ;; The user is encouraged to use the fieldname representations, because
  77. ;; they are easier to read and write, but internally those are all
  78. ;; converted to the canonical representation, which is always the first one
  79. ;; listed in the descriptions above.  Thus, each creation method is a
  80. ;; number, a list whose car is 'literal, or a function specification.  This
  81. ;; permits the code which manipulates creation methods internally to be
  82. ;; more efficient.
  83.  
  84.  
  85. (defun creation-method-literal-p (creation-method)
  86.   (and (consp creation-method)
  87.        (eq (car creation-method) 'literal)))
  88. (proclaim-inline creation-method-literal-p)
  89.  
  90.  
  91. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92. ;;; User interface
  93. ;;;
  94.  
  95. ;; The screen is split into two columns (not necessarily two windows), with
  96. ;; the old database structure on the left and the new database structure on
  97. ;; the right.  From each record in the original database, one record is
  98. ;; created in the new database; by default, the new record is identical to
  99. ;; the old.
  100.  
  101. ;; The user interface will be most useful for small changes, like adding a
  102. ;; single field; for major changes, I suspect that users will construct
  103. ;; fieldname-creation lists by hand.
  104.  
  105.  
  106. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107. ;;; Conversion
  108. ;;;
  109.  
  110. ;; Currently this doesn't create a new database; it destructively changes
  111. ;; the format of the old one.  I suspect this is the desired behavior.
  112.  
  113. ;;;###autoload
  114. (defun db-convert (database fieldnames-creation)
  115.   "Convert DATABASE's field structure according to FIELDNAMES-CREATION.
  116. This function rearranges the field order, converts fields from one type to
  117. another, adds or removes fields, and so forth.
  118.  
  119. FIELDNAMES-CREATION is a list of two-element lists of \(fieldnames
  120. creation-method\); if creation-method would be nil, then fieldname alone
  121. may be used in place of the two-element list."
  122.   (let ((cmethods (db-canonicalize-creation-methods
  123.            (mapcar (function (lambda (fieldname-creation)
  124.                        (if (symbolp fieldname-creation)
  125.                        ""
  126.                      (car (cdr fieldname-creation)))))
  127.                fieldnames-creation)
  128.            database))
  129.     (no-of-new-fields (length fieldnames-creation)))
  130.     (maplinks-macro
  131.      (link-set-record maplinks-link
  132.               (db-convert-record (link-record maplinks-link)
  133.                      cmethods no-of-new-fields))
  134.      database)
  135.  
  136.     ;; Change like fieldlist, accessor functions, etc.
  137.  
  138.     ;; changed from database-set-fieldnames per Henry Thompson
  139.     (db-set-fieldname-vars database
  140.                (mapcar (function car) fieldnames-creation))))
  141.  
  142. ;; Create and return a new record from RECORD using CREATION-METHODS, a list
  143. ;; of canonical creation methods.  Optional argument NO-OF-FIELDS gives the
  144. ;; length of CREATION-METHODS and the number of fields in the result record.
  145. ;; Dynamically binds computed-functions.
  146. (defun db-convert-record (record creation-methods &optional no-of-fields)
  147.   (let ((new-record (make-vector (or no-of-fields
  148.                      (length creation-methods))
  149.                  nil))
  150.     (this-field-no 0)
  151.     computed-functions)
  152.     (while creation-methods
  153.       (aset new-record this-field-no
  154.         (db-convert-compute-field-value (car creation-methods) record))
  155.  
  156.       ;; ...
  157.  
  158.       (setq creation-methods (cdr creation-methods)
  159.         this-field-no (1+ this-field-no)))
  160.     new-record
  161.     ))
  162.  
  163. ;; Uses and sets the "computed-functions" dynamic variable.
  164. ;; Perhaps get rid of the "result" variable.
  165. (defun db-convert-compute-field-value (creation-method old-record)
  166.   (cond ((numberp creation-method)
  167.      (aref old-record creation-method))
  168.     ((creation-method-literal-p creation-method)
  169.      (car (cdr creation-method)))
  170.     ((consp creation-method)
  171.      (let* ((function-spec (car creation-method))
  172.         (result-no (car (cdr creation-method)))
  173.         (result-found (if result-no
  174.                   (assoc function-spec computed-functions))))
  175.        (if result-found
  176.            (nth result-no (cdr result-found))
  177.          (let* ((args (mapcar (function
  178.                    (lambda (arg-spec)
  179.                      (cond ((numberp arg-spec)
  180.                         (aref old-record arg-spec))
  181.                        ((creation-method-literal-p arg-spec)
  182.                         (car (cdr arg-spec)))
  183.                        (t (error "Bad argument specification %s." arg-spec)))))
  184.                   (cdr function-spec)))
  185.             (result (apply (car function-spec) args)))
  186.            (if result-no
  187.            (progn
  188.              (setq computed-functions
  189.                (cons (cons function-spec result) computed-functions))
  190.              (nth result-no result))
  191.          result)))))
  192.     (t (error "Unknown creation method %s" creation-method))))
  193.  
  194.  
  195. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. ;;; Canonicalizing creation methods
  197. ;;;
  198.  
  199. (defun db-canonicalize-creation-methods (creation-methods database)
  200.   (mapcar (function (lambda (creation-method)
  201.          (db-canonicalize-creation-method creation-method database)))
  202.       creation-methods))
  203.  
  204. (defun db-canonicalize-creation-method (creation-method database)
  205.   (cond
  206.    ;; Literals
  207.    ((null creation-method)
  208.     ;; I don't think this clause is ever entered, but just in case...
  209.     ;; The null test must precede the symbolp test, below.
  210.     '(literal ""))
  211.    ((stringp creation-method)
  212.     (list 'literal creation-method))
  213.    ((creation-method-literal-p creation-method)
  214.     creation-method)
  215.    ;; Field references
  216.    ((symbolp creation-method)
  217.     (or (fieldname->fieldnumber creation-method database)
  218.     (error "%s isn't a fieldname in database %s."
  219.            creation-method (database-print-name database))))
  220.    ((numberp creation-method)
  221.     (if (and (> creation-method 0)
  222.          (< creation-method (database-no-of-fields database)))
  223.     creation-method
  224.       (error "%d isn't a valid field number in database %s."
  225.          creation-method (database-print-name database))))
  226.    ;; Functions
  227.    ((not (consp creation-method))
  228.     (error "Ill-formed creation method %s." creation-method))
  229.    (t
  230.     (let ((function-spec (car creation-method))
  231.       function args result-no)
  232.       (if (consp function-spec)
  233.       (setq function (car function-spec)
  234.         args (cdr function-spec)
  235.         result-no (car (cdr creation-method)))
  236.     (setq function function-spec
  237.           args (cdr creation-method)
  238.           result-no nil))
  239.       (if (not (fboundp function))
  240.       (error "%s has no function definition." function))
  241.       (setq args (mapcar (function (lambda (name-or-number)
  242.                      (if (numberp name-or-number)
  243.                      name-or-number
  244.                        fieldname->fieldnumber name-or-number)))
  245.              args))
  246.       (cons (cons function args) result-no)))))
  247.  
  248. ;;; db-convert.el ends here
  249.