mudsync/mudsync/parser.scm

;;; Mudsync --- Live hackable MUD
;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of Mudsync.
;;;
;;; Mudsync is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Mudsync is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mudsync.  If not, see <http://www.gnu.org/licenses/>.

(define-module (mudsync parser)
  #:use-module (rx irregex)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)

  #:export (match-to-kwargs
            split-verb-and-rest
            article preposition

            cmatch-indir-obj
            cmatch-direct-obj
            cmatch-direct-obj-greedy
            cmatch-empty
            cmatch-greedy))

(define (match-to-kwargs irx string)
  (let ((rx-match (irregex-match irx string)))
    (if rx-match
        (fold
         (match-lambda*
           (((match-part . idx) prev)
            (cons (symbol->keyword match-part)
                  (cons (irregex-match-substring
                         rx-match idx)
                        prev))))
         '()
         (irregex-match-names rx-match))
        #f)))

(define (split-verb-and-rest string)
  (let* ((trimmed (string-trim-both string))
         (first-space (string-index trimmed #\space)))
    (if first-space
        (cons (substring trimmed 0 first-space)
              (substring trimmed (+ 1 first-space)))
        (cons trimmed ""))))

;; @@: Not currently used
;; Borrowed from irregex.scm
(define match-string
  '(seq #\" (* (or (~ #\\ #\") (seq #\\ any))) #\"))

;; definite and indefinite, but not partitive articles
(define article '(or "the" "a" "an"))
(define preposition '(or "with" "in" "inside" "into" "on" "out" "out of"
                         "at" "as" "to" "about" "from"))

(define indirect-irx
  (sre->irregex
   `(: (? (: ,preposition (+ space)))  ; possibly a preposition
       (? (: ,article (+ space)))      ; possibly an article (ignored)
       (=> direct-obj (* any))      ; direct object (kept)
       (+ space)
       (=> preposition ,preposition)   ; main preposition (kept)
       (+ space)
       (? (: ,article (+ space)))      ; possibly an article (ignored)
       (=> indir-obj (+ any))))) ; indirect object (kept)

(define (cmatch-indir-obj phrase)
  (match-to-kwargs indirect-irx phrase))

(define direct-irx
  (sre->irregex
   `(: (? (: ,preposition (+ space)))  ; possibly a preposition (ignored)
       (? (: ,article (+ space)))     ; possibly an article (ignored)
       (=> direct-obj (+ any)))))  ; direct object (kept)

(define (cmatch-direct-obj phrase)
  (match-to-kwargs direct-irx phrase))

(define (cmatch-empty phrase)
  (if (equal? (string-trim phrase) "")
      '()
      #f))

(define (cmatch-direct-obj-greedy phrase)
  ;; Turns out this uses the same semantics as splitting verb/rest
  (match (split-verb-and-rest phrase)
    ((direct-obj . rest)
     (list #:direct-obj direct-obj
           #:rest rest))
    (#f #f)))

(define (cmatch-greedy phrase)
  `(#:phrase ,phrase))

;; (define say-example "say I really need to get going.")
;; (define attack-sword-example "hit goblin with sword")
;; (define attack-simple-example "hit goblin")
;; (define put-book-on-desk "put the book on the desk")