rpl-tools/rpl-edb.el

;;; rpl-edb.el -- utilities to parse the entries database

;; Copyright (C) 2014 Paul Onions

;; Author: Paul Onions <paul.onions@acm.org>
;; Keywords: RPL, UserRPL, SysRPL, HP48, HP49, HP50

;; This file is free software, see the LICENCE file in this directory
;; for copying terms.

;;; Commentary:

;; Functions to parse the entries.db file.

;;; Code:
(require 'cl-lib)

(defun rpl-edb-get-line ()
  "Get line that point is on from the current buffer.
Return a string containing the line, or nil if at end of buffer.
As a side-effect set point to the start of the next line."
  (cond ((eobp)
         nil)
        (t
         (beginning-of-line)
         (let ((start (point)))
           (end-of-line)
           (let ((line (buffer-substring-no-properties start (point))))
             (forward-char)
             line)))))

;;; Parsing identifier lines
;;;
(defun rpl-edb-consume-ident-line ()
  "Consume an EDB identifier line.
Return a list of two strings: the identifier and its stack effect
description.  Move point to the start of the next line."
  (let ((line (rpl-edb-get-line)))
    (cond ((string-match "^[[:graph:]]+" line)
           (let* ((name (match-string 0 line))
                  (desc (substring line (match-end 0))))
             ;; Automatically consume continuation lines
             ;; (after line ends with a backslash)
             (while (and (> (length desc) 0)
                         (string-match ".*\\\\[[:blank:]]*$" desc))
               (setq desc (concat (substring desc 0 (1- (length desc)))
                                  "\n"
                                  (rpl-edb-get-line))))
             (list name desc)))
          (t
           (list "" "")))))

;;; Parsing keyword lines
;;;
(defun rpl-edb-parse-keyword-line (line)
  "Parse the given EDB keyword line.
Return a list consisting of the EDB keyword as a keyword symbol
and a parameter string (to be further parsed later)."
  (cond ((string-match "\\.[[:blank:]]+\\([[:alnum:]]+\\):" line)
         (let ((keyword (intern (concat ":" (match-string 1 line))))
               (param-str (substring line (match-end 0))))
           (list keyword param-str)))
        (t
         (list nil ""))))

(defun rpl-edb-parse-calc-param-str (str)
  (cond ((string-match "[[:blank:]]*\\([[:alnum:]]+\\)[[:blank:]]*\\(\\\\\\([[:graph:]]+?\\)\\\\\\)?" str)
         (let ((addr  (match-string 1 str))
               (fmt   (match-string 3 str))
               (flags nil))
           (setq str (substring str (match-end 0)))
           (while (string-match "[[:blank:]]*\\[\\([[:graph:]]+\\)\\]" str)
             (setq flags (cons (intern (concat ":" (match-string 1 str))) flags))
             (setq str (substring str (match-end 1))))
           (list addr fmt (reverse flags))))
        (t
         (list "" "" nil))))

(defun rpl-edb-parse-aka-param-str (str)
  (let ((names nil))
    (while (string-match "[[:blank:]]*\\([[:graph:]]+\\)" str)
      (setq names (cons (match-string 1 str) names))
      (setq str (substring str (match-end 1))))
    (reverse names)))

(defun rpl-edb-consume-keyword-line ()
  (let ((line (rpl-edb-get-line)))
    (cl-destructuring-bind (keyword param-str)
        (rpl-edb-parse-keyword-line line)
      (cond ((member keyword '(:38G :39G :48G :49G))
             (cl-destructuring-bind (addr fmt flags)
                 (rpl-edb-parse-calc-param-str param-str)
               (append (list keyword addr fmt) flags)))
            ((eql keyword :AKA)
             (let ((names (rpl-edb-parse-aka-param-str param-str)))
               (cons keyword names)))
            (t
             (error "Illegal EDB keyword, %s" keyword))))))

;;; Parsing extended description lines
;;;
(defun rpl-edb-consume-description-line ()
  "Consume an EDB extended description line.
Return a string.  Move point to the start of the next line."
  (let ((line (rpl-edb-get-line)))
    (substring line 80)))

;;; Parsing the entries.db buffer
;;;
(defun rpl-edb-parse-buffer ()
  "Parse the current buffer, assumed to be the entries.db file.
Return a list of EDB entries of the format:
???
"
  (interactive)
  (let ((entry-names nil)
        (entry-stack-effect nil)
        (entry-calc-infos nil)
        (entry-description "")
        (entries nil))
    (beginning-of-buffer)
    (while (not (eobp))
      (cond ((eql (char-after) ?*)
             ;; A comment line -- ignore it
             (forward-line))
            ((eql (char-after) ?@)
             ;; A directive -- ignore it
             (forward-line))
            ((eql (char-after) ?\;)
             ;; An extended description line
             (setq entry-description (concat entry-description " "
                                             (rpl-edb-consume-description-line))))
            ((eql (char-after) ?.)
             ;; A keyword line
             (cl-destructuring-bind (keyword &rest params)
                 (rpl-edb-consume-keyword-line)
               (cond ((eql keyword :AKA)
                      (dolist (name params)
                        (push name entry-names)))
                     (t
                      (push (cons keyword params) entry-calc-infos)))))
            (t
             ;; An identifier/stack-effect line
             (when entry-names
               (push (list entry-names entry-stack-effect entry-calc-infos entry-description) entries))
             (cl-destructuring-bind (name stack-effect)
                 (rpl-edb-consume-ident-line)
               (setq entry-names (list name))
               (setq entry-stack-effect stack-effect)
               (setq entry-calc-infos nil)
               (setq entry-description "")))))
    (when entry-names
      (push (list entry-names entry-stack-effect entry-calc-infos entry-description) entries))
    (reverse entries)))

(defvar rpl-edb-entries nil
  "A place on which to push the parsed entries.")