Browse code

Worked on xif.i, removed adjective-phrases <AP> (in favour of <adjective>)

Jaidyn Levesque authored on 2020-01-18 17:46:15
Showing 2 changed files
... ...
@@ -1,5 +1,4 @@
1 1
 <S>       ::= <Aux> <NP> <VP> | <VP>  | <NP> <VP>
2
-<NP>      ::= <proper-noun> | <det> <nominal> | <prep> <proper-noun> | <prep> <det> <nominal> | <det> <AP> <nominal> | <prep> <det> <AP> <nominal> | <AP> <proper-noun> | <prep> <AP> <proper-noun>
2
+<NP>      ::= <proper-noun> | <det> <nominal> | <prep> <proper-noun> | <prep> <det> <nominal> | <det> <adjective> <nominal> | <prep> <det> <adjective> <nominal> | <adjective> <proper-noun> | <prep> <adjective> <proper-noun>
3 3
 <VP>      ::= <verb> <NP> |  <verb>  | <verb> <NP> <NP>
4
-<AP>      ::= <adjective>
5 4
 <nominal> ::= <noun> <nominal> | <noun>
... ...
@@ -19,11 +19,10 @@
19 19
 (defpackage :x-if.misc
20 20
   (:use :cl :anaphora)
21 21
   (:nicknames :xif.m)
22
-  (:export :line-cdr :line-car
23
-           :line-length :line-position
24
-           :in-string-p
25
-           :remove-line
26
-           :position-equal))
22
+  (:export :line-cdr :line-car :line-length :line-position
23
+           :in-string-p :remove-line
24
+           :position-equal
25
+           :triangulate))
27 26
 
28 27
 (defpackage :x-if.lexicon
29 28
   (:use :cl :earley-parser)
... ...
@@ -46,8 +45,10 @@
46 45
            :all-mobs
47 46
            :noun→mobs :proper-noun→mobs :adjective→mobs
48 47
            :noun→locations :proper-noun→locations :adjective→locations
48
+           :verb→actions
49 49
            :all-locations
50 50
            :id :description
51
+           :indirect-object-required-p :direct-object-required-p
51 52
            :nouns :proper-nouns :adjectives
52 53
            :max-children :weight :hp :max-hp
53 54
            :children :parent
... ...
@@ -59,12 +60,14 @@
59 60
   (:export :parse
60 61
            :noun-phrases :det :prep :proper-noun :noun-name :det :prep
61 62
            :nominal-phrase :noun
62
-           :verb-phrase :verb :direct-object :indirect
63
+           :adjective-phrase :adjective
64
+           :verb-phrase :verb :direct-object :indirect-object
63 65
            :the-action :the-subject))
64 66
 
65 67
 (defpackage :x-if.interpret
66 68
   (:use :cl)
67
-  (:nicknames :xif.i))
69
+  (:nicknames :xif.i)
70
+  (:export :noun-phrase→game-objects))
68 71
 
69 72
 (defpackage :x-if.client
70 73
   (:use :cl :xif.e :bknr.datastore)
... ...
@@ -145,6 +148,11 @@
145 148
   "Return a tree's verb-phrase."
146 149
   (assoc "VP" (cdr tree) :test #'equal))
147 150
 
151
+;; TREE → TREE_OF_ADJECTIVE_PHRASE
152
+(defun adjective-phrase (tree)
153
+  "Return the adjective-phrase of a given tree."
154
+  (assoc "AP" (cdr tree) :test #'equal))
155
+
148 156
 ;; TREE_OF_VERB_PHRASE → TREE_OF_NOUN_PHRASE
149 157
 (defun direct-object (verb-phrase)
150 158
   "Return a verb-phrase's direct object."
... ...
@@ -196,6 +204,11 @@
196 204
     (noun (nominal noun-phrase))
197 205
     (proper-noun noun-phrase)))
198 206
 
207
+;; TREE_OF_NOUN_PHRASE → STRING
208
+(defun adjective (noun-phrase)
209
+  "Return the name of a noun's nominal phrase."
210
+  (cadr (assoc "noun" (cdr nominal-phrase) :test #'equal)))
211
+
199 212
 ;; —————————————————————————————————————
200 213
 
201 214
 ;; FULL_TREE → TREE_OF_VERB_PHRASE
... ...
@@ -362,16 +375,16 @@ an :class <det>
362 375
 ;; TODO: Obviously, if there are multiple matches it should error TF out
363 376
 ;; and die, and... and... AHHHH good luck ;w;
364 377
 
365
-;; TREE_OF_STATEMENT → LIST || (SYMBOL SYMBOL)
378
+;; TREE_OF_STATEMENT → LIST || SYMBOL
366 379
 (defmethod interpret ((statement-tree list))
367 380
   "Actually interpret a parsed statement-tree; returns a list with the
368 381
   applicable function-name for the action, and the objects for the direct and
369 382
   indirect objects, as well as the subject."
370
-  (let* ((subject  (or (the-subject statement-tree) (xif.e:get-player)))
383
+  (let* ((subject  (aif (the-subject statement-tree) (name→mobs it) "I")
371 384
          (action   (the-action statement-tree))
372 385
          (verb     (verb action))
373
-         (indirect (xif.e:noun→game-objects (indirect-object action)))
374
-         (direct   (xif.e:noun→game-objects (direct-object action))))
386
+         (indirect (indirect-object action))
387
+         (direct   (direct-object action))))
375 388
     (cond ((not (xif.l:action-p verb))
376 389
            "That… that's just not a thing people do.")
377 390
           ((and (not indirect) (xif.l:action-indirect-required-p verb))
... ...
@@ -382,8 +395,90 @@ an :class <det>
382 395
            (list (xif.l:action-function verb)
383 396
                  :subject subject :indirect indirect :direct direct)))))
384 397
 
385
-           
386
-           
398
+;; SYMBOL → SYMBOL SYMBOL
399
+(defmethod interpret ((error symbol))
400
+  "If passed on an error-symbol by #'xif.p:parse, then return that symbol.
401
+  Note: If you need to determine if a returned error is from parsing (xif.p) or
402
+  interpreting (xif.i), check the symbol's package (#'symbol-package)."
403
+  (values error 'PARSE-DIE))
404
+
405
+;; LIST → GAME-OBJECT
406
+(defun statement→subject-object (statement-tree)
407
+  "Return the the subject's object of a given statement."
408
+  (aif (xif.p:the-subject statement-tree)
409
+       (car (noun-phrase→game-objects it))
410
+       (xif.e:get-player)))
411
+
412
+;; LIST → QUEUED-ACTION
413
+(defun statement→queued-action (statement-tree)
414
+  "Interpret a earley-tree parsed statement into a queued-action for
415
+  later execution."
416
+  (verb-phrase→queued-action
417
+   (xif.p:the-action statement-tree)
418
+   :subject (statement→subject-object statement-tree)))
419
+
420
+;; LIST :OBJECT → QUEUED-ACTION
421
+(defun verb-phrase→queued-action (verb-phrase &key (subject-object nil))
422
+  "Interpret a earley-parsed verb-phrase into an queued-action object."
423
+  (awhen (verb-phrase→action verb-phrase)
424
+    (make-instance 'xif.e::queued-action
425
+      :function-name (slot-value 'function-name it)
426
+      :indirect-object
427
+                   (noun-phrase→game-objects (xif.p:indirect-object verb-phrase)
428
+                                               :subject subject-object)
429
+      :direct-object
430
+                   (noun-phrase→game-objects (xif.p:direct-object verb-phrase)
431
+                                               :subject subject-object))))
432
+
433
+;; LIST → ACTION
434
+(defun verb-phrase→action (verb-phrase)
435
+  "Return the action congruent with the given verb-phrase— that is, the
436
+  indirect/direct options are compatible, and the verb matches."
437
+  (let ((verb     (verb verb-phrase))
438
+        (indirect (noun-phrase→game-objects (xif.p:indirect-object verb-phrase)))
439
+        (direct   (noun-phrase→game-objects (xif.p:direct-object verb-phrase)))
440
+        (actions  (xif.e:verb→actions verb)))
441
+    (loop :for action :in actions
442
+          :if (congruent-vp-action-p action verb indirect direct)
443
+          :return action)))
444
+
445
+;; ACTION STRING VARYING VARYING → BOOLEAN
446
+(defun congruent-vp-action-p (action verb indirect direct)
447
+  "Return whether or not the given indirect and direct object values are
448
+  congruent with a given 'action' object. That is, if there is a NIL indirect
449
+  object (or direct) where there ought not to be, the action and given
450
+  verb-phrase are incompatible. (This allows multiple actions with the same
451
+  to exist, so long as the indirect and direct arguments are compatible)."
452
+  (flet ((congruent-indirect-p (action indirect)
453
+           (or (and (not indirect) (not (xif.e:indirect-object-required-p action)))
454
+               (and indirect       (xif.e:indirect-object-required-p action))))
455
+         (congruent-direct-p (action direct)
456
+           (or (and (not direct) (not (xif.e:direct-object-required-p action)))
457
+               (and direct       (xif.e:direct-object-required-p action)))))
458
+    (and (congurent-indirect-p action indirect)
459
+         (congruent-direct-p action direct))))
460
+
461
+
462
+;; LIST :GAME-OBJECT → LIST_OF_GAME-OBJECT(S)
463
+(defun noun-phrase→game-objects (noun-phrase &key (subject nil))
464
+  "Returns game-object(s) that correspond to the given noun-phrase, using
465
+  the proper-noun/noun and adjective in the phrase. If passed the statement's
466
+  subject (likely player character), it will also narrow down the results by
467
+  matching results' parents to the subject's parent. (Presumably the parent
468
+  would ultimately be the same room as the player.)"
469
+  (let ((adjective (xif.p:adjective noun-phrase))
470
+        (noun (xif.p:noun noun-phrase))
471
+        (proper-noun (xif.p:proper-noun noun-phrase)))
472
+    (alet
473
+      (xif.m:triangulate (xif.e:adjective→game-objects adjective)
474
+                   (xif.e:noun→game-objects noun)
475
+                   (xif.e:proper-noun→game-objects proper-noun))
476
+      (if (and subject (< 1 (length it)))
477
+        (xif.m:triangulate it (parent→game-objects (xif.e:parent subject)))
478
+        it))))
479
+                     
480
+
481
+
387 482
 
388 483
 ;; —————————————————————————————————————
389 484
 ;; X-IF.ENVIRONMENT
... ...
@@ -469,9 +564,11 @@ an :class <det>
469 564
        ; :index-type bknr.datastore::hash-index
470 565
        ; :index-reader verb→action
471 566
    (direct-object-p :read
472
-       :initarg :direct-object-p :initform nil :reader direct-object-required-p)
567
+       :initarg :direct-object-p :initform nil
568
+                    :reader direct-object-required-p)
473 569
    (indirect-object-p :read
474
-       :initarg :indirect-object-p :initform nil :reader indirect-object-required-p)))
570
+       :initarg :indirect-object-p :initform nil
571
+                      :reader indirect-object-required-p)))
475 572
 
476 573
 
477 574
 ;; For tuŝeblaj ACTIONS; generated by :x-if.interpret from interpreting a user
... ...
@@ -495,12 +592,6 @@ an :class <det>
495 592
 ;; and actions will be added when an object is initialized; deleted
496 593
 ;; when destroyed.
497 594
 
498
-;; TODO
499
-;; Nuance is necessary; if a noun/adjective/etc is used for other objects,
500
-;; it shouldn't be added again nor deleted from the lexicon when adding a new
501
-;; object or deleting one, respectively.
502
-;; For now, it's assumed all words are new, and are all used by one object.
503
-
504 595
 (defmethod initialize-instance :after ((game-object game-object) &key)
505 596
   (xif.l:add-game-object-words game-object))
506 597
 
... ...
@@ -705,8 +796,8 @@ an :class <det>
705 796
   (make-instance 'xif.e::action :function-name 'xif.c::examine :direct-object-p T
706 797
                  :verbs '("examine" "look" "view"))
707 798
   
708
-  (link (get-player) (id→game-object 0))
709
-  (link (id→game-object 100) (id→game-object 0)))
799
+  (xif.e:link (xif.e:get-player) (xif.e:id→game-object 0))
800
+  (xif.e:link (xif.e:id→game-object 101) (xif.e:id→game-object 0)))
710 801
 
711 802
 
712 803
 
... ...
@@ -813,7 +904,21 @@ an :class <det>
813 904
         (remove (nth it lines) lines :test #'equal :count 1))
814 905
        (lines-string list)))
815 906
 
816
-;; ITEM LIST → NUMBER
907
+;; VARYING LIST → NUMBER
817 908
 (defun position-equal (item list)
818 909
   "Literally just #'cl:position but with the test equal."
819 910
   (position item list :test #'equal))
911
+
912
+
913
+;; VARYING LIST :FUNCTION → BOOLEAN
914
+(defun lacking (item list &key (test #'equal))
915
+  "Return whether or not the given item is not in a list."
916
+  (not (position item list :test test)))
917
+
918
+;; LIST … LIST → LIST
919
+(defun triangulate (&rest victims)
920
+  "Return a list of values that are within each passed list."
921
+  (loop :for car-item :in (car victims)
922
+        :if (lacking nil
923
+              (mapcar (lambda (victim) (position car-item victim)) victims))
924
+        :collect car-item))