From: Christopher Allan Webber Date: Mon, 2 May 2016 13:57:27 +0000 (-0500) Subject: Add copyright, clean up parser.scm X-Git-Tag: fosdem-2017~204 X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=commitdiff_plain;h=846235afb4cdf32d98c7db8ebdea5bdfcbc72f45 Add copyright, clean up parser.scm --- diff --git a/mudsync/parser.scm b/mudsync/parser.scm index fb88210..51e07c8 100644 --- a/mudsync/parser.scm +++ b/mudsync/parser.scm @@ -1,3 +1,21 @@ +;;; 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 . + (use-modules (rx irregex) (ice-9 match)) @@ -13,18 +31,6 @@ (irregex-match-names rx-match)) #f))) - -;; definite and indefinite, but not partitive articles -(define article '(or "the" "a" "an")) -(define preposition '(or "with" "in" "on" "out of" "at")) - -(define split-verb-and-rest-irx - (sre->irregex - `(: (* space) (=> verb (+ alphanum)) - (? (+ space) (=> rest (* any)))))) - -;; TODO: we could make this MUCH FASTER if we didn't use irregex -;; for this step! (define (split-verb-and-rest string) (let* ((trimmed (string-trim-both string)) (first-space (string-index trimmed #\space))) @@ -39,17 +45,26 @@ (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")) + (define indirect-irx (sre->irregex - `(: (? (: ,article (+ space))) ; possibly an article (ignored) - (=> direct-object (* any)) ; direct object - (+ space) (=> preposition ,preposition) (+ space) - (? (: ,article (+ space))) - (=> indirect-object (+ any))))) + `(: (? (: ,preposition (+ space))) ; possibly a preposition (ignored) + (? (: ,article (+ space))) ; possibly an article (ignored) + (=> direct-object (* any)) ; direct object (kept) + (+ space) + (=> preposition ,preposition) ; main preposition (kept) + (+ space) + (? (: ,article (+ space))) ; possibly an article (ignored) + (=> indirect-object (+ any))))) ; indirect object (kept) (define direct-irx - `(: (? (: ,article (+ space))) ; possibly an article (ignored) - (=> direct-object (* any)))) ; direct object + (sre->irregex + `(: (? (: ,preposition (+ space))) ; possibly a preposition (ignored) + (? (: ,article (+ space))) ; possibly an article (ignored) + (=> direct-object (* any))))) ; direct object (kept) (define say-example "say I really need to get going.")