1 ;;; Mudsync --- Live hackable MUD
2 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
4 ;;; This file is part of Mudsync.
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.
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.
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/>.
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)
25 #:export (match-to-kwargs
31 cmatch-direct-obj-greedy
35 (define (match-to-kwargs irx string)
36 (let ((rx-match (irregex-match irx string)))
40 (((match-part . idx) prev)
41 (cons (symbol->keyword match-part)
42 (cons (irregex-match-substring
46 (irregex-match-names rx-match))
49 (define (split-verb-and-rest string)
50 (let* ((trimmed (string-trim-both string))
51 (first-space (string-index trimmed #\space)))
53 (cons (substring trimmed 0 first-space)
54 (substring trimmed (+ 1 first-space)))
57 ;; @@: Not currently used
58 ;; Borrowed from irregex.scm
60 '(seq #\" (* (or (~ #\\ #\") (seq #\\ any))) #\"))
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" "as" "to"
69 `(: (? (: ,preposition (+ space))) ; possibly a preposition (ignored)
70 (? (: ,article (+ space))) ; possibly an article (ignored)
71 (=> direct-obj (* any)) ; direct object (kept)
73 (=> preposition ,preposition) ; main preposition (kept)
75 (? (: ,article (+ space))) ; possibly an article (ignored)
76 (=> indir-obj (+ any))))) ; indirect object (kept)
78 (define (cmatch-indir-obj phrase)
79 (match-to-kwargs indirect-irx phrase))
83 `(: (? (: ,preposition (+ space))) ; possibly a preposition (ignored)
84 (? (: ,article (+ space))) ; possibly an article (ignored)
85 (=> direct-obj (+ any))))) ; direct object (kept)
87 (define (cmatch-direct-obj phrase)
88 (match-to-kwargs direct-irx phrase))
90 (define (cmatch-empty phrase)
91 (if (equal? (string-trim phrase) "")
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)
99 (list #:direct-obj direct-obj
103 (define (cmatch-greedy phrase)
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")