;;; rpl-edb.el -- utilities to parse the entries database ;; Copyright (C) 2014 Paul Onions ;; Author: Paul Onions ;; 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 ;; (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 2 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)))