mudsync/parser.scm

   1 ;;; Mudsync --- Live hackable MUD
   2 ;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
   3 ;;;
   4 ;;; This file is part of Mudsync.
   5 ;;;
   6 ;;; Mudsync is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or
   9 ;;; (at your option) any later version.
  10 ;;;
  11 ;;; Mudsync is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;; General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with Mudsync.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (mudsync parser)
  20   #:use-module (rx irregex)
  21   #:use-module (ice-9 match)
  22   #:use-module (srfi srfi-1)
  23   #:use-module (srfi srfi-9)
  24
  25   #:export (match-to-kwargs
  26             split-verb-and-rest
  27             article preposition
  28
  29             cmatch-indir-obj
  30             cmatch-direct-obj
  31             cmatch-direct-obj-greedy
  32             cmatch-empty
  33             cmatch-greedy))
  34
  35 (define (match-to-kwargs irx string)
  36   (let ((rx-match (irregex-match irx string)))
  37     (if rx-match
  38         (fold
  39          (match-lambda*
  40            (((match-part . idx) prev)
  41             (cons (symbol->keyword match-part)
  42                   (cons (irregex-match-substring
  43                          rx-match idx)
  44                         prev))))
  45          '()
  46          (irregex-match-names rx-match))
  47         #f)))
  48
  49 (define (split-verb-and-rest string)
  50   (let* ((trimmed (string-trim-both string))
  51          (first-space (string-index trimmed #\space)))
  52     (if first-space
  53         (cons (substring trimmed 0 first-space)
  54               (substring trimmed (+ 1 first-space)))
  55         (cons trimmed ""))))
  56
  57 ;; @@: Not currently used
  58 ;; Borrowed from irregex.scm
  59 (define match-string
  60   '(seq #\" (* (or (~ #\\ #\") (seq #\\ any))) #\"))
  61
  62 ;; definite and indefinite, but not partitive articles
  63 (define article '(or "the" "a" "an"))
  64 (define preposition '(or "with" "in" "inside" "into" "on" "out" "out of"
  65                          "at" "as" "to" "about" "from"))
  66
  67 (define indirect-irx
  68   (sre->irregex
  69    `(: (? (: ,preposition (+ space)))  ; possibly a preposition
  70        (? (: ,article (+ space)))      ; possibly an article (ignored)
  71        (=> direct-obj (* any))      ; direct object (kept)
  72        (+ space)
  73        (=> preposition ,preposition)   ; main preposition (kept)
  74        (+ space)
  75        (? (: ,article (+ space)))      ; possibly an article (ignored)
  76        (=> indir-obj (+ any))))) ; indirect object (kept)
  77
  78 (define (cmatch-indir-obj phrase)
  79   (match-to-kwargs indirect-irx phrase))
  80
  81 (define direct-irx
  82   (sre->irregex
  83    `(: (? (: ,preposition (+ space)))  ; possibly a preposition (ignored)
  84        (? (: ,article (+ space)))     ; possibly an article (ignored)
  85        (=> direct-obj (+ any)))))  ; direct object (kept)
  86
  87 (define (cmatch-direct-obj phrase)
  88   (match-to-kwargs direct-irx phrase))
  89
  90 (define (cmatch-empty phrase)
  91   (if (equal? (string-trim phrase) "")
  92       '()
  93       #f))
  94
  95 (define (cmatch-direct-obj-greedy phrase)
  96   ;; Turns out this uses the same semantics as splitting verb/rest
  97   (match (split-verb-and-rest phrase)
  98     ((direct-obj . rest)
  99      (list #:direct-obj direct-obj
 100            #:rest rest))
 101     (#f #f)))
 102
 103 (define (cmatch-greedy phrase)
 104   `(#:phrase ,phrase))
 105
 106 ;; (define say-example "say I really need to get going.")
 107 ;; (define attack-sword-example "hit goblin with sword")
 108 ;; (define attack-simple-example "hit goblin")
 109 ;; (define put-book-on-desk "put the book on the desk")