;;; Mudsync --- Live hackable MUD ;;; Copyright © 2016 Christopher Allan Webber ;;; ;;; 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 . (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" "on" "out of" "at" "as" "to")) (define indirect-irx (sre->irregex `(: (? (: ,preposition (+ space))) ; possibly a preposition (ignored) (? (: ,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")