mudsync/parser.scm

   1 ;;; Mudsync --- Live hackable MUD
   2 ;;; Copyright © 2016 Christopher Allan 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" "on" "out of" "at"))
  65
  66 (define indirect-irx
  67   (sre->irregex
  68    `(: (? (: ,preposition (+ space)))  ; possibly a preposition (ignored)
  69        (? (: ,article (+ space)))      ; possibly an article (ignored)
  70        (=> direct-obj (* any))      ; direct object (kept)
  71        (+ space)
  72        (=> preposition ,preposition)   ; main preposition (kept)
  73        (+ space)
  74        (? (: ,article (+ space)))      ; possibly an article (ignored)
  75        (=> indir-obj (+ any))))) ; indirect object (kept)
  76
  77 (define (cmatch-indir-obj phrase)
  78   (match-to-kwargs indirect-irx phrase))
  79
  80 (define direct-irx
  81   (sre->irregex
  82    `(: (? (: ,preposition (+ space)))  ; possibly a preposition (ignored)
  83        (? (: ,article (+ space)))     ; possibly an article (ignored)
  84        (=> direct-obj (+ any)))))  ; direct object (kept)
  85
  86 (define (cmatch-direct-obj phrase)
  87   (match-to-kwargs direct-irx phrase))
  88
  89 (define (cmatch-empty phrase)
  90   (if (equal? (string-trim phrase) "")
  91       '()
  92       #f))
  93
  94 (define (cmatch-direct-obj-greedy phrase)
  95   ;; Turns out this uses the same semantics as splitting verb/rest
  96   (match (split-verb-and-rest phrase)
  97     ((direct-obj . rest)
  98      (list #:direct-obj direct-obj
  99            #:rest rest))
 100     (#f #f)))
 101
 102 (define (cmatch-greedy phrase)
 103   `(#:phrase ,phrase))
 104
 105 ;; (define say-example "say I really need to get going.")
 106 ;; (define attack-sword-example "hit goblin with sword")
 107 ;; (define attack-simple-example "hit goblin")
 108 ;; (define put-book-on-desk "put the book on the desk")