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" "inside" "on" "out" "out of"
65 "at" "as" "to" "about" "from"))
69 `(: (? (: ,preposition (+ space))) ; possibly a preposition
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")