(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
;; 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")