X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fparser.scm;h=034b22f3f2f04dc8f5e2bc609658241e5b9fbd43;hp=3ad5b73fe757905cce8f12de2da968a0c05a68f8;hb=095dde9158621c8bb3d690feaa0d525a76342eb9;hpb=d13325f5f6eba20c808636948432dcdff4e138f6

diff --git a/mudsync/parser.scm b/mudsync/parser.scm
index 3ad5b73..034b22f 100644
--- a/mudsync/parser.scm
+++ b/mudsync/parser.scm
@@ -19,28 +19,40 @@
 (define-module (mudsync parser)
   #:use-module (rx irregex)
   #:use-module (ice-9 match)
-  #:use-module (srfi srfi-9))
+  #: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
-        (map (match-lambda
-               ((match-part . idx)
-                (cons match-part
-                      (irregex-match-substring
-                       rx-match idx))))
-             (irregex-match-names 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
-        `((verb . ,(substring trimmed 0 first-space))
-          (rest . ,(substring trimmed (+ 1 first-space))))
-        `((verb . ,trimmed)
-          (rest . "")))))
+        (cons (substring trimmed 0 first-space)
+              (substring trimmed (+ 1 first-space)))
+        (cons trimmed ""))))
 
 ;; @@: Not currently used
 ;; Borrowed from irregex.scm
@@ -49,42 +61,49 @@
 
 ;; definite and indefinite, but not partitive articles
 (define article '(or "the" "a" "an"))
-(define preposition '(or "with" "in" "on" "out of" "at"))
+(define preposition '(or "with" "in" "on" "out of" "at" "as" "to"
+                         "about"))
 
 (define indirect-irx
   (sre->irregex
-   `(: (? (: ,preposition (+ space)))  ; possibly a preposition (ignored)
+   `(: (? (: ,preposition (+ space)))  ; possibly a preposition
        (? (: ,article (+ space)))      ; possibly an article (ignored)
-       (=> direct-object (* any))      ; direct object (kept)
+       (=> direct-obj (* any))      ; direct object (kept)
        (+ space)
        (=> preposition ,preposition)   ; main preposition (kept)
        (+ space)
        (? (: ,article (+ space)))      ; possibly an article (ignored)
-       (=> indirect-object (+ any))))) ; indirect object (kept)
+       (=> indir-obj (+ any))))) ; indirect object (kept)
 
-(define (indirect-matcher phrase)
+(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-object (* any)))))  ; direct object (kept)
+       (=> direct-obj (+ any)))))  ; direct object (kept)
 
-(define (direct-matcher phrase)
+(define (cmatch-direct-obj phrase)
   (match-to-kwargs direct-irx 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")
+(define (cmatch-empty phrase)
+  (if (equal? (string-trim phrase) "")
+      '()
+      #f))
 
-(define-record-type <command-handler>
-  (make-command-handler matcher should-handle action)
-  command-handler?
-  (matcher command-handler-matcher)
-  (should-handle command-handler-should-handle?)
-  (action command-handler-action))
+(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 command-handler make-command-handler)
+(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")